src/gtk2/gui/guiOptions.ml

   1 (* Copyright 2004 b8_bavard INRIA *)
   2 (*
   3     This file is part of mldonkey.
   4
   5     mldonkey is free software; you can redistribute it and/or modify
   6     it under the terms of the GNU General Public License as published by
   7     the Free Software Foundation; either version 2 of the License, or
   8     (at your option) any later version.
   9
  10     mldonkey is distributed in the hope that it will be useful,
  11     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13     GNU General Public License for more details.
  14
  15     You should have received a copy of the GNU General Public License
  16     along with mldonkey; if not, write to the Free Software
  17     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18 *)
  19
  20 (* Options of the Gui. *)
  21
  22 open Gettext
  23 open Options
  24 open CommonGlobals
  25 open GraphTypes
  26
  27 module U = GuiUtf8
  28
  29 let _s x = _s "GuiOptions" x
  30 let _b x = _b "GuiOptions" x
  31
  32 let define_option a b ?desc c d e =
  33   match desc with
  34     None -> define_option a b (_s c) d e
  35   | Some desc -> define_option a b ~desc: (_s desc) (_s c) d e
  36 let define_expert_option a b ?desc c d e =
  37   match desc with
  38     None -> define_expert_option a b (_s c) d e
  39   | Some desc -> define_expert_option a b ~desc: (_s desc) (_s c) d e
  40
  41 module M = GuiMessages
  42 module C = GuiColumns
  43
  44 let _ = Unix2.safe_mkdir GuiMessages.gui_config_dir
  45
  46 let gui_ini = create_options_file
  47     (Filename.concat GuiMessages.gui_config_dir "mlgui.ini")
  48
  49
  50
  51 let tb_styles = [ "both", `BOTH ;
  52                   "both horizontal", `BOTH_HORIZ ;
  53                   "text", `TEXT ;
  54                   "icon", `ICONS ]
  55
  56 let tb_styles_rev = List.map (fun (a,b) -> (b,a)) tb_styles
  57
  58 let string_to_tbstyle s =
  59   try List.assoc (String.lowercase s) tb_styles
  60   with Not_found -> `BOTH
  61
  62 let tbstyle_to_string st = List.assoc st tb_styles_rev
  63
  64 let value_to_tbstyle v =
  65   match v with
  66     StringValue s -> string_to_tbstyle s
  67   | _ -> raise Not_found
  68
  69 let tbstyle_to_value (st:Gtk.Tags.toolbar_style) =
  70   StringValue (tbstyle_to_string st)
  71
  72 let (tbstyle_option : Gtk.Tags.toolbar_style option_class) =
  73     define_option_class "Toolbar"
  74     value_to_tbstyle tbstyle_to_value
  75
  76 let graphtime_to_string gt =
  77   match gt with
  78       GraphHour -> "hour"
  79     | GraphHalfDay -> "half_day"
  80     | GraphDay -> "day"
  81     | GraphWeek -> "week"
  82     | GraphMonth -> "month"
  83     | GraphYear -> "year"
  84     | _ -> "quarter"
  85
  86 let string_to_graphtime s =
  87   match s with
  88       "hour" -> GraphHour
  89     | "half_day" -> GraphHalfDay
  90     | "day" -> GraphDay
  91     | "week" -> GraphWeek
  92     | "month" -> GraphMonth
  93     | "year" -> GraphYear
  94     | _ -> GraphQuarter
  95
  96 let value_to_graphtime v =
  97   match v with
  98       StringValue s -> string_to_graphtime s
  99     | _ -> GraphQuarter
 100
 101 let graphtime_to_value (gt : graph_time) =
 102   StringValue (graphtime_to_string gt)
 103
 104 let (graphtime_option : graph_time option_class) =
 105     define_option_class "GraphTime"
 106     value_to_graphtime graphtime_to_value
 107
 108 let time_option =
 109     define_option_class "Time"
 110     value_to_int int_to_value
 111
 112 let advanced_option =
 113     define_option_class "Advanced"
 114     value_to_bool bool_to_value
 115
 116 let password_option =
 117     define_option_class "Password"
 118     value_to_string string_to_value
 119
 120 let scale_option =
 121     define_option_class "Scale"
 122     value_to_float float_to_value
 123
 124 let main_section = file_section gui_ini ["Main"] "Main options"
 125 let mlgui_section = file_section gui_ini ["MLgui"] "Options to control MLgui"
 126 let mlgui_debug_section = file_section gui_ini ["MLguiDebug"] "Debug Options"
 127
 128 (*************************************************************************)
 129 (*************************************************************************)
 130 (*************************************************************************)
 131 (*                                                                       *)
 132 (*               Options displayed in the config panel                   *)
 133 (*                                                                       *)
 134 (*************************************************************************)
 135 (*************************************************************************)
 136 (*************************************************************************)
 137
 138 let current_section = main_section
 139
 140 let gtk_advanced_options = define_option current_section
 141     ["gtk_advanced_options"]
 142     ~desc:"Advanced options"
 143     "Set to true whether you want to access to the advanced options"
 144     advanced_option false
 145
 146
 147 let current_section = mlgui_section
 148
 149 (* {Connection} *)
 150
 151 let gtk_connection_http_proxy_server = define_option current_section
 152     ["gtk_connection_http_proxy_server"]
 153     ~desc:"HTTP proxy server"
 154     "Direct HTTP queries to HTTP proxy"
 155     string_option ""
 156
 157 let gtk_connection_http_proxy_port = define_option current_section
 158     ["gtk_connection_http_proxy_port"]
 159     ~desc:"HTTP proxy server port"
 160     "Port of HTTP proxy"
 161     port_option 8080
 162
 163 let gtk_connection_http_use_proxy = define_option current_section
 164     ["gtk_connection_http_use_proxy"]
 165     ~desc:"Enable Proxy server"
 166     "Direct TCP connections to HTTP proxy (the proxy should support CONNECT)"
 167     bool_option false
 168
 169 (* {Client} *)
 170
 171 let gtk_client_login = define_option current_section
 172     ["gtk_client_login"]
 173     ~desc:"Login"
 174     "Your login name (default is admin)"
 175     string_option "admin"
 176
 177 let gtk_client_password = define_option current_section
 178     ["gtk_client_password"]
 179     ~desc:"Password"
 180     "The password to use when connecting to the server"
 181     password_option ""
 182
 183 let gtk_client_port = define_option current_section
 184     ["gtk_client_port"]
 185     ~desc:"MLgui port"
 186     "The server port to connect to"
 187     port_option 4001
 188
 189 let gtk_client_hostname = define_option current_section
 190     ["gtk_client_hostname"]
 191     ~desc:"Hostname"
 192     "The server hostname to connect to"
 193     string_option "localhost"
 194
 195 let gtk_client_lang = define_option current_section
 196     ["gtk_client_lang"]
 197     ~desc:"Language"
 198     "The language you want to use in MLgui"
 199     U.language_option U.EN
 200
 201 let gtk_client_history = define_expert_option current_section
 202     ["gtk_client_history"]
 203     ~desc:"History"
 204     "History of connected cores"
 205     (list_option (tuple2_option (string_option, int_option))) []
 206
 207
 208
 209 (* {Look & Feel} *)
 210
 211 let gtk_look_use_size_suffixes = define_option current_section
 212     ["gtk_look_use_size_suffixes"]
 213     ~desc:"Use size suffixes (G, M, k)"
 214     "Whether sizes are printed using G(iga), M(ega) and k(ilo) suffixes."
 215     bool_option true
 216
 217 let gtk_look_use_icons = define_option current_section
 218     ["gtk_look_use_icons"]
 219     ~desc:"Use icons in the lists"
 220     "Whether icons are displayed in MLgui"
 221     bool_option true
 222
 223 let gtk_look_graphical_availability = define_option current_section
 224     ["gtk_look_graphical_availability"]
 225     ~desc:"Use graphical represention for availability"
 226     "What is displayed in availability column : graphical or text"
 227     bool_option true
 228
 229 let gtk_look_icons_directory = define_option current_section
 230     ["gtk_look_icons_directory"]
 231     ~desc:"Icons themes"
 232     "The directory where mldonkey gui's icons are"
 233     path_option [""]
 234
 235 let gtk_look_main_toolbar_icon_size = define_option current_section
 236     ["gtk_look_main_toolbar_icon_size"]
 237     ~desc:"Icons size in the main toolbar"
 238     "The size of the icons in the main toolbar"
 239     int_option 32
 240
 241 let gtk_look_toolbars_icon_size = define_option current_section
 242     ["gtk_look_toolbars_icon_size"]
 243     ~desc:"Icons size in the other toolbars"
 244     "The size of the icons in the other toolbars"
 245     int_option 22
 246
 247 let gtk_look_lists_icon_size = define_option current_section
 248     ["gtk_look_lists_icon_size"]
 249     ~desc:"Icons size in the lists"
 250     "The size of the icons in the lists"
 251     int_option 16
 252
 253 let gtk_look_icon_saturation = define_option current_section
 254     ["gtk_look_icon_saturation"]
 255     ~desc:"Icons saturation"
 256     "The level of saturation when diplaying icons"
 257     scale_option 1.
 258
 259 let gtk_look_toolbars_style = define_option current_section
 260     ["gtk_look_toolbars_style"]
 261     ~desc:"Style of toolbars"
 262     "What is displayed in toolbar buttons : text, icon or both"
 263     tbstyle_option `BOTH
 264
 265
 266
 267 (* {Colors} *)
 268
 269 let gtk_color_default = define_option current_section
 270     ["gtk_color_default"]
 271     ~desc:"Default color"
 272     "Set the default color in MLgui"
 273     color_option "Black"
 274
 275 let gtk_color_state_not_available = define_option current_section
 276     ["gtk_color_state_not_available"]
 277     ~desc:"State not available"
 278     "Color for unavailable files"
 279     color_option "Red"
 280
 281 let gtk_color_state_files_listed = define_option current_section
 282     ["gtk_color_state_files_listed"]
 283     ~desc:"State files listed"
 284     "Color for users whose list of files has been retrieved"
 285     color_option "Blue"
 286
 287 (* {Fonts} *)
 288
 289 let gtk_font_list = define_option current_section
 290     ["gtk_font_list"]
 291     ~desc:"Lists and trees font"
 292     "Font for the list and trees texts"
 293     font_option "sans 12"
 294
 295 let gtk_font_networks = define_option current_section
 296     ["gtk_font_network"]
 297     ~desc:"Networks labels font"
 298     "Font for the networks labels in the Networks Tab"
 299     font_option "sans 16"
 300
 301
 302 (* {2 Graph Options} *)
 303
 304 let gtk_graph_time_downloads =  define_option current_section
 305     ["gtk_graph_time_downloads"]
 306     ~desc:"Time range to view the global downloads"
 307     "Set the time range for the downloads graph"
 308     graphtime_option GraphQuarter
 309
 310 let gtk_graph_time_uploads =  define_option current_section
 311     ["gtk_graph_time_uploads"]
 312     ~desc:"Time range to view the global uploads"
 313     "Set the time range for the uploads graph"
 314     graphtime_option GraphQuarter
 315
 316 let gtk_graph_time_file =  define_option current_section
 317     ["gtk_graph_time_file"]
 318     ~desc:"Time range to view one-file downloads and uploads"
 319     "Set the time range to display the uploads and downloads of one file in the graph tab"
 320     graphtime_option GraphQuarter
 321
 322 let gtk_graph_font = define_option current_section
 323     ["gtk_graph_font"]
 324     ~desc:"Font"
 325     "Set the font to display texts in both the uploads and downloads graphs"
 326     font_option "sans 7"
 327
 328 let gtk_graph_background =  define_option current_section
 329     ["gtk_graph_background"]
 330     ~desc:"Background color"
 331     "Set the background color for both the uploads and downloads graphs"
 332     color_option "#000000"
 333
 334 let gtk_graph_grid =  define_option current_section
 335     ["gtk_graph_grid"]
 336     ~desc:"Grid color"
 337     "Set the color of the grid for both the uploads and downloads graphs"
 338     color_option "#484848"
 339
 340 let gtk_graph_download = define_option current_section
 341     ["gtk_graph_download"]
 342     ~desc:"Downloads color"
 343     "Set the foreground color of the download rate"
 344     color_option "#83afff"
 345
 346 let gtk_graph_upload = define_option current_section
 347     ["gtk_graph_upload"]
 348     ~desc:"Uploads color"
 349     "Set the foreground color of the upload rate"
 350     color_option "#6eec8b"
 351
 352
 353 (* {Misc} *)
 354
 355 let gtk_misc_relative_availability = define_option current_section
 356     ["gtk_misc_relative_availability"]
 357     ~desc:"Use relative % availability"
 358     "Calculate % availability ignoring already present chunks"
 359     bool_option true
 360
 361 let gtk_misc_files_auto_expand_depth = define_option current_section
 362     ["gtk_misc_files_auto_expand_depth"]
 363     ~desc:"Files auto-expand depth"
 364     "The depth to which the directories of a friend are automatically expanded"
 365     int_option 3
 366
 367 let gtk_misc_use_availability_height = define_option current_section
 368     ["gtk_misc_use_availability_height"]
 369     ~desc:"Use height encoded availability"
 370     "Display the availability of a chunk as height or color coded bar"
 371     bool_option true
 372
 373 let gtk_misc_availability_max = define_expert_option current_section
 374     ["gtk_misc_availability_max"]
 375     ~desc:"Max availability"
 376     "If use_availability_height is true, which availability corresponds to a full bar ?"
 377     int_option 10
 378
 379 let gtk_misc_compaction_overhead = define_expert_option current_section
 380     ["gtk_misc_compaction_overhead"]
 381     ~desc:"Compaction overhead"
 382     "The percentage of free memory before a compaction is triggered"
 383     int_option 50
 384
 385 let gtk_misc_interface_buffer = define_expert_option current_section
 386     ["gtk_misc_interface_buffer"]
 387     ~desc:"Interface buffer"
 388     "The size of the buffer to the core"
 389     int_option 10000000
 390
 391 let gtk_misc_copy_messages = define_expert_option current_section
 392     ["gtk_misc_copy_messages"]
 393     ~desc:"Copy messages"
 394     "For bundle binaries, should we directly pass structures between the core and the GUI (faster), or copy them (fewer bugs)"
 395     bool_option true
 396
 397 (*************************************************************************)
 398 (*************************************************************************)
 399 (*************************************************************************)
 400 (*                                                                       *)
 401 (*              Options not displayed in the config panel                *)
 402 (*                                                                       *)
 403 (*************************************************************************)
 404 (*************************************************************************)
 405 (*************************************************************************)
 406
 407 (* {Layout} *)
 408
 409 let servers_vpane_up = define_option current_section
 410     ["layout";"servers_vpane_up"]
 411     "Size in % of upper part of the servers hpane"
 412     float_option 0.50
 413
 414 let friends_hpane_left = define_option current_section
 415     ["layout"; "friends_hpane_left"]
 416     "Size in % of left part of the friends hpane"
 417     float_option 0.17
 418
 419 let friends_vpane_up = define_option current_section
 420     ["layout"; "friends_vpane_up"]
 421     "Size in % of up part of the friends vpane"
 422     float_option 0.69
 423
 424 let friends_hpane_dirs = define_option current_section
 425     ["layout"; "friends_hpane_dirs"]
 426     "Size in % of the directories part of the files box"
 427     float_option 0.13
 428
 429 let rooms_hpane_left = define_option current_section
 430     ["layout"; "rooms_hpane_left"]
 431     "Size in % of left part of the rooms hpane"
 432     float_option 0.30
 433
 434 let rooms_hpane2_left = define_option current_section
 435     ["layout"; "rooms_hpane2_left"]
 436     "Size in % of left part of the second rooms hpane"
 437     float_option 0.50
 438
 439 let queries_hpane_left = define_option current_section
 440     ["layout"; "queries_hpane_up"]
 441     "Size in % of left part of the queries hpane"
 442     float_option 0.20
 443
 444 let uploads_vpane_up = define_option current_section
 445     ["layout"; "uploads_vpane_up"]
 446     "Size in % of up part of the uploads vpane"
 447     float_option 0.50
 448
 449 let im_room_hpane = define_option current_section
 450     ["layout"; "im_room_hpane"]
 451     "Size in % of the left part of the identities hpane"
 452     float_option 0.80
 453
 454 let last_tab = define_option current_section
 455     ["layout"; "last_tab"]
 456     "The last tab opened before closing the GUI"
 457     int_option 0
 458
 459 (* {List columns} *)
 460
 461 let downloads_columns = define_option current_section
 462     ["Colums"; "downloads_columns"]
 463     "Columns for the files being downloaded"
 464     (list_option (tuple2_option (C.File.column_option, float_option)))
 465   [
 466    (C.Col_file_network      , 0.1);
 467    (C.Col_file_priority     , 0.1);
 468    (C.Col_file_name         , 0.1);
 469    (C.Col_file_availability , 0.1);
 470    (C.Col_file_size         , 0.1);
 471    (C.Col_file_downloaded   , 0.1);
 472    (C.Col_file_percent      , 0.1);
 473    (C.Col_file_rate         , 0.1);
 474    (C.Col_file_state        , 0.1);
 475    (C.Col_file_eta          , 0.1);
 476    (C.Col_file_age          , 0.1);
 477   ]
 478
 479 let friends_columns = define_option current_section
 480     ["Colums"; "friends_columns"]
 481     "Columns for the friends"
 482     (list_option (tuple2_option (C.Friend.column_option, float_option)))
 483   [
 484    (C.Col_friend_network , 0.1);
 485    (C.Col_friend_name    , 0.1);
 486   ]
 487
 488 let friends_results_columns = define_option current_section
 489     ["Colums"; "friends_results_columns"]
 490     "Columns for the results of friends files"
 491     (list_option (tuple2_option (C.Result.column_option, float_option)))
 492   [
 493    (C.Col_result_network      , 0.1);
 494    (C.Col_result_name         , 0.1);
 495    (C.Col_result_size         , 0.1);
 496    (C.Col_result_format       , 0.1);
 497    (C.Col_result_duration     , 0.1);
 498    (C.Col_result_codec        , 0.1);
 499    (C.Col_result_bitrate      , 0.1);
 500    (C.Col_result_availability , 0.1);
 501    (C.Col_result_comment      , 0.1);
 502   ]
 503
 504 let friends_dirs_columns = define_option current_section
 505     ["Colums"; "friends_dirs_columns"]
 506     "Columns for the folders of friends files"
 507     (list_option (tuple2_option (C.Directory.column_option, float_option)))
 508   [
 509    (C.Col_dir_name , 0.1);
 510   ]
 511
 512 let uploaders_columns = define_option current_section
 513     ["Colums"; "file_locations_columns"]
 514     "Columns for the uploaders"
 515     (list_option (tuple2_option (C.Client.column_option, float_option)))
 516   [
 517    (C.Col_client_network      , 0.1);
 518    (C.Col_client_name         , 0.1);
 519    (C.Col_client_kind         , 0.1);
 520    (C.Col_client_state        , 0.1);
 521    (C.Col_client_rating       , 0.1);
 522    (C.Col_client_connect_time , 0.1);
 523    (C.Col_client_software     , 0.1);
 524    (C.Col_client_downloaded   , 0.1);
 525    (C.Col_client_uploaded     , 0.1);
 526    (C.Col_client_upload       , 0.1);
 527   ]
 528
 529 let rooms_columns = define_option current_section
 530     ["Colums"; "rooms_columns"]
 531     "Columns of the room lists"
 532     (list_option (tuple2_option (C.Room.column_option, float_option)))
 533   [
 534    (C.Col_room_network , 0.1);
 535    (C.Col_room_name    , 0.1);
 536    (C.Col_room_nusers  , 0.1);
 537   ]
 538
 539 let rooms_users_columns = define_option current_section
 540     ["Colums"; "rooms_users_columns"]
 541     "Columns of the rooms users lists"
 542     (list_option (tuple2_option (C.User.column_option, float_option)))
 543   [
 544    (C.Col_user_name , 0.1);
 545    (C.Col_user_addr , 0.1);
 546    (C.Col_user_tags , 0.1);
 547    (C.Col_user_md4  , 0.1);
 548   ]
 549
 550 let servers_columns = define_option current_section
 551     ["Colums"; "server_columns"]
 552     "Columns for the servers"
 553     (list_option (tuple2_option (C.Server.column_option, float_option)))
 554   [
 555    (C.Col_server_network  , 0.1);
 556    (C.Col_server_preferred, 0.1);
 557    (C.Col_server_name     , 0.1);
 558    (C.Col_server_address  , 0.1);
 559    (C.Col_server_state    , 0.1);
 560    (C.Col_server_users    , 0.1);
 561    (C.Col_server_files    , 0.1);
 562    (C.Col_server_desc     , 0.1);
 563   ]
 564
 565 let servers_users_columns = define_option current_section
 566     ["Colums"; "servers_users_columns"]
 567     "Columns of the servers users lists"
 568     (list_option (tuple2_option (C.User.column_option, float_option)))
 569   [
 570    (C.Col_user_name , 0.1);
 571    (C.Col_user_addr , 0.1);
 572    (C.Col_user_tags , 0.1);
 573    (C.Col_user_md4  , 0.1);
 574   ]
 575
 576 let results_columns = define_option current_section
 577     ["Colums"; "results_columns"]
 578     "Columns for the results of searches and files of a friends"
 579     (list_option (tuple2_option (C.Result.column_option, float_option)))
 580   [
 581    (C.Col_result_network      , 0.1);
 582    (C.Col_result_name         , 0.1);
 583    (C.Col_result_size         , 0.1);
 584    (C.Col_result_format       , 0.1);
 585    (C.Col_result_duration     , 0.1);
 586    (C.Col_result_codec        , 0.1);
 587    (C.Col_result_bitrate      , 0.1);
 588    (C.Col_result_availability , 0.1);
 589    (C.Col_result_comment      , 0.1);
 590   ]
 591
 592 let shared_files_up_columns = define_option current_section
 593     ["Colums"; "shared_files_up_columns"]
 594     "Columns for the list of shared files upload information"
 595     (list_option (tuple2_option (C.Shared_files_up.column_option, float_option)))
 596   [
 597    (C.Col_shared_network  , 0.1);
 598    (C.Col_shared_file     , 0.1);
 599    (C.Col_shared_size     , 0.1);
 600    (C.Col_shared_requests , 0.1);
 601    (C.Col_shared_upsize   , 0.1);
 602    (C.Col_shared_uid      , 0.1);
 603   ]
 604
 605 let account_columns = define_option current_section
 606     ["Colums"; "account_columns"]
 607     "Columns for the Accounts in the IM interface"
 608     (list_option (tuple2_option (C.IMAccount.column_option, float_option)))
 609   [
 610    (C.Col_account_name     , 0.1);
 611    (C.Col_account_status   , 0.1);
 612    (C.Col_account_protocol , 0.1);
 613   ]
 614
 615 let identities_columns = define_option current_section
 616     ["Colums"; "identities_columns"]
 617     "Columns for the Identities in the IM interface"
 618     (list_option (tuple2_option (C.IMIdentities.column_option, float_option)))
 619   [
 620    (C.Col_identity_name , 0.1);
 621   ]
 622
 623
 624 (*************************************************************************)
 625 (*************************************************************************)
 626 (*************************************************************************)
 627 (*                                                                       *)
 628 (*              Debug Options                                            *)
 629 (*                                                                       *)
 630 (*************************************************************************)
 631 (*************************************************************************)
 632 (*************************************************************************)
 633
 634 let current_section = mlgui_debug_section
 635
 636 let gtk_verbose_gview = define_expert_option current_section
 637     ["gtk_verbose_gview"]
 638     ~desc:"verbose Gview"
 639     "Debug module GuiTemplates.Gview"
 640     bool_option false
 641
 642 let gtk_verbose_chat = define_expert_option current_section
 643     ["gtk_verbose_chat"]
 644     ~desc:"verbose Chat"
 645     "Debug module GuiTemplates.Chat"
 646     bool_option false
 647
 648 let gtk_verbose_tools = define_expert_option current_section
 649     ["gtk_verbose_tools"]
 650     ~desc:"verbose tools"
 651     "Debug module GuiTools"
 652     bool_option false
 653
 654 let gtk_verbose_configwin = define_expert_option current_section
 655     ["gtk_verbose_configwin"]
 656     ~desc:"verbose configwin"
 657     "Debug module ConfigWindow"
 658     bool_option false
 659
 660 let gtk_verbose_art = define_expert_option current_section
 661     ["gtk_verbose_art"]
 662     ~desc:"verbose art"
 663     "Debug module GuiArt"
 664     bool_option false
 665
 666 let gtk_verbose_main = define_expert_option current_section
 667     ["gtk_verbose_main"]
 668     ~desc:"verbose main"
 669     "Debug module GuiMain"
 670     bool_option false
 671
 672 let gtk_verbose_networks = define_expert_option current_section
 673     ["gtk_verbose_networks"]
 674     ~desc:"verbose networks"
 675     "Debug module GuiNetworks"
 676     bool_option false
 677
 678 let gtk_verbose_servers = define_expert_option current_section
 679     ["gtk_verbose_servers"]
 680     ~desc:"verbose servers"
 681     "Debug module GuiServers"
 682     bool_option false
 683
 684 let gtk_verbose_downloads = define_expert_option current_section
 685     ["gtk_verbose_downloads"]
 686     ~desc:"verbose downloads"
 687     "Debug module GuiDownloads"
 688     bool_option false
 689
 690 let gtk_verbose_friends = define_expert_option current_section
 691     ["gtk_verbose_friends"]
 692     ~desc:"verbose friends"
 693     "Debug module GuiFriends"
 694     bool_option false
 695
 696 let gtk_verbose_queries = define_expert_option current_section
 697     ["gtk_verbose_queries"]
 698     ~desc:"verbose queries"
 699     "Debug module GuiQueries"
 700     bool_option false
 701
 702 let gtk_verbose_rooms = define_expert_option current_section
 703     ["gtk_verbose_rooms"]
 704     ~desc:"verbose rooms"
 705     "Debug module GuiRooms"
 706     bool_option false
 707
 708 let gtk_verbose_uploads = define_expert_option current_section
 709     ["gtk_verbose_uploads"]
 710     ~desc:"verbose uploads"
 711     "Debug module GuiUploads"
 712     bool_option false
 713
 714 let gtk_verbose_console = define_expert_option current_section
 715     ["gtk_verbose_console"]
 716     ~desc:"verbose console"
 717     "Debug module GuiConsole"
 718     bool_option false
 719
 720 let gtk_verbose_graphbase = define_expert_option current_section
 721     ["gtk_verbose_graphbase"]
 722     ~desc:"verbose graphbase"
 723     "Debug module GuiGraphBase"
 724     bool_option false
 725
 726 let gtk_verbose_graph = define_expert_option current_section
 727     ["gtk_verbose_graph"]
 728     ~desc:"verbose graph"
 729     "Debug module GuiGraph"
 730     bool_option false
 731
 732 let gtk_verbose_im = define_expert_option current_section
 733     ["gtk_verbose_im"]
 734     ~desc:"verbose im"
 735     "Debug module GuiIm"
 736     bool_option false
 737
 738 let gtk_verbose_settings = define_expert_option current_section
 739     ["gtk_verbose_settings"]
 740     ~desc:"verbose settings"
 741     "Debug module GuiConfig"
 742     bool_option false
 743
 744
 745
 746 let _ =
 747   option_hook gtk_misc_compaction_overhead (fun _ ->
 748       let gc_control = Gc.get () in
 749       Gc.set { gc_control with Gc.max_overhead = !!gtk_misc_compaction_overhead };
 750   )