summaryrefslogtreecommitdiffstats
path: root/otherlibs
diff options
context:
space:
mode:
Diffstat (limited to 'otherlibs')
-rw-r--r--otherlibs/labltk/Widgets.src32
-rw-r--r--otherlibs/labltk/browser/editor.ml2
-rw-r--r--otherlibs/labltk/browser/jg_message.ml3
-rw-r--r--otherlibs/labltk/browser/jg_toplevel.ml4
-rw-r--r--otherlibs/labltk/browser/viewer.ml4
-rw-r--r--otherlibs/labltk/compiler/compile.ml10
-rw-r--r--otherlibs/labltk/compiler/intf.ml4
-rw-r--r--otherlibs/labltk/example/clock.ml17
-rw-r--r--otherlibs/labltk/example/demo.ml4
-rw-r--r--otherlibs/labltk/example/eyes.ml2
-rw-r--r--otherlibs/labltk/jpf/balloon.ml4
-rw-r--r--otherlibs/labltk/jpf/fileselect.ml2
12 files changed, 44 insertions, 44 deletions
diff --git a/otherlibs/labltk/Widgets.src b/otherlibs/labltk/Widgets.src
index 52f715062..2f55d860c 100644
--- a/otherlibs/labltk/Widgets.src
+++ b/otherlibs/labltk/Widgets.src
@@ -150,8 +150,6 @@ subtype option(bitmapimage) {
module Imagebitmap {
function (ImageBitmap) create ["image"; "create"; "bitmap"; ?name:[ImageBitmap]; option(bitmapimage) list]
-# function (ImageBitmap) create ["image"; "create"; "bitmap"; option(bitmapimage) list]
-# function (ImageBitmap) create_named ["image"; "create"; "bitmap"; name: ImageBitmap; option(bitmapimage) list]
function () configure [ImageBitmap; "configure"; option(bitmapimage) list]
function (string) configure_get [ImageBitmap; "configure"]
# Functions inherited from the "image" TK class
@@ -1534,7 +1532,7 @@ widget text {
function (bool) compare [widget(text); "compare"; index: TextIndex; op: Comparison; index: TextIndex]
function () configure [widget(text); "configure"; option(text) list]
function (string) configure_get [widget(text); "configure"]
- function () debug [widget(text); "debug"; switch: bool]
+ function () debug [widget(text); "debug"; bool]
function () delete [widget(text); "delete"; start: TextIndex; stop: TextIndex]
function () delete_char [widget(text); "delete"; index: TextIndex]
function (int, int, int, int, int) dlineinfo [widget(text); "dlineinfo"; index: TextIndex]
@@ -1562,7 +1560,7 @@ widget text {
function () see [widget(text); "see"; index: TextIndex]
# Tags
function () tag_add [widget(text); "tag"; "add"; tag: TextTag; start: TextIndex; stop: TextIndex]
- function () tag_add_char [widget(text); "tag"; "add"; tag: TextTag; at: TextIndex]
+ function () tag_add_char [widget(text); "tag"; "add"; tag: TextTag; index: TextIndex]
external tag_bind "builtin/text_tag_bind"
function () tag_configure [widget(text); "tag"; "configure"; tag: TextTag; option(texttag) list]
function () tag_delete [widget(text); "tag"; "delete"; TextTag list]
@@ -1578,7 +1576,7 @@ widget text {
# function () tag_raise_top [widget(text); "tag"; "raise"; tag: TextTag ]
function (Index(text) as "[>`Linechar of int * int]" list) tag_ranges [widget(text); "tag"; "ranges"; tag: TextTag]
function () tag_remove [widget(text); "tag"; "remove"; tag: TextTag; start: TextIndex; stop: TextIndex]
- function () tag_remove_char [widget(text); "tag"; "remove"; tag: TextTag; at: TextIndex]
+ function () tag_remove_char [widget(text); "tag"; "remove"; tag: TextTag; index: TextIndex]
function () window_configure [widget(text); "window"; "configure"; tag: TextTag; option(embeddedw) list]
function () window_create [widget(text); "window"; "create"; index: TextIndex; option(embeddedw) list]
function (widget list) window_names [widget(text); "window"; "names"]
@@ -1681,7 +1679,7 @@ module Winfo {
# unsafe function (widget) containing_displayof ["winfo"; "containing"; "-displayof"; displayof: widget; x: int; y: int]
function (int) depth ["winfo"; "depth"; widget]
function (bool) exists ["winfo"; "exists"; widget]
- function (float) fpixels ["winfo"; "fpixels"; widget; distance: Units]
+ function (float) fpixels ["winfo"; "fpixels"; widget; length: Units]
function (string) geometry ["winfo"; "geometry"; widget]
function (int) height ["winfo"; "height"; widget]
unsafe function (string) id ["winfo"; "id"; widget]
@@ -1695,7 +1693,7 @@ module Winfo {
unsafe function (widget) pathname ["winfo"; "pathname"; ?displayof:["-displayof"; widget]; string]
# unsafe function (widget) pathname ["winfo"; "pathname"; string]
# unsafe function (widget) pathname_displayof ["winfo"; "pathname"; "-displayof"; displayof: widget; string]
- function (int) pixels ["winfo"; "pixels"; widget; distance: Units]
+ function (int) pixels ["winfo"; "pixels"; widget; length: Units]
function (int) pointerx ["winfo"; "pointerx"; widget]
function (int) pointery ["winfo"; "pointery"; widget]
function (int, int) pointerxy ["winfo"; "pointerxy"; widget]
@@ -1750,24 +1748,24 @@ module Wm {
function (string) client_get ["wm"; "client"; widget]
### WM_COLORMAP_WINDOWS
function () colormapwindows_set
- ["wm"; "colormapwindows"; widget; [widgets: widget list]]
+ ["wm"; "colormapwindows"; widget; [windows: widget list]]
unsafe function (widget list) colormapwindows_get
["wm"; "colormapwindows"; widget]
### WM_COMMAND
function () command_clear ["wm"; "command"; widget; ""]
- function () command_set ["wm"; "command"; widget; [commands: string list]]
+ function () command_set ["wm"; "command"; widget; [string list]]
function (string list) command_get ["wm"; "command"; widget]
function () deiconify ["wm"; "deiconify"; widget]
### Focus model
- function () focusmodel_set ["wm"; "focusmodel"; widget; model: FocusModel]
+ function () focusmodel_set ["wm"; "focusmodel"; widget; FocusModel]
function (FocusModel) focusmodel_get ["wm"; "focusmodel"; widget]
function (string) frame ["wm"; "frame"; widget]
### Geometry
- function () geometry_set ["wm"; "geometry"; widget; geometry: string]
+ function () geometry_set ["wm"; "geometry"; widget; string]
function (string) geometry_get ["wm"; "geometry"; widget]
### Grid
@@ -1781,18 +1779,18 @@ module Wm {
unsafe function (widget) group_get ["wm"; "group"; widget]
### Icon bitmap
function () iconbitmap_clear ["wm"; "iconbitmap"; widget; ""]
- function () iconbitmap_set ["wm"; "iconbitmap"; widget; bitmap: Bitmap]
+ function () iconbitmap_set ["wm"; "iconbitmap"; widget; Bitmap]
function (Bitmap) iconbitmap_get ["wm"; "iconbitmap"; widget]
function () iconify ["wm"; "iconify"; widget]
### Icon mask
function () iconmask_clear ["wm"; "iconmask"; widget; ""]
- function () iconmask_set ["wm"; "iconmask"; widget; bitmap: Bitmap]
+ function () iconmask_set ["wm"; "iconmask"; widget; Bitmap]
function (Bitmap) iconmask_get ["wm"; "iconmask"; widget]
### Icon name
- function () iconname_set ["wm"; "iconname"; widget; name: string]
+ function () iconname_set ["wm"; "iconname"; widget; string]
function (string) iconname_get ["wm"; "iconname"; widget]
### Icon position
function () iconposition_clear ["wm"; "iconposition"; widget; ""; ""]
@@ -1813,7 +1811,7 @@ module Wm {
function (bool) overrideredirect_get ["wm"; "overrideredirect"; widget]
### Position
function () positionfrom_clear ["wm"; "positionfrom"; widget; ""]
- function () positionfrom_set ["wm"; "positionfrom"; widget; who: WmFrom]
+ function () positionfrom_set ["wm"; "positionfrom"; widget; WmFrom]
function (WmFrom) positionfrom_get ["wm"; "positionfrom"; widget]
### Protocols
function () protocol_set ["wm"; "protocol"; widget; name: string; command: function()]
@@ -1824,14 +1822,14 @@ module Wm {
function (bool, bool) resizable_get ["wm"; "resizable"; widget(toplevel)]
### Sizefrom
function () sizefrom_clear ["wm"; "sizefrom"; widget; ""]
- function () sizefrom_set ["wm"; "sizefrom"; widget; who: WmFrom]
+ function () sizefrom_set ["wm"; "sizefrom"; widget; WmFrom]
function (WmFrom) sizefrom_get ["wm"; "sizefrom"; widget]
function (string) state ["wm"; "state"; widget]
### Title
function (string) title_get ["wm"; "title"; widget]
- function () title_set ["wm"; "title"; widget; title: string]
+ function () title_set ["wm"; "title"; widget; string]
### Transient
function () transient_clear ["wm"; "transient"; widget; ""]
function () transient_set ["wm"; "transient"; widget; master: widget(toplevel)]
diff --git a/otherlibs/labltk/browser/editor.ml b/otherlibs/labltk/browser/editor.ml
index fc8edbca6..70f02d33f 100644
--- a/otherlibs/labltk/browser/editor.ml
+++ b/otherlibs/labltk/browser/editor.ml
@@ -517,7 +517,7 @@ class editor ~top ~menus = object (self)
bind top ~events:[`Destroy] ~breakable:true ~fields:[`Widget] ~action:
begin fun ev ->
if Widget.name ev.ev_Widget = Widget.name top
- then self#quit ()
+ then (break (); self#quit ())
end;
(* File menu *)
diff --git a/otherlibs/labltk/browser/jg_message.ml b/otherlibs/labltk/browser/jg_message.ml
index 0de81640f..30d8d8154 100644
--- a/otherlibs/labltk/browser/jg_message.ml
+++ b/otherlibs/labltk/browser/jg_message.ml
@@ -84,7 +84,8 @@ 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 = Jg_button.create_destroyer tl ~parent:fw ~text:"Cancel"
+ and cancel = Button.create fw ~text:"Cancel"
+ ~command:(fun () -> r := `cancel; destroy tl)
in
bind tl ~events:[`Destroy] ~extend:true
~action:(fun _ -> Textvariable.set sync "1");
diff --git a/otherlibs/labltk/browser/jg_toplevel.ml b/otherlibs/labltk/browser/jg_toplevel.ml
index 8b4fb1778..46fd376d2 100644
--- a/otherlibs/labltk/browser/jg_toplevel.ml
+++ b/otherlibs/labltk/browser/jg_toplevel.ml
@@ -18,7 +18,7 @@ open Tk
let titled ?iconname title =
let iconname = match iconname with None -> title | Some s -> s in
let tl = Toplevel.create Widget.default_toplevel in
- Wm.title_set tl ~title;
- Wm.iconname_set tl ~name:iconname;
+ Wm.title_set tl title;
+ Wm.iconname_set tl iconname;
Wm.group_set tl ~leader: Widget.default_toplevel;
tl
diff --git a/otherlibs/labltk/browser/viewer.ml b/otherlibs/labltk/browser/viewer.ml
index 7ec4aad9e..4d7afb496 100644
--- a/otherlibs/labltk/browser/viewer.ml
+++ b/otherlibs/labltk/browser/viewer.ml
@@ -265,8 +265,8 @@ let f ?(dir=Unix.getcwd()) ?on () =
let tl = Jg_toplevel.titled "Module viewer" in
ignore (Jg_bind.escape_destroy tl); coe tl
| Some top ->
- Wm.title_set top ~title:"OCamlBrowser";
- Wm.iconname_set top ~name:"OCamlBrowser";
+ Wm.title_set top "OCamlBrowser";
+ Wm.iconname_set top "OCamlBrowser";
let tl = Frame.create top in
pack [tl] ~expand:true ~fill:`Both;
coe tl
diff --git a/otherlibs/labltk/compiler/compile.ml b/otherlibs/labltk/compiler/compile.ml
index daa935fd3..f9dbeed70 100644
--- a/otherlibs/labltk/compiler/compile.ml
+++ b/otherlibs/labltk/compiler/compile.ml
@@ -653,6 +653,8 @@ let write_function ~w def =
in
replace_args ~u:[] ~l:[] ~o:[] (List.rev (variables @ variables2))
in
+ let has_opts = (ov <> [] || co <> "") in
+ if not has_opts then List.iter uv ~f:(fun x -> w " "; w x);
List.iter (lv@ov) ~f:(fun (l, v) -> w " "; w (labelstring l); w v);
if co <> "" then begin
if lv = [] && ov = [] then w (" ?" ^ lbl ^ ":eta");
@@ -660,12 +662,12 @@ let write_function ~w def =
w (co ^ "_optionals");
if lv = [] && ov = [] then w (" ?" ^ lbl ^ ":eta");
w " (fun opts";
- if uv = [] then w " ()"
- else List.iter uv ~f:(fun x -> w " "; w x);
+ if uv = [] then w " ()" else
+ if has_opts then List.iter uv ~f:(fun x -> w " "; w x);
w " ->\n"
end else begin
- List.iter uv ~f:(fun x -> w " "; w x);
- if (ov <> [] || lv = []) && uv = [] then w " ()";
+ if (ov <> [] || lv = []) && uv = [] then w " ()" else
+ if has_opts then List.iter uv ~f:(fun x -> w " "; w x);
w " =\n"
end;
begin match def.result with
diff --git a/otherlibs/labltk/compiler/intf.ml b/otherlibs/labltk/compiler/intf.ml
index 87e1eed85..634e0a315 100644
--- a/otherlibs/labltk/compiler/intf.ml
+++ b/otherlibs/labltk/compiler/intf.ml
@@ -72,7 +72,9 @@ let write_function_type ~w def =
replace_args ~u:[] ~l:[] ~o:[] (List.rev tys)
in
let counter = ref 0 in
- List.iter (ls @ os @ us) ~f:
+ let params =
+ if os = [] then us @ ls else ls @ os @ us in
+ List.iter params ~f:
begin fun (l, t) ->
if l <> "" then w (l ^ ":");
w (ppMLtype t ~counter);
diff --git a/otherlibs/labltk/example/clock.ml b/otherlibs/labltk/example/clock.ml
index 7c8d21311..cefd78495 100644
--- a/otherlibs/labltk/example/clock.ml
+++ b/otherlibs/labltk/example/clock.ml
@@ -82,8 +82,8 @@ class clock ~parent = object (self)
(* Redraw everything *)
method redraw =
- Canvas.coords_set ~coords:[ 1; 1; width - 2; height - 2 ]
- canvas (`Tag "cadran");
+ Canvas.coords_set canvas (`Tag "cadran")
+ ~coords:[ 1; 1; width - 2; height - 2 ];
self#draw_figures;
self#draw_arrows (Unix.localtime (Unix.time ()))
@@ -107,22 +107,19 @@ class clock ~parent = object (self)
let hangle =
float (rflag * (tm.Unix.tm_hour * 60 + tm.Unix.tm_min) - 180)
*. pi /. 360. in
- Canvas.coords_set
+ Canvas.coords_set canvas (`Tag "hours")
~coords:[ self#x 0.; self#y 0.;
- self#x (cos hangle /. 2.); self#y (sin hangle /. 2.) ]
- canvas (`Tag "hours");
+ self#x (cos hangle /. 2.); self#y (sin hangle /. 2.) ];
Canvas.configure_line ~width:(min width height / 50)
canvas (`Tag "minutes");
let mangle = float (rflag * tm.Unix.tm_min - 15) *. pi /. 30. in
- Canvas.coords_set
+ Canvas.coords_set canvas (`Tag "minutes")
~coords:[ self#x 0.; self#y 0.;
- self#x (cos mangle /. 1.5); self#y (sin mangle /. 1.5) ]
- canvas (`Tag "minutes");
+ self#x (cos mangle /. 1.5); self#y (sin mangle /. 1.5) ];
let sangle = float (rflag * tm.Unix.tm_sec - 15) *. pi /. 30. in
- Canvas.coords_set
+ Canvas.coords_set canvas (`Tag "seconds")
~coords:[ self#x 0.; self#y 0.;
self#x (cos sangle /. 1.25); self#y (sin sangle /. 1.25) ]
- canvas (`Tag "seconds")
end
(* Initialize the Tcl interpreter *)
diff --git a/otherlibs/labltk/example/demo.ml b/otherlibs/labltk/example/demo.ml
index 343f45684..e648b3bb1 100644
--- a/otherlibs/labltk/example/demo.ml
+++ b/otherlibs/labltk/example/demo.ml
@@ -25,7 +25,7 @@ let _ =
(* Initialize Tk *)
let top = openTk () in
(* Title setting *)
-Wm.title_set top ~title:"LablTk demo";
+Wm.title_set top "LablTk demo";
(* Base frame *)
let base = Frame.create top in
@@ -118,7 +118,7 @@ pack [bar] ~fill: `X;
(* Toplevel *)
let top2 = Toplevel.create top in
- Wm.title_set top2 ~title:"LablTk demo control";
+ Wm.title_set top2 "LablTk demo control";
let defcol = `Color "#dfdfdf" in
let selcol = `Color "#ffdfdf" in
let buttons =
diff --git a/otherlibs/labltk/example/eyes.ml b/otherlibs/labltk/example/eyes.ml
index 73286d303..a20116ed5 100644
--- a/otherlibs/labltk/example/eyes.ml
+++ b/otherlibs/labltk/example/eyes.ml
@@ -48,7 +48,7 @@ let _ =
else
e.ev_MouseX, e.ev_MouseY
in
- Canvas.move ~x: (nx - !curx) ~y: (ny - !cury) c o;
+ Canvas.move c o ~x: (nx - !curx) ~y: (ny - !cury);
curx := nx;
cury := ny)
c
diff --git a/otherlibs/labltk/jpf/balloon.ml b/otherlibs/labltk/jpf/balloon.ml
index 513214d02..971d1e2d9 100644
--- a/otherlibs/labltk/jpf/balloon.ml
+++ b/otherlibs/labltk/jpf/balloon.ml
@@ -60,8 +60,8 @@ let put ~on: w ~ms: millisec mesg =
Message.configure !popupw ~text: mesg;
raise_window !topw;
Wm.geometry_set !topw (* 9 & 8 are some kind of magic... *)
- ~geometry: ("+"^(string_of_int (ev.ev_RootX + 9))^
- "+"^(string_of_int (ev.ev_RootY + 8)));
+ ("+"^(string_of_int (ev.ev_RootX + 9))^
+ "+"^(string_of_int (ev.ev_RootY + 8)));
Wm.deiconify !topw;
cursor := cget w `Cursor;
configure_cursor w "hand2"))
diff --git a/otherlibs/labltk/jpf/fileselect.ml b/otherlibs/labltk/jpf/fileselect.ml
index f3aa33cf3..6dabf5a0d 100644
--- a/otherlibs/labltk/jpf/fileselect.ml
+++ b/otherlibs/labltk/jpf/fileselect.ml
@@ -183,7 +183,7 @@ let f ~title ~action:proc ~filter:deffilter ~file:deffile ~multi ~sync =
let tl = Toplevel.create default_toplevel in
Focus.set tl;
- Wm.title_set tl ~title;
+ Wm.title_set tl title;
let filter_var = Textvariable.create ~on:tl () (* new_temporary *)
and selection_var = Textvariable.create ~on:tl ()
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-19 05:15:09 +0000