From 20ae742e391a8db65e203213a124126ce8621fe1 Mon Sep 17 00:00:00 2001 From: Pierre-Marie Pédrot Date: Tue, 25 Aug 2015 23:29:52 +0200 Subject: Replacing old-style preferences in CoqIDE. There is no remaining global preference record anymore, every preference is now defined in the new event-based style. --- ide/preferences.ml | 297 +++++++++++++++++++++++------------------------------ 1 file changed, 130 insertions(+), 167 deletions(-) (limited to 'ide/preferences.ml') diff --git a/ide/preferences.ml b/ide/preferences.ml index 74ca6ca83..9432cdb22 100644 --- a/ide/preferences.ml +++ b/ide/preferences.ml @@ -63,6 +63,51 @@ end (** Useful marshallers *) +let mod_to_str m = + match m with + | `MOD1 -> "" + | `MOD2 -> "" + | `MOD3 -> "" + | `MOD4 -> "" + | `MOD5 -> "" + | `CONTROL -> "" + | `SHIFT -> "" + | `HYPER -> "" + | `META -> "" + | `RELEASE -> "" + | `SUPER -> "" + | `BUTTON1| `BUTTON2| `BUTTON3| `BUTTON4| `BUTTON5| `LOCK -> "" + +let mod_list_to_str l = List.fold_left (fun s m -> (mod_to_str m)^s) "" l + +let str_to_mod_list s = snd (GtkData.AccelGroup.parse s) + +type project_behavior = Ignore_args | Append_args | Subst_args + +let string_of_project_behavior = function + |Ignore_args -> "ignored" + |Append_args -> "appended to arguments" + |Subst_args -> "taken instead of arguments" + +let project_behavior_of_string s = + if s = "taken instead of arguments" then Subst_args + else if s = "appended to arguments" then Append_args + else Ignore_args + +type inputenc = Elocale | Eutf8 | Emanual of string + +let string_of_inputenc = function + |Elocale -> "LOCALE" + |Eutf8 -> "UTF-8" + |Emanual s -> s + +let inputenc_of_string s = + (if s = "UTF-8" then Eutf8 + else if s = "LOCALE" then Elocale + else Emanual s) + +let use_default_doc_url = "(automatic)" + module Repr = struct @@ -72,6 +117,18 @@ object method into = function [s] -> Some s | _ -> None end +let string_pair : (string * string) repr = +object + method from (s1, s2) = [s1; s2] + method into = function [s1; s2] -> Some (s1, s2) | _ -> None +end + +let string_list : string list repr = +object + method from s = s + method into s = Some s +end + let bool : bool repr = object method from s = [string_of_bool s] @@ -98,6 +155,14 @@ object | _ -> None end +let custom (from : 'a -> string) (into : string -> 'a) : 'a repr = +object + method from x = try [from x] with _ -> [] + method into = function + | [s] -> (try Some (into s) with _ -> None) + | _ -> None +end + end let get_config_file name = @@ -114,50 +179,6 @@ let loaded_accel_file = try get_config_file "coqide.keys" with Not_found -> Filename.concat (Option.default "" (Glib.get_home_dir ())) ".coqide.keys" -let mod_to_str m = - match m with - | `MOD1 -> "" - | `MOD2 -> "" - | `MOD3 -> "" - | `MOD4 -> "" - | `MOD5 -> "" - | `CONTROL -> "" - | `SHIFT -> "" - | `HYPER -> "" - | `META -> "" - | `RELEASE -> "" - | `SUPER -> "" - | `BUTTON1| `BUTTON2| `BUTTON3| `BUTTON4| `BUTTON5| `LOCK -> "" - -let mod_list_to_str l = List.fold_left (fun s m -> (mod_to_str m)^s) "" l - -let str_to_mod_list s = snd (GtkData.AccelGroup.parse s) - -type project_behavior = Ignore_args | Append_args | Subst_args - -let string_of_project_behavior = function - |Ignore_args -> "ignored" - |Append_args -> "appended to arguments" - |Subst_args -> "taken instead of arguments" - -let project_behavior_of_string s = - if s = "taken instead of arguments" then Subst_args - else if s = "appended to arguments" then Append_args - else Ignore_args - -type inputenc = Elocale | Eutf8 | Emanual of string - -let string_of_inputenc = function - |Elocale -> "LOCALE" - |Eutf8 -> "UTF-8" - |Emanual s -> s - -let inputenc_of_string s = - (if s = "UTF-8" then Eutf8 - else if s = "LOCALE" then Elocale - else Emanual s) - - (** Hooks *) let refresh_editor_hook = ref (fun () -> ()) @@ -197,10 +218,12 @@ let auto_save = let auto_save_delay = new preference ~name:["auto_save_delay"] ~init:10000 ~repr:Repr.(int) -(* let auto_save_name = - new preference ~name:["auto_save_name"] ~init: ~repr:Repr.() *) -(* let read_project = - new preference ~name:["read_project"] ~init: ~repr:Repr.() *) +let auto_save_name = + new preference ~name:["auto_save_name"] ~init:("#","#") ~repr:Repr.(string_pair) + +let read_project = + let repr = Repr.custom string_of_project_behavior project_behavior_of_string in + new preference ~name:["read_project"] ~init:Append_args ~repr let project_file_name = new preference ~name:["project_file_name"] ~init:"_CoqProject" ~repr:Repr.(string) @@ -208,10 +231,14 @@ let project_file_name = let project_path = new preference ~name:["project_path"] ~init:None ~repr:Repr.(option string) -(* let encoding = - new preference ~name:["encoding"] ~init: ~repr:Repr.() *) -(* let automatic_tactics = - new preference ~name:["automatic_tactics"] ~init: ~repr:Repr.() *) +let encoding = + let repr = Repr.custom string_of_inputenc inputenc_of_string in + let init = if Sys.os_type = "Win32" then Eutf8 else Elocale in + new preference ~name:["encoding"] ~init ~repr + +let automatic_tactics = + let init = ["trivial"; "tauto"; "auto"; "omega"; "auto with *"; "intuition" ] in + new preference ~name:["automatic_tactics"] ~init ~repr:Repr.(string_list) let cmd_print = new preference ~name:["cmd_print"] ~init:"lpr" ~repr:Repr.(string) @@ -231,14 +258,35 @@ let modifier_for_display = let modifiers_valid = new preference ~name:["modifiers_valid"] ~init:"" ~repr:Repr.(string) -(* let cmd_browse = - new preference ~name:["cmd_browse"] ~init: ~repr:Repr.() *) -(* let cmd_editor = - new preference ~name:["cmd_editor"] ~init: ~repr:Repr.() *) -(* let text_font = - new preference ~name:["text_font"] ~init: ~repr:Repr.() *) -(* let doc_url = - new preference ~name:["doc_url"] ~init: ~repr:Repr.() *) +let cmd_browse = + new preference ~name:["cmd_browse"] ~init:Flags.browser_cmd_fmt ~repr:Repr.(string) + +let cmd_editor = + let init = if Sys.os_type = "Win32" then "NOTEPAD %s" else "emacs %s" in + new preference ~name:["cmd_editor"] ~init ~repr:Repr.(string) + +let text_font = + let init = match Coq_config.gtk_platform with + | `QUARTZ -> "Arial Unicode MS 11" + | _ -> "Monospace 10" + in + new preference ~name:["text_font"] ~init ~repr:Repr.(string) + +let doc_url = +object + inherit [string] preference + ~name:["doc_url"] ~init:Coq_config.wwwrefman ~repr:Repr.(string) + as super + + method set v = + if not (Flags.is_standard_doc_url v) && + v <> use_default_doc_url && + (* Extra hack to support links to last released doc version *) + v <> Coq_config.wwwcoq ^ "doc" && + v <> Coq_config.wwwcoq ^ "doc/" + then super#set v + +end let library_url = new preference ~name:["library_url"] ~init:Coq_config.wwwstdlib ~repr:Repr.(string) @@ -333,73 +381,15 @@ let nanoPG = (** Old style preferences *) -type pref = - { - - mutable auto_save_name : string * string; - - mutable read_project : project_behavior; - - mutable encoding : inputenc; - - mutable automatic_tactics : string list; - - mutable cmd_browse : string; - mutable cmd_editor : string; - - mutable text_font : Pango.font_description; - - mutable doc_url : string; - -} - -let use_default_doc_url = "(automatic)" - -let current = { - - auto_save_name = "#","#"; - - read_project = Append_args; - - encoding = if Sys.os_type = "Win32" then Eutf8 else Elocale; - - automatic_tactics = ["trivial"; "tauto"; "auto"; "omega"; - "auto with *"; "intuition" ]; - - cmd_browse = Flags.browser_cmd_fmt; - cmd_editor = if Sys.os_type = "Win32" then "NOTEPAD %s" else "emacs %s"; - -(* text_font = Pango.Font.from_string "sans 12";*) - text_font = Pango.Font.from_string (match Coq_config.gtk_platform with - |`QUARTZ -> "Arial Unicode MS 11" - |_ -> "Monospace 10"); - - doc_url = Coq_config.wwwrefman; - } - let save_pref () = if not (Sys.file_exists (Minilib.coqide_config_home ())) then Unix.mkdir (Minilib.coqide_config_home ()) 0o700; let () = try GtkData.AccelMap.save accel_file with _ -> () in - let p = current in let add = Util.String.Map.add in let (++) x f = f x in let fold key obj accu = add key (obj.get ()) accu in (Util.String.Map.fold fold !preferences Util.String.Map.empty) ++ - add "auto_save_name" [fst p.auto_save_name; snd p.auto_save_name] ++ - - add "project_options" [string_of_project_behavior p.read_project] ++ - - add "encoding" [string_of_inputenc p.encoding] ++ - - add "automatic_tactics" p.automatic_tactics ++ - add "cmd_browse" [p.cmd_browse] ++ - add "cmd_editor" [p.cmd_editor] ++ - - add "text_font" [Pango.Font.to_string p.text_font] ++ - - add "doc_url" [p.doc_url] ++ Config_lexer.print_file pref_file let load_pref () = @@ -410,33 +400,7 @@ let load_pref () = try (Util.String.Map.find name !preferences).set v with _ -> () in - let () = Util.String.Map.iter iter m in - let np = current in - let set k f = try let v = Util.String.Map.find k m in f v with _ -> () in - let set_hd k f = set k (fun v -> f (List.hd v)) in - let set_pair k f = set k (function [v1;v2] -> f v1 v2 | _ -> raise Exit) in - let set_command_with_pair_compat k f = - set k (function [v1;v2] -> f (v1^"%s"^v2) | [v] -> f v | _ -> raise Exit) - in - set_pair "auto_save_name" (fun v1 v2 -> np.auto_save_name <- (v1,v2)); - set_hd "encoding" (fun v -> np.encoding <- (inputenc_of_string v)); - set_hd "project_options" - (fun v -> np.read_project <- (project_behavior_of_string v)); - set "automatic_tactics" - (fun v -> np.automatic_tactics <- v); - set_command_with_pair_compat "cmd_browse" (fun v -> np.cmd_browse <- v); - set_command_with_pair_compat "cmd_editor" (fun v -> np.cmd_editor <- v); - set_hd "text_font" (fun v -> np.text_font <- Pango.Font.from_string v); - set_hd "doc_url" (fun v -> - if not (Flags.is_standard_doc_url v) && - v <> use_default_doc_url && - (* Extra hack to support links to last released doc version *) - v <> Coq_config.wwwcoq ^ "doc" && - v <> Coq_config.wwwcoq ^ "doc/" - then - (* ("Warning: Non-standard URL for Coq documentation in preference file: "^v);*) - np.doc_url <- v); - () + Util.String.Map.iter iter m let pstring name p = string ~f:p#set name p#get let pbool name p = bool ~f:p#set name p#get @@ -465,14 +429,13 @@ let configure ?(apply=(fun () -> ())) () = "Goal (∃n : nat, n ≤ 0)∧(∀x,y,z, x∈y⋃z↔x∈y∨x∈z)."; box#pack ~expand:true w#coerce; ignore (w#misc#connect#realize - ~callback:(fun () -> w#set_font_name - (Pango.Font.to_string current.text_font))); + ~callback:(fun () -> w#set_font_name text_font#get)); custom ~label:"Fonts for text" box (fun () -> let fd = w#font_name in - current.text_font <- (Pango.Font.from_string fd) ; + text_font#set fd ; (* Format.printf "in config_font: current.text_font = %s@." (Pango.Font.to_string current.text_font); *) @@ -601,13 +564,13 @@ let configure ?(apply=(fun () -> ())) () = let encodings = combo "File charset encoding " - ~f:(fun s -> current.encoding <- (inputenc_of_string s)) + ~f:(fun s -> encoding#set (inputenc_of_string s)) ~new_allowed: true - ("UTF-8"::"LOCALE":: match current.encoding with + ("UTF-8"::"LOCALE":: match encoding#get with |Emanual s -> [s] |_ -> [] ) - (string_of_inputenc current.encoding) + (string_of_inputenc encoding#get) in let source_style = @@ -628,12 +591,12 @@ let configure ?(apply=(fun () -> ())) () = let read_project = combo "Project file options are" - ~f:(fun s -> current.read_project <- project_behavior_of_string s) + ~f:(fun s -> read_project#set (project_behavior_of_string s)) ~editable:false [string_of_project_behavior Subst_args; string_of_project_behavior Append_args; string_of_project_behavior Ignore_args] - (string_of_project_behavior current.read_project) + (string_of_project_behavior read_project#get) in let project_file_name = pstring "Default name for project file" project_file_name in let modifier_for_tactics = @@ -656,11 +619,11 @@ let configure ?(apply=(fun () -> ())) () = combo ~help:"(%s for file name)" "External editor" - ~f:(fun s -> current.cmd_editor <- s) + ~f:cmd_editor#set ~new_allowed: true - (predefined@[if List.mem current.cmd_editor predefined then "" - else current.cmd_editor]) - current.cmd_editor + (predefined@[if List.mem cmd_editor#get predefined then "" + else cmd_editor#get]) + cmd_editor#get in let cmd_browse = let predefined = [ @@ -673,11 +636,11 @@ let configure ?(apply=(fun () -> ())) () = combo ~help:"(%s for url)" "Browser" - ~f:(fun s -> current.cmd_browse <- s) + ~f:cmd_browse#set ~new_allowed: true - (predefined@[if List.mem current.cmd_browse predefined then "" - else current.cmd_browse]) - current.cmd_browse + (predefined@[if List.mem cmd_browse#get predefined then "" + else cmd_browse#get]) + cmd_browse#get in let doc_url = let predefined = [ @@ -687,11 +650,11 @@ let configure ?(apply=(fun () -> ())) () = ] in combo "Manual URL" - ~f:(fun s -> current.doc_url <- s) + ~f:doc_url#set ~new_allowed: true - (predefined@[if List.mem current.doc_url predefined then "" - else current.doc_url]) - current.doc_url in + (predefined@[if List.mem doc_url#get predefined then "" + else doc_url#get]) + doc_url#get in let library_url = let predefined = [ "file://"^(List.fold_left Filename.concat (Coq_config.docdir) ["html";"stdlib";""]); @@ -707,10 +670,10 @@ let configure ?(apply=(fun () -> ())) () = in let automatic_tactics = strings - ~f:(fun l -> current.automatic_tactics <- l) + ~f:automatic_tactics#set ~add:(fun () -> [""]) "Wizard tactics to try in order" - current.automatic_tactics + automatic_tactics#get in -- cgit v1.2.3