ocaml/otherlibs/labltk/Widgets.src

%%%%%%%%%%%%%% Standard Tk8.0.3 Widgets and functions %%%%%%%%%%%%%%
type Widget external

% cget will probably never be implemented with verifications
function (string) cgets [widget; "cget"; string]
% another version with some hack is 
type options_constrs external
function (string) cget [widget; "cget"; options_constrs]
% constructors of type options_constrs are of the form C<c> 
% where <c> is an option constructor  (e.g. CBackground)

%%%%% Some types for standard options of widgets
type Anchor { 
    NW ["nw"]       N ["n"]           NE ["ne"]
    W  ["w"]   Center ["center"]      E  ["e"]
    SW ["sw"]       S ["s"]           SE ["se"]
}

type Bitmap external    % builtin_GetBitmap.ml
type Cursor external    % builtin_GetCursor.ml
type Color external     % builtin_GetCursor.ml

##ifdef CAMLTK

type ImageBitmap {
  BitmapImage [string]
  }
type ImagePhoto {
  PhotoImage [string]
  }

##else

variant type ImageBitmap {
  Bitmap [string]
  }
variant type ImagePhoto {
  Photo [string]
  }
variant type Image {
  Bitmap [string]
  Photo [string]
}

##endif

type Justification { 
   Justify_Left   ["left"]
   Justify_Center ["center"]
   Justify_Right  ["right"]
}

type Orientation { 
    Vertical ["vertical"]
    Horizontal ["horizontal"] 
}

type Relief { 
   Raised ["raised"]
   Sunken ["sunken"]
   Flat   ["flat"]
   Ridge  ["ridge"]
   Solid  ["solid"]
   Groove ["groove"]
}

type TextVariable external      % textvariable.ml
type Units external             % builtin_GetPixel.ml

%%%%% The standard options, as defined in man page options(n)
%%%%% The subtype is never used
subtype option(standard) {
   ActiveBackground             ["-activebackground"; Color]
   ActiveBorderWidth            ["-activeborderwidth"; Units/int]
   ActiveForeground             ["-activeforeground"; Color]
   Anchor                       ["-anchor"; Anchor]
   Background                   ["-background"; Color]
   Bitmap                       ["-bitmap"; Bitmap]
   BorderWidth                  ["-borderwidth"; Units/int]
   Cursor                       ["-cursor";  Cursor]
   DisabledForeground           ["-disabledforeground"; Color]
   ExportSelection              ["-exportselection"; bool]
   Font                         ["-font"; string]
   Foreground                   ["-foreground"; Color]
% Geometry is not one of standard options...
   Geometry                     ["-geometry"; string]  % Too variable to encode
   HighlightBackground          ["-highlightbackground"; Color]
   HighlightColor               ["-highlightcolor"; Color]
   HighlightThickness           ["-highlightthickness"; Units/int]
##ifdef CAMLTK
   % images are split, to do additionnal static typing
   ImageBitmap (ImageBitmap)    ["-image"; ImageBitmap]
   ImagePhoto  (ImagePhoto)    ["-image"; ImagePhoto]
##else
   Image                        ["-image"; Image]
##endif
   InsertBackground             ["-insertbackground"; Color]
   InsertBorderWidth            ["-insertborderwidth"; Units/int]
   InsertOffTime                ["-insertofftime"; int]   % Positive only
   InsertOnTime                 ["-insertontime"; int]    % Idem
   InsertWidth                  ["-insertwidth"; Units/int]
   Jump                         ["-jump"; bool]
   Justify                      ["-justify"; Justification]
   Orient                       ["-orient"; Orientation]
   PadX                         ["-padx"; Units/int]
   PadY                         ["-pady"; Units/int]
   Relief                       ["-relief"; Relief]
   RepeatDelay                  ["-repeatdelay"; int]
   RepeatInterval               ["-repeatinterval"; int]
   SelectBackground             ["-selectbackground"; Color]
   SelectBorderWidth            ["-selectborderwidth"; Units/int]
   SelectForeground             ["-selectforeground"; Color]
   SetGrid                      ["-setgrid"; bool]
   % incomplete description of TakeFocus
   TakeFocus                    ["-takefocus"; bool]
   Text                         ["-text"; string]
   TextVariable                 ["-textvariable"; TextVariable]
   TroughColor                  ["-troughcolor"; Color]
   UnderlinedChar               ["-underline"; int]
   WrapLength                   ["-wraplength"; Units/int]
   XScrollCommand               ["-xscrollcommand"; function(first:float, last:float)]
   YScrollCommand               ["-yscrollcommand"; function(first:float, last:float)]
}

%%%% Some other common types
type Index external   % builtin_index.ml
type sequence ScrollValue external   % builtin_ScrollValue.ml
% type sequence ScrollValue {
%   MoveTo ["moveto"; float]
%   ScrollUnit ["scroll"; int; "unit"]
%   ScrollPage ["scroll"; int; "page"]
%   }



%%%%% bell(n)
module Bell {
##ifdef CAMLTK
  function () ring ["bell"; ?displayof:["-displayof"; widget]]
  function () ring_displayof ["bell"; "-displayof" ; displayof: widget]
##else
  function () ring ["bell"; ?displayof:["-displayof"; widget]]
##endif
  }

%%%%% bind(n)
% builtin_bind.ml


%%%%% bindtags(n)
%type Bindings {
%   TagBindings [string]
%   WidgetBindings [widget]
%   }

type Bindings external

function () bindtags ["bindtags"; widget; [bindings: Bindings list]]
function (Bindings list) bindtags_get ["bindtags"; widget]

%%%%% bitmap(n)
subtype option(bitmapimage) {
  Background
  Data ["-data"; string]
  File ["-file"; string]
  Foreground
  Maskdata ["-maskdata"; string]
  Maskfile ["-maskfile"; string]
  }

module Imagebitmap {
  function (ImageBitmap) create ["image"; "create"; "bitmap"; ?name:[ImageBitmap]; option(bitmapimage) list]
##ifdef CAMLTK
  function (ImageBitmap) create_named ["image"; "create"; "bitmap"; ImageBitmap; option(bitmapimage) list]
##endif
  function () delete ["image"; "delete"; ImageBitmap]
  function (int) height ["image"; "height"; ImageBitmap]
  function (int) width ["image"; "width"; ImageBitmap]
  function () configure [ImageBitmap; "configure"; option(bitmapimage) list]
  function (string) configure_get [ImageBitmap; "configure"]
  % Functions inherited from the "image" TK class
  }

%%%%% button(n)

type State { 
   Normal ["normal"]
   Active ["active"]
   Disabled ["disabled"]
   Hidden ["hidden"]                           % introduced in tk8.3, requested for Syndex
}

widget button {
   % Standard options
   option ActiveBackground
   option ActiveForeground
   option Anchor
   option Background
   option Bitmap
   option BorderWidth
   option Cursor
   option DisabledForeground
   option Font
   option Foreground
   option HighlightBackground
   option HighlightColor
   option HighlightThickness
##ifdef CAMLTK
   option ImageBitmap
   option ImagePhoto
##else
   option Image
##endif
   option Justify
   option PadX
   option PadY
   option Relief
   option TakeFocus
   option Text
   option TextVariable
   option UnderlinedChar
   option WrapLength
   % Widget specific options
   option Command ["-command"; function ()]
   option Default ["-default"; State]   
   option Height ["-height"; Units/int]
   option State ["-state"; State]
   option Width ["-width"; Units/int]

   function ()  configure [widget(button); "configure"; option(button) list]
   function (string) configure_get [widget(button); "configure"]
   function () flash [widget(button); "flash"]
   function () invoke [widget(button); "invoke"]
   }


%%%%%% canvas(n)
% Item ids and tags
type TagOrId {
  Tag [string]
  Id  [int]
}

% Indices: defined internally
% subtype Index(canvas) {
%   Number End Insert SelFirst SelLast AtXY
%   }

type SearchSpec {
  Above ["above"; TagOrId]
  All   ["all"]
  Below ["below"; TagOrId]
  Closest ["closest"; Units/int; Units/int]
  ClosestHalo (Closesthalo) ["closest"; Units/int; Units/int; Units/int]
  ClosestHaloStart (Closesthalostart) ["closest"; Units/int; Units/int; Units/int; TagOrId]
  Enclosed ["enclosed"; Units/int;Units/int;Units/int;Units/int]
  Overlapping ["overlapping"; int;int;int;int]
  Withtag ["withtag"; TagOrId]
}

type ColorMode { 
   Color ["color"]
   Gray ["gray"]
   Mono ["mono"]
}

subtype option(postscript) {
   % Cannot support this without array variables
   % Colormap ["-colormap"; TextVariable]
   Colormode ["-colormode"; ColorMode]
   File ["-file"; string]
   % Fontmap ["-fontmap"; TextVariable]
   Height
   PageAnchor ["-pageanchor"; Anchor]
   PageHeight ["-pageheight"; Units/int]
   PageWidth ["-pagewidth"; Units/int]
   PageX ["-pagex"; Units/int]
   PageY ["-pagey"; Units/int]
   Rotate ["-rotate"; bool]
   Width
   X ["-x"; Units/int]
   Y ["-y"; Units/int]
   }


% Arc item configuration
type ArcStyle {
   Arc ["arc"]
   Chord ["chord"]
   PieSlice ["pieslice"]
}

subtype option(arc) {
   Extent ["-extent"; float]
   Dash ["-dash"; string]
   % Fill is used by packer
   FillColor ["-fill"; Color]
   Outline ["-outline"; Color]
   OutlineStipple ["-outlinestipple"; Bitmap]
   Start ["-start"; float]
   Stipple ["-stipple"; Bitmap]
   ArcStyle ["-style"; ArcStyle]
   Tags ["-tags"; [TagOrId/string list]]
   Width
  }

% Bitmap item configuration
subtype option(bitmap) {
   Anchor
   Background
   Bitmap
   Foreground
   Tags
}

% Image item configuration
subtype option(image) {
   Anchor
##ifdef CAMLTK
   ImagePhoto
   ImageBitmap
##else
   Image
##endif
   Tags
}

% Line item configuration
type ArrowStyle { 
   Arrow_None ["none"]
   Arrow_First ["first"]
   Arrow_Last ["last"]
   Arrow_Both ["both"]
}

type CapStyle { 
   Cap_Butt ["butt"]
   Cap_Projecting ["projecting"]
   Cap_Round ["round"]
}

type JoinStyle { 
   Join_Bevel ["bevel"]
   Join_Miter ["miter"]
   Join_Round ["round"]
}

subtype option(line) {
   ArrowStyle ["-arrow"; ArrowStyle]
   ArrowShape ["-arrowshape"; [Units/int; Units/int; Units/int]]
   CapStyle ["-capstyle"; CapStyle]
   Dash
   FillColor
   JoinStyle ["-joinstyle"; JoinStyle]
   Smooth ["-smooth"; bool]
   SplineSteps ["-splinesteps"; int]
   Stipple
   Tags
   Width
   }

% Oval item configuration
subtype option(oval) {
   Dash FillColor Outline Stipple Tags Width
   }

% Polygon item configuration
subtype option(polygon) {
   Dash FillColor Outline Smooth SplineSteps
   Stipple Tags Width
   }

% Rectangle item configuration
subtype option(rectangle) {
   Dash FillColor Outline Stipple Tags Width
   }

% Text item configuration

##ifndef CAMLTK
% Only for Labltk. CanvasTextState is unified as State in Camltk
type CanvasTextState { 
   Normal ["normal"]
   Disabled ["disabled"]
   Hidden ["hidden"]
}
##endif

subtype option(canvastext) {
   Anchor FillColor Font Justify
   Stipple Tags Text Width
##ifdef CAMLTK
   State                                       % introduced in tk8.3, requested for Syndex
##else
   CanvasTextState ["-state"; CanvasTextState] % introduced in tk8.3, requested for Syndex
##endif
   }

% Window item configuration
subtype option(window) {
   Anchor Height Tags Width
   Window ["-window"; widget]
   Dash
   }

% Types of items
type CanvasItem {
   Arc_item ["arc"]
   Bitmap_item ["bitmap"]
   Image_item ["image"]
   Line_item ["line"]
   Oval_item ["oval"]
   Polygon_item ["polygon"]
   Rectangle_item ["rectangle"]
   Text_item ["text"]
   Window_item ["window"]
   User_item [string]
}

widget canvas {
   % Standard options
   option Background
   option BorderWidth
   option Cursor
   option HighlightBackground
   option HighlightColor
   option HighlightThickness
   option InsertBackground
   option InsertBorderWidth
   option InsertOffTime
   option InsertOnTime
   option InsertWidth
   option Relief
   option SelectBackground
   option SelectBorderWidth
   option SelectForeground
   option TakeFocus
   option XScrollCommand
   option YScrollCommand
   % Widget specific options
   option CloseEnough ["-closeenough"; float]
   option Confine ["-confine"; bool]
   option Height ["-height"; Units/int]
   option ScrollRegion ["-scrollregion"; [Units/int;Units/int;Units/int;Units/int]]
   option Width ["-width"; Units/int]
   option XScrollIncrement ["-xscrollincrement"; Units/int]
   option YScrollIncrement ["-yscrollincrement"; Units/int]


   function () addtag [widget(canvas); "addtag"; tag: TagOrId/string; specs: SearchSpec list]     % Tag only
   % bbox not fully supported. should be builtin because of ambiguous result
   % will raise Protocol.TkError if no items match TagOrId
   function (int,int,int,int) bbox [widget(canvas); "bbox"; TagOrId list]
   external bind "builtin/canvas_bind"
##ifdef CAMLTK
   function (float) canvasx [widget(canvas); "canvasx"; ?spacing:[Units]; Units]
   function (float) canvasy [widget(canvas); "canvasy"; ?spacing:[Units]; Units]
   function (float) canvasx_grid [widget(canvas); "canvasx"; Units; Units]
   function (float) canvasy_grid [widget(canvas); "canvasy"; Units; Units]
##else
   function (float) canvasx [widget(canvas); "canvasx"; x:int; ?spacing:[int]]
   function (float) canvasy [widget(canvas); "canvasy"; y:int; ?spacing:[int]]
##endif
   function () configure [widget(canvas); "configure"; option(canvas) list]
   function (string) configure_get [widget(canvas); "configure"]
   % TODO: check result
   function (float list) coords_get [widget(canvas); "coords"; TagOrId]
##ifdef CAMLTK
   function () coords_set [widget(canvas); "coords"; TagOrId; xys: Units list]
##else
   function () coords_set [widget(canvas); "coords"; TagOrId; xys: {int, int} list]
##endif
   % create variations (see below)
   function () dchars [widget(canvas); "dchars"; TagOrId; first: Index(canvas); last: Index(canvas)]
   function () delete [widget(canvas); "delete"; TagOrId list]
   function () dtag [widget(canvas); "dtag"; TagOrId; tag: TagOrId/string]
   function (TagOrId list) find [widget(canvas); "find"; specs: SearchSpec list]
   % focus variations
   function () focus_reset [widget(canvas); "focus"; ""]
   function (TagOrId) focus_get [widget(canvas); "focus"]
   function () focus [widget(canvas); "focus"; TagOrId]
   function (TagOrId/string list) gettags [widget(canvas); "gettags"; TagOrId]
   function () icursor [widget(canvas); "icursor"; TagOrId; index: Index(canvas)]
   function (int) index [widget(canvas); "index"; TagOrId; index: Index(canvas)]
   function () insert [widget(canvas); "insert"; TagOrId; before: Index(canvas); text: string]
   % itemcget, itemconfigure are defined later
   function () lower [widget(canvas); "lower"; TagOrId; ?below: [TagOrId]]
##ifdef CAMLTK
   function () lower_below [widget(canvas); "lower"; TagOrId; TagOrId]
   function () lower_bot   [widget(canvas); "lower"; TagOrId]
##endif
   function () move [widget(canvas); "move"; TagOrId; x: Units/int; y: Units/int]
   unsafe function (string) postscript [widget(canvas); "postscript"; option(postscript) list]
   % We use raise with Module name
   function () raise [widget(canvas); "raise"; TagOrId; ?above:[TagOrId]]
##ifdef CAMLTK
   function () raise_above [widget(canvas); "raise"; TagOrId; TagOrId]
   function () raise_top [widget(canvas); "raise"; TagOrId]
##endif
   function () scale [widget(canvas); "scale"; TagOrId; xorigin: Units/int; yorigin: Units/int; xscale: float; yscale: float]
   % For scan, use x:int and y:int since common usage is with mouse coordinates
   function () scan_mark [widget(canvas); "scan"; "mark"; x: int; y: int]
   function () scan_dragto [widget(canvas); "scan"; "dragto"; x: int; y: int]
   % select variations
   function () select_adjust [widget(canvas); "select"; "adjust"; TagOrId; index: Index(canvas)]
   function () select_clear [widget(canvas); "select"; "clear"]
   function () select_from [widget(canvas); "select"; "from"; TagOrId; index: Index(canvas)]
   function (TagOrId) select_item [widget(canvas); "select"; "item"]
   function () select_to  [widget(canvas); "select"; "to"; TagOrId; index: Index(canvas)]

   function (CanvasItem) typeof [widget(canvas); "type"; TagOrId]
   function (float,float) xview_get [widget(canvas); "xview"]
   function (float,float) yview_get [widget(canvas); "yview"]
   function () xview [widget(canvas); "xview"; scroll: ScrollValue]
   function () yview [widget(canvas); "yview"; scroll: ScrollValue]

   % create and configure variations
   function (TagOrId) create_arc [widget(canvas); "create"; "arc"; x1: Units/int; y1: Units/int; x2: Units/int; y2: Units/int; option(arc) list]
   function (TagOrId) create_bitmap [widget(canvas); "create"; "bitmap"; x: Units/int; y: Units/int; option(bitmap) list]
   function (TagOrId) create_image [widget(canvas); "create"; "image"; x: Units/int; y: Units/int; option(image) list]
##ifdef CAMLTK
   function (TagOrId) create_line [widget(canvas); "create"; "line"; Units list; option(line) list]
   function (TagOrId) create_polygon [widget(canvas); "create"; "polygon"; Units list; option(polygon) list]
##else
   function (TagOrId) create_line [widget(canvas); "create"; "line"; xys: {int, int} list; option(line) list]
   function (TagOrId) create_polygon [widget(canvas); "create"; "polygon"; xys: {int, int} list; option(polygon) list]
##endif
   function (TagOrId) create_oval [widget(canvas); "create"; "oval"; x1: Units/int; y1: Units/int; x2: Units/int; y2: Units/int; option(oval) list]
   function (TagOrId) create_rectangle [widget(canvas); "create"; "rectangle"; x1: Units/int; y1: Units/int; x2: Units/int; y2: Units/int; option(rectangle) list]
   function (TagOrId) create_text [widget(canvas); "create"; "text"; x: Units/int; y: Units/int; option(canvastext) list]
   function (TagOrId) create_window [widget(canvas); "create"; "window"; x: Units/int; y: Units/int; option(window) list]

   function (string) itemconfigure_get [widget(canvas); "itemconfigure"; TagOrId]

   function () configure_arc [widget(canvas); "itemconfigure"; TagOrId; option(arc) list]
   function () configure_bitmap [widget(canvas); "itemconfigure"; TagOrId; option(bitmap) list]
   function () configure_image [widget(canvas); "itemconfigure"; TagOrId; option(image) list]
   function () configure_line [widget(canvas); "itemconfigure"; TagOrId; option(line) list]
   function () configure_oval [widget(canvas); "itemconfigure"; TagOrId; option(oval) list]
   function () configure_polygon [widget(canvas); "itemconfigure"; TagOrId; option(polygon) list]
   function () configure_rectangle [widget(canvas); "itemconfigure"; TagOrId; option(rectangle) list]
   function () configure_text [widget(canvas); "itemconfigure"; TagOrId; option(canvastext) list]
   function () configure_window [widget(canvas); "itemconfigure"; TagOrId; option(window) list]
   }


%%%%% checkbutton(n)
widget checkbutton {    
   % Standard options
   option ActiveBackground
   option ActiveForeground
   option Anchor
   option Background
   option Bitmap
   option BorderWidth
   option Cursor
   option DisabledForeground
   option Font
   option Foreground
   option HighlightBackground
   option HighlightColor
   option HighlightThickness
##ifdef CAMLTK
   option ImageBitmap
   option ImagePhoto
##else
   option Image
##endif
   option Justify
   option PadX
   option PadY
   option Relief
   option TakeFocus
   option Text
   option TextVariable
   option UnderlinedChar
   option WrapLength
   % Widget specific options
   option Command
   option Height
   option IndicatorOn ["-indicatoron"; bool]
   option OffValue ["-offvalue"; string]
   option OnValue  ["-onvalue"; string]
   option SelectColor ["-selectcolor"; Color]
##ifdef CAMLTK
   option SelectImageBitmap (SelectImageBitmap) ["-selectimage"; ImageBitmap]
   option SelectImagePhoto (SelectImagePhoto) ["-selectimage"; ImagePhoto]
##else
   option SelectImage ["-selectimage"; Image]
##endif
   option State
   option Variable ["-variable"; TextVariable]
   option Width

   function () configure [widget(checkbutton); "configure"; option(checkbutton) list]
   function (string) configure_get [widget(checkbutton); "configure"]
   function () deselect [widget(checkbutton);  "deselect"]
   function () flash [widget(checkbutton); "flash"]
   function () invoke [widget(checkbutton); "invoke"]
   function () select [widget(checkbutton); "select"]
   function () toggle [widget(checkbutton); "toggle"]
   }

%%%%% clipboard(n)
subtype icccm(clipboard_append) {
  ICCCMFormat ["-format"; string]
  ICCCMType ["-type"; string]
  }

module Clipboard {
  function () clear ["clipboard"; "clear"; ?displayof:["-displayof"; widget]]
  function () append ["clipboard"; "append"; ?displayof:["-displayof"; widget]; icccm(clipboard_append) list; "--"; data: string]
  }

%%%%% destroy(n)
function () destroy ["destroy"; widget]

%%%%% tk_dialog(n)
module Dialog {
  external create "builtin/dialog"
  }

%%%%% entry(n)
% Defined internally
% subtype Index(entry) {
%    Number End Insert SelFirst SelLast At AnchorPoint
% }

##ifndef CAMLTK
% Only for Labltk. InputState is unified as State in Camltk
type InputState { 
   Normal ["normal"]
   Disabled ["disabled"]
}
##endif

widget entry {
   % Standard options
   option Background
   option BorderWidth
   option Cursor
   option ExportSelection
   option Font
   option Foreground
   option HighlightBackground
   option HighlightColor
   option HighlightThickness
   option InsertBackground
   option InsertBorderWidth
   option InsertOffTime
   option InsertOnTime
   option InsertWidth
   option Justify
   option Relief
   option SelectBackground
   option SelectBorderWidth
   option SelectForeground
   option TakeFocus
   option TextVariable
   option XScrollCommand

   % Widget specific options
   option Show ["-show"; char]
##ifdef CAMLTK
   option State
##else
   option EntryState ["-state"; InputState]
##endif
   option TextWidth (Textwidth) ["-width"; int]

   function (int,int,int,int) bbox [widget(entry); "bbox"; Index(entry)]
   function () configure [widget(entry); "configure"; option(entry) list]
   function (string) configure_get [widget(entry); "configure"]
   function () delete_single [widget(entry); "delete"; index: Index(entry)]
   function () delete_range [widget(entry); "delete"; start: Index(entry); stop: Index(entry)]
   function (string) get [widget(entry); "get"]
   function () icursor [widget(entry); "icursor"; index: Index(entry)]
   function (int) index [widget(entry); "index"; index: Index(entry)]
   function () insert [widget(entry); "insert"; index: Index(entry); text: string]
   function () scan_mark [widget(entry); "scan"; "mark"; x: int]
   function () scan_dragto [widget(entry); "scan"; "dragto"; x: int]
   % selection variation
   function () selection_adjust [widget(entry); "selection"; "adjust"; index: Index(entry)]
   function () selection_clear [widget(entry); "selection"; "clear"]
   function () selection_from [widget(entry); "selection"; "from"; index: Index(entry)]
   function (bool) selection_present [widget(entry); "selection"; "present"]
   function () selection_range [widget(entry); "selection"; "range"; start: Index(entry) ; stop: Index(entry)]
   function () selection_to [widget(entry); "selection"; "to"; index: Index(entry)]

   function (float,float) xview_get [widget(entry); "xview"]
   function () xview [widget(entry); "xview"; scroll: ScrollValue]
   function () xview_index [widget(entry); "xview"; index: Index(entry)]
   function (float, float) xview_get [widget(entry); "xview"]
   }


%%%%% focus(n)
%%%%% tk_focusNext(n)
module Focus {
  unsafe function (widget) get ["focus"; ?displayof:["-displayof"; widget]]
  unsafe function (widget) displayof ["focus"; "-displayof"; widget]
  function () set ["focus"; widget]
  function () force ["focus"; "-force"; widget]
  unsafe function (widget) lastfor ["focus"; "-lastfor"; widget]
  unsafe function (widget) next ["tk_focusNext"; widget]
  unsafe function (widget) prev ["tk_focusPrev"; widget]
  function () follows_mouse ["tk_focusFollowsMouse"]
}

type font external % builtin/builtin_font.ml

type weight {
  Weight_Normal(Normal)         ["normal"]
  Weight_Bold(Bold)             ["bold"]
}

type slant {
  Slant_Roman(Roman)            ["roman"]
  Slant_Italic(Italic)          ["italic"]
}

type fontMetrics {
  Ascent ["-ascent"]
  Descent ["-descent"]  
  Linespace ["-linespace"]
  Fixed ["-fixed"]
}

subtype options(font) {
  Font_Family   ["-family"; string]
  Font_Size             ["-size"; int]
  Font_Weight   ["-weight"; weight]
  Font_Slant            ["-slant"; slant]
  Font_Underline        ["-underline"; bool]
  Font_Overstrike       ["-overstrike"; bool]
% later, JP only
% Charset                       ["-charset"; string]
%% Beware of the order of Compound ! Put it as the first option
% Compound                      ["-compound"; [font list]]
% Copy                          ["-copy"; string]
}               

module Font {
  function (string) actual_family ["font"; "actual"; font; 
                                   ?displayof:["-displayof"; widget];
                                   "-family"]
  function (int) actual_size ["font"; "actual"; font; 
                                   ?displayof:["-displayof"; widget];
                                   "-size"]
  function (string) actual_weight ["font"; "actual"; font; 
                                   ?displayof:["-displayof"; widget];
                                   "-weight"]
  function (string) actual_slant ["font"; "actual"; font; 
                                   ?displayof:["-displayof"; widget];
                                   "-slant"]
  function (bool) actual_underline ["font"; "actual"; font; 
                                   ?displayof:["-displayof"; widget];
                                   "-underline"]
  function (bool) actual_overstrike ["font"; "actual"; font; 
                                   ?displayof:["-displayof"; widget];
                                   "-overstrike"]

  function () configure ["font"; "configure"; font; options(font) list]
  function (font) create ["font"; "create"; ?name:[string]; options(font) list]
##ifdef CAMLTK
  function (font) create_named ["font"; "create"; string; options(font) list]
##endif
  function () delete ["font"; "delete"; font]
  function (string list) families ["font"; "families";
                                ?displayof:["-displayof"; widget]] 
##ifdef CAMLTK
  function (string list) families_displayof ["font"; "families";
                                                "-displayof"; widget]
##endif
  function (int) measure ["font"; "measure"; font; string;
                                ?displayof:["-displayof"; widget]] 
##ifdef CAMLTK
  function (int) measure_displayof ["font"; "measure"; font;
                                    "-displayof"; widget; string ]
##endif
  function (int) metrics ["font"; "metrics"; font;
                                ?displayof:["-displayof"; widget];
                                fontMetrics ] 
##ifdef CAMLTK
  function (int) metrics_displayof ["font"; "metrics"; font; 
                                    "-displayof"; widget;
                                    fontMetrics ]
##endif
  function (string list) names ["font"; "names"]
% JP
%  function () failsafe ["font"; "failsafe"; string]
}

%%%%% frame(n)
type Colormap {
  NewColormap (New) ["new"]
  WidgetColormap (Widget) [widget]
  }

% Visual classes are: directcolor, grayscale, greyscale, pseudocolor,
%                     staticcolor, staticgray, staticgrey, truecolor
type Visual {
  ClassVisual (Clas) [[string; int]]  
  DefaultVisual ["default"]
  WidgetVisual (Widget) [widget]
  BestDepth (Bestdepth) [["best"; int]]
  Best ["best"]
  }

widget frame {
   % Standard options
   option BorderWidth
   option Cursor
   option HighlightBackground
   option HighlightColor
   option HighlightThickness
   option Relief
   option TakeFocus

   % Widget specific options
   option Background
##ifdef CAMLTK
   option Class  ["-class"; string]
##else
   option Clas  ["-class"; string]
##endif
   option Colormap ["-colormap"; Colormap]
   option Container ["-container"; bool]        
   option Height
   option Visual ["-visual"; Visual]
   option Width

   % Class and Colormap and Visual cannot be changed
   function () configure [widget(frame); "configure"; option(frame) list]
   function (string) configure_get [widget(frame); "configure"]
   }



%%%%% grab(n)
type GrabStatus {
   GrabNone ["none"]
   GrabLocal ["local"]
   GrabGlobal ["global"]
}
type GrabGlobal external
module Grab {
   function () set ["grab"; "set"; ?global:[GrabGlobal]; widget]
##ifdef CAMLTK
   function () set_global ["grab"; "set"; "-global"; widget]
##endif
   unsafe function (widget list) current ["grab"; "current"; ?displayof:[widget]]
##ifdef CAMLTK
   % all_current is now current.
   % The old current is now current_of
   unsafe function (widget list) current_of ["grab"; "current"; widget]
##endif
   function () release ["grab"; "release"; widget]
   function (GrabStatus) status ["grab"; "status"; widget]
}

subtype option(rowcolumnconfigure) {
  Minsize ["-minsize"; Units/int]
  Weight  ["-weight"; int]
  Pad ["-pad"; Units/int]       
}

subtype option(grid) {
   Column ["-column"; int]
   ColumnSpan ["-columnspan"; int]
   In(Inside) ["-in"; widget]
   IPadX ["-ipadx"; Units/int]
   IPadY ["-ipady"; Units/int]
   PadX
   PadY
   Row ["-row"; int]   
   RowSpan ["-rowspan"; int]   
   Sticky ["-sticky"; string]
   }

% Same as pack
function () grid ["grid"; widget list; option(grid) list]

module Grid {
   function (int,int,int,int) bbox ["grid"; "bbox"; widget]
   function (int,int,int,int) bbox_cell ["grid"; "bbox"; widget; column: int; row: int]
   function (int,int,int,int) bbox_span ["grid"; "bbox"; widget; column1: int; row1: int; column2: int; row2: int]
   function () column_configure 
       ["grid"; "columnconfigure"; widget; int;
         option(rowcolumnconfigure) list]
   function () configure ["grid"; "configure"; widget list; option(grid) list]
   function (string) column_configure_get ["grid"; "columnconfigure"; widget;
                              int]
   function () forget ["grid"; "forget"; widget list]
   %% info returns only a string
    function (string) info ["grid"; "info"; widget]
   %% TODO: check result values
   function (int,int) location ["grid"; "location"; widget; x:Units/int; y:Units/int]
   function (bool) propagate_get ["grid"; "propagate"; widget]
   function () propagate_set ["grid"; "propagate"; widget; bool]
   function () row_configure 
       ["grid"; "rowconfigure"; widget; int; option(rowcolumnconfigure) list]
   function (string) row_configure_get ["grid"; "rowconfigure"; widget; int]
   function (int,int) size ["grid"; "size"; widget]

##ifdef CAMLTK
   function (widget list) slaves ["grid"; "slaves"; widget; ?column:["-column"; int]; ?row:["-row"; int]]
   function (widget list) row_slaves ["grid"; "slaves"; widget; "-row"; int]
   function (widget list) column_slaves ["grid"; "slaves"; widget; "-column"; int]
##else
   function (widget list) slaves ["grid"; "slaves"; widget; ?column:["-column"; int]; ?row:["-row"; int]]
##endif
   }

%%%%% image(n)
%%%%% cf Imagephoto and Imagebitmap
% Some functions on images are implemented in Imagephoto or Imagebitmap.
module Image {
   external names "builtin/image"
}

%%%%% label(n)
widget label {
   % Standard options
   option Anchor
   option Background
   option Bitmap
   option BorderWidth
   option Cursor
   option Font
   option Foreground
   option HighlightBackground
   option HighlightColor
   option HighlightThickness
##ifdef CAMLTK
   option ImageBitmap
   option ImagePhoto
##else
   option Image
##endif
   option Justify
   option PadX
   option PadY
   option Relief
   option TakeFocus
   option Text
   option TextVariable
   option UnderlinedChar
   option WrapLength

   % Widget specific options
   option Height
   % use according to label contents
   option Width
   option TextWidth

   function () configure [widget(label); "configure"; option(label) list]
   function (string) configure_get [widget(label); "configure"]
   }


%%%%% listbox(n)

% Defined internally
% subtype Index(listbox) {
%   Number Active AnchorPoint End AtXY
%}

type SelectModeType {
   Single ["single"]
   Browse ["browse"]
   Multiple ["multiple"]
   Extended ["extended"]
   }


widget listbox {
   % Standard options
   option Background
   option BorderWidth
   option Cursor
   option ExportSelection
   option Font
   option Foreground
   % Height is TextHeight
   option HighlightBackground
   option HighlightColor
   option HighlightThickness
   option Relief
   option SelectBackground
   option SelectBorderWidth
   option SelectForeground
   option SetGrid
   option TakeFocus
   % Width is TextWidth
   option XScrollCommand
   option YScrollCommand
   % Widget specific options
   option TextHeight ["-height"; int]
   option TextWidth
   option SelectMode ["-selectmode"; SelectModeType]

   function () activate [widget(listbox); "activate"; index: Index(listbox)]
   function (int,int,int,int) bbox [widget(listbox); "bbox"; index: Index(listbox)]
   function () configure [widget(listbox); "configure"; option(listbox) list]
   function (string) configure_get [widget(listbox); "configure"]
   function (Index(listbox) as "[>`Num of int]" list) curselection [widget(listbox); "curselection"]
   function () delete [widget(listbox); "delete"; first: Index(listbox); last: Index(listbox)]
   function (string) get [widget(listbox); "get"; index: Index(listbox)]
   function (string list) get_range [widget(listbox); "get"; first: Index(listbox); last: Index(listbox)]
   function (Index(listbox) as "[>`Num of int]") index [widget(listbox); "index"; index: Index(listbox)]
   function () insert [widget(listbox); "insert"; index: Index(listbox); texts: string list]
   function (Index(listbox) as "[>`Num of int]") nearest [widget(listbox); "nearest"; y: int]
   function () scan_mark [widget(listbox); "scan"; "mark"; x: int; y: int]
   function () scan_dragto [widget(listbox); "scan"; "dragto"; x: int; y: int]
   function () see [widget(listbox); "see"; index: Index(listbox)]
   function () selection_anchor [widget(listbox); "selection"; "anchor"; index: Index(listbox)]
   function () selection_clear [widget(listbox); "selection"; "clear"; first: Index(listbox); last: Index(listbox)]
   function (bool) selection_includes [widget(listbox); "selection"; "includes"; index: Index(listbox)]
   function () selection_set [widget(listbox); "selection"; "set"; first: Index(listbox); last: Index(listbox)]
   function (int) size [widget(listbox); "size"]

   function (float,float) xview_get [widget(listbox); "xview"]
   function (float,float) yview_get [widget(listbox); "yview"]
   function () xview_index [widget(listbox); "xview"; index: Index(listbox)]
   function () yview_index [widget(listbox); "yview"; index: Index(listbox)]
   function () xview [widget(listbox); "xview"; scroll: ScrollValue]
   function () yview [widget(listbox); "yview"; scroll: ScrollValue]
   }

%%%%% lower(n)
function () lower_window ["lower"; widget; ?below:[widget]]
##ifdef CAMLTK
function () lower_window_below ["lower"; widget; below: widget]
##endif


%%%%% menu(n)
%%%%% tk_popup(n)
% defined internally
% subtype Index(menu) {
%   Number Active End Last None At Pattern
%   }

type MenuItem {
   Cascade_Item ["cascade"]
   Checkbutton_Item ["checkbutton"]
   Command_Item ["command"]
   Radiobutton_Item ["radiobutton"]
   Separator_Item ["separator"]
   TearOff_Item ["tearoff"]
}

% notused as a subtype. just for cleaning up the rest.
subtype option(menuentry) {
   ActiveBackground
   ActiveForeground
   Accelerator ["-accelerator"; string]
   Background    
   Bitmap
   ColumnBreak ["-columnbreak"; bool]
   Command
   Font
   Foreground
   HideMargin ["-hidemargin"; bool]
##ifdef CAMLTK
   ImageBitmap
   ImagePhoto
##else
   Image
##endif
   IndicatorOn
   Label ["-label"; string]
   Menu ["-menu"; widget(menu)]
   OffValue
   OnValue
   SelectColor
##ifdef CAMLTK
   SelectImageBitmap
   SelectImagePhoto
##else
   SelectImage
##endif
   State
   UnderlinedChar
   Value ["-value"; string]
   Variable
   }

% Options for cascade entry
subtype option(menucascade) {
   ActiveBackground ActiveForeground Accelerator
   Background Bitmap ColumnBreak Command Font Foreground
   HideMargin
##ifdef CAMLTK
   ImageBitmap ImagePhoto 
##else
   Image
##endif
   IndicatorOn Label Menu State UnderlinedChar
   }

% Options for radiobutton entry
subtype option(menuradio) {
   ActiveBackground ActiveForeground Accelerator
   Background Bitmap ColumnBreak Command Font Foreground
##ifdef CAMLTK
   ImageBitmap ImagePhoto SelectImageBitmap SelectImagePhoto
##else
   Image SelectImage
##endif
   IndicatorOn Label SelectColor 
   State UnderlinedChar Value Variable
   }

% Options for checkbutton entry
subtype option(menucheck) {
   ActiveBackground ActiveForeground Accelerator
   Background Bitmap ColumnBreak Command Font Foreground
##ifdef CAMLTK
   ImageBitmap SelectImageBitmap ImagePhoto SelectImagePhoto
##else
   Image SelectImage    
##endif
   IndicatorOn Label
   OffValue OnValue SelectColor
   State UnderlinedChar Variable
   }

% Options for command entry
subtype option(menucommand) {
   ActiveBackground ActiveForeground Accelerator
   Background Bitmap ColumnBreak Command Font Foreground
##ifdef CAMLTK
   ImageBitmap ImagePhoto
##else
   Image
##endif
   Label State UnderlinedChar
   }

type menuType {
  Menu_Menubar ["menubar"]
  Menu_Tearoff ["tearoff"]
  Menu_Normal ["normal"]
}        

% Separators and tearoffs don't have options

widget menu {
   % Standard options
   option ActiveBackground
   option ActiveBorderWidth
   option ActiveForeground
   option Background
   option BorderWidth
   option Cursor
   option DisabledForeground
   option Font
   option Foreground
   option Relief
   option TakeFocus
   % Widget specific options
   option PostCommand ["-postcommand"; function()]
   option SelectColor
   option TearOff ["-tearoff"; bool]
   option TearOffCommand ["-tearoffcommand"; function(menu: widget(any), tornoff: widget(any)) ]
   option MenuTitle ["-title"; string]
   option MenuType ["-type"; menuType]

   function () activate [widget(menu); "activate"; index: Index(menu)]
   % add variations
   function () add_cascade [widget(menu); "add"; "cascade"; option(menucascade) list]
   function () add_checkbutton [widget(menu); "add"; "checkbutton"; option(menucheck) list]
   function () add_command [widget(menu); "add"; "command"; option(menucommand) list]
   function () add_radiobutton [widget(menu); "add"; "radiobutton"; option(menuradio) list]
   function () add_separator [widget(menu); "add"; "separator"]
   % not for user: function clone [widget(menu); "clone"; ???; menuType]
   function () configure [widget(menu); "configure"; option(menu) list]
   function (string) configure_get [widget(menu); "configure"]
   % beware of possible callback leak when deleting menu entries
   function () delete [widget(menu); "delete"; first: Index(menu); last: Index(menu)]
   function () configure_cascade [widget(menu); "entryconfigure"; Index(menu); option(menucascade) list]
   function () configure_checkbutton [widget(menu); "entryconfigure"; Index(menu); option(menucheck) list]
   function () configure_command [widget(menu); "entryconfigure"; Index(menu); option(menucommand) list]
   function () configure_radiobutton [widget(menu); "entryconfigure"; Index(menu); option(menuradio) list]
   function (string) entryconfigure_get [widget(menu); "entryconfigure"; Index(menu)]
   function (int) index [widget(menu); "index"; Index(menu)]
   function () insert_cascade [widget(menu); "insert"; index: Index(menu); "cascade"; option(menucascade) list]
   function () insert_checkbutton [widget(menu); "insert"; index: Index(menu); "checkbutton"; option(menucheck) list]
   function () insert_command [widget(menu); "insert"; index: Index(menu); "command"; option(menucommand) list]
   function () insert_radiobutton [widget(menu); "insert"; index: Index(menu); "radiobutton"; option(menuradio) list]
   function () insert_separator [widget(menu); "insert"; index: Index(menu); "separator"]
   function (string) invoke [widget(menu); "invoke"; index: Index(menu)]
   function () post [widget(menu); "post"; x: int; y: int]
   function () postcascade [widget(menu); "postcascade"; index: Index(menu)]
   % can't use type of course
   function (MenuItem) typeof [widget(menu); "type"; index: Index(menu)]
   function () unpost [widget(menu); "unpost"]
   function (int) yposition [widget(menu); "yposition"; index: Index(menu)]

   function () popup ["tk_popup"; widget(menu); x: int; y: int; ?entry:[Index(menu)]]
##ifdef CAMLTK
   function () popup_entry ["tk_popup"; widget(menu); x: int; y: int; index: Index(menu)]
##endif
   }


%%%%% menubutton(n)

type menubuttonDirection {
   Dir_Above ["above"]
   Dir_Below ["below"]
   Dir_Left  ["left"]
   Dir_Right ["right"] 
}

widget menubutton {
   % Standard options
   option ActiveBackground
   option ActiveForeground
   option Anchor
   option Background
   option Bitmap
   option BorderWidth
   option Cursor
   option DisabledForeground
   option Font
   option Foreground
   option HighlightBackground
   option HighlightColor
   option HighlightThickness
##ifdef CAMLTK
   option ImageBitmap
   option ImagePhoto
##else
   option Image
##endif
   option Justify
   option PadX
   option PadY
   option Relief
   option TakeFocus
   option Text
   option TextVariable
   option UnderlinedChar
   option WrapLength
   % Widget specific options
   option Direction ["-direction"; menubuttonDirection ] 
   option Height
   option IndicatorOn
   option Menu ["-menu"; widget(menu)]
   option State
   option Width
   option TextWidth

   function () configure [widget(menubutton); "configure"; option(menubutton) list]
   function (string) configure_get [widget(menubutton); "configure"]
   }



%%%%% message(n)
widget message {
   % Standard options
   option Anchor
   option Background
   option BorderWidth
   option Cursor
   option Font
   option Foreground
   option HighlightBackground
   option HighlightColor
   option HighlightThickness
   option PadX
   option PadY
   option Relief
   option TakeFocus
   option Text
   option TextVariable
   % Widget specific options
   option Aspect ["-aspect"; int]
   option Justify
   option Width

   function () configure [widget(message); "configure"; option(message) list]
   function (string) configure_get [widget(message); "configure"]
   }


%%%%% option(n)
type OptionPriority {
   WidgetDefault  ["widgetDefault"]
   StartupFile    ["startupFile"]
   UserDefault    ["userDefault"]
   Interactive    ["interactive"]
   Priority      [int]
   }

##ifdef CAMLTK

module Option {
   unsafe function () add ["option"; "add"; string; string; OptionPriority]
   function () clear ["option"; "clear"]
   function (string) get ["option"; "get"; widget; string; string]
   unsafe function () readfile ["option"; "readfile"; string; OptionPriority]
   }
%% Resource is now superseded by Option
module Resource {
   unsafe function () add ["option"; "add"; string; string; OptionPriority]
   function () clear ["option"; "clear"]
   function (string) get ["option"; "get"; widget; string; string]
   unsafe function () readfile ["option"; "readfile"; string; OptionPriority]
   }
##else
module Option {
   unsafe function () add
        ["option"; "add"; path: string; string; ?priority:[OptionPriority]]
   function () clear ["option"; "clear"]
   function (string) get ["option"; "get"; widget; name: string; clas: string]
   unsafe function () readfile
        ["option"; "readfile"; string; ?priority:[OptionPriority]]
   }
##endif

%%%%% tk_optionMenu(n)
module Optionmenu {
   external create "builtin/optionmenu"
   }


%%%%% pack(n)
type Side { 
   Side_Left ["left"]
   Side_Right ["right"]
   Side_Top ["top"]
   Side_Bottom ["bottom"]
}

type FillMode { 
   Fill_None ["none"]
   Fill_X ["x"]
   Fill_Y ["y"]
   Fill_Both ["both"]
}

subtype option(pack) {
   After ["-after"; widget]
   Anchor
   Before ["-before"; widget]
   Expand ["-expand"; bool]
   Fill ["-fill"; FillMode]
   In(Inside) ["-in"; widget]
   IPadX ["-ipadx"; Units/int]
   IPadY ["-ipady"; Units/int]
   PadX
   PadY
   Side ["-side"; Side]
}

function ()  pack ["pack"; widget list; option(pack) list]

module Pack {
    function () configure ["pack"; "configure"; widget list; option(pack) list]
    function () forget ["pack"; "forget"; widget list]
    function (string) info ["pack"; "info"; widget]
    function (bool) propagate_get ["pack"; "propagate"; widget]
    function () propagate_set ["pack"; "propagate"; widget; bool]
    function (widget list) slaves ["pack"; "slaves"; widget]
    }

subtype TkPalette(any) { % Not sophisticated...
  PaletteActiveBackground    ["activeBackground"; Color]
  PaletteActiveForeground    ["activeForeground"; Color]
  PaletteBackground          ["background"; Color]
  PaletteDisabledForeground  ["disabledForeground"; Color]
  PaletteForeground          ["foreground"; Color]
  PaletteHighlightBackground ["hilightBackground"; Color]
  PaletteHighlightColor      ["highlightColor"; Color]
  PaletteInsertBackground    ["insertBackground"; Color]
  PaletteSelectColor         ["selectColor"; Color]
  PaletteSelectBackground    ["selectBackground"; Color]
  PaletteForegroundselectColor ["selectForeground"; Color]
  PaletteTroughColor         ["troughColor"; Color]
}

%%%%% tk_setPalette(n)
%%%% can't simply encode general form of tk_setPalette
module Palette {
  function () set_background ["tk_setPalette"; Color]
  function () set ["tk_setPalette"; TkPalette(any) list]
  function () bisque ["tk_bisque"]
  }

%%%%% photo(n)
type PaletteType external  % builtin_palette.ml

subtype option(photoimage) {
  % Channel ["-channel"; file_descr] % removed in 8.3 ?
  Data
  Format ["-format"; string]
  File
  Gamma ["-gamma"; float]
  Height
  Palette ["-palette"; PaletteType]
  Width
  }

subtype photo(copy) {
  ImgFrom(Src_area) ["-from"; int; int; int; int]
  ImgTo(Dst_area)   ["-to"; int; int; int; int]
  Shrink       ["-shrink"]
  Zoom         ["-zoom"; int; int]
  Subsample    ["-subsample"; int; int]
  }

subtype photo(put) {
  ImgTo 
  }

subtype photo(read) {
  ImgFormat ["-format"; string]
  ImgFrom
  Shrink
  TopLeft(Dst_pos) ["-to"; int; int]
  }

subtype photo(write) {
  ImgFormat ImgFrom
  }

module Imagephoto {
  function (ImagePhoto) create ["image"; "create"; "photo"; ?name:[ImagePhoto]; option(photoimage) list]
##ifdef CAMLTK
  function (ImagePhoto) create_named ["image"; "create"; "photo"; ImagePhoto; option(photoimage) list]
##endif
  function () delete ["image"; "delete"; ImagePhoto]
  function (int) height ["image"; "height"; ImagePhoto]
  function (int) width ["image"; "width"; ImagePhoto]

%name
%type

  function () blank [ImagePhoto; "blank"]
  function () configure [ImagePhoto; "configure"; option(photoimage) list]
  function (string) configure_get [ImagePhoto; "configure"]
  function () copy [ImagePhoto; "copy"; src: ImagePhoto; photo(copy) list]
  function (int, int, int) get [ImagePhoto; "get"; x: int; y: int]
% it is buggy ? can't express nested lists ?
  function () put [ImagePhoto; "put"; [Color list list]; photo(put) list]
%  external put "builtin/imagephoto_put"
  function () read [ImagePhoto; "read"; file: string; photo(read) list]
  function () redither [ImagePhoto; "redither"]
  function () write [ImagePhoto; "write"; file: string; photo(write) list]
  % Functions inherited from the "image" TK class
  }


%%%%% place(n)
type BorderMode {
  Inside ["inside"]
  Outside ["outside"]
  Ignore ["ignore"]
}

subtype option(place) {
  In 
  X 
  RelX ["-relx"; float]
  Y
  RelY ["-rely"; float]
  Anchor
  Width
  RelWidth ["-relwidth"; float]
  Height
  RelHeight ["-relheight"; float]
  BorderMode ["-bordermode"; BorderMode]
}

function () place ["place"; widget; option(place) list]

module Place {
    function () configure ["place"; "configure"; widget; option(place) list]
    function () forget ["place"; "forget"; widget]
    function (string) info ["place"; "info"; widget]
    function (widget list) slaves ["place"; "slaves"; widget]
}


%%%%% radiobutton(n)

widget radiobutton {
   % Standard options
   option ActiveBackground
   option ActiveForeground
   option Anchor
   option Background
   option Bitmap
   option BorderWidth
   option Cursor
   option DisabledForeground
   option Font
   option Foreground
   option HighlightBackground
   option HighlightColor
   option HighlightThickness
##ifdef CAMLTK
   option ImageBitmap
   option ImagePhoto
##else
   option Image
##endif
   option Justify
   option PadX
   option PadY
   option Relief
   option TakeFocus
   option Text
   option TextVariable
   option UnderlinedChar
   option WrapLength

   % Widget specific options
   option Command
   option Height
   option IndicatorOn
   option SelectColor
##ifdef CAMLTK
   option SelectImageBitmap
   option SelectImagePhoto
##else
   option SelectImage
##endif
   option State
   option Value
   option Variable
   option Width

   function () configure [widget(radiobutton); "configure"; option(radiobutton) list]
   function (string) configure_get [widget(radiobutton); "configure"]
   function () deselect [widget(radiobutton); "deselect"]
   function () flash [widget(radiobutton); "flash"]
   function () invoke [widget(radiobutton); "invoke"]
   function () select [widget(radiobutton); "select"]
   }


%%%%% raise(n)
% We cannot use raise !!
function () raise_window ["raise"; widget; ?above:[widget]]
##ifdef CAMLTK
function () raise_window_above ["raise"; widget; widget]
##endif

%%%%% scale(n)
%% shared with scrollbars
##ifdef CAMLTK
subtype WidgetElement(scale) {
  Slider ["slider"]
  Trough1 ["trough1"]
  Trough2 ["trough2"]
  Beyond [""]
  }
##else
type ScaleElement {
  Slider ["slider"]
  Trough1 ["trough1"]
  Trough2 ["trough2"]
  Beyond [""]
  }
##endif

widget scale {
   % Standard options
   option ActiveBackground
   option Background
   option BorderWidth
   option Cursor
   option Font
   option Foreground
   option HighlightBackground
   option HighlightColor
   option HighlightThickness
   option Orient
   option Relief
   option RepeatDelay
   option RepeatInterval
   option TakeFocus
   option TroughColor

   % Widget specific options
   option BigIncrement ["-bigincrement"; float]
   option ScaleCommand ["-command"; function (float)]
   option Digits ["-digits"; int]
   option From(Min) ["-from"; float]
   option Label ["-label"; string]
   option Length ["-length"; Units/int]
   option Resolution ["-resolution"; float]
   option ShowValue ["-showvalue"; bool]
   option SliderLength ["-sliderlength"; Units/int]
   option State
   option TickInterval ["-tickinterval"; float]
   option To(Max) ["-to"; float]
   option Variable
   option Width

##ifdef CAMLTK
   function (int,int) coords [widget(scale); "coords"]
   function (int,int) coords_at [widget(scale); "coords"; at: float]
##else
   function (int,int) coords [widget(scale); "coords"; ?at: [float]]
##endif
   function () configure [widget(scale); "configure"; option(scale) list]
   function (string) configure_get [widget(scale); "configure"]
   function (float) get [widget(scale); "get"]
   function (float) get_xy [widget(scale); "get"; x: int; y: int]
   function (WidgetElement/ScaleElement) identify [widget(scale); x: int; y: int]
   function () set [widget(scale); "set"; float]
   }


%%%%% scrollbar(n)
##ifdef CAMLTK
subtype WidgetElement(scrollbar) {
  Arrow1 ["arrow1"]
  Trough1
  Trough2
  Slider
  Arrow2 ["arrow2"]
  Beyond
  }
##else
type ScrollbarElement {
  Arrow1 ["arrow1"]
  Trough1 ["through1"]
  Trough2 ["through2"]
  Slider ["slider"]
  Arrow2 ["arrow2"]
  Beyond [""]
  }
##endif

widget scrollbar {
   % Standard options
   option ActiveBackground
   option Background
   option BorderWidth
   option Cursor
   option HighlightBackground
   option HighlightColor
   option HighlightThickness
   option Jump
   option Orient
   option Relief
   option RepeatDelay
   option RepeatInterval
   option TakeFocus
   option TroughColor
   % Widget specific options
   option ActiveRelief ["-activerelief"; Relief]
   option ScrollCommand ["-command"; function(scroll: ScrollValue)]
   option ElementBorderWidth ["-elementborderwidth"; Units/int]
   option Width

##ifdef CAMLTK
   function () activate [widget(scrollbar); "activate"; element: WidgetElement(scrollbar)]
##else
   function () activate [widget(scrollbar); "activate"; element: ScrollbarElement]
##endif
   function (WidgetElement/ScrollbarElement) activate_get [widget(scrollbar); "activate"]
   function () configure [widget(scrollbar); "configure"; option(scrollbar) list]
   function (string) configure_get [widget(scrollbar); "configure"]
   function (float) delta [widget(scrollbar); "delta"; x: int; y: int]
   function (float) fraction [widget(scrollbar); "fraction"; x: int; y: int]
   function (float, float) get [widget(scrollbar); "get"]
   function (int,int,int,int) old_get [widget(scrollbar); "get"]
   function (WidgetElement/ScrollbarElement) identify [widget(scale); "identify"; int; int]
   function () set [widget(scrollbar); "set"; first: float; last: float]
   function () old_set [widget(scrollbar); "set"; total:int; window:int; first:int; last:int]
   }


%%%%% selection(n)

subtype icccm(selection_clear) {
  DisplayOf ["-displayof"; widget]
  Selection ["-selection"; string]
  }

subtype icccm(selection_get) {
  DisplayOf
  Selection
  ICCCMType
  }

subtype icccm(selection_ownset) {
  LostCommand ["-command"; function()]
  Selection
  }

subtype icccm(selection_handle) {
  Selection 
  ICCCMType 
  ICCCMFormat ["-format"; string]
  }

module Selection {
   function () clear ["selection"; "clear"; icccm(selection_clear) list]
   function (string) get ["selection"; "get"; icccm(selection_get) list]
   
   % function () handle_set ["selection"; "handle"; icccm(selection_handle) list; widget; function(int,int)]
   external handle_set "builtin/selection_handle_set"
   unsafe function (widget) own_get ["selection"; "own"; icccm(selection_clear) list]
   % builtin
   % function () own_set ["selection"; "own"; widget; icccm(selection_ownset) list]
   external own_set "builtin/selection_own_set"
   }


%%%%% send(n)
type SendOption {
  SendDisplayOf ["-displayof"; widget] % DisplayOf is used for icccm !
  SendAsync ["-async"]          
}

unsafe function () send ["send"; SendOption list; "--"; app: string; command: string list]

%%%%% text(n)

type TextIndex external
type TextTag external
type TextMark external


type TabType {
  TabLeft    [Units/int; "left"]
  TabRight   [Units/int; "right"]
  TabCenter  [Units/int; "center"]
  TabNumeric [Units/int; "numeric"]
  }

type WrapMode { 
  WrapNone ["none"]
  WrapChar ["char"]
  WrapWord ["word"]
}

type Comparison { 
  LT (Lt) ["<"]
  LE (Le) ["<="]
  EQ (Eq) ["=="]
  GE (Ge) [">="]
  GT (Gt) [">"]
  NEQ (Neq) ["!="]
}

type MarkDirection {
  Mark_Left ["left"]
  Mark_Right ["right"]
  }

type AlignType {
  Align_Top ["top"]
  Align_Bottom ["bottom"]
  Align_Center ["center"]
  Align_Baseline ["baseline"]
  }

subtype option(embeddedi) {
  Align ["-align"; AlignType]
##ifdef CAMLTK
  ImageBitmap
  ImagePhoto
##else
  Image
##endif
  Name ["-name"; string]
  PadX
  PadY
  }

subtype option(embeddedw) {
  Align ["-align"; AlignType]
  PadX
  PadY
  Stretch ["-stretch"; bool]
  Window
  }

type TextSearch {
  Forwards ["-forwards"]
  Backwards ["-backwards"]
  Exact ["-exact"]
  Regexp ["-regexp"]
  Nocase ["-nocase"]
  Count ["-count"; TextVariable]
  }

type text_dump {
  DumpAll ["-all"]
  DumpCommand ["-command"; function (key: string, value: string, index: string)]
  DumpMark ["-mark"]
  DumpTag ["-tag"]
  DumpText ["-text"]
  DumpWindow ["-window"] 
  }

widget text {
   % Standard options
   option Background
   option BorderWidth
   option Cursor
   option ExportSelection
   option Font
   option Foreground
   option HighlightBackground
   option HighlightColor
   option HighlightThickness
   option InsertBackground
   option InsertBorderWidth
   option InsertOffTime
   option InsertOnTime
   option InsertWidth
   option PadX
   option PadY
   option Relief
   option SelectBackground
   option SelectBorderWidth
   option SelectForeground
   option SetGrid
   option TakeFocus
   option XScrollCommand
   option YScrollCommand

   % Widget specific options
   option TextHeight
   option Spacing1 ["-spacing1"; Units/int]
   option Spacing2 ["-spacing2"; Units/int]
   option Spacing3 ["-spacing3"; Units/int]
##ifdef CAMLTK
   option State
##else
   option EntryState
##endif
   option Tabs ["-tabs"; [TabType list]]
   option TextWidth
   option Wrap ["-wrap"; WrapMode]

   function (int,int,int,int) bbox [widget(text); "bbox"; index: TextIndex]
   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"; 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]

   % require result parser
   function (string list) dump [widget(text); "dump"; text_dump list; start: TextIndex; stop: TextIndex]
   function (string list) dump_char [widget(text); "dump"; text_dump list; index: TextIndex]
        
   function (string) get [widget(text); "get"; start: TextIndex; stop: TextIndex]
   function (string) get_char [widget(text); "get"; index: TextIndex]
   function () image_configure
     [widget(text); "image"; "configure"; name: string; option(embeddedi) list]
   function (string) image_configure_get
     [widget(text); "image"; "cgets"; name: string]
   function (string) image_create
     [widget(text); "image"; "create"; index: TextIndex; option(embeddedi) list]
   function (string list) image_names [widget(text); "image"; "names"]
   function (Index(text) as "[>`Linechar of int * int]") index [widget(text); "index"; index: TextIndex]
##ifdef CAMLTK
   function () insert [widget(text); "insert"; index: TextIndex; text: string; [TextTag list]]
##else
   function () insert [widget(text); "insert"; index: TextIndex; text: string; ?tags: [TextTag list]]
##endif
   % Mark 
   function () mark_gravity_set [widget(text); "mark"; "gravity"; mark: TextMark; direction: MarkDirection]
   function (MarkDirection) mark_gravity_get [widget(text); "mark"; "gravity"; mark: TextMark]
   function (TextMark list) mark_names [widget(text); "mark"; "names"]
   function (TextMark) mark_next [widget(text); "mark"; "next"; index: TextIndex]
   function (TextMark) mark_previous [widget(text); "mark"; "previous"; index: TextIndex]
   function () mark_set [widget(text); "mark"; "set"; mark: TextMark; index: TextIndex]
   function () mark_unset [widget(text); "mark"; "unset"; marks: TextMark list]
   % Scan 
   function () scan_mark [widget(text); "scan"; "mark"; x: int; y: int]
   function () scan_dragto [widget(text); "scan"; "dragto"; x: int; y: int]
##ifdef CAMLTK
   function (Index) search [widget(text); "search"; TextSearch list; "--"; string; TextIndex; TextIndex]
##else
   function (Index(text) as "[>`Linechar of int * int]") search [widget(text); "search"; switches: TextSearch list; "--"; pattern: string; start: TextIndex; ?stop: [TextIndex]]
##endif
   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; 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]

   function () tag_lower [widget(text); "tag";  "lower"; tag: TextTag; ?below: [TextTag]]
##ifdef CAMLTK
   function () tag_lower_below [widget(text); "tag";  "lower"; TextTag; TextTag]
   function () tag_lower_bot [widget(text); "tag"; "lower"; TextTag]
##endif

   function (TextTag list) tag_names [widget(text); "tag"; "names"; ?index: [TextIndex]]
##ifdef CAMLTK
   function (TextTag list) tag_allnames [widget(text); "tag"; "names"]
   function (TextTag list) tag_indexnames [widget(text); "tag"; "names"; TextIndex]
##endif

##ifdef CAMLTK
   function (Index, Index) tag_nextrange [widget(text); "tag"; "nextrange"; TextTag; start: TextIndex; stop: TextIndex]
   function (Index, Index) tag_prevrange [widget(text); "tag"; "prevrange"; TextTag; start: TextIndex; stop: TextIndex]
##else
   function (Index(text) as "[>`Linechar of int * int]", Index(text) as "[>`Linechar of int * int]") tag_nextrange [widget(text); "tag"; "nextrange"; tag: TextTag; start: TextIndex; ?stop: [TextIndex]]
   function (Index(text) as "[>`Linechar of int * int]", Index(text) as "[>`Linechar of int * int]") tag_prevrange [widget(text); "tag"; "prevrange"; tag: TextTag; start: TextIndex; ?stop: [TextIndex]]
##endif

   function () tag_raise [widget(text); "tag"; "raise"; tag: TextTag; ?above: [TextTag]]
##ifdef CAMLTK
   function () tag_raise_above [widget(text); "tag"; "raise"; TextTag; TextTag]
   function () tag_raise_top [widget(text); "tag"; "raise"; TextTag]
##endif

##ifdef CAMLTK
   function (Index list) tag_ranges [widget(text); "tag"; "ranges"; TextTag]
##else
   function (Index(text) as "[>`Linechar of int * int]" list) tag_ranges [widget(text); "tag"; "ranges"; tag: TextTag]
##endif

   function () tag_remove [widget(text); "tag"; "remove"; tag: TextTag; start: TextIndex; stop: 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"]
   % scrolling
   function (float,float) xview_get [widget(text); "xview"]
   function (float,float) yview_get [widget(text); "yview"]
   function () xview [widget(text); "xview"; scroll: ScrollValue]
   function () yview [widget(text); "yview"; scroll: ScrollValue]
   function () yview_index [widget(text); "yview"; index: TextIndex]
   function () yview_index_pickplace [widget(text); "yview"; "-pickplace"; index: TextIndex]
   function () yview_line [widget(text); "yview"; line: int]      % obsolete
   }

subtype option(texttag) {
   Background
   BgStipple ["-bgstipple"; Bitmap]
   BorderWidth
   FgStipple ["-fgstipple"; Bitmap]
   Font
   Foreground
   Justify
   LMargin1 ["-lmargin1"; Units/int]
   LMargin2 ["-lmargin2"; Units/int]
   Offset ["-offset"; Units/int]
   OverStrike ["-overstrike"; bool]
   Relief
   RMargin ["-rmargin"; Units/int]
   Spacing1
   Spacing2
   Spacing3
   Tabs 
   Underline ["-underline"; bool]
   Wrap ["-wrap"; WrapMode]
   }


%%%%% tk(n)
unsafe function () appname_set ["tk"; "appname"; string]
unsafe function (string) appname_get ["tk"; "appname"]
function (float) scaling_get ["tk"; "scaling"; ?displayof:["-displayof"; widget]]
unsafe function () scaling_set ["tk"; "scaling"; ?displayof:["-displayof"; widget]; float]

%%%%% tk_chooseColor(n)

subtype option(chooseColor){
    InitialColor ["-initialcolor"; Color]
    Parent ["-parent"; widget]
    Title ["-title"; string]    
    }
function (Color) chooseColor ["tk_chooseColor"; option(chooseColor) list] 

%%%%% tkwait(n)
module Tkwait {
   function () variable ["tkwait"; "variable"; TextVariable]
   function () visibility ["tkwait"; "visibility"; widget]
   function () window ["tkwait"; "window"; widget]
   }


%%%%% toplevel(n)
% This module will be renamed "toplevelw" to avoid collision with
% Caml Light standard toplevel module.
widget toplevel {
   % Standard options
   option BorderWidth
   option Cursor
   option HighlightBackground
   option HighlightColor
   option HighlightThickness
   option Relief
   option TakeFocus

   % Widget specific options
   option Background
##ifdef CAMLTK
   option Class
##else
   option Clas
##endif
   option Colormap
   option Container ["-container"; bool]
   option Height
   option Menu 
   option Screen ["-screen"; string]
   option Use ["-use"; string] % must be hexadecimal "0x????"
   option Visual
   option Width

   function () configure [widget(toplevel); "configure"; option(toplevel) list]
   function (string) configure_get [widget(toplevel); "configure"]
   }


%%%%% update(n)
function () update ["update"]
function () update_idletasks ["update"; "idletasks"]


%%%%% winfo(n)

type AtomId {
   AtomId [int]
   }

module Winfo {

   unsafe function (AtomId) atom ["winfo"; "atom"; ?displayof:["-displayof"; widget]; string]
   unsafe function (string) atomname ["winfo"; "atomname"; ?displayof:["-displayof"; widget]; AtomId]
##ifdef CAMLTK
   unsafe function (AtomId) atom_displayof ["winfo"; "atom"; "-displayof"; widget; string]
   unsafe function (string) atomname_displayof ["winfo"; "atomname"; "-displayof"; widget; AtomId]
##endif
   function (int) cells ["winfo"; "cells"; widget]
   function (widget list) children ["winfo"; "children"; widget]
   function (string) class_name ["winfo"; "class"; widget]
   function (bool) colormapfull ["winfo"; "colormapfull"; widget]
   unsafe function (widget) containing ["winfo"; "containing"; ?displayof:["-displayof"; widget]; x: int; y: int]
##ifdef CAMLTK
   unsafe function (widget) containing_displayof ["winfo"; "containing"; "-displayof"; widget; int; int]
##endif
   % addition for applets
   external contained "builtin/winfo_contained"
   function (int) depth ["winfo"; "depth"; widget]
   function (bool) exists ["winfo"; "exists"; widget]
   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]
   unsafe function (string list) interps ["winfo"; "interps"; ?displayof:["-displayof"; widget]]
##ifdef CAMLTK
   unsafe function (string list) interps_displayof ["winfo"; "interps"; "-displayof"; widget]
##endif
   function (bool) ismapped ["winfo"; "ismapped"; widget]
   function (string) manager ["winfo"; "manager"; widget]
   function (string) name ["winfo"; "name"; widget]
   unsafe function (widget) parent ["winfo"; "parent"; widget]        % bogus for top
   unsafe function (widget) pathname ["winfo"; "pathname"; ?displayof:["-displayof"; widget]; string]
##ifdef CAMLTK
   unsafe function (widget) pathname_displayof ["winfo"; "pathname"; "-displayof"; widget; string]
##endif
   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]
   function (int) reqheight ["winfo"; "reqheight"; widget]
   function (int) reqwidth ["winfo"; "reqwidth"; widget]
   function (int,int,int) rgb ["winfo"; "rgb"; widget; color: Color]
   function (int) rootx ["winfo"; "rootx"; widget]
   function (int) rooty ["winfo"; "rooty"; widget]
   unsafe function (string) screen ["winfo"; "screen"; widget]
   function (int) screencells ["winfo"; "screencells"; widget]
   function (int) screendepth ["winfo"; "screendepth"; widget]
   function (int) screenheight ["winfo"; "screenheight"; widget]
   function (int) screenmmheight ["winfo"; "screenmmheight"; widget]
   function (int) screenmmwidth ["winfo"; "screenmmwidth"; widget]
   function (string) screenvisual ["winfo"; "screenvisual"; widget]
   function (int) screenwidth ["winfo"; "screenwidth"; widget]
   unsafe function (string) server ["winfo"; "server"; widget]
   unsafe function (widget(toplevel)) toplevel ["winfo"; "toplevel"; widget]
   function (bool) viewable ["winfo"; "viewable"; widget]
   function (string) visual ["winfo"; "visual"; widget]
   function (int) visualid ["winfo"; "visualid"; widget]
   % need special parser 
   function (string) visualsavailable ["winfo"; "visualsavailable"; widget; ?includeids: [int list]]
   function (int) vrootheight ["winfo"; "vrootheight"; widget]
   function (int) vrootwidth ["winfo"; "vrootwidth"; widget]
   function (int) vrootx ["winfo"; "vrootx"; widget]
   function (int) vrooty ["winfo"; "vrooty"; widget]
   function (int) width ["winfo"; "width"; widget]
   function (int) x ["winfo"; "x"; widget]
   function (int) y ["winfo"; "y"; widget]
}


%%%%% wm(n)

type FocusModel {
   FocusActive ["active"]
   FocusPassive ["passive"]
}

type WmFrom {
   User ["user"]
   Program ["program"]
}

module Wm {
%%% Aspect
   function () aspect_set ["wm"; "aspect"; widget(toplevel); minnum:int; mindenom:int; maxnum:int; maxdenom:int]
   % aspect: problem with empty return
   function (int,int,int,int) aspect_get ["wm"; "aspect"; widget(toplevel)]
%%% WM_CLIENT_MACHINE
   function () client_set ["wm"; "client"; widget(toplevel); name: string]
   function (string) client_get ["wm"; "client"; widget(toplevel)]
%%% WM_COLORMAP_WINDOWS
   function () colormapwindows_set 
        ["wm"; "colormapwindows"; widget(toplevel); [windows: widget list]]
   unsafe function (widget list) colormapwindows_get
        ["wm"; "colormapwindows"; widget(toplevel)]
%%% WM_COMMAND
   function () command_clear ["wm"; "command"; widget(toplevel); ""]
   function () command_set ["wm"; "command"; widget(toplevel); [string list]]
   function (string list) command_get ["wm"; "command"; widget(toplevel)]

   function () deiconify ["wm"; "deiconify"; widget(toplevel)]

%%% Focus model
   function () focusmodel_set ["wm"; "focusmodel"; widget(toplevel); FocusModel]
   function (FocusModel) focusmodel_get ["wm"; "focusmodel"; widget(toplevel)]

   function (string) frame ["wm"; "frame"; widget(toplevel)]

%%% Geometry
   function () geometry_set ["wm"; "geometry"; widget(toplevel); string]
   function (string) geometry_get ["wm"; "geometry"; widget(toplevel)]

%%% Grid
   function () grid_clear ["wm"; "grid"; widget(toplevel); ""; ""; ""; ""]
   function () grid_set ["wm"; "grid"; widget(toplevel); basewidth: int; baseheight: int; widthinc: int; heightinc: int]
   function (int,int,int,int) grid_get ["wm"; "grid"; widget(toplevel)]

%%% Groups
   function () group_clear ["wm"; "group"; widget(toplevel); ""]
   function () group_set ["wm"; "group"; widget(toplevel); leader: widget]
   unsafe function (widget) group_get ["wm"; "group"; widget(toplevel)]
%%% Icon bitmap
   function () iconbitmap_clear ["wm"; "iconbitmap"; widget(toplevel); ""]
   function () iconbitmap_set ["wm"; "iconbitmap"; widget(toplevel); Bitmap]
   function (Bitmap) iconbitmap_get ["wm"; "iconbitmap"; widget(toplevel)]

   function () iconify ["wm"; "iconify"; widget(toplevel)]

%%% Icon mask
   function () iconmask_clear ["wm"; "iconmask"; widget(toplevel); ""]
   function () iconmask_set ["wm"; "iconmask"; widget(toplevel); Bitmap]
   function (Bitmap) iconmask_get ["wm"; "iconmask"; widget(toplevel)]

%%% Icon name
   function () iconname_set ["wm"; "iconname"; widget(toplevel); string]
   function (string) iconname_get ["wm"; "iconname"; widget(toplevel)]
%%% Icon position
   function () iconposition_clear ["wm"; "iconposition"; widget(toplevel); ""; ""]
   function () iconposition_set ["wm"; "iconposition"; widget(toplevel); x: int; y: int]
   function (int,int) iconposition_get ["wm"; "iconposition"; widget(toplevel)]
%%% Icon window
   function () iconwindow_clear ["wm"; "iconwindow"; widget(toplevel); ""]
   function () iconwindow_set ["wm"; "iconwindow"; widget(toplevel); icon: widget(toplevel)]
   unsafe function (widget(toplevel)) iconwindow_get ["wm"; "iconwindow"; widget(toplevel)]

%%% Sizes
   function () maxsize_set ["wm"; "maxsize"; widget(toplevel); width: int; height: int]
   function (int,int) maxsize_get ["wm"; "maxsize"; widget(toplevel)]
   function () minsize_set ["wm"; "minsize"; widget(toplevel); width: int; height: int]
   function (int,int) minsize_get ["wm"; "minsize"; widget(toplevel)]
%%% Override
   unsafe function () overrideredirect_set ["wm"; "overrideredirect"; widget(toplevel); bool]
   function (bool) overrideredirect_get ["wm"; "overrideredirect"; widget(toplevel)]
%%% Position
   function () positionfrom_clear ["wm"; "positionfrom"; widget(toplevel); ""]
   function () positionfrom_set ["wm"; "positionfrom"; widget(toplevel); WmFrom]
   function (WmFrom) positionfrom_get ["wm"; "positionfrom"; widget(toplevel)]
%%% Protocols
   function () protocol_set ["wm"; "protocol"; widget(toplevel); name: string; command: function()]
   function () protocol_clear ["wm"; "protocol"; widget(toplevel); name: string; ""]
   function (string list) protocols ["wm"; "protocol"; widget(toplevel)]
%%% Resize
   function () resizable_set ["wm"; "resizable"; widget(toplevel); width: bool; height: bool]
   function (bool, bool) resizable_get ["wm"; "resizable"; widget(toplevel)]
%%% Sizefrom
   function () sizefrom_clear ["wm"; "sizefrom"; widget(toplevel); ""]
   function () sizefrom_set ["wm"; "sizefrom"; widget(toplevel); WmFrom]
   function (WmFrom) sizefrom_get ["wm"; "sizefrom"; widget(toplevel)]

   function (string) state ["wm"; "state"; widget(toplevel)]

%%% Title
   function (string) title_get ["wm"; "title"; widget(toplevel)]
   function () title_set ["wm"; "title"; widget(toplevel); string]
%%% Transient
   function () transient_clear ["wm"; "transient"; widget(toplevel); ""]
   function () transient_set ["wm"; "transient"; widget(toplevel); master: widget]
   unsafe function (widget) transient_get ["wm"; "transient"; widget(toplevel)]

   function () withdraw ["wm"; "withdraw"; widget(toplevel)]

}

%%%%% tk_getOpenFile(n) (since version 8.0)
type FilePattern external

subtype option(getFile) {
  DefaultExtension ["-defaultextension"; string]
  FileTypes ["-filetypes"; [FilePattern list]] 
  InitialDir ["-initialdir"; string]
  InitialFile ["-initialfile"; string]
  Parent ["-parent"; widget]
  Title ["-title"; string]
}

function (string) getOpenFile ["tk_getOpenFile"; option(getFile) list]
function (string) getSaveFile ["tk_getSaveFile"; option(getFile) list]

%%%%% tk_messageBox
type MessageIcon {
   Error ["error"]
   Info  ["info"]
   Question ["question"]
   Warning ["warning"]
}
type MessageType {
   AbortRetryIgnore ["abortretryignore"]
   Ok ["ok"]
   OkCancel ["okcancel"]
   RetryCancel ["retrycancel"]
   YesNo ["yesno"] 
   YesNoCancel ["yesnocancel"]
}
subtype option(messageBox) {
  MessageDefault ["-default"; string]
  MessageIcon  ["-icon"; MessageIcon]
  Message ["-message"; string]
  Parent
  Title 
  MessageType ["-type"; MessageType]
}

function (string) messageBox ["tk_messageBox"; option(messageBox) list]
 
module Tkvars {
  function (string) library ["$tk_library"]
  function (string) patchLevel ["$tk_patchLevel"]
  function (bool) strictMotif ["$tk_strictMotif"]
  function () set_strictMotif ["set"; "tk_strictMotif"; bool]
  function (string) version ["$tk_version"]
}

% Direct API calls, non Tcl-based modules

module Pixmap {
   external create "builtin/rawimg"
   }

%%% encodings : require if you want write your application international

module Encoding {
  function (string) convertfrom ["encoding"; "convertfrom"; 
                                 ?encoding: [string]; string]
  function (string) convertto ["encoding"; "convertto";
                                ?encoding: [string]; string]    
  function (string list) names ["encoding"; "names"]
  function () system_set ["encoding"; "system"; string]
  function (string) system_get ["encoding"; "system"]
}