2305 lines
75 KiB
Plaintext
2305 lines
75 KiB
Plaintext
%(***********************************************************************)
|
|
%(* *)
|
|
%(* MLTk, Tcl/Tk interface of OCaml *)
|
|
%(* *)
|
|
%(* Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis *)
|
|
%(* projet Cristal, INRIA Rocquencourt *)
|
|
%(* Jacques Garrigue, Kyoto University RIMS *)
|
|
%(* *)
|
|
%(* Copyright 2002 Institut National de Recherche en Informatique et *)
|
|
%(* en Automatique and Kyoto University. All rights reserved. *)
|
|
%(* This file is distributed under the terms of the GNU Library *)
|
|
%(* General Public License, with the special exception on linking *)
|
|
%(* described in file LICENSE found in the OCaml source tree. *)
|
|
%(* *)
|
|
%(***********************************************************************)
|
|
|
|
%%%%%%%%%%%%%% 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"]
|
|
}
|