Imported Upstream version 8.8.2upstream/8.8.2

1 files changed, 28 insertions, 18 deletions

diff --git a/ide/preferences.ml b/ide/preferences.ml
index f0fd45d7..11aaf6e8 100644
--- a/ide/preferences.ml
+++ b/ide/preferences.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Configwin
@@ -73,8 +75,8 @@ end
 let stick (pref : 'a preference) (obj : #GObj.widget as 'obj)
   (cb : 'a -> unit) =
   let _ = cb pref#get in
-  let p_id = pref#connect#changed (fun v -> cb v) in
-  let _ = obj#misc#connect#destroy (fun () -> pref#connect#disconnect p_id) in
+  let p_id = pref#connect#changed ~callback:(fun v -> cb v) in
+  let _ = obj#misc#connect#destroy ~callback:(fun () -> pref#connect#disconnect p_id) in
   ()
 
 (** Useful marshallers *)
@@ -314,7 +316,7 @@ let attach_modifiers (pref : string preference) prefix =
     in
     GtkData.AccelMap.foreach change
   in
-  pref#connect#changed cb
+  pref#connect#changed ~callback:cb
 
 let modifier_for_navigation =
   new preference ~name:["modifier_for_navigation"] ~init:"<Control>" ~repr:Repr.(string)
@@ -360,7 +362,7 @@ object
     ~name:["doc_url"] ~init:Coq_config.wwwrefman ~repr:Repr.(string)
     as super
 
-  method set v =
+  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 *)
@@ -407,11 +409,15 @@ let opposite_tabs =
 let background_color =
   new preference ~name:["background_color"] ~init:"cornsilk" ~repr:Repr.(string)
 
+let attach_tag (pref : string preference) (tag : GText.tag) f =
+  tag#set_property (f pref#get);
+  pref#connect#changed ~callback:(fun c -> tag#set_property (f c))
+
 let attach_bg (pref : string preference) (tag : GText.tag) =
-  pref#connect#changed (fun c -> tag#set_property (`BACKGROUND c))
+  attach_tag pref tag (fun c -> `BACKGROUND c)
 
 let attach_fg (pref : string preference) (tag : GText.tag) =
-  pref#connect#changed (fun c -> tag#set_property (`FOREGROUND c))
+  attach_tag pref tag (fun c -> `FOREGROUND c)
 
 let processing_color =
   new preference ~name:["processing_color"] ~init:"light blue" ~repr:Repr.(string)
@@ -468,7 +474,7 @@ let create_tag name default =
   let iter table =
     let tag = GText.tag ~name () in
     table#add tag#as_tag;
-    ignore (pref#connect#changed (fun _ -> set_tag tag));
+    ignore (pref#connect#changed ~callback:(fun _ -> set_tag tag));
     set_tag tag;
   in
   List.iter iter [Tags.Script.table; Tags.Proof.table; Tags.Message.table];
@@ -601,8 +607,8 @@ object (self)
     box#pack italic#coerce;
     box#pack underline#coerce;
     let cb but obj = obj#set_sensitive (not but#active) in
-    let _ = fg_unset#connect#toggled (fun () -> cb fg_unset fg_color#misc) in
-    let _ = bg_unset#connect#toggled (fun () -> cb bg_unset bg_color#misc) in
+    let _ = fg_unset#connect#toggled ~callback:(fun () -> cb fg_unset fg_color#misc) in
+    let _ = bg_unset#connect#toggled ~callback:(fun () -> cb bg_unset bg_color#misc) in
     ()
 
 end
@@ -643,6 +649,10 @@ let pmodifiers ?(all = false) name p = modifiers
   name
   (str_to_mod_list p#get)
 
+[@@@ocaml.warning "-3"]       (* String.uppercase_ascii since 4.03.0 GPR#124 *)
+let uppercase = String.uppercase
+[@@@ocaml.warning "+3"]
+
 let configure ?(apply=(fun () -> ())) () =
   let cmd_coqtop =
     string
@@ -692,7 +702,7 @@ let configure ?(apply=(fun () -> ())) () =
         ~color:(Tags.color_of_string pref#get)
         ~packing:(table#attach ~left:1 ~top:i) ()
       in
-      let _ = button#connect#color_set begin fun () ->
+      let _ = button#connect#color_set ~callback:begin fun () ->
         pref#set (Tags.string_of_color button#color)
       end in
       let reset _ =
@@ -754,7 +764,7 @@ let configure ?(apply=(fun () -> ())) () =
     let button text (pref : bool preference) =
       let active = pref#get in
       let but = GButton.check_button ~label:text ~active ~packing:box#pack () in
-      ignore (but#connect#toggled (fun () -> pref#set but#active))
+      ignore (but#connect#toggled ~callback:(fun () -> pref#set but#active))
     in
     let () = button "Dynamic word wrap" dynamic_word_wrap in
     let () = button "Show line number" show_line_number in
@@ -918,7 +928,7 @@ let configure ?(apply=(fun () -> ())) () =
   in
   let doc_url =
     let predefined = [
-      "file://"^(List.fold_left Filename.concat (Coq_config.docdir) ["refman";"html"]);
+      "file://"^(List.fold_left Filename.concat (Envars.docdir ()) ["refman";"html"]);
       Coq_config.wwwrefman;
       use_default_doc_url
     ] in
@@ -931,7 +941,7 @@ let configure ?(apply=(fun () -> ())) () =
       doc_url#get in
   let library_url =
     let predefined = [
-      "file://"^(List.fold_left Filename.concat (Coq_config.docdir) ["stdlib";"html"]);
+      "file://"^(List.fold_left Filename.concat (Envars.docdir ()) ["stdlib";"html"]);
       Coq_config.wwwstdlib
     ] in
     combo
@@ -969,7 +979,7 @@ let configure ?(apply=(fun () -> ())) () =
     let k =
       if Int.equal (CString.length k) 1 && Util.is_letter k.[0] then k
       else "" in
-    let k = CString.uppercase k in
+    let k = uppercase k in
       [q, k]
   in