%%%%%%%%%%%%%% 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 % where 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"] 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"] } 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 subtype option(canvastext) { Anchor FillColor Font Justify Stipple Tags Text Width } % 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"; float] 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)] 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"; 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"] }