Les fonctions internal_tracevis et internal_tracedestroy sont mal dec…

…larees.

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

otherlibs/labltk/support/camltkwrap.ml

@@ -23,12 +23,12 @@ end
 module Protocol = struct
   open Widget
   include Protocol
-      
+
   let opentk () = coe (opentk ())
   let opentk_with_args args = coe (opentk_with_args args)
   let openTk ?display ?clas () = coe (openTk ?display ?clas ())
 
-  let cCAMLtoTKwidget table w = 
+  let cCAMLtoTKwidget table w =
     Widget.check_class w table; (* we need run time type check of widgets *)
     TkToken (Widget.name w)
 
@@ -71,7 +71,7 @@ module Timer = struct
   let remove = remove
 end
 
-(* 
+(*
 Not compiled in support
-module Tkwait = Tkwait 
+module Tkwait = Tkwait
 *)

otherlibs/labltk/support/camltkwrap.mli

@@ -16,13 +16,13 @@
 module Widget : sig
   type widget = Widget.any Widget.widget
     (* widget is an abstract type *)
-  
+
   val default_toplevel : widget
     (* [default_toplevel] is "." in Tk, the toplevel widget that is
        always existing during a Tk session. Destroying [default_toplevel]
        ends the main loop
      *)
-  
+
   val atom : parent: widget -> name: string -> widget
     (* [atom parent name] returns the widget [parent.name]. The widget is
        not created. Only its name is returned. In a given parent, there may
@@ -31,35 +31,35 @@ module Widget : sig
        with a known name. It doesn't add the widget to the internal tables
        of CamlTk.
      *)
-  
+
   val name : widget -> string
     (* [name w] returns the name (tk "path") of a widget *)
-  
+
   (*--*)
   (* The following functions are used internally.
      There is normally no need for them in users programs
    *)
-  
+
   val known_class : widget -> string
     (* [known_class w] returns the class of a widget (e.g. toplevel, frame),
        as known by the CamlTk interface.
        Not equivalent to "winfo w" in Tk.
      *)
-  
+
   val dummy : widget
     (* [dummy] is a widget used as context when we don't have any.
        It is *not* a real widget.
      *)
-            
+
   val new_atom : parent: widget -> ?name: string -> string -> widget
       (* incompatible with the classic camltk *)
 
   val get_atom : string -> widget
     (* [get_atom path] returns the widget with Tk path [path] *)
-  
+
   val remove : widget -> unit
     (* [remove w] removes widget from the internal tables *)
-  
+
   (* Subtypes tables *)
   val widget_any_table : string list
   val widget_button_table : string list
@@ -77,95 +77,95 @@ module Widget : sig
   val widget_scrollbar_table : string list
   val widget_text_table : string list
   val widget_toplevel_table : string list
-  
+
   val chk_sub : string -> 'a list -> 'a -> unit
   val check_class : widget -> string list -> unit
         (* Widget subtyping *)
-  
+
   exception IllegalWidgetType of string
         (* Raised when widget command applied illegally*)
 
   (* this function is not used, but introduced for the compatibility
      with labltk. useless for camltk users *)
-  val coe : 'a Widget.widget -> Widget.any Widget.widget 
+  val coe : 'a Widget.widget -> Widget.any Widget.widget
 end
 
 module Protocol : sig
   open Widget
-  
+
   (* Lower level interface *)
   exception TkError of string
         (* Raised by the communication functions *)
-  
-  val debug : bool ref 
+
+  val debug : bool ref
         (* When set to true, displays approximation of intermediate Tcl code *)
-  
+
   type tkArgs =
       TkToken of string
     | TkTokenList of tkArgs list          (* to be expanded *)
     | TkQuote of tkArgs                   (* mapped to Tcl list *)
-  
-  
+
+
   (* Misc *)
   external splitlist : string -> string list
           = "camltk_splitlist"
-  
+
   val add_destroy_hook : (widget -> unit) -> unit
-  
-  
+
+
   (* Opening, closing, and mainloop *)
   val default_display : unit -> string
-  
+
   val opentk : unit -> widget
     (* The basic initialization function. [opentk ()] parses automatically
        the command line options and use the tk related options in them
-       such as "-display localhost:0" to initialize Tk applications. 
+       such as "-display localhost:0" to initialize Tk applications.
        Consult wish manpage about the supported options. *)
-  
+
   val keywords : (string * Arg.spec * string) list
     (* Command line parsing specification for Arg.parse, which contains
        the standard Tcl/Tk command line options such as "-display" and "-name".
        These Tk command line options are used by opentk *)
-  
+
   val opentk_with_args : string list -> widget
-    (* [opentk_with_args argv] invokes [opentk] with the tk related 
-       command line options given by [argv] to the executable program. *) 
-  
+    (* [opentk_with_args argv] invokes [opentk] with the tk related
+       command line options given by [argv] to the executable program. *)
+
   val openTk : ?display:string -> ?clas:string -> unit -> widget
       (* [openTk ~display:display ~clas:clas ()] is equivalent to
          [opentk ["-display"; display; "-name"; clas]] *)
-  
+
   (* Legacy opentk functions *)
   val openTkClass: string -> widget
       (* [openTkClass class] is equivalent to [opentk ["-name"; class]] *)
   val openTkDisplayClass: string -> string -> widget
-      (* [openTkDisplayClass disp class] is equivalent to 
+      (* [openTkDisplayClass disp class] is equivalent to
          [opentk ["-display"; disp; "-name"; class]] *)
-  
+
   val closeTk : unit -> unit
-  val finalizeTk : unit -> unit 
-      (* Finalize tcl/tk before exiting. This function will be automatically 
+  val finalizeTk : unit -> unit
+      (* Finalize tcl/tk before exiting. This function will be automatically
          called when you call [Pervasives.exit ()] *)
-  
+
   val mainLoop : unit -> unit
-  
-  
+
+
   (* Direct evaluation of tcl code *)
   val tkEval : tkArgs array -> string
-  
+
   val tkCommand : tkArgs array -> unit
-  
+
   (* Returning a value from a Tcl callback *)
   val tkreturn: string -> unit
-  
-  
+
+
   (* Callbacks: this is private *)
-  
+
   type cbid = Protocol.cbid
-  
+
   type callback_buffer = string list
         (* Buffer for reading callback arguments *)
-  
+
   val callback_naming_table : (cbid, callback_buffer -> unit) Hashtbl.t
   (* CAMLTK val callback_memo_table : (widget, cbid) Hashtbl.t *)
   val callback_memo_table : (widget, cbid) Hashtbl.t
@@ -181,25 +181,25 @@ module Protocol : sig
         (* Clean up callbacks associated to widget. Must be used only when
            the Destroy event is bind by the user and masks the default
            Destroy event binding *)
-  
+
   val cTKtoCAMLwidget : string -> widget
   val cCAMLtoTKwidget : string list -> widget -> tkArgs
-  
+
   val register : string -> callback:(callback_buffer -> unit) -> unit
-  
+
   (*-*)
   val prerr_cbid : cbid -> unit
 end
 
 module Textvariable : sig
   open Widget
   open Protocol
-  
+
   type textVariable = Textvariable.textVariable
         (* TextVariable is an abstract type *)
-  
+
   val create : ?on: widget -> unit -> textVariable
-        (* Allocation of a textVariable with lifetime associated to widget 
+        (* Allocation of a textVariable with lifetime associated to widget
            if a widget is specified *)
   val create_temporary : widget -> textVariable
         (* for backward compatibility
@@ -211,22 +211,22 @@ module Textvariable : sig
         (* Reading the val of a textVariable *)
   val name : textVariable -> string
         (* Its tcl name *)
-  
+
   val cCAMLtoTKtextVariable : textVariable -> tkArgs
         (* Internal conversion function *)
-  
+
   val handle : textVariable -> (unit -> unit) -> unit
         (* Callbacks on variable modifications *)
-  
+
   val coerce : string -> textVariable
-  
+
   (*-*)
   val free : textVariable -> unit
 end
 
 module Fileevent : sig
   open Unix
-  
+
   val   add_fileinput : file_descr -> (unit -> unit) -> unit
   val   remove_fileinput: file_descr -> unit
   val   add_fileoutput : file_descr -> (unit -> unit) -> unit
@@ -236,16 +236,16 @@ end
 
 module Timer : sig
   type t = Timer.t
-  
+
   val add : int -> (unit -> unit) -> t
   val set : int -> (unit -> unit) -> unit
   val remove : t -> unit
 end
 
-(* 
+(*
 Tkwait exists, but is not used in support
 module Tkwait : sig
-  val internal_tracevis : string -> string -> unit
-  val internal_tracedestroy : string -> string -> unit
+  val internal_tracevis : string -> Protocol.cbid -> unit
+  val internal_tracedestroy : string -> Protocol.cbid -> unit
 end
 *)

otherlibs/labltk/support/tkwait.ml

@@ -16,7 +16,10 @@
 
 (* $Id$ *)
 
-external internal_tracevis : string -> string -> unit
+external internal_tracevis : string -> Protocol.cbid -> unit
         = "camltk_wait_vis"
-external internal_tracedestroy : string -> string -> unit
+;;
+
+external internal_tracedestroy : string -> Protocol.cbid -> unit
         = "camltk_wait_des"
+;;