add -modern and -w options

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2897 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

otherlibs/labltk/browser/editor.ml

@@ -25,19 +25,22 @@ and type_on_load = ref false
 let compiler_preferences () =
   let tl = Jg_toplevel.titled "Compiler" in
   Wm.transient_set tl master:Widget.default_toplevel;
-  let mk_chkbutton :text :ref =
+  let mk_chkbutton :text :ref :invert =
     let variable = Textvariable.create on:tl () in
-    if !ref then Textvariable.set variable to:"1";
+    if (if invert then not !ref else !ref) then
+      Textvariable.set variable to:"1";
     Checkbutton.create tl :text :variable,
-    (fun () -> ref := Textvariable.get variable = "1")
+    (fun () ->
+      ref := Textvariable.get variable = (if invert then "0" else "1"))
   in
   let chkbuttons, setflags = List.split
-      (List.map fun:(fun (text, ref) -> mk_chkbutton :text :ref)
-        ["No pervasives", Clflags.nopervasives;
-         "No warnings", Typecheck.nowarnings;
-         "Classic", Clflags.classic;
-         "Lex on load", lex_on_load;
-         "Type on load", type_on_load])
+      (List.map
+	 fun:(fun (text, ref, invert) -> mk_chkbutton :text :ref :invert)
+         [ "No pervasives", Clflags.nopervasives, false;
+           "No warnings", Typecheck.nowarnings, false;
+           "Modern", Clflags.classic, true;
+           "Lex on load", lex_on_load, false;
+           "Type on load", type_on_load, false ])
   in
   let buttons = Frame.create tl in
   let ok = Button.create buttons text:"Ok" padx:20 command:

otherlibs/labltk/browser/main.ml

@@ -19,10 +19,25 @@ let _ =
   let path = ref [] in
   Arg.parse
     keywords:[ "-I", Arg.String (fun s -> path := s :: !path),
-               "<dir>  Add <dir> to the list of include directories" ]
+               "<dir>  Add <dir> to the list of include directories";
+	       "-modern", Arg.Unit (fun () -> Clflags.classic := false),
+	       "Use strict label syntax";
+	       "-w", Arg.String (fun s -> Shell.warnings := s),
+               "<flags>  Enable or disable warnings according to <flags>:\n\
+		\032    A/a enable/disable all warnings\n\
+		\032    C/c enable/disable suspicious comment\n\
+		\032    F/f enable/disable partially applied function\n\
+		\032    M/m enable/disable overriden method\n\
+		\032    P/p enable/disable partial match\n\
+		\032    S/s enable/disable non-unit statement\n\
+		\032    U/u enable/disable unused match case\n\
+		\032    V/v enable/disable hidden instance variable\n\
+		\032    X/x enable/disable all other warnings\n\
+		\032    default setting is A (all warnings enabled)" ]
     others:(fun name -> raise(Arg.Bad("don't know what to do with " ^ name)))
     errmsg:"ocamlbrowser :";
   Config.load_path := List.rev !path @ [Config.standard_library];
+  Warnings.parse_options !Shell.warnings;
   begin
     try Searchid.start_env := Env.open_pers_signature "Pervasives" Env.initial
     with Env.Error _ -> ()

otherlibs/labltk/browser/shell.ml

@@ -250,6 +250,8 @@ let may_exec =
 
 let path_sep = if Sys.os_type = "Win32" then ";" else ":"
 
+let warnings = ref "A"
+
 let f :prog :title =
   let progargs =
     List.filter pred:((<>) "") (Str.split sep:~" " prog) in
@@ -282,7 +284,12 @@ let f :prog :title =
       end in
   let load_path =
     List2.flat_map !Config.load_path fun:(fun dir -> ["-I"; dir]) in
-  let args = Array.of_list (progargs @ load_path) in
+  let modern = if !Clflags.classic then [] else ["-modern"] in
+  let warnings =
+    if List.mem item:"-w" progargs || !warnings = "A" then []
+    else ["-w"; !warnings]
+  in
+  let args = Array.of_list (progargs @ modern @ warnings @ load_path) in
   let sh = new shell textw:tw :prog :env :args in
   let current_dir = ref (Unix.getcwd ()) in
   file_menu#add_command "Use..." command:

otherlibs/labltk/browser/shell.mli

@@ -29,5 +29,6 @@ class shell :
 
 val kill_all : unit -> unit
 val get_all : unit -> (string * shell) list
+val warnings : string ref
 
 val f : prog:string -> title:string -> unit