meilleurs labels

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

3 files changed, 20 insertions, 20 deletions

diff --git a/otherlibs/labltk/Widgets.src b/otherlibs/labltk/Widgets.src
index c5c2d290d..7fdf547af 100644
--- a/otherlibs/labltk/Widgets.src
+++ b/otherlibs/labltk/Widgets.src
@@ -691,7 +691,7 @@ subtype option(rowcolumnconfigure) {
 subtype option(grid) {
    Column ["-column"; int]
    ColumnSpan ["-columnspan"; int]
-   Inside ["-in"; widget]
+   In(Inside) ["-in"; widget]
    IPadX ["-ipadx"; int]
    IPadY ["-ipady"; int]
    PadX
@@ -1106,7 +1106,7 @@ subtype option(pack) {
    Before ["-before"; widget]
    Expand ["-expand"; bool]
    Fill ["-fill"; FillMode]
-   In ["-in"; widget]
+   In(Inside) ["-in"; widget]
    IPadX ["-ipadx"; int]
    IPadY ["-ipady"; int]
    PadX
@@ -1161,11 +1161,11 @@ subtype option(photoimage) {
   }
 
 subtype photo(copy) {
-  ImgFrom ["-from"; int; int; int; int]
-  ImgTo   ["-to"; int; int; int; int]
-  Shrink  ["-shrink"]
-  Zoom    ["-zoom"; int; int]
-  Subsample ["-subsample"; int; int]
+  ImgFrom(Src) ["-from"; int; int; int; int]
+  ImgTo(Dst)   ["-to"; int; int; int; int]
+  Shrink       ["-shrink"]
+  Zoom         ["-zoom"; int; int]
+  Subsample    ["-subsample"; int; int]
   }
 
 subtype photo(put) {
@@ -1176,7 +1176,7 @@ subtype photo(read) {
   ImgFormat ["-format"; string]
   ImgFrom
   Shrink
-  TopLeft ["-to"; int; int]
+  TopLeft(Dst) ["-to"; int; int]
   }
 
 subtype photo(write) {
@@ -1323,7 +1323,7 @@ widget scale {
    option BigIncrement ["-bigincrement"; float]
    option ScaleCommand ["-command"; function (float)]
    option Digits ["-digits"; int]
-   option From ["-from"; float]
+   option From(Min) ["-from"; float]
    option Label ["-label"; string]
    option Length ["-length"; int]
    option Resolution ["-resolution"; float]
@@ -1331,7 +1331,7 @@ widget scale {
    option SliderLength ["-sliderlength"; int]
    option State
    option TickInterval ["-tickinterval"; float]
-   option To ["-to"; float]
+   option To(Max) ["-to"; float]
    option Variable
    option Width
 
diff --git a/otherlibs/labltk/compiler/compile.ml b/otherlibs/labltk/compiler/compile.ml
index 7bf3c9d6c..daa935fd3 100644
--- a/otherlibs/labltk/compiler/compile.ml
+++ b/otherlibs/labltk/compiler/compile.ml
@@ -33,12 +33,10 @@ let labelstring l =
 let typelabel l =
   if l = "" then l else l ^ ":"
 
+let forbidden = [ "class"; "type"; "in"; "from"; "to" ]
 let nicknames =
   [ "class", "clas";
-    "type", "typ";
-    "in", "inside";
-    "from", "src";
-    "to", "dst" ]
+    "type", "typ" ]
 
 let small = String.lowercase
 
@@ -52,8 +50,10 @@ let gettklabel fc =
         then String.sub s ~pos:1 ~len:(String.length s - 1)
         else s
       in begin
-        try List.assoc s nicknames
-        with Not_found -> s
+        if List.mem s forbidden then
+          try List.assoc s nicknames
+          with Not_found -> small fc.var_name
+        else s
       end
   | _ -> raise (Failure "gettklabel")
 
@@ -101,7 +101,7 @@ let ppMLtype ?(any=false) ?(return=false) ?(def=false) ?(counter=ref 0) =
         let l = List.map fcl ~f:
           begin fun fc ->
             "?" ^ begin let p = gettklabel fc in
-                  if count ~item:p tklabels > 1 then small fc.ml_name else p
+                  if count ~item:p tklabels > 1 then small fc.var_name else p
                   end
             ^ ":" ^ 
             let l = types_of_template fc.template in
@@ -209,7 +209,7 @@ let write_constructors ~w = function
         end
 
 (* Write an ML variant *)
-let write_variant ~w {ml_name = mlconstr; var_name = varname; template = t} =
+let write_variant ~w {var_name = varname; template = t} =
   w "`";
   w varname;
   begin match types_of_template t with
@@ -740,7 +740,7 @@ let write_catch_optionals ~w clas ~def:typdef =
         if co <> "" then fatal_error "optionals in optionals";
         *)
         let p = gettklabel fc in
-        (if count ~item:p tklabels > 1 then small fc.ml_name else p),
+        (if count ~item:p tklabels > 1 then small fc.var_name else p),
         small fc.ml_name
       end in
     let p =  List.map l ~f:(fun (si, _) -> "  ?" ^ si) in
diff --git a/otherlibs/labltk/compiler/intf.ml b/otherlibs/labltk/compiler/intf.ml
index 353caaccf..87e1eed85 100644
--- a/otherlibs/labltk/compiler/intf.ml
+++ b/otherlibs/labltk/compiler/intf.ml
@@ -30,7 +30,7 @@ let write_create_p ~w wname =
       let l = List.map classdefs ~f:
         begin fun fc ->
           begin let p = gettklabel fc in
-            if count ~item:p tklabels > 1 then small fc.ml_name else p
+            if count ~item:p tklabels > 1 then small fc.var_name else p
           end,
           fc.template
         end in