Added a background color configuration option in CoqIDE.

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@15127 85f007b7-540e-0410-9357-904b9bb8a0f7

1 files changed, 21 insertions, 4 deletions

diff --git a/ide/preferences.ml b/ide/preferences.ml
index 80caefa5f..828294c33 100644
--- a/ide/preferences.ml
+++ b/ide/preferences.ml
@@ -93,6 +93,7 @@ type pref =
       mutable vertical_tabs : bool;
       mutable opposite_tabs : bool;
 
+      mutable background_color : string;
       mutable processing_color : string;
       mutable processed_color : string;
 
@@ -158,6 +159,7 @@ let (current:pref ref) =
     vertical_tabs = false;
     opposite_tabs = false;
 
+    background_color = "cornsilk";
     processed_color = "light green";
     processing_color = "light blue";
 
@@ -166,6 +168,8 @@ let (current:pref ref) =
 
 let change_font = ref (fun f -> ())
 
+let change_background_color = ref (fun clr -> ())
+
 let show_toolbar = ref (fun x -> ())
 
 let auto_complete = ref (fun x -> ())
@@ -228,6 +232,7 @@ let save_pref () =
     add "lax_syntax" [string_of_bool p.lax_syntax] ++
     add "vertical_tabs" [string_of_bool p.vertical_tabs] ++
     add "opposite_tabs" [string_of_bool p.opposite_tabs] ++
+    add "background_color" [p.background_color] ++
     add "processing_color" [p.processing_color] ++
     add "processed_color" [p.processed_color] ++
     Config_lexer.print_file pref_file
@@ -303,6 +308,7 @@ let load_pref () =
     set_bool "lax_syntax" (fun v -> np.lax_syntax <- v);
     set_bool "vertical_tabs" (fun v -> np.vertical_tabs <- v);
     set_bool "opposite_tabs" (fun v -> np.opposite_tabs <- v);
+    set_hd "background_color" (fun v -> np.background_color <- v);
     set_hd "processing_color" (fun v -> np.processing_color <- v);
     set_hd "processed_color" (fun v -> np.processed_color <- v);
     current := np
@@ -362,28 +368,39 @@ let configure ?(apply=(fun () -> ())) () =
       ~border_width:2
       ~packing:(box#pack ~expand:true) ()
     in
+    let background_label = GMisc.label
+      ~text:"Background color"
+      ~packing:(table#attach ~expand:`X ~left:0 ~top:0) ()
+    in
     let processed_label = GMisc.label
       ~text:"Background color of processed text"
-      ~packing:(table#attach ~expand:`X ~left:0 ~top:0) ()
+      ~packing:(table#attach ~expand:`X ~left:0 ~top:1) ()
     in
     let processing_label = GMisc.label
       ~text:"Background color of text being processed"
-      ~packing:(table#attach ~expand:`X ~left:0 ~top:1) ()
+      ~packing:(table#attach ~expand:`X ~left:0 ~top:2) ()
     in
+    let () = background_label#set_xalign 0. in
     let () = processed_label#set_xalign 0. in
     let () = processing_label#set_xalign 0. in
+    let background_button = GButton.color_button
+      ~color:(Tags.color_of_string (!current.background_color))
+      ~packing:(table#attach ~left:1 ~top:0) ()
+    in
     let processed_button = GButton.color_button
       ~color:(Tags.get_processed_color ())
-      ~packing:(table#attach ~left:1 ~top:0) ()
+      ~packing:(table#attach ~left:1 ~top:1) ()
     in
     let processing_button = GButton.color_button
       ~color:(Tags.get_processing_color ())
-      ~packing:(table#attach ~left:1 ~top:1) ()
+      ~packing:(table#attach ~left:1 ~top:2) ()
     in
     let label = "Color configuration" in
     let callback () =
+      !current.background_color <- Tags.string_of_color background_button#color;
       !current.processing_color <- Tags.string_of_color processing_button#color;
       !current.processed_color <- Tags.string_of_color processed_button#color;
+      !change_background_color background_button#color;
       Tags.set_processing_color processing_button#color;
       Tags.set_processed_color processed_button#color
     in