diff options
| -rw-r--r-- | otherlibs/labltk/browser/editor.ml | 12 | ||||
| -rw-r--r-- | otherlibs/labltk/browser/jg_message.ml | 7 | ||||
| -rw-r--r-- | otherlibs/labltk/browser/jg_message.mli | 10 |
3 files changed, 16 insertions, 13 deletions
diff --git a/otherlibs/labltk/browser/editor.ml b/otherlibs/labltk/browser/editor.ml index 70f02d33f..a5fbdfe74 100644 --- a/otherlibs/labltk/browser/editor.ml +++ b/otherlibs/labltk/browser/editor.ml @@ -473,20 +473,20 @@ class editor ~top ~menus = object (self) method close_file () = self#close_window (List.hd windows) - method quit () = + method quit ?(cancel=true) () = try List.iter windows ~f: begin fun txt -> if Textvariable.get txt.modified = "modified" then - match Jg_message.ask ~master:top ~title:"Quit" + match Jg_message.ask ~master:top ~title:"Quit" ~cancel ("`" ^ Filename.basename txt.name ^ "' modified. Save it?") with `yes -> self#save_text txt | `no -> () | `cancel -> raise Exit end; bind top ~events:[`Destroy]; - destroy top; break () - with Exit -> break () + destroy top + with Exit -> () method reopen ~file ~pos = if not (Winfo.ismapped top) then Wm.deiconify top; @@ -514,10 +514,10 @@ class editor ~top ~menus = object (self) ~action:(fun _ -> act (); break ()) end; - bind top ~events:[`Destroy] ~breakable:true ~fields:[`Widget] ~action: + bind top ~events:[`Destroy] ~fields:[`Widget] ~action: begin fun ev -> if Widget.name ev.ev_Widget = Widget.name top - then (break (); self#quit ()) + then self#quit ~cancel:false () end; (* File menu *) diff --git a/otherlibs/labltk/browser/jg_message.ml b/otherlibs/labltk/browser/jg_message.ml index 30d8d8154..97a90bf9f 100644 --- a/otherlibs/labltk/browser/jg_message.ml +++ b/otherlibs/labltk/browser/jg_message.ml @@ -70,7 +70,7 @@ let formatted ~title ?on ?(ppf = Format.std_formatter) pack [Jg_text.add_scrollbar tw] ~before:tw ~side:`Right ~fill:`Y end -let ask ~title ?master text = +let ask ~title ?master ?(cancel=true) text = let tl = Jg_toplevel.titled title in begin match master with None -> () | Some master -> Wm.transient_set tl ~master @@ -84,12 +84,13 @@ let ask ~title ?master text = ~command:(fun () -> r := `yes; destroy tl) and refuse = Button.create fw ~text:"No" ~command:(fun () -> r := `no; destroy tl) - and cancel = Button.create fw ~text:"Cancel" + and cancelB = Button.create fw ~text:"Cancel" ~command:(fun () -> r := `cancel; destroy tl) in bind tl ~events:[`Destroy] ~extend:true ~action:(fun _ -> Textvariable.set sync "1"); - pack [accept; refuse; cancel] ~side:`Left ~fill:`X ~expand:true; + pack [accept; refuse] ~side:`Left ~fill:`X ~expand:true; + if cancel then pack [cancelB] ~side:`Left ~fill:`X ~expand:true; pack [mw] ~side:`Top ~fill:`Both; pack [fw] ~side:`Bottom ~fill:`X ~expand:true; Grab.set tl; diff --git a/otherlibs/labltk/browser/jg_message.mli b/otherlibs/labltk/browser/jg_message.mli index ed638db40..0aef59742 100644 --- a/otherlibs/labltk/browser/jg_message.mli +++ b/otherlibs/labltk/browser/jg_message.mli @@ -13,15 +13,17 @@ (* $Id$ *) +open Widget + val formatted : title:string -> - ?on:Widget.frame Widget.widget -> + ?on:frame widget -> ?ppf:Format.formatter -> ?width:int -> ?maxheight:int -> ?minheight:int -> - unit -> Widget.any Widget.widget * Widget.text Widget.widget * (unit -> unit) + unit -> any widget * text widget * (unit -> unit) val ask : - title:string -> ?master:Widget.toplevel Widget.widget -> - string -> [`cancel|`no|`yes] + title:string -> ?master:toplevel widget -> + ?cancel:bool -> string -> [`cancel|`no|`yes] |