diff options
| author | Damien Doligez <damien.doligez-inria.fr> | 2010-01-22 12:48:24 +0000 |
|---|---|---|
| committer | Damien Doligez <damien.doligez-inria.fr> | 2010-01-22 12:48:24 +0000 |
| commit | 04b1656222698bd7e92f213e9a718b7a4185643a (patch) | |
| tree | 6186d1ba1e00adb1232908f95cb92c299902a943 /otherlibs/labltk/frx | |
| parent | bdc0fadee2dc9669818955486b4c3497016edda5 (diff) | |
clean up spaces and tabs
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@9547 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'otherlibs/labltk/frx')
23 files changed, 144 insertions, 153 deletions
diff --git a/otherlibs/labltk/frx/.depend b/otherlibs/labltk/frx/.depend index d815ab0eb..9b27a76b0 100644 --- a/otherlibs/labltk/frx/.depend +++ b/otherlibs/labltk/frx/.depend @@ -1,38 +1,38 @@ -frx_after.cmo: frx_after.cmi -frx_after.cmx: frx_after.cmi -frx_color.cmo: frx_color.cmi -frx_color.cmx: frx_color.cmi -frx_ctext.cmo: frx_fit.cmi frx_text.cmi frx_ctext.cmi -frx_ctext.cmx: frx_fit.cmx frx_text.cmx frx_ctext.cmi -frx_dialog.cmo: frx_dialog.cmi -frx_dialog.cmx: frx_dialog.cmi -frx_entry.cmo: frx_entry.cmi -frx_entry.cmx: frx_entry.cmi -frx_fillbox.cmo: frx_fillbox.cmi -frx_fillbox.cmx: frx_fillbox.cmi -frx_fit.cmo: frx_after.cmi frx_fit.cmi -frx_fit.cmx: frx_after.cmx frx_fit.cmi -frx_focus.cmo: frx_focus.cmi -frx_focus.cmx: frx_focus.cmi -frx_font.cmo: frx_misc.cmi frx_font.cmi -frx_font.cmx: frx_misc.cmx frx_font.cmi -frx_lbutton.cmo: frx_lbutton.cmi -frx_lbutton.cmx: frx_lbutton.cmi -frx_listbox.cmo: frx_listbox.cmi -frx_listbox.cmx: frx_listbox.cmi -frx_mem.cmo: frx_mem.cmi -frx_mem.cmx: frx_mem.cmi -frx_misc.cmo: frx_misc.cmi -frx_misc.cmx: frx_misc.cmi -frx_req.cmo: frx_entry.cmi frx_listbox.cmi frx_widget.cmi frx_req.cmi -frx_req.cmx: frx_entry.cmx frx_listbox.cmx frx_widget.cmx frx_req.cmi -frx_rpc.cmo: frx_rpc.cmi -frx_rpc.cmx: frx_rpc.cmi -frx_selection.cmo: frx_selection.cmi -frx_selection.cmx: frx_selection.cmi -frx_synth.cmo: frx_synth.cmi -frx_synth.cmx: frx_synth.cmi -frx_text.cmo: frx_misc.cmi frx_text.cmi -frx_text.cmx: frx_misc.cmx frx_text.cmi -frx_widget.cmo: frx_widget.cmi -frx_widget.cmx: frx_widget.cmi +frx_after.cmo: frx_after.cmi +frx_after.cmx: frx_after.cmi +frx_color.cmo: frx_color.cmi +frx_color.cmx: frx_color.cmi +frx_ctext.cmo: frx_fit.cmi frx_text.cmi frx_ctext.cmi +frx_ctext.cmx: frx_fit.cmx frx_text.cmx frx_ctext.cmi +frx_dialog.cmo: frx_dialog.cmi +frx_dialog.cmx: frx_dialog.cmi +frx_entry.cmo: frx_entry.cmi +frx_entry.cmx: frx_entry.cmi +frx_fillbox.cmo: frx_fillbox.cmi +frx_fillbox.cmx: frx_fillbox.cmi +frx_fit.cmo: frx_after.cmi frx_fit.cmi +frx_fit.cmx: frx_after.cmx frx_fit.cmi +frx_focus.cmo: frx_focus.cmi +frx_focus.cmx: frx_focus.cmi +frx_font.cmo: frx_misc.cmi frx_font.cmi +frx_font.cmx: frx_misc.cmx frx_font.cmi +frx_lbutton.cmo: frx_lbutton.cmi +frx_lbutton.cmx: frx_lbutton.cmi +frx_listbox.cmo: frx_listbox.cmi +frx_listbox.cmx: frx_listbox.cmi +frx_mem.cmo: frx_mem.cmi +frx_mem.cmx: frx_mem.cmi +frx_misc.cmo: frx_misc.cmi +frx_misc.cmx: frx_misc.cmi +frx_req.cmo: frx_entry.cmi frx_listbox.cmi frx_widget.cmi frx_req.cmi +frx_req.cmx: frx_entry.cmx frx_listbox.cmx frx_widget.cmx frx_req.cmi +frx_rpc.cmo: frx_rpc.cmi +frx_rpc.cmx: frx_rpc.cmi +frx_selection.cmo: frx_selection.cmi +frx_selection.cmx: frx_selection.cmi +frx_synth.cmo: frx_synth.cmi +frx_synth.cmx: frx_synth.cmi +frx_text.cmo: frx_misc.cmi frx_text.cmi +frx_text.cmx: frx_misc.cmx frx_text.cmi +frx_widget.cmo: frx_widget.cmi +frx_widget.cmx: frx_widget.cmi diff --git a/otherlibs/labltk/frx/Makefile b/otherlibs/labltk/frx/Makefile index 0f9c9e3fd..192034cf5 100644 --- a/otherlibs/labltk/frx/Makefile +++ b/otherlibs/labltk/frx/Makefile @@ -45,7 +45,7 @@ $(OBJSX): ../lib/$(LIBNAME).cmxa $(CAMLOPT) -c $(COMPFLAGS) $< -depend: +depend: $(CAMLDEP) *.mli *.ml > .depend include .depend diff --git a/otherlibs/labltk/frx/frx_color.ml b/otherlibs/labltk/frx/frx_color.ml index 4df3eb6b4..140e13879 100644 --- a/otherlibs/labltk/frx/frx_color.ml +++ b/otherlibs/labltk/frx/frx_color.ml @@ -25,7 +25,7 @@ let check s = if StringSet.mem s !available_colors then true else begin try - let f = Frame.create_named Widget.default_toplevel "frxcolorcheck" + let f = Frame.create_named Widget.default_toplevel "frxcolorcheck" [Background (NamedColor s)] in available_colors := StringSet.add s !available_colors; destroy f; diff --git a/otherlibs/labltk/frx/frx_ctext.ml b/otherlibs/labltk/frx/frx_ctext.ml index 0d4fd836e..7d3cbb15a 100644 --- a/otherlibs/labltk/frx/frx_ctext.ml +++ b/otherlibs/labltk/frx/frx_ctext.ml @@ -23,12 +23,12 @@ let create top opts navigation = let rf = Frame.create f [] in let c = Canvas.create lf [BorderWidth (Pixels 0)] and xscroll = Scrollbar.create lf [Orient Horizontal] - and yscroll = Scrollbar.create rf [Orient Vertical] + and yscroll = Scrollbar.create rf [Orient Vertical] and secret = Frame.create_named rf "secret" [] in let t = Text.create c (BorderWidth(Pixels 0) :: opts) in if navigation then Frx_text.navigation_keys t; - + (* Make the text widget an embedded canvas object *) ignore (Canvas.create_window c (Pixels 0) (Pixels 0) @@ -50,7 +50,7 @@ let create top opts navigation = YScrollCommand (fun first last -> scroll first last; let x,y,w,h = Canvas.bbox c [Tag "main"] in - Canvas.configure c + Canvas.configure c [ScrollRegion (Pixels x, Pixels y, Pixels w, Pixels h)]) ]; diff --git a/otherlibs/labltk/frx/frx_ctext.mli b/otherlibs/labltk/frx/frx_ctext.mli index 157c0cad1..e539f5a8b 100644 --- a/otherlibs/labltk/frx/frx_ctext.mli +++ b/otherlibs/labltk/frx/frx_ctext.mli @@ -21,5 +21,3 @@ val create : with "pixel scrolling". Based on a trick learned from Steve Ball. Returns (frame widget, text widget). *) - - diff --git a/otherlibs/labltk/frx/frx_dialog.ml b/otherlibs/labltk/frx/frx_dialog.ml index 0b65b419e..12289de63 100644 --- a/otherlibs/labltk/frx/frx_dialog.ml +++ b/otherlibs/labltk/frx/frx_dialog.ml @@ -18,7 +18,7 @@ open Protocol let rec mapi f n l = match l with - [] -> [] + [] -> [] | x::l -> let v = f n x in v::(mapi f (succ n) l) (* Same as tk_dialog, but not sharing the tkwait variable *) @@ -29,7 +29,7 @@ let f w name title mesg bitmap def buttons = Wm.iconname_set t "Dialog"; Wm.protocol_set t "WM_DELETE_WINDOW" (function () -> ()); (* Wm.transient_set t (Winfo.toplevel w); *) - let ftop = + let ftop = Frame.create_named t "top" [Relief Raised; BorderWidth (Pixels 1)] and fbot = Frame.create_named t "bot" [Relief Raised; BorderWidth (Pixels 1)] @@ -38,37 +38,37 @@ let f w name title mesg bitmap def buttons = pack [fbot][Side Side_Bottom; Fill Fill_Both]; let l = - Label.create_named ftop "msg" + Label.create_named ftop "msg" [Justify Justify_Left; Text mesg; WrapLength (Pixels 600)] in pack [l][Side Side_Right; Expand true; Fill Fill_Both; PadX (Millimeters 3.0); PadY (Millimeters 3.0)]; begin match bitmap with Predefined "" -> () | _ -> - let b = + let b = Label.create_named ftop "bitmap" [Bitmap bitmap] in pack [b][Side Side_Left; PadX (Millimeters 3.0); PadY (Millimeters 3.0)] end; - + let waitv = Textvariable.create_temporary t in - + let buttons = mapi (fun i bname -> - let b = Button.create t - [Text bname; + let b = Button.create t + [Text bname; Command (fun () -> Textvariable.set waitv (string_of_int i))] in if i = def then begin - let f = Frame.create_named fbot "default" + let f = Frame.create_named fbot "default" [Relief Sunken; BorderWidth (Pixels 1)] in raise_window_above b f; - pack [f][Side Side_Left; Expand true; + pack [f][Side Side_Left; Expand true; PadX (Millimeters 3.0); PadY (Millimeters 2.0)]; pack [b][In f; PadX (Millimeters 2.0); PadY (Millimeters 2.0)]; bind t [[], KeyPressDetail "Return"] (BindSet ([], (fun _ -> Button.flash b; Button.invoke b))) end else - pack [b][In fbot; Side Side_Left; Expand true; + pack [b][In fbot; Side Side_Left; Expand true; PadX (Millimeters 3.0); PadY (Millimeters 2.0)]; b ) @@ -86,7 +86,7 @@ let f w name title mesg bitmap def buttons = let oldfocus = try Some (Focus.get()) with _ -> None and oldgrab = Grab.current ~displayof: t () and grabstatus = ref None in - begin match oldgrab with + begin match oldgrab with [] -> () | x::l -> grabstatus := Some(Grab.status x) end; @@ -104,7 +104,7 @@ let f w name title mesg bitmap def buttons = destroy t; begin match oldgrab with [] -> () - | x::l -> + | x::l -> try match !grabstatus with Some(GrabGlobal) -> Grab.set_global x diff --git a/otherlibs/labltk/frx/frx_dialog.mli b/otherlibs/labltk/frx/frx_dialog.mli index 2124150ca..cd256acb3 100644 --- a/otherlibs/labltk/frx/frx_dialog.mli +++ b/otherlibs/labltk/frx/frx_dialog.mli @@ -17,6 +17,6 @@ open Camltk val f : Widget.widget -> string -> string -> string -> Camltk.bitmap -> int -> string list -> int - (* same as Dialog.create_named, but with a local variable for - synchronisation. Makes it possible to have several dialogs + (* same as Dialog.create_named, but with a local variable for + synchronisation. Makes it possible to have several dialogs simultaneously *) diff --git a/otherlibs/labltk/frx/frx_entry.ml b/otherlibs/labltk/frx/frx_entry.ml index eea7362d6..ec8422186 100644 --- a/otherlibs/labltk/frx/frx_entry.ml +++ b/otherlibs/labltk/frx/frx_entry.ml @@ -25,7 +25,7 @@ let new_label_entry parent txt action = let f = Frame.create parent [] in let m = Label.create f [Text txt] and e = Entry.create f [Relief Sunken; TextWidth 0] in - Camltk.bind e [[], KeyPressDetail "Return"] + Camltk.bind e [[], KeyPressDetail "Return"] (BindSet ([], fun _ -> action(Entry.get e))); pack [m][Side Side_Left]; pack [e][Side Side_Right; Fill Fill_X; Expand true]; @@ -38,5 +38,3 @@ let new_labelm_entry parent txt memo = pack [m][Side Side_Left]; pack [e][Side Side_Right; Fill Fill_X; Expand true]; f,e - - diff --git a/otherlibs/labltk/frx/frx_fileinput.ml b/otherlibs/labltk/frx/frx_fileinput.ml index cf59d1303..de1368670 100644 --- a/otherlibs/labltk/frx/frx_fileinput.ml +++ b/otherlibs/labltk/frx/frx_fileinput.ml @@ -37,4 +37,3 @@ let add fd f = end let remove fd = - diff --git a/otherlibs/labltk/frx/frx_fillbox.ml b/otherlibs/labltk/frx/frx_fillbox.ml index d9e474188..611b55a5d 100644 --- a/otherlibs/labltk/frx/frx_fillbox.ml +++ b/otherlibs/labltk/frx/frx_fillbox.ml @@ -31,8 +31,8 @@ let new_vertical parent w h = [FillColor okcolor; Outline okcolor] in c, (function - 0 -> Canvas.configure_rectangle c i [FillColor okcolor; - Outline okcolor]; + 0 -> Canvas.configure_rectangle c i [FillColor okcolor; + Outline okcolor]; Canvas.coords_set c i [Pixels 0; Pixels 0; Pixels w; Pixels 0] | -1 -> Canvas.configure_rectangle c i [FillColor kocolor; @@ -52,8 +52,8 @@ let new_horizontal parent w h = [FillColor okcolor; Outline okcolor] in c, (function - 0 -> Canvas.configure_rectangle c i [FillColor okcolor; - Outline okcolor]; + 0 -> Canvas.configure_rectangle c i [FillColor okcolor; + Outline okcolor]; Canvas.coords_set c i [Pixels 0; Pixels 0; Pixels 0; Pixels h] | -1 -> Canvas.configure_rectangle c i [FillColor kocolor; diff --git a/otherlibs/labltk/frx/frx_fit.ml b/otherlibs/labltk/frx/frx_fit.ml index 2011699ab..c03d6997a 100644 --- a/otherlibs/labltk/frx/frx_fit.ml +++ b/otherlibs/labltk/frx/frx_fit.ml @@ -23,26 +23,26 @@ let vert wid = and last_last = ref 0.0 in let rec resize () = pending_resize := false; - if !debug then + if !debug then (Printf.eprintf "%s Resize %d\n" (Widget.name wid) !newsize; flush stderr); Text.configure wid [TextHeight !newsize]; () - and check () = - let first, last = Text.yview_get wid in + and check () = + let first, last = Text.yview_get wid in check1 first last and check1 first last = let curheight = int_of_string (cget wid CHeight) in if !debug then begin - Printf.eprintf "%s C %d %f %f\n" + Printf.eprintf "%s C %d %f %f\n" (Widget.name wid) curheight first last; flush stderr end; if first = 0.0 && last = 1.0 then () (* Don't attempt anything if widget is not visible *) else if not (Winfo.viewable wid) then begin - if !debug then + if !debug then (Printf.eprintf "%s C notviewable\n" (Widget.name wid); flush stderr); (* Try again later *) @@ -51,7 +51,7 @@ let vert wid = check())) end else begin - let delta = + let delta = if last = 0.0 then 1 else if last = !last_last then (* it didn't change since our last resize ! *) diff --git a/otherlibs/labltk/frx/frx_focus.ml b/otherlibs/labltk/frx/frx_focus.ml index f33b9e6df..ce855e201 100644 --- a/otherlibs/labltk/frx/frx_focus.ml +++ b/otherlibs/labltk/frx/frx_focus.ml @@ -20,7 +20,7 @@ open Camltk (* ? use bind tag ? how about the global reference then *) let auto w = let old_focus = ref w in - bind w [[],Enter] + bind w [[],Enter] (BindSet([], fun _ -> old_focus := Focus.get (); Focus.set w)); - bind w [[],Leave] + bind w [[],Leave] (BindSet([], fun _ -> Focus.set !old_focus)) diff --git a/otherlibs/labltk/frx/frx_font.ml b/otherlibs/labltk/frx/frx_font.ml index 023470261..3b739a650 100644 --- a/otherlibs/labltk/frx/frx_font.ml +++ b/otherlibs/labltk/frx/frx_font.ml @@ -18,7 +18,7 @@ open Widget let version = "$Id$" -(* +(* * Finding fonts. Inspired by code in Ical by Sanjay Ghemawat. * Possibly bogus because some families use "i" for italic where others * use "o". @@ -30,7 +30,7 @@ module StringSet = Set.Make(struct type t = string let compare = compare end) let available_fonts = ref (StringSet.empty) -let get_canvas = +let get_canvas = Frx_misc.autodef (fun () -> Canvas.create Widget.default_toplevel []) @@ -41,11 +41,10 @@ let find fmly wght slant pxlsz = else let c = get_canvas() in try - let tag = Canvas.create_text c (Pixels 0) (Pixels 0) + let tag = Canvas.create_text c (Pixels 0) (Pixels 0) [Text "foo"; Font fontspec] in Canvas.delete c [tag]; available_fonts := StringSet.add fontspec !available_fonts; fontspec with _ -> raise (Invalid_argument fontspec) - diff --git a/otherlibs/labltk/frx/frx_font.mli b/otherlibs/labltk/frx/frx_font.mli index c0b7e6806..8dd999737 100644 --- a/otherlibs/labltk/frx/frx_font.mli +++ b/otherlibs/labltk/frx/frx_font.mli @@ -14,7 +14,7 @@ (* *) (***********************************************************************) val find : string -> string -> string -> int -> string - (* [find family weight slant pxlsz] returns the X11 full name of + (* [find family weight slant pxlsz] returns the X11 full name of the font required font, if available. Raises Invalid_argument fullname otherwise. *) diff --git a/otherlibs/labltk/frx/frx_lbutton.mli b/otherlibs/labltk/frx/frx_lbutton.mli index d79431f34..60c26a5b5 100644 --- a/otherlibs/labltk/frx/frx_lbutton.mli +++ b/otherlibs/labltk/frx/frx_lbutton.mli @@ -21,4 +21,3 @@ val version : string val create : Widget -> option list -> Widget and configure : Widget -> option list -> unit - diff --git a/otherlibs/labltk/frx/frx_listbox.ml b/otherlibs/labltk/frx/frx_listbox.ml index 8bb2941c0..17d6a3f9a 100644 --- a/otherlibs/labltk/frx/frx_listbox.ml +++ b/otherlibs/labltk/frx/frx_listbox.ml @@ -17,20 +17,20 @@ open Camltk let version = "$Id$" -(* +(* * Link a scrollbar and a listbox *) let scroll_link sb lb = - Listbox.configure lb + Listbox.configure lb [YScrollCommand (Scrollbar.set sb)]; - Scrollbar.configure sb + Scrollbar.configure sb [ScrollCommand (Listbox.yview lb)] -(* - * Completion for listboxes, Macintosh style. +(* + * Completion for listboxes, Macintosh style. * As long as you type fast enough, the listbox is repositioned to the * first entry "greater" than the typed prefix. - * assumes: + * assumes: * sorted list (otherwise it's stupid) * fixed size, because we don't recompute size at each callback invocation *) @@ -69,9 +69,9 @@ let add_completion lb action = recenter() in - bind lb [[], KeyPress] - (BindSet([Ev_Char; Ev_Time], - (function ev -> + bind lb [[], KeyPress] + (BindSet([Ev_Char; Ev_Time], + (function ev -> (* consider only keys producing characters. The callback is called * even if you press Shift. *) @@ -84,7 +84,7 @@ let add_completion lb action = let new_scrollable_listbox top options = let f = Frame.create top [] in - let lb = Listbox.create f options + let lb = Listbox.create f options and sb = Scrollbar.create f [] in scroll_link sb lb; pack [lb] [Side Side_Left; Fill Fill_Both; Expand true]; diff --git a/otherlibs/labltk/frx/frx_mem.ml b/otherlibs/labltk/frx/frx_mem.ml index 4bab86862..37af20830 100644 --- a/otherlibs/labltk/frx/frx_mem.ml +++ b/otherlibs/labltk/frx/frx_mem.ml @@ -24,7 +24,7 @@ let wordsize = (* officially approved *) if 1 lsl 31 = 0 then 4 else 8 -let init () = +let init () = let top = Toplevel.create Widget.default_toplevel [Class "CamlGC"] in let name = Camltk.appname_get () in Wm.title_set top (name ^ " Memory Gauge"); diff --git a/otherlibs/labltk/frx/frx_misc.ml b/otherlibs/labltk/frx/frx_misc.ml index d2be00922..75c8a3e4d 100644 --- a/otherlibs/labltk/frx/frx_misc.ml +++ b/otherlibs/labltk/frx/frx_misc.ml @@ -31,12 +31,12 @@ let create_photo options = let hasopt = ref None in (* Check options *) List.iter (function - Data s -> + Data s -> begin match !hasopt with None -> hasopt := Some (Data s) | Some _ -> raise (Protocol.TkError "two data sources in options") end - | File f -> + | File f -> begin match !hasopt with None -> hasopt := Some (File f) | Some _ -> raise (Protocol.TkError "two data sources in options") @@ -51,8 +51,8 @@ let create_photo options = let oc = open_out_bin tmpfile in output_string oc s; close_out oc; - let newopts = - List.map (function + let newopts = + List.map (function | Data s -> File tmpfile | o -> o) options in diff --git a/otherlibs/labltk/frx/frx_req.ml b/otherlibs/labltk/frx/frx_req.ml index 029f4973b..ab7308fa3 100644 --- a/otherlibs/labltk/frx/frx_req.ml +++ b/otherlibs/labltk/frx/frx_req.ml @@ -16,14 +16,14 @@ open Camltk (* - * Some standard requesters (in Amiga techspeak) or dialog boxes (in Apple + * Some standard requesters (in Amiga techspeak) or dialog boxes (in Apple * jargon). *) let version = "$Id$" (* - * Simple requester + * Simple requester * an entry field, unrestricted, with emacs-like bindings * Note: grabs focus, thus always unique at one given moment, and we * shouldn't have to worry about toplevel widget name. @@ -51,7 +51,7 @@ let open_simple title action notaction memory = let f = Frame.create t [] in let bok = Button.create f [Text "Ok"; Command activate] in let bcancel = Button.create f - [Text "Cancel"; + [Text "Cancel"; Command (fun () -> notaction(); Grab.release t; destroy t)] in bind e [[], KeyPressDetail "Escape"] @@ -76,7 +76,7 @@ let open_simple_synchronous title memory = Entry.create t [Relief Sunken; TextVariable memory; TextWidth len] in let waiting = Textvariable.create_temporary t in - + let activate _ = Grab.release t; (* because of wm *) destroy t; (* so action can call open_simple *) @@ -86,10 +86,10 @@ let open_simple_synchronous title memory = let f = Frame.create t [] in let bok = Button.create f [Text "Ok"; Command activate] in - let bcancel = + let bcancel = Button.create f - [Text "Cancel"; - Command (fun () -> + [Text "Cancel"; + Command (fun () -> Grab.release t; destroy t; Textvariable.set waiting "0")] in bind e [[], KeyPressDetail "Escape"] @@ -118,7 +118,7 @@ let open_list title elements action notaction = Wm.title_set t title; let tit = Label.create t [Text title] in - let fls = Frame.create t [Relief Sunken; BorderWidth (Pixels 2)] in + let fls = Frame.create t [Relief Sunken; BorderWidth (Pixels 2)] in let lb = Listbox.create fls [SelectMode Extended] in let sb = Scrollbar.create fls [] in Frx_listbox.scroll_link sb lb; @@ -135,12 +135,12 @@ let open_list title elements action notaction = bind lb [[Double], ButtonPressDetail 1] (BindSetBreakable ([], activate)); - Frx_listbox.add_completion lb activate; + Frx_listbox.add_completion lb activate; let f = Frame.create t [] in let bok = Button.create f [Text "Ok"; Command activate] in - let bcancel = Button.create f - [Text "Cancel"; + let bcancel = Button.create f + [Text "Cancel"; Command (fun () -> notaction(); Grab.release t; destroy t)] in pack [bok; bcancel] [Side Side_Left; Fill Fill_X; Expand true]; @@ -167,8 +167,8 @@ let open_passwd title = and fp,ep = Frx_entry.new_label_entry t "Password" (fun s -> ()) in let fb = Frame.create t [] in - let bok = Button.create fb - [Text "Ok"; Command (fun _ -> + let bok = Button.create fb + [Text "Ok"; Command (fun _ -> username := Entry.get eu; password := Entry.get ep; Grab.release t; (* because of wm *) @@ -183,8 +183,8 @@ let open_passwd title = bind eu [[], KeyPressDetail "Return"] (BindSetBreakable ([], (fun _ -> Focus.set ep; break()))); bind ep [[], KeyPressDetail "Return"] - (BindSetBreakable ([], (fun _ -> Button.flash bok; - Button.invoke bok; + (BindSetBreakable ([], (fun _ -> Button.flash bok; + Button.invoke bok; break()))); pack [bok] [Side Side_Left; Expand true]; diff --git a/otherlibs/labltk/frx/frx_req.mli b/otherlibs/labltk/frx/frx_req.mli index 815b28459..41de7df35 100644 --- a/otherlibs/labltk/frx/frx_req.mli +++ b/otherlibs/labltk/frx/frx_req.mli @@ -25,7 +25,7 @@ val open_simple : val open_simple_synchronous : string -> Textvariable.textVariable -> bool (* [open_simple_synchronous title memory] - A synchronous dialog with a message and an entry field (with + A synchronous dialog with a message and an entry field (with memory between invocations). Returns true if the user clicks Ok or false if the user clicks Cancel. *) diff --git a/otherlibs/labltk/frx/frx_synth.ml b/otherlibs/labltk/frx/frx_synth.ml index d7acf06f7..76b83b640 100644 --- a/otherlibs/labltk/frx/frx_synth.ml +++ b/otherlibs/labltk/frx/frx_synth.ml @@ -22,18 +22,18 @@ open Protocol let events = Hashtbl.create 37 (* Notes: - * "cascading" events (on the same event) are not supported + * "cascading" events (on the same event) are not supported * Only one binding active at a time for each event on each widget. *) (* Get the callback table associated with <name>. Initializes if required *) let get_event name = - try Hashtbl.find events name + try Hashtbl.find events name with Not_found -> let h = Hashtbl.create 37 in Hashtbl.add events name h; - (* Initialize the callback invocation mechanism, based on + (* Initialize the callback invocation mechanism, based on variable trace *) let var = "camltk_events(" ^ name ^")" in @@ -44,9 +44,9 @@ let get_event name = begin match Textvariable.get tkvar with "all" -> (* Invoke all callbacks *) Hashtbl.iter - (fun p f -> - try - f (cTKtoCAMLwidget p) + (fun p f -> + try + f (cTKtoCAMLwidget p) with _ -> ()) h | p -> (* Invoke callback for p *) @@ -56,14 +56,14 @@ let get_event name = f w with _ -> () - end; + end; set ()(* reactivate the callback *) ) in set(); - h + h (* Remove binding for event <name> on widget <w> *) -let remove w name = +let remove w name = Hashtbl.remove (get_event name) (Widget.name w) (* Adds <f> as callback for widget <w> on event <name> *) @@ -77,7 +77,7 @@ let broadcast name = (* Sends event <name> to widget <w> *) let send name w = - Textvariable.set (Textvariable.coerce ("camltk_events(" ^ name ^")")) + Textvariable.set (Textvariable.coerce ("camltk_events(" ^ name ^")")) (Widget.name w) (* Remove all callbacks associated to widget <w> *) diff --git a/otherlibs/labltk/frx/frx_text.ml b/otherlibs/labltk/frx/frx_text.ml index 7c1f551b1..18d9961ff 100644 --- a/otherlibs/labltk/frx/frx_text.ml +++ b/otherlibs/labltk/frx/frx_text.ml @@ -17,8 +17,8 @@ open Camltk let version = "$Id$" -(* - * convert an integer to an absolute index +(* + * convert an integer to an absolute index *) let abs_index n = TextIndex (LineChar(0,0), [CharOffset n]) @@ -35,8 +35,8 @@ let textEnd = let textBegin = TextIndex (LineChar(0,0), []) -(* - * Link a scrollbar and a text widget +(* + * Link a scrollbar and a text widget *) let scroll_link sb tx = Text.configure tx [YScrollCommand (Scrollbar.set sb)]; @@ -64,7 +64,7 @@ let navigation_keys tx = let new_scrollable_text top options navigation = let f = Frame.create top [] in - let tx = Text.create f options + let tx = Text.create f options and sb = Scrollbar.create f [] in scroll_link sb tx; (* IN THIS ORDER -- RESIZING *) @@ -85,11 +85,11 @@ let topsearch t = Wm.title_set top "Text search"; let f = Frame.create_named top "fpattern" [] in let m = Label.create_named f "search" [Text "Search pattern"] - and e = Entry.create_named f "pattern" + and e = Entry.create_named f "pattern" [Relief Sunken; TextVariable (patternv()) ] in let hgroup = Frame.create top [] and bgroup = Frame.create top [] in - let fdir = Frame.create hgroup [] + let fdir = Frame.create hgroup [] and fmisc = Frame.create hgroup [] in let direction = Textvariable.create_temporary fdir and exactv = Textvariable.create_temporary fdir @@ -101,11 +101,11 @@ let topsearch t = and exact = Checkbutton.create_named fmisc "exact" [Text "Exact match"; Variable exactv] and case = Checkbutton.create_named fmisc "case" - [Text "Fold Case"; Variable (casev())] + [Text "Fold Case"; Variable (casev())] and searchb = Button.create_named bgroup "search" [Text "Search"] and contb = Button.create_named bgroup "continue" [Text "Continue"] and dismissb = Button.create_named bgroup "dismiss" - [Text "Dismiss"; + [Text "Dismiss"; Command (fun () -> Text.tag_delete t ["search"]; destroy top)] in Radiobutton.invoke forw; @@ -131,24 +131,24 @@ let topsearch t = try let forward = Textvariable.get direction = "f" in let i = Text.search t !opts (Entry.get e) - (if cont then !current_index + (if cont then !current_index else if forward then textBegin else TextIndex(End, [CharOffset (-1)])) (* does not work with end *) - (if forward then textEnd + (if forward then textEnd else textBegin) in let found = TextIndex (i, []) in - current_index := + current_index := TextIndex(i, [CharOffset (if forward then 1 else (-1))]); Text.tag_delete t ["search"]; Text.tag_add t "search" found (TextIndex (i, [WordEnd])); - Text.tag_configure t "search" + Text.tag_configure t "search" [Relief Raised; BorderWidth (Pixels 1); Background Red]; Text.see t found with Invalid_argument _ -> Bell.ring() in - - bind e [[], KeyPressDetail "Return"] + + bind e [[], KeyPressDetail "Return"] (BindSet ([], fun _ -> search false ())); Button.configure searchb [Command (search false)]; Button.configure contb [Command (search true)]; @@ -163,10 +163,10 @@ let addsearch tx = | _ -> () (* We use Mod1 instead of Meta or Alt *) -let init () = +let init () = List.iter (function ev -> - tag_bind "TEXT_RO" ev - (BindSetBreakable ([Ev_Widget], + tag_bind "TEXT_RO" ev + (BindSetBreakable ([Ev_Widget], (fun ei -> page_up ei.ev_Widget; break())))) [ [[], KeyPressDetail "BackSpace"]; @@ -176,8 +176,8 @@ let init () = [[Mod1], KeyPressDetail "v"] ]; List.iter (function ev -> - tag_bind "TEXT_RO" ev - (BindSetBreakable ([Ev_Widget], + tag_bind "TEXT_RO" ev + (BindSetBreakable ([Ev_Widget], (fun ei -> page_down ei.ev_Widget; break())))) [ [[], KeyPressDetail "space"]; @@ -185,16 +185,16 @@ let init () = [[Control], KeyPressDetail "v"] ]; List.iter (function ev -> - tag_bind "TEXT_RO" ev - (BindSetBreakable ([Ev_Widget], + tag_bind "TEXT_RO" ev + (BindSetBreakable ([Ev_Widget], (fun ei -> line_up ei.ev_Widget; break())))) [ [[], KeyPressDetail "Up"]; [[Mod1], KeyPressDetail "z"] ]; List.iter (function ev -> - tag_bind "TEXT_RO" ev - (BindSetBreakable ([Ev_Widget], + tag_bind "TEXT_RO" ev + (BindSetBreakable ([Ev_Widget], (fun ei -> line_down ei.ev_Widget; break())))) [ [[], KeyPressDetail "Down"]; @@ -202,8 +202,8 @@ let init () = ]; List.iter (function ev -> - tag_bind "TEXT_RO" ev - (BindSetBreakable ([Ev_Widget], + tag_bind "TEXT_RO" ev + (BindSetBreakable ([Ev_Widget], (fun ei -> top ei.ev_Widget; break())))) [ [[], KeyPressDetail "Home"]; @@ -211,8 +211,8 @@ let init () = ]; List.iter (function ev -> - tag_bind "TEXT_RO" ev - (BindSetBreakable ([Ev_Widget], + tag_bind "TEXT_RO" ev + (BindSetBreakable ([Ev_Widget], (fun ei -> bottom ei.ev_Widget; break())))) [ [[], KeyPressDetail "End"]; @@ -226,4 +226,3 @@ let init () = [ [[Control], KeyPressDetail "s"] ] - diff --git a/otherlibs/labltk/frx/frx_widget.ml b/otherlibs/labltk/frx/frx_widget.ml index ab7d26112..a81c768f0 100644 --- a/otherlibs/labltk/frx/frx_widget.ml +++ b/otherlibs/labltk/frx/frx_widget.ml @@ -21,4 +21,3 @@ let version = "$Id$" let resizeable t = update_idletasks(); (* wait until layout is computed *) Wm.minsize_set t (Winfo.width t) (Winfo.height t) - |