summaryrefslogtreecommitdiffstats
path: root/otherlibs/labltk/browser
diff options
context:
space:
mode:
Diffstat (limited to 'otherlibs/labltk/browser')
-rw-r--r--otherlibs/labltk/browser/editor.ml30
-rw-r--r--otherlibs/labltk/browser/jg_menu.ml24
-rw-r--r--otherlibs/labltk/browser/main.ml7
-rw-r--r--otherlibs/labltk/browser/shell.ml6
-rw-r--r--otherlibs/labltk/browser/viewer.ml25
5 files changed, 42 insertions, 50 deletions
diff --git a/otherlibs/labltk/browser/editor.ml b/otherlibs/labltk/browser/editor.ml
index 1e6e3c0ee..617cdfa85 100644
--- a/otherlibs/labltk/browser/editor.ml
+++ b/otherlibs/labltk/browser/editor.ml
@@ -287,8 +287,8 @@ class editor ~top ~menus = object (self)
val compiler_menu = new Jg_menu.c "Compiler" ~parent:menus
val module_menu = new Jg_menu.c "Modules" ~parent:menus
val window_menu = new Jg_menu.c "Windows" ~parent:menus
- val label =
- Checkbutton.create menus ~state:`Disabled
+ initializer
+ Menu.add_checkbutton menus ~state:`Disabled
~onvalue:"modified" ~offvalue:"unchanged"
val mutable current_dir = Unix.getcwd ()
val mutable error_messages = []
@@ -314,14 +314,18 @@ class editor ~top ~menus = object (self)
~command:(fun () -> self#set_edit txt)
end
+ method set_file_name txt =
+ Menu.configure_checkbutton menus `Last
+ ~label:(Filename.basename txt.name)
+ ~variable:txt.modified
+
method set_edit txt =
if windows <> [] then
Pack.forget [(List.hd windows).frame];
windows <- txt :: exclude txt windows;
self#reset_window_menu;
current_tw <- txt.tw;
- Checkbutton.configure label ~text:(Filename.basename txt.name)
- ~variable:txt.modified;
+ self#set_file_name txt;
Textvariable.set vwindow txt.number;
Text.yview txt.tw ~scroll:(`Page 0);
pack [txt.frame] ~fill:`Both ~expand:true ~side:`Bottom
@@ -381,7 +385,7 @@ class editor ~top ~menus = object (self)
pack [sb] ~fill:`Y ~side:`Right;
pack [tw] ~fill:`Both ~expand:true ~side:`Left;
self#set_edit txt;
- Checkbutton.deselect label;
+ Textvariable.set txt.modified "unchanged";
Lexical.init_tags txt.tw
method clear_errors () =
@@ -429,9 +433,8 @@ class editor ~top ~menus = object (self)
let text = Text.get txt.tw ~start:tstart ~stop:(tposend 1) in
output_string file text;
close_out file;
- Checkbutton.configure label ~text:(Filename.basename name);
- Checkbutton.deselect label;
- txt.name <- name
+ txt.name <- name;
+ self#set_file_name txt
with
Sys_error _ ->
Jg_message.info ~master:top ~title:"Error"
@@ -453,7 +456,7 @@ class editor ~top ~menus = object (self)
| `No -> ()
| `Cancel -> raise Exit
end;
- Checkbutton.deselect label;
+ Textvariable.set txt.modified "unchanged";
(Text.index current_tw ~index:(`Mark"insert", []), [])
with Not_found -> self#new_window name; tstart
in
@@ -629,13 +632,6 @@ class editor ~top ~menus = object (self)
~command:Viewer.search_symbol;
module_menu#add_command "Close all"
~command:Viewer.close_all_views;
-
- (* pack everything *)
- pack (List.map ~f:(fun m -> coe m#button)
- [file_menu; edit_menu; compiler_menu; module_menu; window_menu]
- @ [coe label])
- ~side:`Left ~ipadx:5 ~anchor:`W;
- pack [menus] ~before:(List.hd windows).frame ~side:`Top ~fill:`X
end
(* The main function starts here ! *)
@@ -658,7 +654,7 @@ let editor ?file ?(pos=0) ?(reuse=false) () =
false
then () else
let top = Jg_toplevel.titled "OCamlBrowser Editor" in
- let menus = Frame.create top ~name:"menubar" in
+ let menus = Jg_menu.menubar top in
let ed = new editor ~top ~menus in
already_open := !already_open @ [ed];
if file <> None then ed#reopen ~file ~pos
diff --git a/otherlibs/labltk/browser/jg_menu.ml b/otherlibs/labltk/browser/jg_menu.ml
index 62712f36d..b399d10d8 100644
--- a/otherlibs/labltk/browser/jg_menu.ml
+++ b/otherlibs/labltk/browser/jg_menu.ml
@@ -16,15 +16,12 @@
open Tk
-class c ~parent ?underline:(n=0) text = object (self)
- val pair =
- let button =
- Menubutton.create parent ~text ~underline:n in
- let menu = Menu.create button in
- Menubutton.configure button ~menu;
- button, menu
- method button = fst pair
- method menu = snd pair
+class c ~parent ?(underline=0) label = object (self)
+ val menu =
+ let menu = Menu.create parent in
+ Menu.add_cascade parent ~menu ~label ~underline;
+ menu
+ method menu = menu
method virtual add_command :
?underline:int ->
?accelerator:string -> ?activebackground:color ->
@@ -33,10 +30,15 @@ class c ~parent ?underline:(n=0) text = object (self)
?font:string -> ?foreground:color ->
?image:image -> ?state:state ->
string -> unit
- method add_command ?underline:(n=0) ?accelerator ?activebackground
+ method add_command ?(underline=0) ?accelerator ?activebackground
?activeforeground ?background ?bitmap ?command ?font ?foreground
?image ?state label =
- Menu.add_command (self#menu) ~label ~underline:n ?accelerator
+ Menu.add_command menu ~label ~underline ?accelerator
?activebackground ?activeforeground ?background ?bitmap
?command ?font ?foreground ?image ?state
end
+
+let menubar tl =
+ let menu = Menu.create tl ~name:"menubar" ~typ:`Menubar in
+ Toplevel.configure tl ~menu;
+ menu
diff --git a/otherlibs/labltk/browser/main.ml b/otherlibs/labltk/browser/main.ml
index 2bc122fe9..8866f8d0e 100644
--- a/otherlibs/labltk/browser/main.ml
+++ b/otherlibs/labltk/browser/main.ml
@@ -67,7 +67,7 @@ let _ =
let path = ref [] in
let st = ref true in
- let spec =
+ (*let spec =
[ "-I", Arg.String (fun s -> path := s :: !path),
"<dir> Add <dir> to the list of include directories";
"-labels", Arg.Clear Clflags.classic, " <obsolete>";
@@ -100,7 +100,7 @@ let _ =
if not (check ~spec Sys.argv) then fatal_error (usage ~spec errmsg);
Arg.parse spec
(fun name -> raise(Arg.Bad("don't know what to do with " ^ name)))
- errmsg;
+ errmsg;*)
Config.load_path :=
Sys.getcwd ()
:: List.rev_map ~f:(Misc.expand_directory Config.standard_library) !path
@@ -135,5 +135,6 @@ let _ =
try
if is_win32 then mainLoop ()
else Printexc.print mainLoop ()
- with Protocol.TkError _ -> ()
+ with Protocol.TkError _ ->
+ if not is_win32 then flush stderr
done
diff --git a/otherlibs/labltk/browser/shell.ml b/otherlibs/labltk/browser/shell.ml
index 18e1f3494..ec0a61868 100644
--- a/otherlibs/labltk/browser/shell.ml
+++ b/otherlibs/labltk/browser/shell.ml
@@ -279,13 +279,11 @@ let f ~prog ~title =
if res = "" then may_exec (Filename.concat dir prog) else res) in
if progpath = "" then program_not_found prog else
let tl = Jg_toplevel.titled title in
- let menus = Frame.create tl ~name:"menubar" in
+ let menus = Menu.create tl ~name:"menubar" ~typ:`Menubar in
+ Toplevel.configure tl ~menu:menus;
let file_menu = new Jg_menu.c "File" ~parent:menus
and history_menu = new Jg_menu.c "History" ~parent:menus
and signal_menu = new Jg_menu.c "Signal" ~parent:menus in
- pack [menus] ~side:`Top ~fill:`X;
- pack [file_menu#button; history_menu#button; signal_menu#button]
- ~side:`Left ~ipadx:5 ~anchor:`W;
let frame, tw, sb = Jg_text.create_with_scrollbar tl in
Text.configure tw ~background:`White;
pack [sb] ~fill:`Y ~side:`Right;
diff --git a/otherlibs/labltk/browser/viewer.ml b/otherlibs/labltk/browser/viewer.ml
index 17c3ba584..41353d8c1 100644
--- a/otherlibs/labltk/browser/viewer.ml
+++ b/otherlibs/labltk/browser/viewer.ml
@@ -316,19 +316,19 @@ let show_help () =
(* Launch the classical viewer *)
let f ?(dir=Unix.getcwd()) ?on () =
- let tl = match on with
+ let (top, tl) = match on with
None ->
let tl = Jg_toplevel.titled "Module viewer" in
- ignore (Jg_bind.escape_destroy tl); coe tl
+ ignore (Jg_bind.escape_destroy tl); (tl, coe tl)
| Some top ->
Wm.title_set top "OCamlBrowser";
Wm.iconname_set top "OCamlBrowser";
let tl = Frame.create top in
bind tl ~events:[`Destroy] ~action:(fun _ -> exit 0);
pack [tl] ~expand:true ~fill:`Both;
- coe tl
+ (top, coe tl)
in
- let menus = Frame.create tl ~name:"menubar" in
+ let menus = Jg_menu.menubar top in
let filemenu = new Jg_menu.c "File" ~parent:menus
and modmenu = new Jg_menu.c "Modules" ~parent:menus in
let fmbox, mbox, msb = Jg_box.create_with_scrollbar tl in
@@ -366,8 +366,6 @@ let f ?(dir=Unix.getcwd()) ?on () =
~command:(fun () -> reset_modules mbox; Env.reset_cache ());
modmenu#add_command "Search symbol..." ~command:search_symbol;
- pack [filemenu#button; modmenu#button] ~side:`Left ~ipadx:5 ~anchor:`W;
- pack [menus] ~side:`Top ~fill:`X;
pack [close; search] ~fill:`X ~side:`Right ~expand:true;
pack [coe buttons; coe ew] ~fill:`X ~side:`Bottom;
pack [msb] ~side:`Right ~fill:`Y;
@@ -378,19 +376,20 @@ let f ?(dir=Unix.getcwd()) ?on () =
(* Smalltalk-like version *)
class st_viewer ?(dir=Unix.getcwd()) ?on () =
- let tl = match on with
+ let (top, tl) = match on with
None ->
let tl = Jg_toplevel.titled "Module viewer" in
- ignore (Jg_bind.escape_destroy tl); coe tl
+ ignore (Jg_bind.escape_destroy tl); (tl, coe tl)
| Some top ->
Wm.title_set top "OCamlBrowser";
Wm.iconname_set top "OCamlBrowser";
let tl = Frame.create top in
bind tl ~events:[`Destroy] ~action:(fun _ -> exit 0);
- pack [tl] ~expand:true ~fill:`Both;
- coe tl
+ pack [tl] ~side:`Bottom ~expand:true ~fill:`Both;
+ (top, coe tl)
in
- let menus = Frame.create tl ~name:"menubar" in
+ let menus = Menu.create top ~name:"menubar" ~typ:`Menubar in
+ let () = Toplevel.configure top ~menu:menus in
let filemenu = new Jg_menu.c "File" ~parent:menus
and modmenu = new Jg_menu.c "Modules" ~parent:menus
and viewmenu = new Jg_menu.c "View" ~parent:menus
@@ -490,10 +489,6 @@ object (self)
(* Help menu *)
helpmenu#add_command "Manual..." ~command:show_help;
- pack [filemenu#button; viewmenu#button; modmenu#button]
- ~side:`Left ~ipadx:5 ~anchor:`W;
- pack [helpmenu#button] ~side:`Right ~anchor:`E ~ipadx:5;
- pack [menus] ~fill:`X;
pack [search_frame] ~fill:`X;
pack [boxes_frame] ~fill:`Both ~expand:true;
pack [buttons] ~fill:`X ~side:`Bottom;
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-20 14:33:21 +0000