Tk Source Code

# tkoWidget(3) -- oo class like widgets

*   [NAME](#NAME)
*   [SYNOPSIS](#SYNOPSIS)
*   [ARGUMENTS](#ARGUMENTS)
*   [DESCRIPTION](#DESCRIPTION)
*   [SEE ALSO](#SEE-ALSO)
*   [KEYWORDS](#KEYWORDS)
*   [COPYRIGHT](#COPYRIGHT)

<a name="NAME"></a>
## NAME

Tko\_WidgetClassDefine,
Tko\_WidgetCreate,
Tko\_WidgetDestroy,
Tko\_WidgetClientData,
Tko\_WidgetOptionGet,
Tko\_WidgetOptionSet,

<a name="SYNOPSIS"></a>
## SYNOPSIS

**#include "tkoWidget.h"**

int
**Tko\_WidgetClassDefine**(*interp,classname,methods,options*)
int
**Tko\_WidgetCreate**(*clientdata,interp,object,createmode,arglist*)
void
**Tko\_WidgetDestroy**(*context*)
ClientData
**Tko\_WidgetClientData**(*context*)
Tcl\_Obj \*
**Tko\_WidgetOptionGet**(*widget,option*)
int
**Tko\_WidgetOptionSet**(*widget,option,value*)

<a name="ARGUMENTS"></a>
## ARGUMENTS

| Tcl\_Interp **\*interp** | Used interpreter.
| Tcl\_Obj **\*classname** |Oo class name of widget.
| const Tcl\_MethodType **\*methods** | This array defines class methods to create. For creation methods see [Tcl\_NewMethod] manpage. If the method name of the first array entry is not NULL it will be used as **constructor**, if the second method name is not NULL it used as **destructor**. Then follow public methods until an entry with an method name equal NULL comes. Then follow private methods until an entry with an method name equal NULL comes.
| const Tko\_WidgetOptionDefine **\*options** | This array contain option definitions.
| Tcl\_Object **object** | This is the current object reference.
| Tko_WidgetCreateMode **createmode** | When =1 then create a toplevel otherwise a frame window.
| Tcl\_Obj **arglist** | Argument list of constructor call.
| ClientData **cientdata** | Pointer to widget structure. First part in this struct is Tko\_Widget. It
| Tcl\_ObjectContext **context** | Context of method calls.
| Tcl\_Obj **\*option** | The name of the used option.
| Tcl\_Obj **\*value** | New value of the given option.

<a name="DESCRIPTION"></a>
## DESCRIPTION

The **Tko\_WidgetClassDefine** function create a new tko widget class of *classname*. The function create the class add common methods (cget, configure, \_tko\_configure) and then add given methods and options.

The **Tko\_WidgetCreate** function create a new window. The *clientdata* should be *ckalloc*ed in the widget constructor. The function add the given *clientdata* to the object metadata. The function should be called in a C widget constructor.

The **Tko\_WidgetDestroy** function clears all internal widget data. The function also arrange the *ckfree* of the *clientdata*.

The **Tko\_WidgetClientData** should be used from inside widget methods to get the widget structure data given in the **Tko\_WidgetCreate** function.

The **Tko\_WidgetOptionGet** function returns the current value of the given option.

The **Tko\_WidgetOptionSet** function set the given *option* to the new given *value*.

### Enum: `Tko_WidgetOptionType`

Suported enum type in the **Tko\_WidgetOptionDefine** definition. As comment is the type of the address provided in the **Tko\_WidgetOptionDefine** definition.

    typedef enum Tko\_WidgetOptionType {
        TKO_SET_CLASS = 1,     /* (Tcl_Obj **)address */
        TKO_SET_VISUAL, /* (Tcl_Obj **)address */
        TKO_SET_COLORMAP,       /* (Tcl_Obj **)address */
        TKO_SET_USE,        /* (Tcl_Obj **)address */
        TKO_SET_CONTAINER,      /* (int *)address */
        TKO_SET_TCLOBJ, /* (Tcl_Obj **)address */
        TKO_SET_XCOLOR, /* (Xcolor **)address */
        TKO_SET_3DBORDER,       /* (Tk_3DBorder *)address */
        TKO_SET_PIXEL,  /* (int *)address */
        TKO_SET_PIXELNONEGATIV, /* (int *)address */
        TKO_SET_PIXELPOSITIV,   /* (int *)address */
        TKO_SET_DOUBLE, /* (double *)address */
        TKO_SET_BOOLEAN,        /* (int *)address */
        TKO_SET_CURSOR, /* (Tk_Cursor *)address */
        TKO_SET_INT,    /* (int *)address */
        TKO_SET_RELIEF, /* (int *)address */
        TKO_SET_ANCHOR, /* (int *)address */
        TKO_SET_WINDOW, /* (Tk_Window *)address */
        TKO_SET_FONT,   /* (Tk_Font *)address */
        TKO_SET_STRING, /* (char **)address */
        TKO_SET_SCROLLREGION,   /* (int *[4])address */
        TKO_SET_JUSTIFY /* (Tk_Justify *)address */
    } Tko\_WidgetOptionType;

### Enum: `Tko_WidgetCreateMode`

Supported values in **Tko\_WdigetCreate()** function call.

    typedef enum Tko_WidgetCreateMode {
      TKO_CREATE_WIDGET, /* Create new widget */
      TKO_CREATE_TOPLEVEL, /* Create new toplevel widget */
      TKO_CREATE_CLASS, /* See "tko initclass" */
      TKO_CREATE_WRAP /* See "tko initwrap" */
    } Tko_WidgetCreateMode;

### Struct: `Tko_WidgetOptionDefine`

Widget definition data used in class.
An option set method "-option" is created in the following order:
  - "option"=NULL indicate the end of a list of option definitions.
  - If "method" is given it will be used as option set method.
  - If "type" is greater 0 a common option set method will be used.
    In this case "offset" are used as offset in the widget structure.

    typedef struct Tko_WidgetOptionDefine {
        const char *option;    /* Name of option. Starts with "-" minus sign */
        const char *dbname;    /* Option DB name or synonym option if dbclass is NULL */
        const char *dbclass;   /* Option DB class name or NULL for synonym options. */
        const char *defvalue;  /* Default value. */
        int flags;             /* bit array of TKO_OPTION_* values to configure option behaviour */
        Tcl_MethodCallProc *method;    /* If not NULL it is the function name of the -option method */
        Tko_WidgetOptionType type;  /* if greater 0 then option type used in common option set method */
        int offset;            /* offset in meta data struct */
    } Tko_WidgetOptionDefine;
    #define TKO_OPTION_READONLY 0x1 /* option is only setable at creation time */

### Struct: `Tko_Widget`

Widget structure data used in objects.
These structure will be filled in the **Tko\_WidgetCreate** call and cleared in
the **Tko\_WidgetDestroy** call. Widget methods should check the value of *tkWin* on NULL before using it.

    typedef struct Tko_Widget {
        Tk_Window tkWin;       /* Window that embodies the widget. NULL means
                                * that the window has been destroyed but the
                                * data structures haven't yet been cleaned
                                * up.*/
        Display *display;      /* Display containing widget. Used, among
                                * other things, so that resources can be
                                * freed even after tkwin has gone away. */
        Tcl_Interp *interp;    /* Interpreter associated with widget. */
        Tcl_Command widgetCmd; /* Token for command. */
        Tcl_Object object;     /* our own object */
        Tcl_Obj *myCmd;        /* Objects "my" command. Needed to call internal methods. */
        Tcl_Obj *optionsArray; /* Name of option array variable */
        Tcl_HashTable *optionsTable; /* Hash table containing all used options */
    } Tko_Widget;


<a name="EXAMPLES"></a>
### EXAMPLES

    static Tko_WidgetOptionDefine myOptions[] = {
        /*
         * Readonly option, only setable on creation time.
         * Use of internal standard option setting function.
         */
        {"-class","class","Class","TkoFrame",TKO_OPTION_READONLY,
            NULL,NULL,TKO_SET_CLASS,NULL,0},
        /*
         * Option value in structure have NULL value when option is empty.
         * Use of internal standard option setting function.
         */
        {"-background","background","Background",DEF_FRAME_BG_COLOR,TKO_OPTION_NULL,
            NULL,NULL,TKO_SET_3DBORDER,&frameMeta,offsetof(tkoFrame, border)},
        /*
         * Use own provided oo method to set option value.
         */
        {"-backgroundimage","backgroundImage","BackgroundImage",DEF_FRAME_BG_IMAGE,0,
            NULL,FrameMethod_backgroundimage,0,NULL,0},
        /*
         * Synonym option definition.
         */
        {"-bg","-background",NULL,NULL,0,NULL,NULL,0,NULL,0},
        /*
         * Indicate end of options in array.
         */
        {NULL,NULL,NULL,NULL,0,NULL,NULL,0,NULL,0}
    };

For detailed examples see also the implementation of **tko::toplevel**, **tko::frame** and **tko::labelframe** widgets in file generic/tko/tkoFrame.c.

<a name="SEE-ALSO"></a>
## SEE ALSO

[frame][], [labelframe][], [toplevel][], [oo::class][]

<a name="KEYWORDS"></a>
## KEYWORDS

oo widget method option

<a name="COPYRIGHT"></a>
## COPYRIGHT

&copy; 2019- René Zaumseil <[email protected]>

BSD style license.

[options]: options.htm
[frame]: frame.htm
[labelframe]: labelframe.htm
[toplevel]: toplevel.htm
[oo::class]: class.htm
[graph]: graph.htm
[path]: path.htm
[Tkpath]: <https://sourceforge.net/projects/tclbitprint/>
[Rbc]: <https://sourceforge.net/projects/rbctoolkit/>

# tko(n) -- oo class like widgets

*   [SYNOPSIS](#SYNOPSIS)
*   [TKO STANDARD OPTIONS](#TKO-STANDARD-OPTIONS)
  [-class, class, Class](#-class)
  [-screen, screen, Screen](#-screen)
*   [DESCRIPTION](#DESCRIPTION)
*   [PUBLIC METHODS](#PUBLIC-METHODS)
*   [PRIVATE METHODS](#PRIVATE-METHODS)
*   [OPTIONS](#OPTIONS)
*   [EXAMPLES](#EXAMPLES)
*   [SEE ALSO](#SEE-ALSO)
*   [KEYWORDS](#KEYWORDS)
*   [COPYRIGHT](#COPYRIGHT)

<a name="SYNOPSIS"></a>
## SYNOPSIS

### Tko widgets

**::tko::toplevel** *pathName ?option value? ..*

**::tko::frame** *pathName ?option value? ..*

**::tko::labelframe** *pathName ?option value? ..*

### Class functions

**::tko initclass**

**::tko initfrom** *tkoclass*

**::tko initwrap** *widget readonlyoptionlist methodlist*

**::tko eventoption**

**::tko optiondef** *classname ?-option definitionlist? .. ?body?*

**::tko optiondel** *classname ?-option? ..*

**::tko optionget** *classname ?-option? ..*

**::tko optionhide** *classname ?-option? ..*

**::tko optionshow** *classname ?-option? ..*

### Widget methods

**my \_tko optionadd** *-option definitionlist ?body?*

**my \_tko optiondel** *-option* ..

**my \_tko optionhide** *-option* ..

**my \_tko optionshow** *-option* ..

<a name="TKO-STANDARD-OPTIONS"></a>
## TKO STANDARD OPTIONS

<a name="-class"></a>
Command-Line Name: **-class**
Database Name: **class**
Database Class: **Class**

> Define class for use in getting values from option database. Can only be set on widget creation time. The option should be the first option in the option definition list because it is needed to get other option values from the option database. Only the **-screen** option can precede it.

<a name="-screen"></a>
Command-Line Name: **-screen**
Database Name: **screen**
Database Class: **Screen**

> Affect creation of underlying widget structure. If given the created widget will be a toplevel widget. The option should be the very first option of an widget to be recognised.

<a name="DESCRIPTION"></a>
## DESCRIPTION

### Option definitionlist

In the *definitionlist* description below an entry with name *flags* can contain a combination of the following letters:

  - "r" the option is readonly and can only be set on creation
  - "h" The option is hidden from use in **cget** and **configure** methods.

The *definitionlist* can have one of the following forms:

  - *{-synonym flags}*

> Description of an synonym option. When *-option* is set then instead the provided *-synonym* option will be set.

  - *{dbname dbclass default flags}*

> Description of an option.
If *dbname* or *dbclass* is not empty then the values will be used to search for an default option value in the option database.
The search will need a **Tk\_Window** and therefore this definition can only be used in an widget class.
If both value are empty then the option definition can be used in an normal class create with **tko initclass**.
*default* is the default value if no value can be found in the option database.

### Function **::tko**

**::tko initclass**

> The function will create public **constructor**, **destructor**, **cget** and **configure** methods and private **_tko** and **_tko_configure** methods in the current class.

> The function can be used to add **cget** and **configure** functionality to an normal oo class.
No additional functionality is added.

> The function should be called only once inside the "oo::class create" script.
When called the list of used options will be cleared.

**::tko initfrom** *tkoclass*

> This function will provide the necessary initialization of an oo class as tko widget.
The argument *tkoclass* should be an **tko** widget class.
The class *tkoclass* will be the superclass of the current widget and all options of *tkoclass* will be added to our new class.

> If you create your own **constructor**, **destructor**, **cget** or **configure** methods you need to call **next** inside these function to call the function of the *tkoclass* superclass.

> The function should be called only once inside the "oo::class create" script.
When called the list of used options will be cleared.

**::tko initwrap** *widget readonlyoptionlist methodlist*

> This function will wrap an existing normal tk widget as an tko widget class.
The argumen *widget* is the name of the normal tk widget.
The argument *readonlyoptionlist* is a list of all readonly options of the given *widget*.
The argument *methodlist* is a list of methods to link to the wrapped *widget*.

> The function will create public **constructor**, **destructor**, **cget** and **configure** methods and private **_tko** and **_tko_configure** methods in the current class.

> The function should be called only once inside the "oo::class create" script.
When called the list of used options will be cleared.

**::tko eventoption**

> This option will send an <<TkoEventChanged>> virtual event to all widgets.
If a option value was set using the option database then the value of this option will updated with the current value of the option database.
The option database can so be used as a style source.

**::tko optiondef** *classname ?-option definitionlist? .. ?body?*

> The function will add or replace all given *-option definitionlist* pairs to the given *classname*. If an additional ?body? argument is given it will be used to create the *-option* method of the last given *-option* in *classname*

**::tko optiondel** *::classname ?-option? ..*

> The function will remove the given options from the defined class options of the given *::classname*. If no option is given then all existing options will be removed.

**::tko optionget** *::classname ?-option? ..*

> This function will return a list of *-option definitionlist* pairs ready for use in the **::tko optiondef** command.
The list consist of the specified options or all options if there are no options given.
THe option will be read from the fully qualified ?::classname? definitions.

**::tko optionhide** *::classname ?-option ..*

> Hide the given options from the use in **cget** and **configure** methods. If no options are given then return the list of all hidden options.

**::tko optionshow** *::classname ?-option ..*

> Unhide the given options from the use in **cget** and **configure** methods. If no options are given then return the list of all useable options.

<a name="tko-toplevel"></a>
### Widget **::tko::toplevel**

These class contain the functionality of the [toplevel][] widget command.

<a name="tko-frame"></a>
### Widget **::tko::frame**

These class contain the functionality of the [frame][] widget command.

<a name="tko-labelframe"></a>
### Widget **::tko::labelframe**

These class contain the functionality of the [labelframe][] widget command.

<a name="PUBLIC-METHODS"></a>
## PUBLIC METHODS

Widget methods can be dynamically added and removed at class or object level.

**NOTE** Do not change *tkoClass*'s behaviour. Instead create your own class and modify it to your need! Or change created widget objects behaviour.

<a name="method-cget"></a>
**cget** *-option*

> Return the current value of the given *option*.

<a name="method-configure"></a>
**configure**

> The method will return a sorted list of all configuration options.

**configure** *-option*

> Return value of given option.

**configure** *-option value* ..

> Use given *-option vlaue* pairs to set options.

<a name="PRIVATE-METHODS"></a>
## PRIVATE METHODS

<a name="method-_tko"></a>
**my \_tko optionadd** *-option definitionlist ?body?*

> Add a new option in the current object. The meaning of the *definitionlist* argument is the same as in the **::tko optionset** command.
The function will only add new options.
It is not possible to change object options.

**my \_tko optiondel** *-option* ..

> Delete the given option and unset the entry in the tko array variable. The created *-option* method's are not deleted. This is the task of the caller.

**my \_tko optionhide** *-option* ..

> If no *-option* is given return a list of all not configure'able options. Otherwise hide all of the given options.

**my \_tko optionshow** *-option* ..

> If no *-option* is given return a list of all configure'able options. Otherwise make all of the given options configure'able.

<a name="method-tko-configure"></a>
**my \_tko\_configure**

> This is an virtual method of the *tkoClass* widgets. This method will be called at the end of each **configure** *-option value ..* call. It can be implemented in each class to make necessary changes. If it is implemented it should also call **next** to notify underlying classes.

<a name="OPTIONS"></a>
## OPTIONS

Widget option values are saved in an option array **tko**. The option name is the field name in the array. Additionally is an field "**.**" containing the tk widget path name of the widget.

Widget options can be dynamically added and removed at class or object level.
It is possible to hide and unhide options.

<a name="EXAMPLES"></a>
## EXAMPLES

    #
    # Configurable object
    #
    oo::class create A {
      ::tko initclass
    }
    A create a1
    a1 configure ==>

    # Add class option
    ::tko optiondef A -o1 {o1 O1 v1 {}} {set tko(-o1) x}
    A create a2
    a2 configure
    ==> {-o1 o1 O1 v1 v1}

    # Add object option
    oo::define A method mycmd {args} {my {*}$args}
    a2 mycmd _tko optionadd -o2 {o2 O2 v2 {}} {variable tko; set tko(-o2) x}
    a2 configure
    ==> {-o1 o1 O1 v1 v1} {-o2 o2 O2 v2 x}

    #
    # Wrap an existing widget
    #
    oo::class create B {
      ::tko initwrap frame {-class -container -colormap -visual} {}
    }
    B .b
    lindex [.b configure] 0
    ==> {-background background Background SystemButtonFace SystemButtonFace}

    #
    # Create a new widget class.
    #
    oo::class create C {
      ::tko initfrom ::tko::frame
      constructor {args} {next {*}$args}
      destructor {next}
      method mycmd {args} {my {*}$args}
    }

    # Hide all inherited frame options
    ::tko optionhide C {*}[::tko optionhide C]
    ::tko optionshow C
    ==> -class -visual -colormap -container -borderwidth ...
    C .c
    .c configure
    ==>

    # Add a new option
    oo::define C method -o1 {} {puts $tko(-o1)}
    ::tko optiondef C -o1 {o1 O1 v1 {}}
    ::tko optionhide C
    ==> -o1

    # Add another option
    ::tko optiondef C -o2 {o2 O2 v2 {}} {puts $tko(-o2)}
    ::tko optionhide C
    ==> -o1 -o2

    # Add options at object level:
    C .c1
    .c1 mycmd _tko optionadd -o3 {o3 O3 v3 {}} {my variable tko; puts $tko(-o3)}
    .c1 configure
    ==> {-o1 o1 O1 v1 v1} {-o2 o2 O2 v2 v2} {-o3 o3 O3 v3 v3}

    # Show all frame options again
    .c1 mycmd _tko optionshow {*}[.c1 mycmd _tko optionshow]
    llength [.c1 configure]
    ==> 24

    # Intercept options
    oo::define C method -width {} {
        puts "[my cget -width]->$tko(-width)->[set tko(-width) 100]"
    }
    .c1 configure -width 1
    ==> 0->1->100

<a name="SEE-ALSO"></a>
## SEE ALSO

[frame][], [labelframe][], [toplevel][], [oo::class][]

<a name="KEYWORDS"></a>
## KEYWORDS

oo widget method option

<a name="COPYRIGHT"></a>
## COPYRIGHT

&copy; 2019- René Zaumseil <[email protected]>

BSD style license.

[options]: options.htm
[frame]: frame.htm
[labelframe]: labelframe.htm
[toplevel]: toplevel.htm
[oo::class]: class.htm

/*
 * Themed widget set init function:
 */

MODULE_SCOPE int	Ttk_Init(Tcl_Interp *interp);

/*
 * Tko widget set init function:
 */

MODULE_SCOPE int	Tko_Init(Tcl_Interp *interp);

/*
 * Internal functions shared among Tk modules but not exported to the outside
 * world:
 */

MODULE_SCOPE int	Tk_BellObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,

     * Initialized the themed widget set
     */

    code = Ttk_Init(interp);
    if (code != TCL_OK) {
	goto done;
    }

    /*
     * Initialized the tko widget set
     */

    code = Tko_Init(interp);
    if (code != TCL_OK) {
	goto done;
    }

    /*
     * Invoke platform-specific initialization. Unlock mutex before entering
     * TkpInit, as that may run through the Tk_Init routine again for the
     * console window interpreter.
     */

/*
 * tkoFrame.c --
 *
 *    This module implements "frame", "labelframe" and "toplevel" widgets
 *    for the Tk toolkit. Frames are windows with a background color and
 *    possibly a 3-D effect, but not much else in the way of attributes.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 2019 Rene Zaumseil
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tkoWidget.h"

 /*
  * The following enum is used to define the type of the frame.
  */
enum FrameType {
    TYPE_FRAME, TYPE_TOPLEVEL, TYPE_LABELFRAME
};

/*
 * tkoFrame --
 *
 * A data structure of the following type is kept for each
 * frame that currently exists for this process.
 *
 * ATTENTION!!!
 * tkWinWM.c will call TkInstallFromMenu() from file tkFrame.c for toplevels.
 * Inside these function a struct Frame and memeber menuName will be used.
 * We noe have to ensure that our structure has the same form as Frame.
 * Therefore we place some dummy arguments in the structure.
 */
typedef struct tkoFrame {
    Tko_Widget widget;
    enum FrameType type;       /* Type of widget, such as TYPE_FRAME. */
    char *dummy1;
    char *menuName;            /* Textual description of menu to use for
                                * menubar. Malloc-ed, may be NULL. */
    Colormap colormap;         /* If not None, identifies a colormap
                                * allocated for this window, which must be
                                * freed when the window is deleted. */
    Tk_3DBorder border;        /* Structure used to draw 3-D border and
                                * background. NULL means no background or
                                * border. */
    int borderWidth;           /* Width of 3-D border (if any). */
    int relief;                /* 3-d effect: TK_RELIEF_RAISED etc. */
    int highlightWidth;        /* Width in pixels of highlight to draw around
                                * widget when it has the focus. 0 means don't
                                * draw a highlight. */
    XColor *highlightBgColorPtr;
    /* Color for drawing traversal highlight area
     * when highlight is off. */
    XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
    int width;                 /* Width to request for window. <= 0 means
                                * don't request any size. */
    int height;                /* Height to request for window. <= 0 means
                                * don't request any size. */
    Tk_Cursor cursor;          /* Current cursor for window, or None. */
    Tk_Window tkWinCreate;
    char *dummy2;
    int isContainer;           /* 1 means this window is a container, 0 means
                                * that it isn't. */
    Tcl_Obj *useThis;          /* If the window is embedded, this points to
                                * the name of the window in which it is
                                * embedded (malloc'ed). For non-embedded
                                * windows this is NULL. */
    int flags;                 /* Various flags; see below for
                                * definitions. */
    int padX;                  /* Integer value corresponding to padXPtr. */
    int padY;                  /* Integer value corresponding to padYPtr. */
    unsigned int mask;
    Tk_Image bgimg;            /* Derived from -backgroundimage by calling
                                * Tk_GetImage, or NULL. */
    int tile;                  /* Whether to tile the bgimg. */
#ifndef TK_NO_DOUBLE_BUFFERING
    GC copyGC;                 /* GC for copying when double-buffering. */
#endif /* TK_NO_DOUBLE_BUFFERING */
} tkoFrame;

/*
 * tkoLabelframe --
 *
 * A data structure of the following type is kept for each labelframe widget
 * managed by this file:
 */
typedef struct tkoLabelframe {
    tkoFrame frame;            /* A pointer to the generic frame structure.
                                * This must be the first element of the
                                * tkoLabelframe. */
    /*
     * tkoLabelframe specific configuration settings.
     */
    Tcl_Obj *textPtr;          /* Value of -text option: specifies text to
                                * display in button. */
    Tk_Font tkfont;            /* Value of -font option: specifies font to
                                * use for display text. */
    XColor *textColorPtr;      /* Value of -fg option: specifies foreground
                                * color in normal mode. */
    int labelAnchor;           /* Value of -labelanchor option: specifies
                                * where to place the label. */
    Tk_Window labelWin;        /* Value of -labelwidget option: Window to use
                                * as label for the frame. */
    /*
     * tkoLabelframe specific fields for use with configuration settings above.
     */
    GC  textGC;                /* GC for drawing text in normal mode. */
    Tk_TextLayout textLayout;  /* Stored text layout information. */
    XRectangle labelBox;       /* The label's actual size and position. */
    int labelReqWidth;         /* The label's requested width. */
    int labelReqHeight;        /* The label's requested height. */
    int labelTextX, labelTextY; /* Position of the text to be drawn. */
} tkoLabelframe;

/*
 * The following macros define how many extra pixels to leave around a label's
 * text.
 */
#define LABELSPACING 1
#define LABELMARGIN 4

 /*
  * Flag bits for frames:
  *
  * REDRAW_PENDING:             Non-zero means a DoWhenIdle handler has
  *                             already been queued to redraw this window.
  * GOT_FOCUS:                  Non-zero means this widget currently has the
  *                             input focus.
  */
#define REDRAW_PENDING        1
#define GOT_FOCUS        4

  /*
   * The following enum is used to define a type for the -labelanchor option of
   * the Labelframe widget. These values are used as indices into the string
   * table below.
   */
enum labelanchor {
    LABELANCHOR_E, LABELANCHOR_EN, LABELANCHOR_ES,
    LABELANCHOR_N, LABELANCHOR_NE, LABELANCHOR_NW,
    LABELANCHOR_S, LABELANCHOR_SE, LABELANCHOR_SW,
    LABELANCHOR_W, LABELANCHOR_WN, LABELANCHOR_WS
};

/*
* Methods
*/
static int FrameConstructorFrame(
    ClientData clientData,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[]);
static int FrameConstructorLabelframe(
    ClientData clientData,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[]);
static int FrameConstructorToplevel(
    ClientData clientData,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[]);
static int FrameConstructor(
    enum FrameType type,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[]);
static int FrameDestructor(
    ClientData clientData,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[]);
static int FrameMethod_tko_configure(
    ClientData clientData,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[]);
static int FrameMethod_labelanchor(
    ClientData clientData,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[]);
static int FrameMethod_labelwidget(
    ClientData clientData,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[]);
static int FrameMethod_backgroundimage(
    ClientData clientData,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[]);
static int FrameMethod_menu(
    ClientData clientData,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[]);

/*
 * Functions
 */
static void FrameComputeGeometry(
    tkoFrame * frame);
static void FrameDisplay(
    ClientData clientData);
static void    FrameDrawBackground(
    Tk_Window tkwin,
    Pixmap pixmap,
    int highlightWidth,
    int borderWidth,
    Tk_Image bgimg,
    int bgtile);
static void    FrameBgImageProc(
    ClientData clientData,
    int x,
    int y,
    int width,
    int height,
    int imgWidth,
    int imgHeight);
static void FrameEventProc(
    ClientData clientData,
    XEvent * eventPtr);
static void FrameLostSlaveProc(
    ClientData clientData,
    Tk_Window tkWin);
static void FrameRequestProc(
    ClientData clientData,
    Tk_Window tkWin);
static void FrameStructureProc(
    ClientData clientData,
    XEvent * eventPtr);
static void FrameWorldChanged(
    ClientData instanceData);
static void FrameLabelwinRemove(
    tkoLabelframe * labelframe);
static void FrameMap(
    ClientData clientData);

/*
 * Data
 */

/*
 * frameClass --
 *
 * The structure below defines frame class behavior by means of functions that
 * can be invoked from generic window code.
 */
static const Tk_ClassProcs frameClass = {
    sizeof(Tk_ClassProcs),      /* size */
    FrameWorldChanged,  /* worldChangedProc */
    NULL,      /* createProc */
    NULL       /* modalProc */
};

/*
 * frameGeomType --
 *
 * The structure below defines the official type record for the labelframe's
 * geometry manager:
 */
static const Tk_GeomMgr frameGeomType = {
    "labelframe",       /* name */
    FrameRequestProc,   /* requestProc */
    FrameLostSlaveProc  /* lostSlaveProc */
};

/*
 * Definition of options created in object constructor.
 * Order of used options in definition is important:
 * -class -visual -colormap -container -use
 */

/* Common options for all defined widgets. */
#define FRAME_COMMONDEFINE \
    { "-background" , "background", "Background", DEF_FRAME_BG_COLOR, TKO_OPTION_NULL, \
        NULL, TKO_SET_3DBORDER, offsetof(tkoFrame, border)}, \
    { "-backgroundimage", "backgroundImage", "BackgroundImage", DEF_FRAME_BG_IMAGE, 0, \
        FrameMethod_backgroundimage ,TKO_SET_NONE, 0}, \
    { "-bg" , "-background", NULL, NULL, 0, NULL,TKO_SET_NONE,0}, \
    { "-bgimg", "-backgroundimage", NULL, NULL, 0, NULL,TKO_SET_NONE,0}, \
    { "-bd" , "-borderwidth", NULL, NULL, 0, NULL, TKO_SET_NONE,0}, \
    { "-cursor" , "cursor", "Cursor", DEF_FRAME_CURSOR, 0, \
        NULL, TKO_SET_CURSOR, offsetof(tkoFrame, cursor)}, \
    { "-height" , "height", "Height", DEF_FRAME_HEIGHT, 0, \
        NULL, TKO_SET_PIXEL, offsetof(tkoFrame, height)}, \
    { "-highlightbackground", "highlightbackground", "highlightBackground", DEF_FRAME_HIGHLIGHT_BG, 0, \
        NULL, TKO_SET_XCOLOR, offsetof(tkoFrame, highlightBgColorPtr)}, \
    { "-highlightcolor", "highlightColor", "HighlightColor", DEF_FRAME_HIGHLIGHT, 0, \
        NULL, TKO_SET_XCOLOR, offsetof(tkoFrame, highlightColorPtr)}, \
    { "-highlightthickness" , "highlightThickness", "HighlightThickness", DEF_FRAME_HIGHLIGHT_WIDTH,  0, \
        NULL, TKO_SET_PIXEL, offsetof(tkoFrame, highlightWidth)}, \
    { "-padx" , "padX", "Pad", DEF_FRAME_PADX, 0, \
        NULL, TKO_SET_PIXEL, offsetof(tkoFrame, padX)}, \
    { "-pady" , "padY", "Pad", DEF_FRAME_PADY, 0, \
        NULL, TKO_SET_PIXEL, offsetof(tkoFrame, padY)}, \
    { "-takefocus" , "takeFocus", "TakeFocus", DEF_FRAME_TAKE_FOCUS,  0, \
        NULL, TKO_SET_STRING, 0}, \
    { "-tile", "tile", "Tile", DEF_FRAME_BG_TILE, 0, \
        NULL, TKO_SET_BOOLEAN, offsetof(tkoFrame, tile)}, \
    { "-width" , "width", "Width", DEF_FRAME_WIDTH,  0, \
        NULL, TKO_SET_PIXEL, offsetof(tkoFrame, width)}, \
    { NULL,NULL,NULL,NULL,0,NULL,TKO_SET_NONE,0}

/*
 * frameOptions --
 *  List of tko::frame options.
 */
static const Tko_WidgetOptionDefine frameOptions[] = {
    {"-class", "class", "Class", "TkoFrame", TKO_OPTION_READONLY,
    NULL, TKO_SET_CLASS, 0},
    {"-visual", "visual", "Visual", DEF_FRAME_VISUAL, TKO_OPTION_READONLY,
    NULL, TKO_SET_VISUAL, 0},
    {"-colormap", "colormap", "Colormap", DEF_FRAME_COLORMAP, TKO_OPTION_READONLY,
    NULL, TKO_SET_COLORMAP, 0},
    {"-container", "container", "Container", DEF_FRAME_CONTAINER, TKO_OPTION_READONLY,
    NULL, TKO_SET_CONTAINER, offsetof(tkoFrame, isContainer)},
    {"-borderwidth", "borderWidth", "BorderWidth", DEF_FRAME_BORDER_WIDTH, 0,
    NULL, TKO_SET_PIXEL, offsetof(tkoFrame, borderWidth)},
    {"-relief", "relief", "Relief", DEF_FRAME_RELIEF, 0,
    NULL, TKO_SET_RELIEF, offsetof(tkoFrame, relief)},
    FRAME_COMMONDEFINE
};

/*
 * toplevelOptions --
 *  List of tko::toplevel options.
 */
static const Tko_WidgetOptionDefine toplevelOptions[] = {
    {"-screen", "screen", "Screen", "", TKO_OPTION_READONLY,
    NULL, TKO_SET_STRING, 0},
    {"-class", "class", "Class", "TkoToplevel", TKO_OPTION_READONLY,
    NULL, TKO_SET_CLASS, 0},
    {"-container", "container", "Container", DEF_FRAME_CONTAINER, TKO_OPTION_READONLY,
    NULL, TKO_SET_CONTAINER, offsetof(tkoFrame, isContainer)},
    {"-use", "use", "Use", DEF_TOPLEVEL_USE, TKO_OPTION_READONLY|TKO_OPTION_NULL,
    NULL, TKO_SET_USE, offsetof(tkoFrame, useThis)},
    {"-visual", "visual", "Visual", DEF_FRAME_VISUAL, TKO_OPTION_READONLY,
    NULL, TKO_SET_VISUAL, 0},
    {"-colormap", "colormap", "Colormap", DEF_FRAME_COLORMAP, TKO_OPTION_READONLY,
    NULL, TKO_SET_COLORMAP, 0},
    {"-borderwidth", "borderWidth", "BorderWidth", DEF_FRAME_BORDER_WIDTH, 0,
    NULL, TKO_SET_PIXEL, offsetof(tkoFrame, borderWidth)},
    {"-menu", "menu", "Menu", DEF_TOPLEVEL_MENU, TKO_OPTION_NULL,
    FrameMethod_menu, TKO_SET_NONE, 0},
    {"-relief", "relief", "Relief", DEF_FRAME_RELIEF, 0,
    NULL, TKO_SET_RELIEF, offsetof(tkoFrame, relief)},
    FRAME_COMMONDEFINE
};

/*
 * labelframeOptions --
 *  List of tko::labelframe options.
 */
static const Tko_WidgetOptionDefine labelframeOptions[] = {
    {"-class", "class", "Class", "TkoLabelframe", TKO_OPTION_READONLY,
    NULL, TKO_SET_CLASS, 0},
    {"-visual", "visual", "Visual", DEF_FRAME_VISUAL, TKO_OPTION_READONLY,
    NULL, TKO_SET_VISUAL, 0},
    {"-colormap", "colormap", "Colormap", DEF_FRAME_COLORMAP, TKO_OPTION_READONLY,
    NULL, TKO_SET_COLORMAP, 0},
    {"-borderwidth", "borderWidth", "BorderWidth", DEF_LABELFRAME_BORDER_WIDTH, 0,
    NULL, TKO_SET_PIXEL, offsetof(tkoFrame, borderWidth)},
    {"-fg", "-foreground", NULL, NULL, 0, NULL, TKO_SET_NONE, 0},
    {"-font", "font", "Font", DEF_LABELFRAME_FONT, 0,
    NULL, TKO_SET_FONT, offsetof(tkoLabelframe, tkfont)},
    {"-foreground", "foreground", "Foreground", DEF_LABELFRAME_FG, 0,
    NULL, TKO_SET_XCOLOR, offsetof(tkoLabelframe, textColorPtr)},
    {"-labelanchor", "labelAnchor", "LabelAnchor", DEF_LABELFRAME_LABELANCHOR, 0,
    FrameMethod_labelanchor, TKO_SET_NONE, 0},
    {"-labelwidget", "labelWidget", "LabelWidget", "",0,
    FrameMethod_labelwidget, TKO_SET_NONE, 0},
    {"-relief", "relief", "Relief", DEF_LABELFRAME_RELIEF, 0,
    NULL, TKO_SET_RELIEF, offsetof(tkoFrame, relief)},
    {"-text", "text", "Text", DEF_LABELFRAME_TEXT, 0,
    NULL, TKO_SET_TCLOBJ, offsetof(tkoLabelframe, textPtr)},
    FRAME_COMMONDEFINE
};

/*
 * Definition of object methods created in Tko_FrameInit() function.
 */

/*
 * frameMethods --
 *    List of used public and private tko::frame methods.
 */
static Tcl_MethodType frameMethods[] = {
    {TCL_OO_METHOD_VERSION_CURRENT, NULL, FrameConstructorFrame, NULL, NULL},
    {TCL_OO_METHOD_VERSION_CURRENT, NULL, FrameDestructor, NULL, NULL},
    {-1, NULL, NULL, NULL, NULL},
    {TCL_OO_METHOD_VERSION_CURRENT, "_tko_configure", FrameMethod_tko_configure,
            NULL, NULL},
    {-1, NULL, NULL, NULL, NULL}
};

/*
 * labelframeMethods --
 *    List of used public and private tko::labelframe methods.
 */
static Tcl_MethodType labelframeMethods[] = {
    {TCL_OO_METHOD_VERSION_CURRENT, NULL, FrameConstructorLabelframe, NULL,
            NULL},
    {TCL_OO_METHOD_VERSION_CURRENT, NULL, FrameDestructor, NULL, NULL},
    {-1, NULL, NULL, NULL, NULL},
    {TCL_OO_METHOD_VERSION_CURRENT, "_tko_configure", FrameMethod_tko_configure,
            NULL, NULL},
    {-1, NULL, NULL, NULL, NULL}
};

/*
 * toplevelMethods --
 *    List of used public and private tko::toplevel methods.
 */
static Tcl_MethodType toplevelMethods[] = {
    {TCL_OO_METHOD_VERSION_CURRENT, NULL, FrameConstructorToplevel, NULL, NULL},
    {TCL_OO_METHOD_VERSION_CURRENT, NULL, FrameDestructor, NULL, NULL},
    {-1, NULL, NULL, NULL, NULL},
    {TCL_OO_METHOD_VERSION_CURRENT, "_tko_configure", FrameMethod_tko_configure,
            NULL, NULL},
    {-1, NULL, NULL, NULL, NULL}
};

/*
 * Tko_FrameInit --
 *
 * Create tko frame widget class objects.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *  Create new oo::class's.
 */
int
Tko_FrameInit(
    Tcl_Interp * interp)
{              /* Tcl interpreter. */
    Tcl_Obj *tmpPtr;
    int ret;

    /*
     * ::tko::toplevel
     */
    tmpPtr = Tcl_NewStringObj("::tko::toplevel", -1);
    Tcl_IncrRefCount(tmpPtr);
    ret = Tko_WidgetClassDefine(interp, tmpPtr,
        toplevelMethods, toplevelOptions);
    Tcl_DecrRefCount(tmpPtr);
    if (ret != TCL_OK) {
        return TCL_ERROR;
    }
    /*
     * ::tko::frame
     */
    tmpPtr = Tcl_NewStringObj("::tko::frame", -1);
    Tcl_IncrRefCount(tmpPtr);
    ret = Tko_WidgetClassDefine(interp, tmpPtr,
        frameMethods, frameOptions);
    Tcl_DecrRefCount(tmpPtr);
    if (ret != TCL_OK) {
        return TCL_ERROR;
    }

    /*
     * ::tko::labelframe
     */
    tmpPtr = Tcl_NewStringObj("::tko::labelframe", -1);
    Tcl_IncrRefCount(tmpPtr);
    ret = Tko_WidgetClassDefine(interp, tmpPtr,
        labelframeMethods, labelframeOptions);
    Tcl_DecrRefCount(tmpPtr);
    if (ret != TCL_OK) {
        return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 * FrameConstructorFrame --
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *  Call common constructor for frames.
 */
static int
FrameConstructorFrame(
    ClientData dummy,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[])
{
    (void)dummy;

    return FrameConstructor(TYPE_FRAME, interp, context, objc, objv);
}

/*
 * FrameConstructorLabelframe --
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *  Call common constructor for labelframes.
 */
static int
FrameConstructorLabelframe(
    ClientData dummy,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[])
{
    (void)dummy;
    return FrameConstructor(TYPE_LABELFRAME, interp, context, objc, objv);
}

/*
 * FrameConstructorToplevel --
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *  Call common constructor for toplevels.
 */
static int
FrameConstructorToplevel(
    ClientData dummy,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[])
{
    (void)dummy;
    return FrameConstructor(TYPE_TOPLEVEL, interp, context, objc, objv);
}

/*
 * FrameConstructor --
 *
 * Common part of all widget contructors.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *  Create new widget and options.
 *    Set readonly options and default option values.
 */
static int
FrameConstructor(
    enum FrameType type,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[])
{
    Tcl_Object object;
    Tko_Widget *widget;
    tkoFrame *frame;
    Tcl_Obj *myArglist;
    int skip;
    Tko_WidgetCreateMode createMode;

    /* Get current object. Should not fail? */
    if ((object = Tcl_ObjectContextObject(context)) == NULL) {
        return TCL_ERROR;
    }
    if (type == TYPE_FRAME) {
        frame = (tkoFrame *)ckalloc(sizeof(tkoFrame));
        assert(frame);
        memset(frame, 0, sizeof(tkoFrame));
        createMode = TKO_CREATE_WIDGET;
    }
    else if (type == TYPE_LABELFRAME) {
        tkoLabelframe *labelframe;
        labelframe = (tkoLabelframe *)ckalloc(sizeof(tkoLabelframe));
        assert(labelframe);
        memset(labelframe, 0, sizeof(tkoLabelframe));
        frame = (tkoFrame *)labelframe;
        labelframe->textPtr = NULL;
        labelframe->tkfont = NULL;
        labelframe->textColorPtr = NULL;
        labelframe->labelAnchor = LABELANCHOR_NW;
        labelframe->labelWin = NULL;
        labelframe->textGC = NULL;
        labelframe->textLayout = NULL;
        /*labelframe->labelBox */
        labelframe->labelReqWidth = 0;
        labelframe->labelReqHeight = 0;
        labelframe->labelTextX = 0;
        labelframe->labelTextY = 0;
        createMode = TKO_CREATE_WIDGET;
    }
    else if (type == TYPE_TOPLEVEL) {
        frame = (tkoFrame *)ckalloc(sizeof(tkoFrame));
        assert(frame);
        memset(frame, 0, sizeof(tkoFrame));
        createMode = TKO_CREATE_TOPLEVEL;
    }
    else {
        Tcl_WrongNumArgs(interp, 1, objv, "internal type error");
        return TCL_ERROR;
    }
    widget = (Tko_Widget *)frame;
    frame->type = type;
    frame->menuName = NULL;
    frame->colormap = None;
    frame->border = NULL;
    frame->borderWidth = 0;
    frame->relief = TK_RELIEF_FLAT;
    frame->highlightWidth = 0;
    frame->highlightBgColorPtr = NULL;
    frame->highlightColorPtr = NULL;
    frame->width = 0;
    frame->height = 0;
    frame->cursor = NULL;
    frame->isContainer = 0;
    frame->useThis = NULL;
    frame->flags = 0;
    frame->padX = 0;
    frame->padY = 0;
    frame->mask = ExposureMask | StructureNotifyMask | FocusChangeMask;
    frame->bgimg = NULL;
#ifndef TK_NO_DOUBLE_BUFFERING
    frame->copyGC = NULL;
#endif
    frame->tile = 0;
    if (type == TYPE_TOPLEVEL) {
        frame->mask |= ActivateMask;
    }
    skip = Tcl_ObjectContextSkippedArgs(context);
    if (objc - skip > 0) {
        myArglist = Tcl_NewListObj(objc - skip, &objv[skip]);
    }
    else {
        myArglist = Tcl_NewListObj(0, NULL);
    }
    if (Tko_WidgetCreate(&(frame->widget), interp, object, createMode,
        myArglist) != TCL_OK) {
        Tcl_DecrRefCount(myArglist);
        return TCL_ERROR;
    }
    Tcl_DecrRefCount(myArglist);
    frame->tkWinCreate = widget->tkWin;
    if (frame->isContainer && frame->useThis != NULL) {
        Tcl_SetObjResult(interp,
            Tcl_NewStringObj
            ("windows cannot have both the -use and the -container"
                " option set", -1));
        Tcl_SetErrorCode(interp, "TK", "FRAME", "CONTAINMENT", NULL);
        return TCL_ERROR;
    }
    /*
    * For top-level windows, provide an initial geometry request of 200x200,
    * just so the window looks nicer on the screen if it doesn't request a
    * size for itself.
    */
    if (type == TYPE_TOPLEVEL) {
        Tk_GeometryRequest(widget->tkWin, 200, 200);
    }

    /*
    * Store backreference to frame widget in window structure.
    */

    Tk_SetClassProcs(widget->tkWin, &frameClass, frame);

    /*
    * Mark Tk frames as suitable candidates for [wm manage].
    */

    ((TkWindow *) widget->tkWin)->flags |= TK_WM_MANAGEABLE;

    Tk_CreateEventHandler(widget->tkWin, frame->mask, FrameEventProc, frame);

    if (type == TYPE_TOPLEVEL) {
        Tcl_DoWhenIdle(FrameMap, frame);
    }

    return TCL_OK;
}

/*
 * FrameDestructor --
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *  Delete widget ressources.
 */
static int
FrameDestructor(
    ClientData dummy,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[])
{
    Tko_Widget *widget;
    (void)dummy;
    (void)interp;
    (void)objc;
    (void)objv;

    if((widget = (Tko_Widget *)Tko_WidgetClientData(context)) != NULL) {
        tkoFrame *frame = (tkoFrame *)widget;
        tkoLabelframe *labelframe = (tkoLabelframe *) widget;
        Tcl_Preserve(widget);

        if(widget->tkWin) {
            Tk_DeleteEventHandler(widget->tkWin, frame->mask, FrameEventProc, frame);
        }
        if(widget->display != NULL) {
#ifndef TK_NO_DOUBLE_BUFFERING
            if (frame->copyGC != NULL) {
                Tk_FreeGC(widget->display, frame->copyGC);
            }
            frame->copyGC = NULL;
#endif /* TK_NO_DOUBLE_BUFFERING */
            if(frame->cursor != NULL) {
                Tk_FreeCursor(widget->display, frame->cursor);
            }
            frame->cursor = NULL;
        }
        if (frame->bgimg != NULL) {
            Tk_FreeImage(frame->bgimg);
        }
        frame->bgimg = NULL;
        frame->flags = 0;
        Tcl_CancelIdleCall(FrameDisplay, frame);
        Tcl_CancelIdleCall(FrameMap, frame);

        if(frame->menuName != NULL && frame->tkWinCreate) {
            Tk_SetWindowMenubar(frame->widget.interp, frame->tkWinCreate, frame->menuName, NULL);
            ckfree(frame->menuName);
            frame->menuName = NULL;
        }
        if(frame->type == TYPE_LABELFRAME && labelframe->labelWin) {
            Tk_ManageGeometry(labelframe->labelWin, NULL, NULL);
            if(widget->tkWin && (widget->tkWin != Tk_Parent(labelframe->labelWin))) {
                Tk_UnmaintainGeometry(labelframe->labelWin, widget->tkWin);
            }
            Tk_UnmapWindow(labelframe->labelWin);
            labelframe->labelWin = NULL;
        }
        if (frame->useThis) {
            Tcl_DecrRefCount(frame->useThis);
        }
        if (frame->type == TYPE_LABELFRAME) {
            if (labelframe->textLayout) {
                Tk_FreeTextLayout(labelframe->textLayout);
            }
            if (labelframe->textGC != NULL && widget->display != NULL) {
                Tk_FreeGC(widget->display, labelframe->textGC);
            }
        }
        if (frame->border) {
            Tk_Free3DBorder(frame->border);
        }
        if (frame->colormap != None && widget->display != NULL) {
            Tk_FreeColormap(widget->display, frame->colormap);
        }
        if (frame->highlightBgColorPtr != NULL) {
            Tk_FreeColor(frame->highlightBgColorPtr);
        }
        if (frame->highlightColorPtr != NULL) {
            Tk_FreeColor(frame->highlightColorPtr);
        }
        Tko_WidgetDestroy(context);
        Tcl_Release(frame);
    }
    return TCL_OK;
}

/*
 * FrameMethod_tko_configure --
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *  After configure step.
 */
static int
FrameMethod_tko_configure(
    ClientData dummy,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[])
{
    Tko_Widget *widget;
    tkoFrame *frame;
    (void)dummy;
    (void)interp;
    (void)objc;
    (void)objv;

    if((widget = (Tko_Widget *)Tko_WidgetClientData(context)) == NULL
        || widget->tkWin == NULL) {
        return TCL_ERROR;
    }
    frame = (tkoFrame *)widget;

    if(frame->border != NULL) {
        Tk_SetBackgroundFromBorder(widget->tkWin, frame->border);
    } else {
        Tk_SetWindowBackgroundPixmap(widget->tkWin, None);
    }

    if(frame->highlightWidth < 0) {
        frame->highlightWidth = 0;
    }
    if(frame->padX < 0) {
        frame->padX = 0;
    }
    if(frame->padY < 0) {
        frame->padY = 0;
    }

    FrameWorldChanged(frame);
    return TCL_OK;
}

/*
 * FrameMethod_labelanchor --
 *
 * Process -labelanchor option.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *  Set new option value.
 */
static int
FrameMethod_labelanchor(
    ClientData dummy,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[])
{
    int index, code;
    tkoFrame *frame;
    tkoLabelframe *labelframe;
    Tcl_Obj *value;
    static const char *const labelAnchorStrings[] = {
        "e", "en", "es", "n", "ne", "nw", "s", "se", "sw", "w", "wn", "ws",
        NULL
    };
    (void)dummy;

    if((frame =
            (tkoFrame *)Tko_WidgetClientData(context)) == NULL
        || (value =
            Tko_WidgetOptionGet(&frame->widget, objv[objc - 1])) == NULL) {
        return TCL_ERROR;
    }
    labelframe = (tkoLabelframe *)frame;
    code =
        Tcl_GetIndexFromObj(interp, value, labelAnchorStrings, "labelanchor", 0,
        &index);
    if(code != TCL_OK) {
        return TCL_ERROR;
    }
    labelframe->labelAnchor = (Tk_Anchor) index;
    return TCL_OK;
}

/*
 * FrameMethod_labelwidget --
 *
 * Process -labelwidget option.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *  Set new option value.
 */
static int
FrameMethod_labelwidget(
    ClientData dummy,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[])
{
    Tko_Widget *widget;
    Tk_Window oldWindow = NULL;
    Tk_Window newWindow = NULL;
    Tk_Window ancestor, parent, sibling = NULL;
    tkoLabelframe *labelframe;
    Tcl_Obj *value;
    (void)dummy;

    if((widget = (Tko_Widget *)Tko_WidgetClientData(context)) == NULL
        || widget->tkWin == NULL
        || (value = Tko_WidgetOptionGet(widget, objv[objc - 1])) == NULL) {
        return TCL_ERROR;
    }
    labelframe = (tkoLabelframe *)widget;

    if(value == NULL || Tcl_GetCharLength(value) == 0) {
        newWindow = NULL;
    } else if(TkGetWindowFromObj(interp, widget->tkWin, value, &newWindow) != TCL_OK) {
        return TCL_ERROR;
    }
    /*
     * If a -labelwidget is specified, check that it is valid and set up
     * geometry management for it.
     */
    oldWindow = labelframe->labelWin;
    if(oldWindow != newWindow) {
        if(newWindow != NULL) {
            /*
             * Make sure that the frame is either the parent of the window
             * used as label or a descendant of that parent. Also, don't
             * allow a top-level window to be managed inside the frame.
             */
            parent = Tk_Parent(newWindow);
            for(ancestor = widget->tkWin;; ancestor = Tk_Parent(ancestor)) {
                if(ancestor == parent) {
                    break;
                }
                sibling = ancestor;
                if(Tk_IsTopLevel(ancestor)) {
                    goto badLabelWindow;
                }
            }
            if(Tk_IsTopLevel(newWindow)) {
                goto badLabelWindow;
            }
            if(newWindow == widget->tkWin) {
                goto badLabelWindow;
            }
        }
        if(oldWindow != NULL) {
            Tk_DeleteEventHandler(oldWindow, StructureNotifyMask,
                FrameStructureProc, labelframe);
            Tk_ManageGeometry(oldWindow, NULL, NULL);
            Tk_UnmaintainGeometry(oldWindow, widget->tkWin);
            Tk_UnmapWindow(oldWindow);
        }
        if(newWindow != NULL) {
            Tk_CreateEventHandler(newWindow,
                StructureNotifyMask, FrameStructureProc, labelframe);
            Tk_ManageGeometry(newWindow, &frameGeomType, labelframe);
            /*
             * If the frame is not parent to the label, make sure the
             * label is above its sibling in the stacking order.
             */
            if(sibling != NULL) {
                Tk_RestackWindow(newWindow, Above, sibling);
            }
        }
        labelframe->labelWin = newWindow;
    }
    return TCL_OK;

  badLabelWindow:
    Tcl_SetObjResult(interp,
        Tcl_ObjPrintf("can't use %s as label in this frame",
            Tk_PathName(labelframe->labelWin)));
    Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL);
    labelframe->labelWin = NULL;
    return TCL_ERROR;
}

/*
 * FrameMethod_backgroundimage --
 *
 * Process -backgroundimage option.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *  Set new option value.
 */
static int
FrameMethod_backgroundimage(
    ClientData dummy,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[])
{
    Tko_Widget *widget;
    tkoFrame *frame;
    Tcl_Obj *value;
    Tk_Image image;
    (void)dummy;

    if((widget = (Tko_Widget *)Tko_WidgetClientData(context)) == NULL
        || widget->tkWin == NULL
        || (value = Tko_WidgetOptionGet(widget, objv[objc - 1])) == NULL) {
        return TCL_ERROR;
    }
    frame = (tkoFrame *)widget;
    /* check on widget destroyed */
    if(widget->tkWin == NULL)
        return TCL_OK;
    /* try to create new image */
    if(value == NULL || Tcl_GetCharLength(value) == 0) {
        image = NULL;
    } else {
        image = Tk_GetImage(interp, widget->tkWin,
            Tcl_GetString(value), FrameBgImageProc, frame);
        if (image == NULL) {
            return TCL_ERROR;
        }
    }
    if (frame->bgimg) {
        Tk_FreeImage(frame->bgimg);
    }
    frame->bgimg = image;
    return TCL_OK;
}

/*
* FrameMethod_menu --
*
* Process -menu option.
*
* Results:
*    A standard Tcl result.
*
* Side effects:
*  Set new option value.
*/
static int
FrameMethod_menu(
    ClientData dummy,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[])
{
    Tko_Widget *widget;
    tkoFrame *frame;
    Tcl_Obj *value;
    char *newMenu;
    int length;
    (void)dummy;

    if((widget = (Tko_Widget *)Tko_WidgetClientData(context)) == NULL
        || widget->tkWin == NULL
        || (value = Tko_WidgetOptionGet(widget, objv[objc - 1])) == NULL) {
        return TCL_ERROR;
    }
    frame = (tkoFrame *)widget;

    newMenu = Tcl_GetStringFromObj(value, &length);
    if (length==0) {
        newMenu = NULL;
    }
    if ((((newMenu == NULL) && (frame->menuName != NULL))
        || ((newMenu != NULL) && (frame->menuName == NULL))
        || ((newMenu != NULL) && (frame->menuName != NULL)
            && strcmp(newMenu, frame->menuName) != 0))
        && frame->type == TYPE_TOPLEVEL) {
        Tk_SetWindowMenubar(interp, widget->tkWin, frame->menuName, newMenu);
        if (frame->menuName) { ckfree(frame->menuName); }
        if (length) {
            frame->menuName = (char *)ckalloc(length + 1);
            assert(frame->menuName);
            strncpy(frame->menuName,newMenu,length);
            frame->menuName[length] = '\0';
        }
        else {
            frame->menuName = NULL;
        }
    }
    return TCL_OK;
}

/*
 * FrameWorldChanged --
 *
 *    This function is called when the world has changed in some way and the
 *    widget needs to recompute all its graphics contexts and determine its
 *    new geometry.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Frame will be relayed out and redisplayed.
 */
static void
FrameWorldChanged(
    ClientData clientData)
{              /* Information about widget. */
    Tko_Widget *widget = (Tko_Widget *)clientData;
    tkoFrame *frame = (tkoFrame *)clientData;
    tkoLabelframe *labelframe = (tkoLabelframe *)clientData;
    XGCValues gcValues;
    GC  gc;
    int anyTextLabel, anyWindowLabel;
    int bWidthLeft, bWidthRight, bWidthTop, bWidthBottom;
    const char *labelText;

    if (widget->tkWin == NULL) {
        return;
    }

    anyTextLabel = (frame->type == TYPE_LABELFRAME) &&
        (labelframe->textPtr != NULL) && (labelframe->labelWin == NULL);
    anyWindowLabel = (frame->type == TYPE_LABELFRAME) &&
        (labelframe->labelWin != NULL);

#ifndef TK_NO_DOUBLE_BUFFERING
    gcValues.graphics_exposures = False;
    gc = Tk_GetGC(widget->tkWin, GCGraphicsExposures, &gcValues);
    if (frame->copyGC != NULL) {
        Tk_FreeGC(widget->display, frame->copyGC);
    }
    frame->copyGC = gc;
#endif /* TK_NO_DOUBLE_BUFFERING */

    if(frame->type == TYPE_LABELFRAME) {
        /*
         * The textGC is needed even in the labelWin case, so it's always
         * created for a labelframe.
         */

        gcValues.font = Tk_FontId(labelframe->tkfont);
        gcValues.foreground = labelframe->textColorPtr->pixel;
        gcValues.graphics_exposures = False;
        gc = Tk_GetGC(widget->tkWin, GCForeground | GCFont | GCGraphicsExposures,
            &gcValues);
        if(labelframe->textGC != NULL) {
            Tk_FreeGC(widget->display, labelframe->textGC);
        }
        labelframe->textGC = gc;

        /*
         * Calculate label size.
         */

        labelframe->labelReqWidth = labelframe->labelReqHeight = 0;

        if(anyTextLabel) {
            labelText = Tcl_GetString(labelframe->textPtr);
            if(labelframe->textLayout) {
                Tk_FreeTextLayout(labelframe->textLayout);
            }
            labelframe->textLayout =
                Tk_ComputeTextLayout(labelframe->tkfont,
                labelText, -1, 0, TK_JUSTIFY_CENTER, 0,
                &labelframe->labelReqWidth, &labelframe->labelReqHeight);
            labelframe->labelReqWidth += 2 * LABELSPACING;
            labelframe->labelReqHeight += 2 * LABELSPACING;
        } else if(anyWindowLabel) {
            labelframe->labelReqWidth = Tk_ReqWidth(labelframe->labelWin);
            labelframe->labelReqHeight = Tk_ReqHeight(labelframe->labelWin);
        }

        /*
         * Make sure label size is at least as big as the border. This
         * simplifies later calculations and gives a better appearance with
         * thick borders.
         */

        if((labelframe->labelAnchor >= LABELANCHOR_N) &&
            (labelframe->labelAnchor <= LABELANCHOR_SW)) {
            if(labelframe->labelReqHeight < frame->borderWidth) {
                labelframe->labelReqHeight = frame->borderWidth;
            }
        } else {
            if(labelframe->labelReqWidth < frame->borderWidth) {
                labelframe->labelReqWidth = frame->borderWidth;
            }
        }
    }

    /*
     * Calculate individual border widths.
     */

    bWidthBottom = bWidthTop = bWidthRight = bWidthLeft =
        frame->borderWidth + frame->highlightWidth;

    bWidthLeft += frame->padX;
    bWidthRight += frame->padX;
    bWidthTop += frame->padY;
    bWidthBottom += frame->padY;

    if(anyTextLabel || anyWindowLabel) {
        switch (labelframe->labelAnchor) {
        case LABELANCHOR_E:
        case LABELANCHOR_EN:
        case LABELANCHOR_ES:
            bWidthRight += labelframe->labelReqWidth - frame->borderWidth;
            break;
        case LABELANCHOR_N:
        case LABELANCHOR_NE:
        case LABELANCHOR_NW:
            bWidthTop += labelframe->labelReqHeight - frame->borderWidth;
            break;
        case LABELANCHOR_S:
        case LABELANCHOR_SE:
        case LABELANCHOR_SW:
            bWidthBottom += labelframe->labelReqHeight - frame->borderWidth;
            break;
        default:
            bWidthLeft += labelframe->labelReqWidth - frame->borderWidth;
            break;
        }
    }

    Tk_SetInternalBorderEx(widget->tkWin, bWidthLeft, bWidthRight, bWidthTop,
        bWidthBottom);

    FrameComputeGeometry(frame);

    /*
     * A labelframe should request size for its label.
     */

    if(frame->type == TYPE_LABELFRAME) {
        int minwidth = labelframe->labelReqWidth;
        int minheight = labelframe->labelReqHeight;
        int padding = frame->highlightWidth;

        if(frame->borderWidth > 0) {
            padding += frame->borderWidth + LABELMARGIN;
        }
        padding *= 2;
        if((labelframe->labelAnchor >= LABELANCHOR_N) &&
            (labelframe->labelAnchor <= LABELANCHOR_SW)) {
            minwidth += padding;
            minheight += frame->borderWidth + frame->highlightWidth;
        } else {
            minheight += padding;
            minwidth += frame->borderWidth + frame->highlightWidth;
        }
        Tk_SetMinimumRequestSize(widget->tkWin, minwidth, minheight);
    }

    if((frame->width > 0) || (frame->height > 0)) {
        Tk_GeometryRequest(widget->tkWin, frame->width, frame->height);
    }

    if(Tk_IsMapped(widget->tkWin)) {
        if(!(frame->flags & REDRAW_PENDING)) {
            Tcl_DoWhenIdle(FrameDisplay, frame);
        }
        frame->flags |= REDRAW_PENDING;
    }
}

/*
 * FrameComputeGeometry --
 *
 *    This function is called to compute various geometrical information for
 *    a frame, such as where various things get displayed. It's called when
 *    the window is reconfigured.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Display-related numbers get changed in *frame.
 */

static void
FrameComputeGeometry(
    tkoFrame * frame)
{
    int otherWidth, otherHeight, otherWidthT, otherHeightT, padding;
    int maxWidth, maxHeight;
    Tko_Widget *widget = (Tko_Widget *)frame;
    tkoLabelframe *labelframe = (tkoLabelframe *) frame;

    /*
     * We have nothing to do here unless there is a label.
     */
    if (widget->tkWin == NULL || frame->type != TYPE_LABELFRAME) {
        return;
    }

    if(labelframe->textPtr == NULL && labelframe->labelWin == NULL) {
        return;
    }

    /*
     * Calculate the available size for the label
     */

    labelframe->labelBox.width = labelframe->labelReqWidth;
    labelframe->labelBox.height = labelframe->labelReqHeight;

    padding = frame->highlightWidth;
    if(frame->borderWidth > 0) {
        padding += frame->borderWidth + LABELMARGIN;
    }
    padding *= 2;

    maxHeight = Tk_Height(widget->tkWin);
    maxWidth = Tk_Width(widget->tkWin);

    if((labelframe->labelAnchor >= LABELANCHOR_N) &&
        (labelframe->labelAnchor <= LABELANCHOR_SW)) {
        maxWidth -= padding;
        if(maxWidth < 1) {
            maxWidth = 1;
        }
    } else {
        maxHeight -= padding;
        if(maxHeight < 1) {
            maxHeight = 1;
        }
    }
    if(labelframe->labelBox.width > maxWidth) {
        labelframe->labelBox.width = maxWidth;
    }
    if(labelframe->labelBox.height > maxHeight) {
        labelframe->labelBox.height = maxHeight;
    }

    /*
     * Calculate label and text position. The text's position is based on the
     * requested size (= the text's real size) to get proper alignment if the
     * text does not fit.
     */

    otherWidth = Tk_Width(widget->tkWin) - labelframe->labelBox.width;
    otherHeight = Tk_Height(widget->tkWin) - labelframe->labelBox.height;
    otherWidthT = Tk_Width(widget->tkWin) - labelframe->labelReqWidth;
    otherHeightT = Tk_Height(widget->tkWin) - labelframe->labelReqHeight;
    padding = frame->highlightWidth;

    switch (labelframe->labelAnchor) {
    case LABELANCHOR_E:
    case LABELANCHOR_EN:
    case LABELANCHOR_ES:
        labelframe->labelTextX = otherWidthT - padding;
        labelframe->labelBox.x = otherWidth - padding;
        break;
    case LABELANCHOR_N:
    case LABELANCHOR_NE:
    case LABELANCHOR_NW:
        labelframe->labelTextY = padding;
        labelframe->labelBox.y = padding;
        break;
    case LABELANCHOR_S:
    case LABELANCHOR_SE:
    case LABELANCHOR_SW:
        labelframe->labelTextY = otherHeightT - padding;
        labelframe->labelBox.y = otherHeight - padding;
        break;
    default:
        labelframe->labelTextX = padding;
        labelframe->labelBox.x = padding;
        break;
    }

    if(frame->borderWidth > 0) {
        padding += frame->borderWidth + LABELMARGIN;
    }

    switch (labelframe->labelAnchor) {
    case LABELANCHOR_NW:
    case LABELANCHOR_SW:
        labelframe->labelTextX = padding;
        labelframe->labelBox.x = padding;
        break;
    case LABELANCHOR_N:
    case LABELANCHOR_S:
        labelframe->labelTextX = otherWidthT / 2;
        labelframe->labelBox.x = otherWidth / 2;
        break;
    case LABELANCHOR_NE:
    case LABELANCHOR_SE:
        labelframe->labelTextX = otherWidthT - padding;
        labelframe->labelBox.x = otherWidth - padding;
        break;
    case LABELANCHOR_EN:
    case LABELANCHOR_WN:
        labelframe->labelTextY = padding;
        labelframe->labelBox.y = padding;
        break;
    case LABELANCHOR_E:
    case LABELANCHOR_W:
        labelframe->labelTextY = otherHeightT / 2;
        labelframe->labelBox.y = otherHeight / 2;
        break;
    default:
        labelframe->labelTextY = otherHeightT - padding;
        labelframe->labelBox.y = otherHeight - padding;
        break;
    }
}

/*
 * FrameDisplay --
 *
 *    This function is invoked to display a frame widget.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Commands are output to X to display the frame in its current mode.
 */
static void
FrameDisplay(
    ClientData clientData /* Information about widget. */)
{
    Tko_Widget *widget = (Tko_Widget *)clientData;
    tkoFrame *frame = (tkoFrame *)clientData;
    int bdX1, bdY1, bdX2, bdY2, hlWidth;
    Pixmap pixmap;
    TkRegion clipRegion = NULL;

    if (widget->tkWin == NULL) {
        return;
    }

    frame->flags &= ~REDRAW_PENDING;
    if(!Tk_IsMapped(widget->tkWin)) {
        return;
    }

    /*
     * Highlight shall always be drawn if it exists, so do that first.
     */

    hlWidth = frame->highlightWidth;

    if(hlWidth != 0) {
        GC  fgGC, bgGC;

        bgGC = Tk_GCForColor(frame->highlightBgColorPtr,
            Tk_WindowId(widget->tkWin));
        if(frame->flags & GOT_FOCUS) {
            fgGC = Tk_GCForColor(frame->highlightColorPtr,
                Tk_WindowId(widget->tkWin));
            Tk_DrawHighlightBorder(widget->tkWin, fgGC, bgGC, hlWidth,
                Tk_WindowId(widget->tkWin));
        } else {
            Tk_DrawHighlightBorder(widget->tkWin, bgGC, bgGC, hlWidth,
                Tk_WindowId(widget->tkWin));
        }
    }

    /*
     * If -background is set to "", no interior is drawn.
     */

    if(frame->border == NULL) {
        return;
    }

#ifndef TK_NO_DOUBLE_BUFFERING
    /*
     * In order to avoid screen flashes, this function redraws the frame into
     * off-screen memory, then copies it back on-screen in a single operation.
     * This means there's no point in time where the on-screen image has been
     * cleared.
     */

    pixmap = Tk_GetPixmap(widget->display, Tk_WindowId(widget->tkWin),
        Tk_Width(widget->tkWin), Tk_Height(widget->tkWin), Tk_Depth(widget->tkWin));
#else
    pixmap = Tk_WindowId(widget->tkWin);
#endif /* TK_NO_DOUBLE_BUFFERING */

    if(frame->type != TYPE_LABELFRAME) {
        /*
         * Pass to platform specific draw function. In general, it just draws
         * a simple rectangle, but it may "theme" the background.
         */

    noLabel:
        TkpDrawFrameEx(widget->tkWin, pixmap, frame->border,
            hlWidth, frame->borderWidth, frame->relief);
        if (frame->bgimg) {
            FrameDrawBackground(widget->tkWin, pixmap, hlWidth,
                frame->borderWidth, frame->bgimg, frame->tile);
        }
    } else {
        tkoLabelframe *labelframe = (tkoLabelframe *) frame;

        if((labelframe->textPtr == NULL) && (labelframe->labelWin == NULL)) {
            goto noLabel;
        }

        /*
         * Clear the pixmap.
         */

        Tk_Fill3DRectangle(widget->tkWin, pixmap, frame->border, 0, 0,
            Tk_Width(widget->tkWin), Tk_Height(widget->tkWin), 0,
            TK_RELIEF_FLAT);

        /*
         * Calculate how the label affects the border's position.
         */

        bdX1 = bdY1 = hlWidth;
        bdX2 = Tk_Width(widget->tkWin) - hlWidth;
        bdY2 = Tk_Height(widget->tkWin) - hlWidth;

        switch (labelframe->labelAnchor) {
        case LABELANCHOR_E:
        case LABELANCHOR_EN:
        case LABELANCHOR_ES:
            bdX2 -= (labelframe->labelBox.width - frame->borderWidth) / 2;
            break;
        case LABELANCHOR_N:
        case LABELANCHOR_NE:
        case LABELANCHOR_NW:
            /*
             * Since the glyphs of the text tend to be in the lower part we
             * favor a lower border position by rounding up.
             */

            bdY1 += (labelframe->labelBox.height - frame->borderWidth + 1) / 2;
            break;
        case LABELANCHOR_S:
        case LABELANCHOR_SE:
        case LABELANCHOR_SW:
            bdY2 -= (labelframe->labelBox.height - frame->borderWidth) / 2;
            break;
        default:
            bdX1 += (labelframe->labelBox.width - frame->borderWidth) / 2;
            break;
        }

        /*
         * Draw border
         */

        Tk_Draw3DRectangle(widget->tkWin, pixmap, frame->border, bdX1, bdY1,
            bdX2 - bdX1, bdY2 - bdY1, frame->borderWidth, frame->relief);

        if(labelframe->labelWin == NULL) {
            /*
             * Clear behind the label
             */

            Tk_Fill3DRectangle(widget->tkWin, pixmap,
                frame->border, labelframe->labelBox.x,
                labelframe->labelBox.y, labelframe->labelBox.width,
                labelframe->labelBox.height, 0, TK_RELIEF_FLAT);

            /*
             * Draw label. If there is not room for the entire label, use
             * clipping to get a nice appearance.
             */

            if((labelframe->labelBox.width < labelframe->labelReqWidth)
                || (labelframe->labelBox.height < labelframe->labelReqHeight)) {
                clipRegion = TkCreateRegion();
                TkUnionRectWithRegion(&labelframe->labelBox, clipRegion,
                    clipRegion);
                TkSetRegion(widget->display, labelframe->textGC, clipRegion);
            }

            Tk_DrawTextLayout(widget->display, pixmap,
                labelframe->textGC, labelframe->textLayout,
                labelframe->labelTextX + LABELSPACING,
                labelframe->labelTextY + LABELSPACING, 0, -1);

            if(clipRegion != NULL) {
                XSetClipMask(widget->display, labelframe->textGC, None);
                TkDestroyRegion(clipRegion);
            }
        } else {
            /*
             * Reposition and map the window (but in different ways depending
             * on whether the frame is the window's parent).
             */

            if(widget->tkWin == Tk_Parent(labelframe->labelWin)) {
                if((labelframe->labelBox.x != Tk_X(labelframe->labelWin))
                    || (labelframe->labelBox.y != Tk_Y(labelframe->labelWin))
                    || (labelframe->labelBox.width !=
                        Tk_Width(labelframe->labelWin))
                    || (labelframe->labelBox.height !=
                        Tk_Height(labelframe->labelWin))) {
                    Tk_MoveResizeWindow(labelframe->labelWin,
                        labelframe->labelBox.x,
                        labelframe->labelBox.y,
                        labelframe->labelBox.width,
                        labelframe->labelBox.height);
                }
                Tk_MapWindow(labelframe->labelWin);
            } else {
                Tk_MaintainGeometry(labelframe->labelWin, widget->tkWin,
                    labelframe->labelBox.x, labelframe->labelBox.y,
                    labelframe->labelBox.width, labelframe->labelBox.height);
            }
        }
    }
#ifndef TK_NO_DOUBLE_BUFFERING
    /*
    * Everything's been redisplayed; now copy the pixmap onto the screen
    * and free up the pixmap.
    */

    XCopyArea(widget->display, pixmap, Tk_WindowId(widget->tkWin),
        frame->copyGC, hlWidth, hlWidth,
        (unsigned)(Tk_Width(widget->tkWin) - 2 * hlWidth),
        (unsigned)(Tk_Height(widget->tkWin) - 2 * hlWidth),
        hlWidth, hlWidth);
    Tk_FreePixmap(widget->display, pixmap);
#endif /* TK_NO_DOUBLE_BUFFERING */
}

/*
 * FrameEventProc --
 *
 *    This function is invoked by the Tk dispatcher on structure changes to
 *    a frame. For frames with 3D borders, this function is also invoked for
 *    exposures.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    When the window gets deleted, internal structures get cleaned up.
 *    When it gets exposed, it is redisplayed.
 */
static void
FrameEventProc(
    ClientData clientData,     /* Information about window. */
    register XEvent * eventPtr)
{              /* Information about event. */
    Tko_Widget *widget = (Tko_Widget *)clientData;
    tkoFrame *frame = (tkoFrame *)clientData;
    if(eventPtr->type == DestroyNotify || widget->tkWin == NULL
        || widget->tkWin == NULL)
        return;

    if((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
        goto redraw;
    } else if(eventPtr->type == ConfigureNotify) {
        FrameComputeGeometry(frame);
        goto redraw;
    } else if(eventPtr->type == FocusIn) {
        if(eventPtr->xfocus.detail != NotifyInferior) {
            frame->flags |= GOT_FOCUS;
            if(frame->highlightWidth > 0) {
                goto redraw;
            }
        }
    } else if(eventPtr->type == FocusOut) {
        if(eventPtr->xfocus.detail != NotifyInferior) {
            frame->flags &= ~GOT_FOCUS;
            if(frame->highlightWidth > 0) {
                goto redraw;
            }
        }
    } else if(eventPtr->type == ActivateNotify) {
        Tk_SetMainMenubar(frame->widget.interp, widget->tkWin, frame->menuName);
    }
    return;

  redraw:
    if(!(frame->flags & REDRAW_PENDING)) {
        Tcl_DoWhenIdle(FrameDisplay, frame);
        frame->flags |= REDRAW_PENDING;
    }
}

/*
 * FrameMap --
 *
 *    This function is invoked as a when-idle handler to map a newly-created
 *    top-level frame.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The frame given by the clientData argument is mapped.
 */
static void
FrameMap(
    ClientData clientData)
{              /* Pointer to frame structure. */
    Tko_Widget *widget = (Tko_Widget *)clientData;
    tkoFrame *frame = (tkoFrame *)clientData;

    if (widget->tkWin == NULL) {
        return;
    }

    /*
     * Wait for all other background events to be processed before mapping
     * window. This ensures that the window's correct geometry will have been
     * determined before it is first mapped, so that the window manager
     * doesn't get a false idea of its desired geometry.
     */

    Tcl_Preserve(frame);
    while(1) {
        if(Tcl_DoOneEvent(TCL_IDLE_EVENTS) == 0) {
            break;
        }

        /*
         * After each event, make sure that the window still exists and quit
         * if the window has been destroyed.
         */
        if(widget->tkWin == NULL) {
            Tcl_Release(frame);
            return;
        }
    }
    Tk_MapWindow(widget->tkWin);
    Tcl_Release(frame);
}


/*
 * FrameStructureProc --
 *
 *    This function is invoked whenever StructureNotify events occur for a
 *    window that's managed as label for the frame. This procudure's only
 *    purpose is to clean up when windows are deleted.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The window is disassociated from the frame when it is deleted.
 */
static void
FrameStructureProc(
    ClientData clientData,     /* Pointer to record describing frame. */
    XEvent * eventPtr)
{              /* Describes what just happened. */
    tkoLabelframe *labelframe = (tkoLabelframe *)clientData;

    /*
     * This should only happen in a labelframe but it doesn't hurt to be
     * careful.
     */
    if((eventPtr->type == DestroyNotify)
        && (labelframe->frame.type == TYPE_LABELFRAME)) {
        FrameLabelwinRemove(labelframe);
    }
}

/*
 * FrameLabelwinRemove --
 *
 * Results:
 *  None.
 *
 * Side effects:
 */
static void
FrameLabelwinRemove(
    tkoLabelframe * labelframe)
{
    tkoFrame *frame = (tkoFrame *) labelframe;
    Tcl_Obj *tmpPtr;

    labelframe->labelWin = NULL;
    tmpPtr = Tcl_NewStringObj("-labelwidget", -1);
    Tcl_IncrRefCount(tmpPtr);
    Tko_WidgetOptionSet(&frame->widget, tmpPtr, Tcl_NewStringObj("", 0));
    Tcl_DecrRefCount(tmpPtr);
    FrameWorldChanged(labelframe);
}

/*
 * FrameRequestProc --
 *
 *    This function is invoked whenever a window that's associated with a
 *    frame changes its requested dimensions.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The size and location on the screen of the window may change depending
 *    on the options specified for the frame.
 */
static void
FrameRequestProc(
    ClientData clientData,     /* Pointer to record for frame. */
    Tk_Window tkWin)
{              /* Window that changed its desired size. */
    tkoFrame *frame = (tkoFrame *)clientData;
    (void)tkWin;

    FrameWorldChanged(frame);
}

/*
 * FrameLostSlaveProc --
 *
 *    This function is invoked by Tk whenever some other geometry claims
 *    control over a slave that used to be managed by us.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Forgets all frame-related information about the slave.
 */
static void
FrameLostSlaveProc(
    ClientData clientData,     /* Frame structure for slave window that was
                                * stolen away. */
    Tk_Window tkWin            /* Tk's handle for the slave window. */)
{
    tkoLabelframe *labelframe = (tkoLabelframe *)clientData;

    /*
     * This should only happen in a labelframe but it doesn't hurt to be
     * careful.
     */

    if(labelframe->frame.type == TYPE_LABELFRAME) {
        Tk_DeleteEventHandler(labelframe->labelWin, StructureNotifyMask,
            FrameStructureProc, labelframe);
        if(tkWin != Tk_Parent(labelframe->labelWin)) {
            Tk_UnmaintainGeometry(labelframe->labelWin, tkWin);
        }
        Tk_UnmapWindow(labelframe->labelWin);
        FrameLabelwinRemove(labelframe);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * FrameBgImageProc --
 *
 *    This function is invoked by the image code whenever the manager for an
 *    image does something that affects the size or contents of an image
 *    displayed on a frame's background.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Arranges for the button to get redisplayed.
 *
 *----------------------------------------------------------------------
 */

static void
FrameBgImageProc(
    ClientData clientData,    /* Pointer to widget record. */
    int x, int y,        /* Upper left pixel (within image) that must
                 * be redisplayed. */
    int width, int height,    /* Dimensions of area to redisplay (might be
                 * <= 0). */
    int imgWidth, int imgHeight)/* New dimensions of image. */
{
    Tko_Widget *widget = (Tko_Widget *)clientData;
    tkoFrame *frame = (tkoFrame *)clientData;
    (void)x;
    (void)y;
    (void)width;
    (void)height;
    (void)imgWidth;
    (void)imgHeight;

    if (widget->tkWin == NULL) return;

    /*
     * Changing the background image never alters the dimensions of the frame.
     */

    if (Tk_IsMapped(widget->tkWin) &&
        !(frame->flags & REDRAW_PENDING)) {
        Tcl_DoWhenIdle(FrameDisplay, frame);
        frame->flags |= REDRAW_PENDING;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * FrameDrawBackground --
 *
 *    This function draws the background image of a rectangular frame area.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Draws inside the tkwin area.
 *
 *----------------------------------------------------------------------
 */

static void
FrameDrawBackground(
    Tk_Window tkwin,
    Pixmap pixmap,
    int highlightWidth,
    int borderWidth,
    Tk_Image bgimg,
    int bgtile)
{
    int width, height;            /* Area to paint on. */
    int imageWidth, imageHeight;    /* Dimensions of image. */
    const int bw = highlightWidth + borderWidth;

    Tk_SizeOfImage(bgimg, &imageWidth, &imageHeight);
    width = Tk_Width(tkwin) - 2*bw;
    height = Tk_Height(tkwin) - 2*bw;

    if (bgtile) {
        /*
         * Draw the image tiled in the widget (inside the border).
         */

        int x, y;

        for (x = bw; x - bw < width; x += imageWidth) {
            int w = imageWidth;
            if (x - bw + imageWidth > width) {
            w = (width + bw) - x;
            }
            for (y = bw; y < height + bw; y += imageHeight) {
            int h = imageHeight;
            if (y - bw + imageHeight > height) {
                h = (height + bw) - y;
            }
            Tk_RedrawImage(bgimg, 0, 0, w, h, pixmap, x, y);
            }
        }
    } else {
        /*
         * Draw the image centred in the widget (inside the border).
         */

        int x, y, xOff, yOff, w, h;

        if (width > imageWidth) {
            x = 0;
            xOff = (Tk_Width(tkwin) - imageWidth) / 2;
            w = imageWidth;
        } else {
            x = (imageWidth - width) / 2;
            xOff = bw;
            w = width;
        }
        if (height > imageHeight) {
            y = 0;
            yOff = (Tk_Height(tkwin) - imageHeight) / 2;
            h = imageHeight;
        } else {
            y = (imageHeight - height) / 2;
            yOff = bw;
            h = height;
        }
        Tk_RedrawImage(bgimg, x, y, w, h, pixmap, xOff, yOff);
    }
}

/* vim: set ts=4 sw=4 sts=4 ff=unix et : */

/*
 * tkoWidget.c --
 *
 *    This file contains the tko widget class.
 *
 * Copyright (c) 2019 Rene Zaumseil
 *
 */

#include "tkoWidget.h"
#include "tclOOInt.h" /*TODO needed for Widget_GetClassName() below */

/*
 * Widget_GetClassName --
 *    Return class name of object.
 *    Should be OO core function.
 *
 * Results:
 *    Name of class or NULL on error.
 *
 * Side effects:
 *    Use internal OO structures!!!
 */
Tcl_Obj *
Widget_GetClassName(
    Tcl_Interp * interp,
    Tcl_Object object)
{
    Tcl_Object classPtr;
    classPtr = (Tcl_Object)(((Object *)object)->selfCls->thisPtr);
    if (classPtr == NULL) return NULL;

    return Tcl_GetObjectName(interp, classPtr);
}

/*
 * Widget option.
 */
typedef struct WidgetOption {
    Tcl_Obj *option;           /* Name of option */
    Tcl_Obj *dbname;           /* Database name or name of synonym option */
    Tcl_Obj *dbclass;          /* Class name or NULL for synonym options */
    Tcl_Obj *defvalue;         /* Default value from initialization */
    Tcl_Obj *flags;            /* Default value from initialization */
    Tcl_Obj *value;            /* Contain last known value of option */
    int flagbits;               /* see flags in struct Tko_WidgetOptionDefine */
} WidgetOption;

/*
 * Clientdata of option methods.
 */
typedef struct WidgetClientdata {
    Tcl_MethodType method;
    Tcl_Obj *option;
    int offset;
    int type;
    int flags;
} WidgetClientdata;

typedef struct TkoThreadData {
    /* UID of class sctring */
    Tk_Uid Uid_class;
    Tk_Uid Uid_empty;
    /* Static string objects.  */
    Tcl_Obj *Obj_empty; /* "" */
    Tcl_Obj *Obj_tko__option; /* "::tko::_option" */
    Tcl_Obj *Obj_tko__eventoption; /* "::tko::_eventoption" */
    Tcl_Obj *Obj_next; /* "next" */
    Tcl_Obj *Obj_uplevel; /* "::uplevel" */
    Tcl_Obj *Obj_oo_define; /* "::oo::define" */
    Tcl_Obj *Obj_oo_objdefine; /* "::oo::objdefine" */
    Tcl_Obj *Obj_method; /* "method" */
    Tcl_Obj *Obj__tko_configure; /* "_tko_configure" */
    Tcl_Obj *Obj__tko; /* "_tko" */
    Tcl_Obj *Obj_cget; /* "cget" */
    Tcl_Obj *Obj_configure; /* "configure" */
    Tcl_Obj *Obj_tko; /* "::tko" */
    Tcl_Obj *Obj_tko_widget; /* "::tko::widget" */
    Tcl_Obj *Obj_lsort; /* "::lsort" */
    Tcl_Obj *Obj_point; /* "." */
    Tcl_Obj *Obj_point2; /* ".." */
    Tcl_Obj *Obj__screen; /* "-screen" */
    Tcl_Obj *Obj_flags_r; /* "r" */
    Tcl_Obj *Obj_flags_rh; /* "rh" */
    Tcl_Obj *Obj_flags_h; /* "h" */
    Tcl_Obj *Obj_rename; /* "rename" */
    Tcl_Obj *Obj_tko__self; /* "::tko::_self" */
} TkoThreadData;
static Tcl_ThreadDataKey tkoKey;

/*
 * Methods
 */
static int WidgetMethod_cget(
    ClientData clientData,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[]);
static int WidgetMethod_configure(
    ClientData clientData,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[]);
static int WidgetMethod_tko_configure(
    ClientData clientData,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[]);
static int WidgetMethod_tko(
    ClientData clientData,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[]);

/*
 * Functions
 */
static char *WidgetOptionTrace(
    ClientData clientData,
    Tcl_Interp * interp,
    const char *name1,
    const char *name2,
    int flags);
static void WidgetOptionDelEntry(
    Tcl_HashEntry * entry);
static void WidgetEventProc(
    ClientData clientData,
    XEvent * eventPtr);
static void WidgetEventChanged(
    Tko_Widget *widget);
static int WidgetOptionAdd(
    Tcl_Interp * interp,
    Tko_Widget * widget,
    Tcl_Obj * option,
    Tcl_Obj * dbname,
    Tcl_Obj * dbclass,
    Tcl_Obj * defvalue,
    Tcl_Obj * flags,
    Tcl_Obj * value,
    int initmode);
static int WidgetOptionGet(
    Tcl_Interp * interp,
    Tko_Widget * widget,
    Tcl_Obj * option);
static int WidgetOptionSet(
    Tcl_Interp * interp,
    Tko_Widget * widget,
    Tcl_Obj * option,
    Tcl_Obj * value);
static void WidgetMetaDestroy(
    Tko_Widget * widget);
static void WidgetMetaDelete(
    ClientData clientData);
static int WidgetMethod_(
    ClientData clientData,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[]);
static int WidgetFlagsObj(
    Tcl_Obj *flagsPtr,
    int *flags);
static int WidgetFlagsHideGet(
    Tcl_Obj *flags);
static Tcl_Obj *WidgetFlagsHideSet(
    Tcl_Obj *flags);
static Tcl_Obj *WidgetFlagsHideUnset(
    Tcl_Obj *flags);
static void WidgetClientdataDelete(
    ClientData clientdata);
static int WidgetClientdataClone(
    Tcl_Interp *interp,
    ClientData clientdata,
    ClientData *newPtr);
static int WidgetDestructor(
    ClientData clientData,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[]);
static int WidgetWrapConstructor(
    ClientData clientData,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[]);
static int WidgetClassConstructor(
    ClientData clientData,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[]);
static void WidgetDeleteTkwin(
    Tko_Widget *widget);

/* List of all internally defined public and private methods. */
#define TKO_1 TCL_OO_METHOD_VERSION_CURRENT
static Tcl_MethodType tkoWidgetMethods[] = {
    { TKO_1, NULL, WidgetClassConstructor, NULL, NULL },
    { TKO_1, NULL, WidgetWrapConstructor, NULL, NULL },
    { TKO_1, NULL, WidgetDestructor, NULL, NULL },
    { TKO_1, "cget", WidgetMethod_cget, NULL, NULL },
    { TKO_1, "configure", WidgetMethod_configure, NULL, NULL },
    { TKO_1, "_tko_configure", WidgetMethod_tko_configure, NULL, NULL },
    { TKO_1, "_tko", WidgetMethod_tko, NULL, NULL },
};

/*
 * tkoWidgetMeta --
 *    Identifier for attached tko widget data.
 */
Tcl_ObjectMetadataType tkoWidgetMeta = {
    TCL_OO_METADATA_VERSION_CURRENT,
    "tkoWidgetMeta",
    WidgetMetaDelete,
    NULL
};

/*
* Tko_TkoObjCmd --
*    Implementation of the "::tko" command.
*    Initialization of new widgets.
*    Configuration of widget class options.
*
* Results:
*    A standard Tcl result.
*
* Side effects:
*    Create available oo::class tko widgets.
*    Add, delete return, hide and show options.
*/
int
Tko_TkoObjCmd(
    ClientData dummy,    /* Not used. */
    Tcl_Interp *interp,        /* Current interpreter. */
    int objc,            /* Number of arguments. */
    Tcl_Obj *const objv[])    /* Argument objects. */
{
    static const char *const myOptions[] = {
        "initclass", "initfrom", "initwrap",
        "eventoption",
        "optiondef", "optiondel","optionget",
        "optionhide","optionshow",NULL
    };
    enum options {
        MY_INITCLASS, MY_INITFROM, MY_INITWRAP,
        MY_EVENTOPTION,
        MY_OPTIONDEF, MY_OPTIONDEL, MY_OPTIONGET,
        MY_OPTIONHIDE, MY_OPTIONSHOW
    };
    int index;
    Tcl_Obj *dictPtr;
    Tcl_Obj *namePtr;
    Tcl_Obj *listPtr;
    int ret;
    int i;
    Tcl_DictSearch search;
    Tcl_Obj *key, *value;
    int argObjc;
    Tcl_Obj **argObjv;
    int done;
    Tcl_Obj *myCmd[6];
    const char *ch, *ch1;
    int length;
    Tcl_Obj *tmpPtr;
    Tcl_Class clazz;
    Tcl_Object object;
    TkoThreadData *tkoPtr = (TkoThreadData *)Tcl_GetThreadData(&tkoKey, sizeof(TkoThreadData));
    (void)dummy;

    if (objc < 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
        return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObjStruct(interp, objv[1], myOptions,
        sizeof(char *), "option", 0, &index) != TCL_OK) {
        return TCL_ERROR;
    }
    switch ((enum options) index) {
    case MY_INITCLASS: /* Add cget/configure functionalite to current class */
        if (objc != 2) {
            Tcl_WrongNumArgs(interp, 2, objv, "");
            return TCL_ERROR;
        }
        ret = Tcl_Eval(interp, "set ::tko::_option([self]) {} ; variable tko ; self");
        if (ret != TCL_OK) {
            return TCL_ERROR;
        }
        /* Get class object */
        tmpPtr = Tcl_GetObjResult(interp);
        if ((object = Tcl_GetObjectFromObj(interp, tmpPtr)) == NULL
            || (clazz = Tcl_GetObjectAsClass(object)) == NULL) {
            return TCL_ERROR;
        }
        /*
        * Add methods
        */
        Tcl_ClassSetConstructor(interp, clazz,
            Tcl_NewMethod(interp, clazz, NULL, 1, &tkoWidgetMethods[0], NULL));
        Tcl_ClassSetDestructor(interp, clazz,
            Tcl_NewMethod(interp, clazz, NULL, 1, &tkoWidgetMethods[2], NULL));
        Tcl_NewMethod(interp, clazz, tkoPtr->Obj_cget, 1, &tkoWidgetMethods[3], NULL);
        Tcl_NewMethod(interp, clazz, tkoPtr->Obj_configure, 1, &tkoWidgetMethods[4], NULL);
        Tcl_NewMethod(interp, clazz, tkoPtr->Obj__tko_configure, 0, &tkoWidgetMethods[5], NULL);
        Tcl_NewMethod(interp, clazz, tkoPtr->Obj__tko, 0, &tkoWidgetMethods[6], NULL);

        return TCL_OK;
    case MY_INITFROM: /* Initialize new tko class */
        if (objc != 3) {
            Tcl_WrongNumArgs(interp, 2, objv, "tkoclass");
            return TCL_ERROR;
        }
        /* Use fqn superclass  and get all options from it */
        ch = Tcl_GetStringFromObj(objv[2], &length);
        if (length < 2 || ch[0] != ':') {
            tmpPtr = Tcl_ObjPrintf(
                "set ::tko::_option([self]) {} ; unexport destroy; variable tko; {*}$::tko::_unknown\n"
                "superclass ::%s ; set ::tko::_option([self]) [::tko optionget ::%s]",
                ch,ch);
        }
        else{
            tmpPtr = Tcl_ObjPrintf(
                "set ::tko::_option([self]) {} ; unexport destroy; variable tko; {*}$::tko::_unknown\n"
                "superclass %s ; set ::tko::_option([self]) [::tko optionget %s]",
                ch,ch);
        }
        Tcl_IncrRefCount(tmpPtr);
        ret = Tcl_Eval(interp, Tcl_GetString(tmpPtr));
        Tcl_DecrRefCount(tmpPtr);
        if (ret != TCL_OK) {
            return TCL_ERROR;
        }
        return TCL_OK;
    case MY_INITWRAP: /* Wrap widget in new class */
        if (objc != 5) {
            Tcl_WrongNumArgs(interp, 2, objv, "widget readonlyoptionlist methodlist");
            return TCL_ERROR;
        }
        /* Create fqn widgetname */
        ch = Tcl_GetStringFromObj(objv[2], &length);
        if (length < 2 || ch[0] != ':') {
            namePtr = Tcl_ObjPrintf("::%s", Tcl_GetString(objv[2]));
        }
        else {
            namePtr = objv[2];
        }
        Tcl_IncrRefCount(namePtr);
        ch = Tcl_GetString(namePtr);
        ch1 = Tcl_GetString(objv[3]);
        tmpPtr = Tcl_ObjPrintf("set ::tko::_option([self]) {}\n"
            "unexport destroy ; variable tko\n"
            "::tko::_initwrap [self] %s {%s} {%s}\n"
            "self method unknown {pathName args} {\n"
            " set a {}; foreach {o v} $args {if {$o in {%s}} {lappend a $o $v}}\n"
            " rename [%s $pathName {*}$a] ::tko::$pathName\n"
            " tailcall [[self] create ::$pathName {*}$args] configure .\n"
            "}\n"
            "self",
            ch,ch1,Tcl_GetString(objv[4]),ch1,ch);
        Tcl_IncrRefCount(tmpPtr);
        ret = Tcl_Eval(interp, Tcl_GetString(tmpPtr));
        Tcl_DecrRefCount(namePtr);
        Tcl_DecrRefCount(tmpPtr);
        if (ret != TCL_OK) {
            return TCL_ERROR;
        }
        /* Get class object */
        tmpPtr = Tcl_GetObjResult(interp);
        if ((object = Tcl_GetObjectFromObj(interp, tmpPtr)) == NULL
            || (clazz = Tcl_GetObjectAsClass(object)) == NULL) {
            return TCL_ERROR;
        }
        /*
        * Add methods
        */
        Tcl_ClassSetConstructor(interp, clazz,
            Tcl_NewMethod(interp, clazz, NULL, 1, &tkoWidgetMethods[1], NULL));
        Tcl_ClassSetDestructor(interp, clazz,
            Tcl_NewMethod(interp, clazz, NULL, 1, &tkoWidgetMethods[2], NULL));
        Tcl_NewMethod(interp, clazz, tkoPtr->Obj_cget, 1, &tkoWidgetMethods[3], NULL);
        Tcl_NewMethod(interp, clazz, tkoPtr->Obj_configure, 1, &tkoWidgetMethods[4], NULL);
        Tcl_NewMethod(interp, clazz, tkoPtr->Obj__tko_configure, 0, &tkoWidgetMethods[5], NULL);
        Tcl_NewMethod(interp, clazz, tkoPtr->Obj__tko, 0, &tkoWidgetMethods[6], NULL);

        return TCL_OK;
    case MY_EVENTOPTION: /* Call proc ::tko::_eventoption */
        return Tcl_EvalObjEx(interp, tkoPtr->Obj_tko__eventoption, TCL_EVAL_GLOBAL);
    case MY_OPTIONDEF: /* Add or replace option definitions and return new state */
        if (objc != 3 && objc < 5) {
            Tcl_WrongNumArgs(interp, 2, objv, "::classname ?-option definition? .. ?body?");
            return TCL_ERROR;
        }
        /* Create fqn classname */
        ch = Tcl_GetStringFromObj(objv[2], &length);
        if (length < 2 || ch[0] != ':') {
            namePtr = Tcl_ObjPrintf("::%s", Tcl_GetString(objv[2]));
        }
        else {
            namePtr = objv[2];
        }
        Tcl_IncrRefCount(namePtr);
        /* get current value or create new one */
        dictPtr = Tcl_ObjGetVar2(interp, tkoPtr->Obj_tko__option, namePtr, TCL_GLOBAL_ONLY);
        if (dictPtr == NULL) {
            dictPtr = Tcl_NewObj();
        }
        else {
            dictPtr = Tcl_DuplicateObj(dictPtr);
        }
        Tcl_IncrRefCount(dictPtr);
        /* if no options then return current state */
        if (objc == 3) {
            Tcl_SetObjResult(interp, dictPtr);
            Tcl_DecrRefCount(dictPtr);
            Tcl_DecrRefCount(namePtr);
            return TCL_OK;
        }
        /* Add or replace options */
        for (i = 3; i < objc-1; i = i + 2) {
            /* check definition list */
            if (Tcl_ListObjGetElements(interp, objv[i + 1], &argObjc, &argObjv) != TCL_OK) {
                Tcl_SetObjResult(interp, Tcl_ObjPrintf("no definition list: %s {%s}",
                    Tcl_GetString(objv[i]), Tcl_GetString(objv[i + 1])));
                Tcl_DecrRefCount(dictPtr);
                Tcl_DecrRefCount(namePtr);
                return TCL_ERROR;
            }
            /* Check definition list */
            switch (argObjc) {
            case 2: /* synonym flags */
                ret = WidgetOptionAdd(interp, NULL, objv[i], argObjv[0], NULL, NULL, argObjv[1], NULL, 0);
                if (ret == TCL_OK) {
                    ret = Tcl_DictObjPut(interp, dictPtr, objv[i], objv[i + 1]);
                }
                break;
            case 4: /* dbname dbclass default flags */
                ret = WidgetOptionAdd(interp, NULL, objv[i], argObjv[0], argObjv[1], argObjv[2], argObjv[3], NULL, 0);
                if (ret == TCL_OK) {
                    ret = Tcl_DictObjPut(interp, dictPtr, objv[i], objv[i + 1]);
                }
                break;
            default:
                Tcl_SetObjResult(interp, Tcl_ObjPrintf("wrong definition: %s {%s}",
                    Tcl_GetString(objv[i]), Tcl_GetString(objv[i + 1])));
                ret = TCL_ERROR;
            }
            if (ret != TCL_OK) {
                Tcl_DecrRefCount(dictPtr);
                Tcl_DecrRefCount(namePtr);
                return TCL_ERROR;
            }

        }
        /* Add body to last definition. */
        if (objc % 2 == 0) {
            myCmd[0] = tkoPtr->Obj_oo_define;
            myCmd[1] = namePtr;
            myCmd[2] = tkoPtr->Obj_method;
            myCmd[3] = objv[objc - 3];
            myCmd[4] = tkoPtr->Obj_empty;
            myCmd[5] = objv[objc - 1];
            ret = Tcl_EvalObjv(interp, 6, myCmd, TCL_EVAL_GLOBAL);
            if (ret != TCL_OK) {
                Tcl_DecrRefCount(dictPtr);
                Tcl_DecrRefCount(namePtr);
                return TCL_ERROR;
            }
        }        tmpPtr = Tcl_ObjSetVar2(interp, tkoPtr->Obj_tko__option, namePtr, dictPtr, TCL_GLOBAL_ONLY);
        Tcl_DecrRefCount(dictPtr);
        Tcl_DecrRefCount(namePtr);
        if (tmpPtr == NULL) {
            return TCL_ERROR;
        }
        Tcl_SetObjResult(interp, tmpPtr);
        return TCL_OK;
    case MY_OPTIONDEL: /* Delete option definitions and return new state */
        if (objc < 3) {
            Tcl_WrongNumArgs(interp, 2, objv, "::classname ?-option? ..");
            return TCL_ERROR;
        }
        /* Create fqn classname */
        ch = Tcl_GetStringFromObj(objv[2], &length);
        if (length < 2 || ch[0] != ':') {
            namePtr = Tcl_ObjPrintf("::%s", Tcl_GetString(objv[2]));
        }
        else {
            namePtr = objv[2];
        }
        Tcl_IncrRefCount(namePtr);
        /* if no options then remove all options */
        if (objc == 3) {
            tmpPtr = Tcl_ObjSetVar2(interp, tkoPtr->Obj_tko__option, namePtr,tkoPtr->Obj_empty,TCL_GLOBAL_ONLY);
            Tcl_DecrRefCount(namePtr);
            if (tmpPtr == NULL) {
                return TCL_ERROR;
            }
            Tcl_SetObjResult(interp, tmpPtr);
            return TCL_OK;
        }
        /* remove given options from dictionary */
        dictPtr = Tcl_ObjGetVar2(interp, tkoPtr->Obj_tko__option, namePtr, TCL_GLOBAL_ONLY);
        if (dictPtr == NULL) {
            Tcl_DecrRefCount(namePtr);
            return TCL_ERROR;
        }
        dictPtr = Tcl_DuplicateObj(dictPtr);
        Tcl_IncrRefCount(dictPtr);
        /* remove with error check */
        for (i = 3; i < objc; i++) {
            if (Tcl_DictObjRemove(interp, dictPtr, objv[i]) != TCL_OK) {
                Tcl_DecrRefCount(dictPtr);
                Tcl_DecrRefCount(namePtr);
                return TCL_ERROR;
            }
        }
        tmpPtr = Tcl_ObjSetVar2(interp, tkoPtr->Obj_tko__option, namePtr,dictPtr,TCL_GLOBAL_ONLY);
        Tcl_DecrRefCount(dictPtr);
        Tcl_DecrRefCount(namePtr);
        if (tmpPtr == NULL) {
            return TCL_ERROR;
        }
        Tcl_SetObjResult(interp, tmpPtr);
        return TCL_OK;
    case MY_OPTIONGET: /* Return all or selected option definitions */
        if (objc < 3) {
            Tcl_WrongNumArgs(interp, 2, objv, "::classname ?-option? ..");
            return TCL_ERROR;
        }
        /* Create fqn classname */
        ch = Tcl_GetStringFromObj(objv[2], &length);
        if (length < 2 || ch[0] != ':') {
            namePtr = Tcl_ObjPrintf("::%s", Tcl_GetString(objv[2]));
        }
        else {
            namePtr = objv[2];
        }
        Tcl_IncrRefCount(namePtr);
        /* return all definitions */
        dictPtr = Tcl_ObjGetVar2(interp, tkoPtr->Obj_tko__option, namePtr, TCL_GLOBAL_ONLY);
        Tcl_DecrRefCount(namePtr);
        if (dictPtr == NULL) {
            Tcl_DecrRefCount(namePtr);
            return TCL_ERROR;
        }
        if (objc == 3) {
            Tcl_SetObjResult(interp, dictPtr);
            return TCL_OK;
        }
        /* return only selected definitions */
        listPtr = Tcl_NewListObj(0, NULL);
        Tcl_IncrRefCount(listPtr);
        /* get with error checks */
        for (i = 3; i < objc; i++) {
            if (Tcl_DictObjGet(interp, dictPtr, objv[i], &tmpPtr) != TCL_OK
                || tmpPtr == NULL) {
                Tcl_SetObjResult(interp, Tcl_ObjPrintf("unknown option: %s",
                    Tcl_GetString(objv[i])));
                Tcl_DecrRefCount(listPtr);
                return TCL_ERROR;
            }
            Tcl_ListObjAppendElement(interp, listPtr, objv[i]);
            Tcl_ListObjAppendElement(interp, listPtr, tmpPtr);
        }
        Tcl_SetObjResult(interp, listPtr);
        Tcl_DecrRefCount(listPtr);
        return TCL_OK;
    case MY_OPTIONHIDE: /* Hide given options or return all hide'able options */
        if (objc < 3) {
            Tcl_WrongNumArgs(interp, 2, objv, "::classname ?-option? ..");
            return TCL_ERROR;
        }
        /* Create fqn classname */
        ch = Tcl_GetStringFromObj(objv[2], &length);
        if (length < 2 || ch[0] != ':') {
            namePtr = Tcl_ObjPrintf("::%s", Tcl_GetString(objv[2]));
        }
        else {
            namePtr = objv[2];
        }
        Tcl_IncrRefCount(namePtr);
        dictPtr = Tcl_ObjGetVar2(interp, tkoPtr->Obj_tko__option, namePtr, TCL_GLOBAL_ONLY);
        if (dictPtr == NULL) {
            Tcl_DecrRefCount(namePtr);
            return TCL_ERROR;
        }
        /* return list of hide'able options */
        if (objc == 3) {
            /* return list of visible options */
            if (Tcl_DictObjFirst(interp, dictPtr, &search,
                &key, &value, &done) != TCL_OK) {
                Tcl_DecrRefCount(namePtr);
                return TCL_ERROR;
            }
            listPtr = Tcl_NewListObj(0, NULL);
            for (; !done; Tcl_DictObjNext(&search, &key, &value, &done)) {
                Tcl_ListObjGetElements(interp, value, &argObjc, &argObjv);
                switch (argObjc) {
                case 1:
                case 3:
                    Tcl_ListObjAppendElement(interp, listPtr, key);
                    break;
                case 2:
                    if (WidgetFlagsHideGet(argObjv[1]) == 0) {
                        Tcl_ListObjAppendElement(interp, listPtr, key);
                    }
                    break;
                case 4:
                    if (WidgetFlagsHideGet(argObjv[3]) == 0) {
                        Tcl_ListObjAppendElement(interp, listPtr, key);
                    }
                    break;
                }
                /* ignore internal error on wrong definition lists */
            }
            Tcl_DictObjDone(&search);
            Tcl_SetObjResult(interp, listPtr);
            Tcl_DecrRefCount(namePtr);
            return TCL_OK;
        }
        /* hide given options */
        dictPtr = Tcl_DuplicateObj(dictPtr);
        Tcl_IncrRefCount(dictPtr);
        for (i = 3; i < objc; i++) {
            if (Tcl_DictObjGet(interp, dictPtr, objv[i], &listPtr) != TCL_OK
                || listPtr == NULL) {
                Tcl_SetObjResult(interp, Tcl_ObjPrintf("unknown option: %s",
                    Tcl_GetString(objv[i])));
                Tcl_DecrRefCount(dictPtr);
                Tcl_DecrRefCount(namePtr);
                return TCL_ERROR;
            }
            Tcl_ListObjGetElements(interp, listPtr, &argObjc, &argObjv);
            listPtr = NULL;
            switch (argObjc) {
            case 1:
                listPtr = Tcl_NewListObj(0, NULL);
                Tcl_ListObjAppendElement(interp, listPtr, argObjv[0]);
                Tcl_ListObjAppendElement(interp, listPtr, tkoPtr->Obj_flags_h);
                break;
            case 2:
                listPtr = Tcl_NewListObj(0, NULL);
                Tcl_ListObjAppendElement(interp, listPtr, argObjv[0]);
                Tcl_ListObjAppendElement(interp, listPtr, WidgetFlagsHideSet(argObjv[1]));
                break;
            case 3:
                listPtr = Tcl_NewListObj(0, NULL);
                Tcl_ListObjAppendElement(interp, listPtr, argObjv[0]);
                Tcl_ListObjAppendElement(interp, listPtr, argObjv[1]);
                Tcl_ListObjAppendElement(interp, listPtr, argObjv[2]);
                Tcl_ListObjAppendElement(interp, listPtr, tkoPtr->Obj_flags_h);
                break;
            case 4:
                listPtr = Tcl_NewListObj(0, NULL);
                Tcl_ListObjAppendElement(interp, listPtr, argObjv[0]);
                Tcl_ListObjAppendElement(interp, listPtr, argObjv[1]);
                Tcl_ListObjAppendElement(interp, listPtr, argObjv[2]);
                Tcl_ListObjAppendElement(interp, listPtr, WidgetFlagsHideSet(argObjv[3]));
                break;
            default: /* ignore internal error */
                continue;
            }
            if (Tcl_DictObjPut(interp, dictPtr, objv[i], listPtr) != TCL_OK) {
                Tcl_DecrRefCount(dictPtr);
                Tcl_DecrRefCount(namePtr);
                return TCL_ERROR;
            }
        }
        tmpPtr = Tcl_ObjSetVar2(interp, tkoPtr->Obj_tko__option, namePtr, dictPtr, TCL_GLOBAL_ONLY);
        Tcl_DecrRefCount(dictPtr);
        Tcl_DecrRefCount(namePtr);
        if (tmpPtr == NULL) {
            return TCL_ERROR;
        }
        return TCL_OK;
    case MY_OPTIONSHOW: /* Show given options or return all hidden options */
        if (objc < 3) {
            Tcl_WrongNumArgs(interp, 2, objv, "::classname ?-option? ..");
            return TCL_ERROR;
        }
        /* Create fqn classname */
        ch = Tcl_GetStringFromObj(objv[2], &length);
        if (length < 2 || ch[0] != ':') {
            namePtr = Tcl_ObjPrintf("::%s", Tcl_GetString(objv[2]));
        }
        else {
            namePtr = objv[2];
        }
        Tcl_IncrRefCount(namePtr);
        dictPtr = Tcl_ObjGetVar2(interp, tkoPtr->Obj_tko__option, namePtr, TCL_GLOBAL_ONLY);
        if (dictPtr == NULL) {
            Tcl_DecrRefCount(namePtr);
            return TCL_ERROR;
        }
        /* return list of show'able options */
        if (objc == 3) {
            /* return list of visible options */
            if (Tcl_DictObjFirst(interp, dictPtr, &search,
                &key, &value, &done) != TCL_OK) {
                Tcl_DecrRefCount(namePtr);
                return TCL_ERROR;
            }
            listPtr = Tcl_NewListObj(0, NULL);
            for (; !done; Tcl_DictObjNext(&search, &key, &value, &done)) {
                Tcl_ListObjGetElements(interp, value, &argObjc, &argObjv);
                if (argObjc == 2) {
                    if (WidgetFlagsHideGet(argObjv[1]) == 1) {
                        Tcl_ListObjAppendElement(interp, listPtr, key);
                    }
                } else if (argObjc == 4) {
                    if (WidgetFlagsHideGet(argObjv[3]) == 1) {
                        Tcl_ListObjAppendElement(interp, listPtr, key);
                    }
                }
            }
            Tcl_DictObjDone(&search);
            Tcl_SetObjResult(interp, listPtr);
            Tcl_DecrRefCount(namePtr);
            return TCL_OK;
        }
        /* show given options */
        dictPtr = Tcl_DuplicateObj(dictPtr);
        Tcl_IncrRefCount(dictPtr);
        for (i = 3; i < objc; i++) {
            if (Tcl_DictObjGet(interp, dictPtr, objv[i], &listPtr) != TCL_OK
                || listPtr == NULL) {
                Tcl_SetObjResult(interp, Tcl_ObjPrintf("unknown option: %s",
                    Tcl_GetString(objv[i])));
                Tcl_DecrRefCount(dictPtr);
                Tcl_DecrRefCount(namePtr);
                return TCL_ERROR;
            }
            Tcl_ListObjGetElements(interp, listPtr, &argObjc, &argObjv);
            switch (argObjc) {
            case 1: /* already visible */
                continue;
            case 2:
                listPtr = Tcl_NewListObj(0, NULL);
                Tcl_ListObjAppendElement(interp, listPtr, argObjv[0]);
                Tcl_ListObjAppendElement(interp, listPtr, WidgetFlagsHideUnset(argObjv[1]));
                break;
            case 3: /* already visible */
                continue;
            case 4:
                listPtr = Tcl_NewListObj(0, NULL);
                Tcl_ListObjAppendElement(interp, listPtr, argObjv[0]);
                Tcl_ListObjAppendElement(interp, listPtr, argObjv[1]);
                Tcl_ListObjAppendElement(interp, listPtr, argObjv[2]);
                Tcl_ListObjAppendElement(interp, listPtr, WidgetFlagsHideUnset(argObjv[3]));
                continue;
            default: /* ignore internal error */
                continue;
            }
            if (Tcl_DictObjPut(interp, dictPtr, objv[i], listPtr) != TCL_OK) {
                Tcl_DecrRefCount(dictPtr);
                Tcl_DecrRefCount(namePtr);
                return TCL_ERROR;
            }
        }
        tmpPtr = Tcl_ObjSetVar2(interp, tkoPtr->Obj_tko__option, namePtr, dictPtr, TCL_GLOBAL_ONLY);
        Tcl_DecrRefCount(dictPtr);
        Tcl_DecrRefCount(namePtr);
        if (tmpPtr == NULL) {
            return TCL_ERROR;
        }
        return TCL_OK;
    }
    return TCL_ERROR;
}

/*
* WidgetMethod_tko --
*    Implementation of the "my _tko" method.
*    Configuration of widget object options.
*
* Results:
*    A standard Tcl result.
*
* Side effects:
*/
static int WidgetMethod_tko(
    ClientData dummy,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[])
{
    static const char *const myOptions[] = {
        "optionadd", "optiondel",
        "optionhide", "optionshow",NULL
    };
    enum options {
        MY_OPTIONADD, MY_OPTIONDEL,
        MY_OPTIONHIDE, MY_OPTIONSHOW
    };
    int index;
    Tcl_Obj *listPtr;
    int i;
    Tko_Widget *widget;
    int skip;
    Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    WidgetOption *optionPtr;
    Tcl_Obj *myCmd[6];
    Tcl_Object object;
    int argObjc;
    Tcl_Obj **argObjv;
    TkoThreadData *tkoPtr = (TkoThreadData *)Tcl_GetThreadData(&tkoKey, sizeof(TkoThreadData));
    (void)dummy;

    widget = (Tko_Widget *) Tko_WidgetClientData(context);
    if (widget == NULL || widget->myCmd == NULL) {
        return TCL_ERROR;
    }
    skip = Tcl_ObjectContextSkippedArgs(context);

    if (objc-skip <= 0) {
        Tcl_WrongNumArgs(interp, objc, objv, "option ?arg ...?");
        return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObjStruct(interp, objv[skip], myOptions,
        sizeof(char *), "option", 0, &index) != TCL_OK) {
        return TCL_ERROR;
    }

    switch ((enum options) index) {
    case MY_OPTIONADD:
        if (objc - skip != 3 && objc - skip != 4) {
            Tcl_WrongNumArgs(interp, skip + 1, objv,
                "-option definitionlist ?body?");
        }
        /* Check definition list */
        if (Tcl_ListObjGetElements(interp, objv[skip + 2], &argObjc, &argObjv) != TCL_OK) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("no definition list: %s {%s}",
                Tcl_GetString(objv[skip+1]), Tcl_GetString(objv[skip+2])));
            return TCL_ERROR;
        }
        /* Add body if given. */
        if (objc - skip == 4) {
            object = Tcl_ObjectContextObject(context);
            if (object == NULL) return TCL_ERROR;
            myCmd[0] = tkoPtr->Obj_oo_objdefine;
            myCmd[1] = Tcl_GetObjectName(interp, object);
            myCmd[2] = tkoPtr->Obj_method;
            myCmd[3] = objv[skip + 1];
            myCmd[4] = tkoPtr->Obj_empty;
            myCmd[5] = objv[skip + 3];
            if (Tcl_EvalObjv(interp, 6, myCmd, TCL_EVAL_GLOBAL) != TCL_OK) {
                return TCL_ERROR;
            }
        }
        switch (argObjc) {
        case 2: /* synonym flags */
            return (WidgetOptionAdd(interp, widget, objv[skip+1], argObjv[0], NULL, NULL, argObjv[1], NULL, 0));
        case 4: /* dbname dbclass default flags */
            return (WidgetOptionAdd(interp, widget, objv[skip+1], argObjv[0], argObjv[1], argObjv[2], argObjv[3], NULL, 0));
        }
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("wrong definition list: %s {%s}",
                Tcl_GetString(objv[skip+1]), Tcl_GetString(objv[skip+2])));
        return TCL_ERROR;
    case MY_OPTIONDEL: /* delete object options */
        for (i= skip+1; i<objc; i++) {
            entryPtr =
                Tcl_FindHashEntry(widget->optionsTable,
                    Tk_GetUid(Tcl_GetString(objv[i])));
            if (entryPtr == NULL) {
                Tcl_SetObjResult(interp,
                    Tcl_ObjPrintf("unknown option \"%s\"", Tcl_GetString(objv[i])));
                return TCL_ERROR;
            }
            /* delete with no additional check on synonym option */
            Tcl_UnsetVar2(interp, Tcl_GetString(widget->optionsArray),
                Tcl_GetString(objv[i]), TCL_GLOBAL_ONLY);
            WidgetOptionDelEntry(entryPtr);
        }
        return TCL_OK;
    case MY_OPTIONHIDE:
        /* Without args return all not hidden options */
        if ((objc - skip) == 1) {
            listPtr = Tcl_NewListObj(0,NULL);
            entryPtr = Tcl_FirstHashEntry(widget->optionsTable, &search);
            while (entryPtr != NULL) {
                optionPtr = (WidgetOption *)Tcl_GetHashValue(entryPtr);
                entryPtr = Tcl_NextHashEntry(&search);
                if ((optionPtr->flagbits&TKO_OPTION_HIDE)==0) {
                    Tcl_ListObjAppendElement(interp, listPtr, optionPtr->option);
                }
            }
            Tcl_SetObjResult(interp, listPtr);
            return TCL_OK;
        }
        /* Hide given options */
        skip++;
        while (skip < objc) {
            entryPtr = Tcl_FindHashEntry(widget->optionsTable,
                Tk_GetUid(Tcl_GetString(objv[skip])));
            if (entryPtr == NULL) {
                Tcl_SetObjResult(interp,
                    Tcl_ObjPrintf("unknown option \"%s\"", Tcl_GetString(objv[skip])));
                return TCL_ERROR;
            }
            optionPtr = (WidgetOption *)Tcl_GetHashValue(entryPtr);
            optionPtr->flagbits |= TKO_OPTION_HIDE;
            skip++;
        }
        return TCL_OK;
    case MY_OPTIONSHOW:
        /* Without args return all hidden options */
        if ((objc - skip) == 1) {
            listPtr = Tcl_NewObj();
            entryPtr = Tcl_FirstHashEntry(widget->optionsTable, &search);
            while (entryPtr != NULL) {
                optionPtr = (WidgetOption *)Tcl_GetHashValue(entryPtr);
                entryPtr = Tcl_NextHashEntry(&search);
                if (optionPtr->flagbits & TKO_OPTION_HIDE) {
                    Tcl_ListObjAppendElement(interp, listPtr, optionPtr->option);
                }
            }
            Tcl_SetObjResult(interp, listPtr);
            return TCL_OK;
        }
        /* Show given options */
        skip++;
        while (skip < objc) {
            entryPtr = Tcl_FindHashEntry(widget->optionsTable,
                Tk_GetUid(Tcl_GetString(objv[skip])));
            if (entryPtr == NULL) {
                Tcl_SetObjResult(interp,
                    Tcl_ObjPrintf("unknown option \"%s\"", Tcl_GetString(objv[skip])));
                return TCL_ERROR;
            }
            optionPtr = (WidgetOption *)Tcl_GetHashValue(entryPtr);
            optionPtr->flagbits &= ~TKO_OPTION_HIDE;
            skip++;
        }
        return TCL_OK;
    }
    return TCL_OK;
}


/*
* Tko_Init --
*    Initialize tko widgets.
*
* Results:
*    A standard Tcl result.
*
* Side effects:
*    Create available oo::class tko widgets.
*/
int
Tko_Init(
    Tcl_Interp * interp /* Tcl interpreter. */)
{
    /* Create common tko variables. */
    /* tko::_eventoption according library/ttk.tcl proc ttk::ThemeChanged */
    static const char initScript[] =
        "namespace eval ::tko {}\n"
        "array set ::tko::_option {}\n"
        "set ::tko::_unknown [list self method unknown {pathName args} {\n"
        " tailcall [[self] create ::$pathName {*}$args] configure .\n"
        "}]\n"
        "proc ::tko::_eventoption {} {\n"
        " set l .\n"
        " while {[llength $l]} {\n"
        "  set l1 [list]\n"
        "  foreach w $l {\n"
        "   event generate $w <<TkoEventOption>>\n"
        "   foreach c [winfo children $w] {\n"
        "    lappend l1 $c\n"
        "   }\n"
        "  }\n"
        "  set l $l1\n"
        " }\n"
        "}\n"
        "proc ::tko::_initwrap {class widget ro ml} {\n"
        " catch {destroy .__tko__}\n"
        " set myConf [[$widget .__tko__] configure]\n"
        " destroy .__tko__\n"
        " foreach myCmd $ml {\n"
        "  if {$myCmd in {cget configure}} continue\n"
        "  uplevel 1 [list method $myCmd args \"\\$tko(..) $myCmd {*}\\$args\"]\n"
        " }\n"
        " foreach myList $myConf {\n"
        "  lassign $myList o n c d\n"
        "  switch [llength $myList] {\n"
        "   2 {::tko optiondef $class $o [list $n {}]}\n"
        "   5 {if {$o in $ro} {set f r} else {set f {}}\n"
        "    ::tko optiondef $class $o [list $n $c $d $f ] \"\\$tko(..) configure $o \\$tko($o) ; set tko($o) \\[\\$tko(..) cget $o\\]\"\n"
        "   }\n"
        "  }\n"
        " }\n"
        "}";
    TkoThreadData *tkoPtr = (TkoThreadData *)Tcl_GetThreadData(&tkoKey, sizeof(TkoThreadData));

    /* Needed oo extension */
    if (Tcl_OOInitStubs(interp) == NULL) {
        return TCL_ERROR;
    }
    /*
    * Create tko namespace and data
    */
    if (Tcl_Eval(interp, initScript) != TCL_OK) {
        return TCL_ERROR;
    }

    /*
     * Constants
     */
    tkoPtr->Uid_class = Tk_GetUid("-class");
    tkoPtr->Uid_empty = Tk_GetUid("");
    Tcl_IncrRefCount((tkoPtr->Obj_empty = Tcl_NewStringObj("", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_tko__option =
        Tcl_NewStringObj("::tko::_option", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_tko__eventoption =
        Tcl_NewStringObj("::tko::_eventoption", -1)));
    /* Internally visible */
    Tcl_IncrRefCount((tkoPtr->Obj_next = Tcl_NewStringObj("next", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_uplevel = Tcl_NewStringObj("::uplevel", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_oo_define =
        Tcl_NewStringObj("::oo::define", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_oo_objdefine =
        Tcl_NewStringObj("::oo::objdefine", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_method = Tcl_NewStringObj("method", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj__tko_configure =
        Tcl_NewStringObj("_tko_configure", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj__tko =
        Tcl_NewStringObj("_tko", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_cget =
        Tcl_NewStringObj("cget", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_configure =
        Tcl_NewStringObj("configure", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_tko = Tcl_NewStringObj("::tko", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_tko_widget =
        Tcl_NewStringObj("::tko::widget", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_lsort = Tcl_NewStringObj("::lsort", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_point = Tcl_NewStringObj(".", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_point2 = Tcl_NewStringObj("..", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj__screen = Tcl_NewStringObj("-screen", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_flags_r = Tcl_NewStringObj("r", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_flags_rh = Tcl_NewStringObj("rh", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_flags_h = Tcl_NewStringObj("h", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_rename = Tcl_NewStringObj("rename", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_tko__self = Tcl_NewStringObj("::tko::_self", -1)));
    /* commands */
    Tcl_CreateObjCommand(interp, "::tko", Tko_TkoObjCmd, NULL, NULL);

    if (Tko_FrameInit(interp) != TCL_OK) {
        return TCL_ERROR;
    }
/* TODO */
#ifdef USE_RBC
    if (Tko_GraphInit(interp) != TCL_OK) {
        return TCL_ERROR;
    }
    if (Tko_VectorInit(interp) != TCL_OK) {
        return TCL_ERROR;
    }
#endif
    return TCL_OK;
}

/*
 * Tko_WidgetClassDefine --
 *    Create a new tko widget class.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    Create new class with methods and option defines.
 */
int
Tko_WidgetClassDefine(
    Tcl_Interp * interp,
    Tcl_Obj * classname,
    const Tcl_MethodType * methods,
    const Tko_WidgetOptionDefine * options)
{
    Tcl_Class clazz;
    Tcl_Object object;
    Tcl_Obj *listPtr;
    Tcl_Obj *optionPtr;
    Tcl_Obj *tmpObj;
    Tcl_Obj *dictPtr;
    WidgetClientdata *clientdata;
    int i;
    TkoThreadData *tkoPtr = (TkoThreadData *)Tcl_GetThreadData(&tkoKey, sizeof(TkoThreadData));

    if (classname == NULL) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("missing class name"));
        return TCL_ERROR;
    }
    /*
     * Create widget class.
     */
    tmpObj = Tcl_ObjPrintf("::oo::class create %s {unexport destroy; variable tko; {*}$::tko::_unknown}", Tcl_GetString(classname));
    Tcl_IncrRefCount(tmpObj);
    if (Tcl_GlobalEval(interp, Tcl_GetString(tmpObj)) != TCL_OK) {
        Tcl_DecrRefCount(tmpObj);
        return TCL_ERROR;
    }
    Tcl_DecrRefCount(tmpObj);

    /* Get class object */
    if ((object = Tcl_GetObjectFromObj(interp, classname)) == NULL
        || (clazz = Tcl_GetObjectAsClass(object)) == NULL) {
        return TCL_ERROR;
    }

    /*
     * Add methods
     */
    if(methods) {
        /* constructor */
        if(methods[0].name == NULL && methods[0].callProc) {
            Tcl_ClassSetConstructor(interp, clazz,
                Tcl_NewMethod(interp, clazz, NULL, 1, &methods[0], NULL));
        }
        /* destructor */
        if(methods[1].name == NULL && methods[1].callProc) {
            Tcl_ClassSetDestructor(interp, clazz,
                Tcl_NewMethod(interp, clazz, NULL, 1, &methods[1], NULL));
        }
        /* our own methods */
        Tcl_NewMethod(interp, clazz, tkoPtr->Obj_cget, 1, &tkoWidgetMethods[3], NULL);
        Tcl_NewMethod(interp, clazz, tkoPtr->Obj_configure, 1, &tkoWidgetMethods[4], NULL);
        Tcl_NewMethod(interp, clazz, tkoPtr->Obj__tko_configure, 0, &tkoWidgetMethods[5], NULL);
        Tcl_NewMethod(interp, clazz, tkoPtr->Obj__tko, 0, &tkoWidgetMethods[6], NULL);
        /* public */
        for(i = 2; methods[i].name != NULL; i++) {
            tmpObj = Tcl_NewStringObj(methods[i].name, -1);
            Tcl_IncrRefCount(tmpObj);
            Tcl_NewMethod(interp, clazz, tmpObj, 1, &methods[i], NULL);
            Tcl_DecrRefCount(tmpObj);
        }
        i++;
        /* private */
        for(; methods[i].name != NULL; i++) {
            tmpObj = Tcl_NewStringObj(methods[i].name, -1);
            Tcl_IncrRefCount(tmpObj);
            Tcl_NewMethod(interp, clazz, tmpObj, 0, &methods[i], NULL);
            Tcl_DecrRefCount(tmpObj);
        }
    }
    /*
     *Add options
     */
    if(options) {
        /* get dict variable */
        dictPtr = Tcl_ObjGetVar2(interp, tkoPtr->Obj_tko__option, classname,
            TCL_GLOBAL_ONLY);
        if (dictPtr == NULL) {
            dictPtr = Tcl_NewDictObj();
        }
        else {
            dictPtr = Tcl_DuplicateObj(dictPtr);
        }
        Tcl_IncrRefCount(dictPtr);
        /* Loop over all option definitions */
        for(i = 0;; i++) {
            /* test on end of options */
            if (options[i].option == NULL) {
                break;
            }
            /* test option name starting with "-" */
            if (options[i].option[0] != '-') {
                Tcl_SetObjResult(interp, Tcl_ObjPrintf("wrong option name: %s",
                    options[i].option));
                Tcl_DecrRefCount(dictPtr);
                return TCL_ERROR;
            }
            /* we need at least an synonym name here */
            if(options[i].dbname == NULL) {
                Tcl_SetObjResult(interp,
                    Tcl_ObjPrintf("wrong option definition: %d", i));
                Tcl_DecrRefCount(dictPtr);
                return TCL_ERROR;
            }
            /* no dbclass means synonym option definition */
            if (options[i].dbclass == NULL || options[i].dbclass[0] == '\0') {
                /* test synonym option starting with "-" */
                if (options[i].dbname[0] != '-') {
                    Tcl_SetObjResult(interp, Tcl_ObjPrintf("wrong synonym name: %s",
                        options[i].dbname));
                    Tcl_DecrRefCount(dictPtr);
                    return TCL_ERROR;
                }
            }
            /* we build all options with {dbname dbclass defvalue flag} */
            optionPtr = Tcl_NewStringObj(options[i].option, -1);
            Tcl_IncrRefCount(optionPtr);
            listPtr = Tcl_NewListObj(0, NULL);
            Tcl_ListObjAppendElement(interp, listPtr,
                Tcl_NewStringObj(options[i].dbname, -1));
            /* only if not synonym option */
            if (options[i].dbclass != NULL) {
                Tcl_ListObjAppendElement(interp, listPtr,
                    Tcl_NewStringObj(options[i].dbclass, -1));
                if (options[i].defvalue == NULL) {
                    Tcl_ListObjAppendElement(interp, listPtr, tkoPtr->Obj_empty);
                }
                else {
                    Tcl_ListObjAppendElement(interp, listPtr,
                        Tcl_NewStringObj(options[i].defvalue, -1));
                }
            }
            /* always add flags */
            if (options[i].flags & TKO_OPTION_READONLY) {
                if (options[i].flags & TKO_OPTION_HIDE) {
                    Tcl_ListObjAppendElement(interp, listPtr, tkoPtr->Obj_flags_rh);
                }
                Tcl_ListObjAppendElement(interp, listPtr, tkoPtr->Obj_flags_r);
            }
            else if (options[i].flags & TKO_OPTION_HIDE) {
                Tcl_ListObjAppendElement(interp, listPtr, tkoPtr->Obj_flags_h);
            }
            else {
                Tcl_ListObjAppendElement(interp, listPtr, tkoPtr->Obj_empty);
            }
            if (Tcl_DictObjPut(interp, dictPtr, optionPtr, listPtr) != TCL_OK) {
                Tcl_DecrRefCount(optionPtr);
                Tcl_DecrRefCount(dictPtr);
                return TCL_ERROR;
            }
            /*
             * Now we create the necessary -option method if provided.
             * If given we create the -option method with the given method.
             * Or we use the internal implementation of a given type.
             * If none of the above are provided it is up to the caller
             * to create the necessary -option method.
             */
            if (options[i].method != NULL || options[i].type >= 0) {
                clientdata = (WidgetClientdata *)ckalloc(sizeof(WidgetClientdata));
                assert(clientdata);
                clientdata->method.version = TCL_OO_METHOD_VERSION_CURRENT;
                clientdata->method.name = options[i].option;
                if (options[i].method != NULL) {
                    clientdata->method.callProc = options[i].method;
                }
                else {
                    clientdata->method.callProc = WidgetMethod_;
                }
                clientdata->method.deleteProc = WidgetClientdataDelete;
                clientdata->method.cloneProc = WidgetClientdataClone;
                clientdata->option = optionPtr;/* we do not decrement here */
                clientdata->offset = options[i].offset;
                clientdata->type = options[i].type;
                clientdata->flags = options[i].flags;
                Tcl_NewMethod(interp, clazz, optionPtr, 0, &clientdata->method,
                    (ClientData) clientdata);
            }
            else {
                Tcl_DecrRefCount(optionPtr);
            }
        }
        if (Tcl_ObjSetVar2(interp, tkoPtr->Obj_tko__option, classname, dictPtr,
            TCL_GLOBAL_ONLY) == 0) {
            Tcl_DecrRefCount(dictPtr);
            return TCL_ERROR;
        }
        Tcl_DecrRefCount(dictPtr);
    }
    return TCL_OK;
}

/*
* WidgetDestructor --
*
* Results:
*    A standard Tcl result.
*
* Side effects:
*  Delete widget ressources.
*/
static int
WidgetDestructor(
    ClientData dummy,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[])
{
    Tko_Widget *widget;
    (void)dummy;
    (void)interp;
    (void)objc;
    (void)objv;

    if ((widget = (Tko_Widget *)Tko_WidgetClientData(context)) != NULL) {
        Tcl_Preserve(widget);
        Tko_WidgetDestroy(context);
        Tcl_Release(widget);
    }
    return TCL_OK;
}

/*
* WidgetClassConstructor --
*    Create a new tko class object with common methods.
*
* Results:
*    A standard Tcl result.
*
* Side effects:
*    Create new object with methods and option defines.
 */
static int
WidgetClassConstructor(
    ClientData dummy,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[])
{
    Tcl_Object object;
    Tko_Widget *widget;
    Tcl_Obj *myArglist;
    int skip;
    (void)dummy;

    /* Get current object. Should not fail? */
    if ((object = Tcl_ObjectContextObject(context)) == NULL) {
        return TCL_ERROR;
    }

    /* Create and initialize internal widget structure */
    widget = (Tko_Widget *)ckalloc(sizeof(Tko_Widget));
    assert(widget);
    memset(widget, 0, sizeof(Tko_Widget));

    skip = Tcl_ObjectContextSkippedArgs(context);
    if (objc - skip > 0) {
        myArglist = Tcl_NewListObj(objc - skip, &objv[skip]);
    }
    else {
        myArglist = Tcl_NewListObj(0,NULL);
    }
    Tcl_IncrRefCount(myArglist);
    if (Tko_WidgetCreate(widget, interp, object, TKO_CREATE_CLASS,
        myArglist) != TCL_OK) {
        Tcl_DecrRefCount(myArglist);
        return TCL_ERROR;
    }
    Tcl_DecrRefCount(myArglist);
    return TCL_OK;
}

/*
* WidgetWrapConstructor --
*    Create a new tko widget object with wrapping of the given widget command.
*
* Results:
*    A standard Tcl result.
*
* Side effects:
*    Create new object with methods and option defines.
*/
static int
WidgetWrapConstructor(
    ClientData dummy,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[])
{
    Tcl_Object object;
    Tko_Widget *widget;
    Tcl_Obj *myArglist;
    int skip;
    const char *ch;
    int length;
    Tk_Window tkWin;
    Tk_Window tkWinTmp; /* tmp. created window to get Tk_Window from embedded window */
    Tcl_Obj *tmpPtr; /* tmp. string for evaluating code */
    (void)dummy;

                     /* Get current object. Should not fail? */
    if ((object = Tcl_ObjectContextObject(context)) == NULL) {
        return TCL_ERROR;
    }
    /* Check widget name on "::.*" */
    ch = NULL;
    if ((tmpPtr = Tcl_GetObjectName(interp, object)) == NULL
        || (ch = TclGetStringFromObj(tmpPtr, &length)) == NULL
        || length < 4 || ch[0] != ':' || ch[1] != ':' || ch[2] != '.') {
        if (ch == NULL) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("no pathName"));
        }
        else {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("wrong pathName: %s", ch));
        }
        return TCL_ERROR;
    }

    /*
    * Get real widget Tk_Window.
    */
    tmpPtr = Tcl_NewStringObj(&ch[2], length - 2);
    Tcl_AppendToObj(tmpPtr, ".1", 2);
    Tcl_IncrRefCount(tmpPtr);
    tkWinTmp = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp), Tcl_GetString(tmpPtr), NULL);
    Tcl_DecrRefCount(tmpPtr);
    if (tkWinTmp == NULL) {
        return TCL_ERROR;
    }
    tkWin = Tk_NameToWindow(interp, &ch[2], tkWinTmp);
    Tk_DestroyWindow(tkWinTmp);
    if (tkWin == NULL) {
        return TCL_ERROR;
    }

    /* Create and initialize internal widget structure */
    widget = (Tko_Widget *)ckalloc(sizeof(Tko_Widget));
    assert(widget);
    memset(widget, 0, sizeof(Tko_Widget));
    widget->tkWin = tkWin;

    skip = Tcl_ObjectContextSkippedArgs(context);
    if (objc - skip > 0) {
        myArglist = Tcl_NewListObj(objc - skip, &objv[skip]);
    }
    else {
        myArglist = Tcl_NewListObj(0, NULL);
    }
    Tcl_IncrRefCount(myArglist);
    if (Tko_WidgetCreate(widget, interp, object, TKO_CREATE_WRAP,
        myArglist) != TCL_OK) {
        Tcl_DecrRefCount(myArglist);
        return TCL_ERROR;
    }
    Tcl_DecrRefCount(myArglist);
    return TCL_OK;
}

/*
 * Tko_WidgetCreate --
 *    Create new tko object.
 *    A check on the correct name of the object should be done in the calling function.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    Can create new widget.
 */
int
Tko_WidgetCreate(
    ClientData clientdata, /* pointer to Tko_Widget structure */
    Tcl_Interp * interp,
    Tcl_Object object,
    Tko_WidgetCreateMode createmode, /* */
    Tcl_Obj *arglist) /* -value option .. list, used options will be removed */
{
    Tko_Widget *widget;
    char *nsPtr;
    int argSize;
    Tcl_Obj *classObj;
    Tcl_Obj *optionList;
    Tcl_Obj *tmpObj;
    Tcl_Obj **optionObjv;
    int optionObjc;
    Tcl_Obj **argObjv;
    int argObjc;
    int index = 0; /* Index in option list */
    int ret;
    Tcl_Obj *value;
    Tcl_Obj *screen;
    char *ch;
    int length;
    Tcl_Obj *tmpPtr;
    int initmode=1;/* 1=own widget 2=wrapped widget */
    Tk_Window wrapWin = NULL;/* needed in error case */
    TkoThreadData *tkoPtr = (TkoThreadData *)Tcl_GetThreadData(&tkoKey, sizeof(TkoThreadData));

    /* This would be an internal programming error */
    if (clientdata == NULL) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("no widget data"));
        return TCL_ERROR;
    }
    /* Check name starting with "::" */
    if ((tmpPtr = Tcl_GetObjectName(interp, object)) == NULL
        || (ch = TclGetStringFromObj(tmpPtr, &length)) == NULL
        || length < 3 || ch[0] != ':' || ch[1] != ':') {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("no object"));
        return TCL_ERROR;
    }

    /* Add widget to metadata so it can be released  */
    Tcl_ObjectSetMetadata(object, &tkoWidgetMeta, clientdata);

    /*
    * Initialize internal widget strucure.
    */
    widget = (Tko_Widget *)clientdata;
    widget->interp = interp;
    widget->object = object;
    widget->optionsTable = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
    Tcl_InitHashTable(widget->optionsTable, TCL_ONE_WORD_KEYS);
    widget->widgetCmd = Tcl_GetObjectCommand(object);
    /* Create option array variable */
    nsPtr = Tcl_GetObjectNamespace(object)->fullName;
    widget->optionsArray = Tcl_ObjPrintf("%s::tko", nsPtr);
    Tcl_IncrRefCount(widget->optionsArray);
    /* Create my command */
    widget->myCmd = Tcl_ObjPrintf("%s::my", nsPtr);
    Tcl_IncrRefCount(widget->myCmd);

    if (createmode == TKO_CREATE_WRAP) {
        wrapWin = widget->tkWin;
        widget->tkWin = NULL;
    }

    /*
    * Get options from outermost class.
    */
    classObj = Widget_GetClassName(interp, object);
    if (classObj == NULL) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("no class name"));
        goto error;
    }
    optionList = Tcl_ObjGetVar2(interp, tkoPtr->Obj_tko__option, classObj, TCL_GLOBAL_ONLY);
    if (optionList == NULL) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("no option definitions"));
        goto error;
    }
    if (Tcl_ListObjGetElements(interp, optionList, &optionObjc, &optionObjv) != TCL_OK
        || optionObjc % 2 != 0) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("wrong option definitions"));
        goto error;
    }

    /* Convert argument list in dictionary */
    if (Tcl_DictObjSize(interp, arglist, &argSize) != TCL_OK) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not get arglist"));
        goto error;
    }

    /*
     * Do some initialization depending on the given createmode.
     */
    switch (createmode) {
    case TKO_CREATE_CLASS:
        widget->tkWin = NULL;
        break;
    case TKO_CREATE_TOPLEVEL:
        /* Check name starting with "::." */
        if (ch[2] != '.') {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("wrong pathName: %s", ch));
            goto error;
        }
        if (optionObjc < 2) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("missing option definitions"));
            goto error;
        }
        /* The "-screen" option definition should be the first option in toplevels. */
        screen = NULL;
        /* -screen option should be first */
        if (strncmp("-screen", Tcl_GetString(optionObjv[0]), 8) != 0) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("missing -screen option"));
            goto error;
        }
        /* we only check argument number and assume readonly flag */
        if (Tcl_ListObjGetElements(interp, optionObjv[1], &argObjc, &argObjv) != TCL_OK
            || argObjc != 4) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("wrong -screen option"));
            goto error;
        }
        /* Try to get value from command line or use default one. */
        Tcl_DictObjGet(interp, arglist, tkoPtr->Obj__screen, &screen);
        if (screen != NULL) {
            Tcl_DictObjRemove(interp, arglist, tkoPtr->Obj__screen);
            argSize--;
        }
        else {
            screen = argObjv[2];
        }
        Tcl_IncrRefCount(screen);
        widget->tkWin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp), &ch[2],
            Tcl_GetString(screen));
        if (widget->tkWin == NULL) {
            goto error;
        }
        Tk_MakeWindowExist(widget->tkWin);
        if ((widget->display = Tk_Display(widget->tkWin))==NULL) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not get display"));
            goto error;
        }
        /* When creating toplevels then check on "-screen" as first option. */
        ret = WidgetOptionAdd(interp, widget, optionObjv[0], argObjv[0],
            argObjv[1], argObjv[2], argObjv[3], screen, initmode);
        Tcl_DecrRefCount(screen);
        if (ret != TCL_OK) {
            goto error;
        }
        index = 2;
        break;
    case TKO_CREATE_WIDGET:
        /* Check name starting with "::." */
        if (ch[2] != '.') {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("wrong pathName: %s", ch));
            goto error;
        }
        widget->tkWin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp), &ch[2],
            NULL);
        if (widget->tkWin == NULL) {
            goto error;
        }
        Tk_MakeWindowExist(widget->tkWin);
        if ((widget->display = Tk_Display(widget->tkWin))==NULL) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not get display"));
            goto error;
        }
        if (optionObjc < 1) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("empty option definitions"));
            goto error;
        }
        break;
    case TKO_CREATE_WRAP:
        if (wrapWin == NULL) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("wrap widget not found"));
            goto error;
        }
        /* Check name starting with "::." */
        if (ch[2] != '.') {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("wrong pathName: %s", ch));
            goto error;
        }
        /* Set tko(..) to name of hidden widget */
        tmpObj = Tcl_ObjPrintf("::tko::%s", &ch[2]);
        Tcl_IncrRefCount(tmpObj);
        if (Tcl_ObjSetVar2(interp, widget->optionsArray, tkoPtr->Obj_point2,
            tmpObj, TCL_GLOBAL_ONLY) == NULL) {
            Tcl_DecrRefCount(tmpObj);
            goto error;
        }
        Tcl_DecrRefCount(tmpObj);
        if ((widget->display = Tk_Display(wrapWin))==NULL) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not get display"));
            goto error;
        }
        widget->tkWin = wrapWin;
        wrapWin = NULL;
        initmode = 2;
        break;
    default:
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("wrong internal create mode"));
        goto error;
    }
    /* Set tko(.) to name of widget or class */
    if (Tcl_ObjSetVar2(interp, widget->optionsArray, tkoPtr->Obj_point,
        Tcl_NewStringObj(&ch[2], length - 2), TCL_GLOBAL_ONLY) == NULL) {
        goto error;
    }

    /*
     * When creating widgets then "-class" option should be first option now.
     * It's value is needed to get option informations from option database.
     */
    if (createmode == TKO_CREATE_TOPLEVEL || createmode == TKO_CREATE_WIDGET) {
        ch = Tcl_GetStringFromObj(optionObjv[index], &length);
        if (strncmp(ch, "-class", length) != 0) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("missing -class option"));
            goto error;
        }
    }
    /*
     * Add options.
     */
    for(; index < optionObjc; index=index+2) {
        if (Tcl_ListObjGetElements(interp, optionObjv[index+1], &argObjc, &argObjv) !=TCL_OK
            || argObjc < 1 || argObjc > 4) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("wrong option def: %s {%s}",
                    Tcl_GetString(optionObjv[index]),Tcl_GetString(optionObjv[index+1])));
            goto error;
        }
        Tcl_DictObjGet(interp, arglist, optionObjv[index], &value);
        if(value) {
            Tcl_IncrRefCount(value);
            Tcl_DictObjRemove(interp, arglist, optionObjv[index]);
            argSize--;
        }
        switch (argObjc) {
        case 2: /* synonym flags */
            ret = WidgetOptionAdd(interp, widget, optionObjv[index], argObjv[0],
                NULL, NULL, argObjv[1], value, initmode);
            break;
        case 4: /* dbname dbclass default flags */
            ret = WidgetOptionAdd(interp, widget, optionObjv[index], argObjv[0],
                argObjv[1], argObjv[2], argObjv[3], value, initmode);
            break;
        }
        if (value) {
            Tcl_DecrRefCount(value);
        }
        if (ret != TCL_OK) goto error;
    }
    if(argSize) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("unknown options: %s",
                Tcl_GetString(arglist)));
        goto error;
    }

    Tcl_TraceVar2(interp, Tcl_GetString(widget->optionsArray), NULL,
        TCL_TRACE_WRITES | TCL_TRACE_RESULT_OBJECT, WidgetOptionTrace, widget);

    if (widget->tkWin) {
        Tk_CreateEventHandler(widget->tkWin, StructureNotifyMask | VirtualEventMask,
            WidgetEventProc, (ClientData)widget);
    }

    return TCL_OK;

error:
    if (wrapWin) {
        tmpObj = Tcl_ObjPrintf("rename ::tko::%s {}", &ch[2]);
        Tcl_IncrRefCount(tmpObj);
        Tcl_EvalObjEx(interp, tmpObj, TCL_GLOBAL_ONLY);
        Tcl_DecrRefCount(tmpObj);
    }
    Tcl_DeleteCommandFromToken(interp, widget->widgetCmd);
    return TCL_ERROR;
}

/*
 * Tko_WidgetDestroy --
 *    Delete widget window and command.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    Delete widget ressources and remove widget window.
 */
void
Tko_WidgetDestroy(
    Tcl_ObjectContext context)
{
    Tko_Widget *widget;

    if ((widget = (Tko_Widget *)Tko_WidgetClientData(context)) == NULL) {
        return;
    }
    Tcl_Preserve(widget);
    if (widget->tkWin) {
        WidgetDeleteTkwin(widget);
    }
    if (widget->myCmd) {
        Tcl_DecrRefCount(widget->myCmd);
        widget->myCmd = NULL;
    }
    Tcl_ObjectSetMetadata(widget->object, &tkoWidgetMeta, NULL);
    Tcl_Release(widget);
    return;
}

/*
* Tko_WidgetClientData --
*    Return pointer to widget client data.
*
* Results:
*    None.
*
* Side effects:
*    None.
*/
ClientData Tko_WidgetClientData(
    Tcl_ObjectContext context)
{
    Tcl_Object object;
    if ((object = Tcl_ObjectContextObject(context)) == NULL) {
        return NULL;
    }
    return Tcl_ObjectGetMetadata(object, &tkoWidgetMeta);
}

/*
 * WidgetMetaDestroy --
 *    Free ressources.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Delete or give back all used internal ressources
 */
static void
WidgetMetaDestroy(
    Tko_Widget * widget)
{
    Tcl_HashSearch search;
    Tcl_HashEntry *entryPtr;

    entryPtr = Tcl_FirstHashEntry(widget->optionsTable, &search);
    while (entryPtr != NULL) {
        WidgetOptionDelEntry(entryPtr);
        entryPtr = Tcl_NextHashEntry(&search);
    }
    if (widget->optionsTable) {
        Tcl_DeleteHashTable(widget->optionsTable);
        ckfree(widget->optionsTable);
    }
    if (widget->optionsArray != NULL) {
        Tcl_DecrRefCount((widget->optionsArray));
        widget->optionsArray = NULL;
    }
    ckfree(widget);
}

/*
* WidgetDeleteTkwin --
*    Resets internal Tk_Window in widget structure.
*
* Results:
*    None.
*
* Side effects:
*    Delete event handler of widget.
*    When the widget is wrappen then delete wrap widget command.
*/
static void WidgetDeleteTkwin(
    Tko_Widget *widget)
{
    Tcl_Obj *tmpObj;
    TkoThreadData *tkoPtr = (TkoThreadData *)Tcl_GetThreadData(&tkoKey, sizeof(TkoThreadData));
    Tk_DeleteEventHandler(widget->tkWin, StructureNotifyMask | VirtualEventMask,
        WidgetEventProc, widget);
    tmpObj = Tcl_ObjGetVar2(widget->interp, widget->optionsArray, tkoPtr->Obj_point2, TCL_GLOBAL_ONLY);
    if (tmpObj) {
        tmpObj = Tcl_ObjPrintf("rename %s {}", Tcl_GetString(tmpObj));
        Tcl_IncrRefCount(tmpObj);
        Tcl_EvalObjEx(widget->interp, tmpObj,TCL_GLOBAL_ONLY);
        Tcl_DecrRefCount(tmpObj);
    }
    else {
        Tk_DestroyWindow(widget->tkWin);
    }
    widget->tkWin = NULL;
}

/*
* WidgetEventProc --
*    This function is invoked by the Tk dispatcher for various events on
*    canvases.
*
* Results:
*    None.
*
* Side effects:
*    When the window gets deleted, internal structures get cleaned up.
*/
static void
WidgetEventProc(
    ClientData clientData,     /* Information about window. */
    XEvent * eventPtr)
{              /* Information about event. */
    Tko_Widget *widget = (Tko_Widget *)clientData;

    switch (eventPtr->type) {
    case DestroyNotify:
        if (widget->tkWin) {
            WidgetDeleteTkwin(widget);
            Tcl_DeleteCommandFromToken(widget->interp, widget->widgetCmd);
        }
        if (widget->myCmd) {
            Tcl_DecrRefCount(widget->myCmd);
            widget->myCmd = NULL;
        }
        break;
    case VirtualEvent:
        if (widget->tkWin) {
            if (!strcmp("TkoEventOption", ((XVirtualEvent *)(eventPtr))->name)) {
                WidgetEventChanged(widget);
            }
        }
    }
}

/*
* WidgetEventChanged --
*    Reset all option with no TKO_OPTION_USER bit from option database.
*    canvases.
*
* Results:
*    None.
*
* Side effects:
*  Apply changed option database values.
*/
static void
WidgetEventChanged(
    Tko_Widget *widget)
{
    Tcl_HashSearch search;
    Tcl_HashEntry *entryPtr;
    WidgetOption *optionPtr;
    Tk_Uid valueUid;
    Tk_Uid dbnameUid;
    Tk_Uid dbclassUid;
    int changed;
    Tcl_Obj *defvalue;
    Tcl_Obj *myObjv[2];
    TkoThreadData *tkoPtr = (TkoThreadData *)Tcl_GetThreadData(&tkoKey, sizeof(TkoThreadData));

    if (widget->myCmd == NULL) return;
    Tcl_Preserve(widget);
    entryPtr = Tcl_FirstHashEntry(widget->optionsTable, &search);
    changed = 0;
    while (entryPtr != NULL) {
        optionPtr = (WidgetOption *)Tcl_GetHashValue(entryPtr);
        entryPtr = Tcl_NextHashEntry(&search);
        if (optionPtr->dbclass == NULL) continue;/* synonym option */
        if (optionPtr->dbname == tkoPtr->Obj_empty && optionPtr->dbclass == tkoPtr->Obj_empty) continue;
        if (optionPtr->flagbits & TKO_OPTION_READONLY) continue;/* readonly option */
        if (optionPtr->flagbits & TKO_OPTION__USER) continue;/* user changed option */
          /*
          * Get value from option database or
          * check for a system-specific default value.
          */
        dbnameUid = Tk_GetUid(Tcl_GetString(optionPtr->dbname));
        dbclassUid = Tk_GetUid(Tcl_GetString(optionPtr->dbclass));
        if ((valueUid = Tk_GetOption(widget->tkWin, dbnameUid, dbclassUid)) != NULL) {
            defvalue = Tcl_NewStringObj(valueUid, -1);
        }
        else {
            defvalue = Tk_GetSystemDefault(widget->tkWin, dbnameUid, dbclassUid);
            if (defvalue == NULL) continue;
        }
        Tcl_IncrRefCount(defvalue);
        /* No need to set same value again */
        if (strcmp(Tcl_GetString(defvalue), Tcl_GetString(optionPtr->value)) == 0) {
            Tcl_DecrRefCount(defvalue);
            continue;
        }
        /* Set new value */
        if (WidgetOptionSet(widget->interp, widget, optionPtr->option, defvalue) != TCL_OK) {
            Tcl_DecrRefCount(defvalue);
            optionPtr->flagbits &= ~TKO_OPTION__USER;/* reset option */
            continue; /* no additional error handling here */
        }
        Tcl_DecrRefCount(defvalue);
        changed++;
    }
    if (changed) {
        myObjv[0] = widget->myCmd;
        myObjv[1] = tkoPtr->Obj__tko_configure;
        if (Tcl_EvalObjv(widget->interp, 2, myObjv, TCL_EVAL_GLOBAL) != TCL_OK) {
            /* ignore errors */
        }
    }
    Tcl_Release(widget);
}

/*
 * WidgetMethod_cget --
 *    Tcl syntax: "widget cget -option".
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    Return option value in interpreter result.
 */
static int
WidgetMethod_cget(
    ClientData dummy,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[])
{
    Tko_Widget *widget;         /* widget. */
    int skip;
    (void)dummy;

    if ((widget = (Tko_Widget *)Tko_WidgetClientData(context)) == NULL
        || widget->myCmd == NULL) {
        return TCL_ERROR;
    }
    skip = Tcl_ObjectContextSkippedArgs(context);

    if(objc - skip != 1) {
        Tcl_WrongNumArgs(interp, skip, objv, "option");
        return TCL_ERROR;
    }
    return WidgetOptionGet(interp, widget, objv[skip]);
}

/*
 * WidgetMethod_configure --
 *    Tcl syntax:
 *        configure
 *        configure "-option"
 *        configure "-option value .."
 *        configure "add option dbname dbclass ?default?"
 *        configure "del option"
 *        configure "after"
 *    Changing of option values:
 *    1.    set tk(-option)
 *  2.    WidgetTraceOption()
 *    3.    "my -option $v .."
 *
 * Results:
 *    A standard Tcl result. Return result value in interpreter result.
 *
 * Side effects:
 *    Can add, delete or change options.
 */
static int
WidgetMethod_configure(
    ClientData dummy,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[])
{
    Tko_Widget *widget;         /* widget. */
    int skip;
    Tcl_Obj *myObjv[2];
    Tcl_HashSearch search;
    Tcl_HashEntry *entryPtr;
    WidgetOption *optionPtr;
    Tcl_Obj *retPtr;
    Tcl_Obj *listPtr;
    const char *ch;
    int length;
    int i;
    TkoThreadData *tkoPtr = (TkoThreadData *)Tcl_GetThreadData(&tkoKey, sizeof(TkoThreadData));
    (void)dummy;

    if ((widget = (Tko_Widget *)Tko_WidgetClientData(context)) == NULL
        || widget->myCmd == NULL) {
        return TCL_ERROR;
    }
    skip = Tcl_ObjectContextSkippedArgs(context);

    /* configure */
    if(objc - skip == 0) {
        retPtr = Tcl_NewObj();
        entryPtr = Tcl_FirstHashEntry(widget->optionsTable, &search);
        while(entryPtr != NULL) {
            optionPtr = (WidgetOption *) Tcl_GetHashValue(entryPtr);
            entryPtr = Tcl_NextHashEntry(&search);
            /* hidden option, not visible in configure method */
            if (optionPtr->flagbits&TKO_OPTION_HIDE) continue;
            listPtr = Tcl_NewObj();
            Tcl_ListObjAppendElement(interp, listPtr, optionPtr->option);
            Tcl_ListObjAppendElement(interp, listPtr, optionPtr->dbname);
            if (optionPtr->dbclass != NULL) {
                Tcl_ListObjAppendElement(interp, listPtr, optionPtr->dbclass);
                Tcl_ListObjAppendElement(interp, listPtr, optionPtr->defvalue);
                Tcl_ListObjAppendElement(interp, listPtr, optionPtr->value);
            }
            Tcl_ListObjAppendElement(interp, retPtr, listPtr);
        }
        /* Return sorted list */
        myObjv[0] = tkoPtr->Obj_lsort;
        myObjv[1] = retPtr;
        return (Tcl_EvalObjv(interp, 2, myObjv, TCL_EVAL_GLOBAL));
    }
    /* configure "-option ?value? .." */
    if(objc - skip == 1) {  /* configure -option */
        ch = Tcl_GetStringFromObj(objv[skip],&length);
        /* configure . */
        if(ch[0] == '.' && length == 1) {
            // collect all not readonly options and configure
            Tcl_Preserve(widget);
            myObjv[0] = widget->myCmd;
            entryPtr = Tcl_FirstHashEntry(widget->optionsTable, &search);
            while (entryPtr != NULL) {
                optionPtr = (WidgetOption *)Tcl_GetHashValue(entryPtr);
                entryPtr = Tcl_NextHashEntry(&search);
                if (optionPtr->dbclass == NULL) {    /* synonym option */
                    if (optionPtr->value) {
                        Tcl_ObjSetVar2(interp, widget->optionsArray,
                            optionPtr->dbname, optionPtr->value, TCL_GLOBAL_ONLY);
                        Tcl_DecrRefCount(optionPtr->value);
                        optionPtr->value = NULL;
                    }
                }
                else {    /* normal option */
                    if ((optionPtr->flagbits & TKO_OPTION_READONLY) == 0) {
                        myObjv[1] = optionPtr->option;
                        if (Tcl_EvalObjv(interp, 2, myObjv,
                            TCL_EVAL_GLOBAL) != TCL_OK) {
                            retPtr = Tcl_GetObjResult(interp);
                            Tcl_IncrRefCount(retPtr);
                            Tcl_Release(widget);
                            Tcl_DeleteCommandFromToken(interp, widget->widgetCmd);
                            Tcl_SetObjResult(interp, retPtr);
                            Tcl_DecrRefCount(retPtr);
                            return TCL_ERROR;
                        }
                    }
                }
            }
            myObjv[1] = tkoPtr->Obj__tko_configure;
            if (Tcl_EvalObjv(interp, 2, myObjv, TCL_EVAL_GLOBAL) != TCL_OK) {
                retPtr = Tcl_GetObjResult(interp);
                Tcl_IncrRefCount(retPtr);
                Tcl_Release(widget);
                Tcl_DeleteCommandFromToken(interp, widget->widgetCmd);
                Tcl_SetObjResult(interp, retPtr);
                Tcl_DecrRefCount(retPtr);
                return TCL_ERROR;
            }
            Tcl_Release(widget);
            Tcl_SetObjResult(interp, Tcl_ObjGetVar2(interp, widget->optionsArray, tkoPtr->Obj_point, TCL_GLOBAL_ONLY));
            return TCL_OK;
        }
        entryPtr =
            Tcl_FindHashEntry(widget->optionsTable,
            Tk_GetUid(Tcl_GetString(objv[skip])));
        if(entryPtr == NULL) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("unknown option \"%s\"",
                Tcl_GetString(objv[skip])));
            return TCL_ERROR;
        }
        optionPtr = (WidgetOption *) Tcl_GetHashValue(entryPtr);
        /* hidden option, not visible in configure method */
        if (optionPtr->flagbits&TKO_OPTION_HIDE) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("hidden option \"%s\"",
                Tcl_GetString(objv[skip])));
            return TCL_ERROR;
        }
        if (optionPtr->dbclass == NULL) {
            entryPtr =
                Tcl_FindHashEntry(widget->optionsTable,
                Tk_GetUid(Tcl_GetString(optionPtr->dbname)));
            if(entryPtr == NULL) {
                Tcl_SetObjResult(interp,
                    Tcl_ObjPrintf("unknown option \"%s\"",
                    Tcl_GetString(objv[skip])));
                return TCL_ERROR;
            }
            optionPtr = (WidgetOption *) Tcl_GetHashValue(entryPtr);
            if(optionPtr->dbclass == NULL) {
                Tcl_SetObjResult(interp,
                    Tcl_ObjPrintf("unknown option \"%s\"",
                    Tcl_GetString(objv[skip])));
                return TCL_ERROR;
            }
        }
        listPtr = Tcl_NewObj();
        Tcl_ListObjAppendElement(interp, listPtr, optionPtr->option);
        Tcl_ListObjAppendElement(interp, listPtr, optionPtr->dbname);
        Tcl_ListObjAppendElement(interp, listPtr, optionPtr->dbclass);
        if (optionPtr->defvalue) {
            Tcl_ListObjAppendElement(interp, listPtr, optionPtr->defvalue);
        }
        else {
            Tcl_ListObjAppendElement(interp, listPtr, tkoPtr->Obj_empty);
        }
        Tcl_ListObjAppendElement(interp, listPtr, optionPtr->value);
        Tcl_SetObjResult(interp, listPtr);
        return TCL_OK;
    }
    /* configure "-option ?value? .." */
    if((objc - skip) % 2 == 0) {
        Tcl_Preserve(widget);
        for (i = skip; i < objc; i = i + 2) {
            if (WidgetOptionSet(interp, widget, objv[i], objv[i + 1]) != TCL_OK) {
                Tcl_Release(widget);
                return TCL_ERROR;
            }
        }
        myObjv[0] = widget->myCmd;
        myObjv[1] = tkoPtr->Obj__tko_configure;
        if (Tcl_EvalObjv(interp, 2, myObjv, TCL_EVAL_GLOBAL) != TCL_OK) {
            Tcl_Release(widget);
            return TCL_ERROR;
        }
        Tcl_Release(widget);
        return TCL_OK;
    }
    Tcl_WrongNumArgs(interp, skip, objv, "?-option value ..?");
    return TCL_ERROR;
}

/*
 * WidgetOptionAdd --
 *    Add a new option to a created widget.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    Add and initialize the new option.
 */
static int
WidgetOptionAdd(
    Tcl_Interp * interp, /* used interpreter */
    Tko_Widget * widget, /* currrent widget or NULL if only checks should be done  */
    Tcl_Obj * option, /* name of option, always given*/
    Tcl_Obj * dbname, /* dbname or synonym, always given */
    Tcl_Obj * dbclass, /* dbclass or NULL if synonym option */
    Tcl_Obj * defvalue, /* default value of option */
    Tcl_Obj * flags, /* value or NULL if synonym option */
    Tcl_Obj * value, /* initialization value */
    int initmode) /* 0 when adding to existing object, 1 when constructor, 2 when wrapped widget */
{
    Tcl_HashEntry *entryPtr;
    WidgetOption *optionPtr;
    Tk_Uid valueUid;
    int isNew;
    Tk_Uid optionUid;
    Tk_Uid dbnameUid;
    Tk_Uid dbclassUid;
    int intFlags;
    int readonly;
    Tcl_Obj *myObjv[2];
    const char *ch;
    const char *opt;
    int traceadd = 0; /* if not 0 then readd trace on array variable */
    int searchdb = 0; /* search optiondb for values */
    TkoThreadData *tkoPtr = (TkoThreadData *)Tcl_GetThreadData(&tkoKey, sizeof(TkoThreadData));

    if((opt=Tcl_GetString(option))[0] != '-') {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("wrong option: %s", opt));
        return TCL_ERROR;
    }
    /* synonym option check */
    if(dbclass == NULL) {
        if((ch=Tcl_GetString(dbname))[0] != '-' || ch[1]=='\0') {
            Tcl_SetObjResult(interp,
                Tcl_ObjPrintf("wrong synonym: %s %s", opt, ch));
            return TCL_ERROR;
        }
    }
    /* int flag */
    intFlags = 0;
    if (flags && WidgetFlagsObj(flags,&intFlags) != TCL_OK) {
        Tcl_SetObjResult(interp,
            Tcl_ObjPrintf("wrong flags: %s %s",opt,Tcl_GetString(flags)));
        return TCL_ERROR;
    }
    if (intFlags & TKO_OPTION_READONLY) {
        intFlags &= ~TKO_OPTION_READONLY;
        readonly = TKO_OPTION_READONLY;
    }
    else {
        readonly = 0;
    }
    /* return if no widget given, all class checks are done */
    if(widget == NULL) {
        return TCL_OK;
    }
    optionUid = Tk_GetUid(opt);
    entryPtr = Tcl_CreateHashEntry(widget->optionsTable, optionUid, &isNew);
    if(isNew == 0) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("option exists: %s", opt));
        return TCL_ERROR;
    }
    /* create option */
    optionPtr = (WidgetOption *)ckalloc(sizeof(WidgetOption));
    assert(optionPtr);
    memset(optionPtr, 0, sizeof(WidgetOption));
    optionPtr->option = option;
    Tcl_IncrRefCount(optionPtr->option);
    if (Tcl_GetString(dbname)[0] == '\0') {
        optionPtr->dbname = tkoPtr->Obj_empty;
        searchdb++;
    }
    else {
        optionPtr->dbname = dbname;
    }
    Tcl_IncrRefCount(optionPtr->dbname);
    Tcl_SetHashValue(entryPtr, (char *)optionPtr);
    if (flags) {
        optionPtr->flags = flags;
    }
    else {
        optionPtr->flags = tkoPtr->Obj_empty;
    }
    Tcl_IncrRefCount(optionPtr->flags);
    optionPtr->flagbits = intFlags;
    /* synonym options can have flags.
     * Need to check usage of init value! */
    if(dbclass == NULL) {
        optionPtr->dbclass = NULL;
        optionPtr->defvalue = NULL;
        if(value) {
            optionPtr->value = value;
            Tcl_IncrRefCount(optionPtr->value);
        }
        /* normal option */
    } else {
        if (Tcl_GetString(dbclass)[0] == '\0') {
            optionPtr->dbclass = tkoPtr->Obj_empty;
            dbclassUid = tkoPtr->Uid_empty;
            searchdb++;
        }
        else {
            dbclassUid = Tk_GetUid(Tcl_GetString(dbclass));
            optionPtr->dbclass = dbclass;
        }
        Tcl_IncrRefCount(optionPtr->dbclass);

        optionPtr->defvalue = defvalue;
        Tcl_IncrRefCount(optionPtr->defvalue);

        /*
         * If value is given use it.
         */
        if(value) {
            optionPtr->value = value;
            optionPtr->flagbits |= TKO_OPTION__USER;
        } else {
            if (searchdb < 2 && widget->tkWin != NULL) {
                /*
                 * Get value from option database
                 */
                dbnameUid = Tk_GetUid(Tcl_GetString(dbname));
                if (optionPtr->value == NULL) {
                    valueUid = Tk_GetOption(widget->tkWin, dbnameUid, dbclassUid);
                    if (valueUid != NULL) {
                        optionPtr->value = Tcl_NewStringObj(valueUid, -1);
                    }
                }
                /*
                 * Check for a system-specific default value.
                 * Do not for -class because Tcl_SetClass was not called.
                 * When -class is not first option (after -screen) we get a crash!
                 */
                if (optionPtr->value == NULL && optionUid != tkoPtr->Uid_class) {
                    optionPtr->value =
                        Tk_GetSystemDefault(widget->tkWin, dbnameUid, dbclassUid);
                }
            }
            /*
             * Use default value.
             */
            if(optionPtr->value == NULL) {
                optionPtr->value = defvalue;
                optionPtr->flagbits |= TKO_OPTION__USER;
            }
        }
        /*
         * No given value defaults to empty string.
         */
        if(optionPtr->value == NULL) {
            optionPtr->value = tkoPtr->Obj_empty;
            /* No flag as this does not count as user supplied */
        }
        Tcl_IncrRefCount(optionPtr->value);
        /*
         * Outside initmode the trace on the array variable needs to be disabled.
         */
        if (initmode == 0) {
            Tcl_UntraceVar2(interp, Tcl_GetString(widget->optionsArray), NULL,
                TCL_TRACE_WRITES | TCL_TRACE_RESULT_OBJECT, WidgetOptionTrace, widget);
            traceadd = 1;
        }
        /*
         *Set option array variable
         */
        if (Tcl_ObjSetVar2(interp, widget->optionsArray, option,
            optionPtr->value, TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG) == NULL) {
            goto error;
        }
        /*
         * Do initialization with -option method.
         * We do it for readonly options only here.
         * And we do it for options added with "configure optionadd ..".
         */
        if (readonly || initmode == 0) {
            if (initmode != 2) {
                myObjv[0] = widget->myCmd;
                myObjv[1] = option;
                if (Tcl_EvalObjv(interp, 2, myObjv, TCL_EVAL_GLOBAL) != TCL_OK) {
                    goto error;
                }
                /*
                * We set the value again because the -option method may have changed it.
                */
                if (optionPtr->value) {
                    Tcl_DecrRefCount(optionPtr->value);
                }
                optionPtr->value = Tcl_ObjGetVar2(interp, widget->optionsArray, option, TCL_GLOBAL_ONLY);
                Tcl_IncrRefCount(optionPtr->value);
            }
            /* Now we are ready to set the readonly bit */
            if (readonly) {
                optionPtr->flagbits |= TKO_OPTION_READONLY;
            }
        }
    }
    if (traceadd) {
        Tcl_TraceVar2(interp, Tcl_GetString(widget->optionsArray), NULL,
            TCL_TRACE_WRITES | TCL_TRACE_RESULT_OBJECT, WidgetOptionTrace, widget);
    }
    return TCL_OK;
error:
    if (traceadd) {
        /* There should be no error and thus we don't need to save the result. */
        Tcl_TraceVar2(interp, Tcl_GetString(widget->optionsArray), NULL,
            TCL_TRACE_WRITES | TCL_TRACE_RESULT_OBJECT, WidgetOptionTrace, widget);
    }
    WidgetOptionDelEntry(entryPtr);
    return TCL_ERROR;
}

/*
 * WidgetOptionGet --
 *    Get option value.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    return current vlaue of widget option.
 */
static int
WidgetOptionGet(
    Tcl_Interp * interp,
    Tko_Widget * widget,
    Tcl_Obj * option)
{
    Tcl_Obj *retPtr;
    Tcl_HashEntry *entryPtr;
    WidgetOption *optionPtr;

    if(option == NULL) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("no option given"));
        return TCL_ERROR;
    }
    entryPtr =
        Tcl_FindHashEntry(widget->optionsTable,
        Tk_GetUid(Tcl_GetString(option)));
    if(entryPtr == NULL) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("unknown option \"%s\"",
                Tcl_GetString(option)));
        return TCL_ERROR;
    }
    optionPtr = (WidgetOption *)Tcl_GetHashValue(entryPtr);
    /* hidden option, not visible in cget method */
    if (optionPtr->flagbits&TKO_OPTION_HIDE) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("hidden option \"%s\"",
            Tcl_GetString(option)));
        return TCL_ERROR;
    }
    /* synonym option */
    if(optionPtr->dbclass == NULL) {
        entryPtr =
            Tcl_FindHashEntry(widget->optionsTable,
            Tk_GetUid(Tcl_GetString(optionPtr->dbname)));
        if(entryPtr == NULL) {
            Tcl_SetObjResult(interp,
                Tcl_ObjPrintf("unknown synonym option \"%s\"",
                    Tcl_GetString(option)));
            return TCL_ERROR;
        }
        optionPtr = (WidgetOption *)Tcl_GetHashValue(entryPtr);
        if(optionPtr->dbclass == NULL) {
            Tcl_SetObjResult(interp,
                Tcl_ObjPrintf("synonym option is synonym \"%s\"",
                    Tcl_GetString(option)));
            return TCL_ERROR;
        }
    }
    retPtr = optionPtr->value;
    Tcl_SetObjResult(interp, retPtr);
    return TCL_OK;
}

/*
 * WidgetOptionSet --
 *    Set new widget option value.
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    Set option value and call
 */
static int
WidgetOptionSet(
    Tcl_Interp * interp,
    Tko_Widget * widget,
    Tcl_Obj * option,
    Tcl_Obj * value)
{
    Tcl_HashEntry *entryPtr;
    WidgetOption *optionPtr;

    if(option == NULL || value == NULL) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("missing option and/or value"));
        return TCL_ERROR;
    }
    entryPtr =
        Tcl_FindHashEntry(widget->optionsTable,
        Tk_GetUid(Tcl_GetString(option)));
    if(entryPtr == NULL) {
        Tcl_SetObjResult(interp,
            Tcl_ObjPrintf("unknown option \"%s\"", Tcl_GetString(option)));
        return TCL_ERROR;
    }
    optionPtr = (WidgetOption *)Tcl_GetHashValue(entryPtr);
    /* hidden option, not visible in cget method */
    if (optionPtr->flagbits&TKO_OPTION_HIDE) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("hidden option \"%s\"",
            Tcl_GetString(option)));
        return TCL_ERROR;
    }
    /* synonym option */
    if(optionPtr->dbclass == NULL) {
        entryPtr =
            Tcl_FindHashEntry(widget->optionsTable,
            Tk_GetUid(Tcl_GetString(optionPtr->dbname)));
        if(entryPtr == NULL) {
            Tcl_SetObjResult(interp,
                Tcl_ObjPrintf("unknown synonym option \"%s\"",
                    Tcl_GetString(option)));
            return TCL_ERROR;
        }
        optionPtr = (WidgetOption *)Tcl_GetHashValue(entryPtr);
        if(optionPtr->dbclass == NULL) {
            Tcl_SetObjResult(interp,
                Tcl_ObjPrintf("synonym option is synonym \"%s\"",
                    Tcl_GetString(option)));
            return TCL_ERROR;
        }
        if(Tcl_ObjSetVar2(interp, widget->optionsArray, optionPtr->option,
                value, TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG) == NULL) {
            return TCL_ERROR;
        }
    } else {
        if(Tcl_ObjSetVar2(interp, widget->optionsArray, option, value,
                TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG) == NULL) {
            return TCL_ERROR;
        }
    }
    optionPtr->flagbits |= TKO_OPTION__USER;
    return TCL_OK;
}

/*
* Tko_WidgetOptionGet --
*
* Results:
*    Return TclObj value of option or NULL if widget is destroyed.
*
* Side effects:
*/
Tcl_Obj *
Tko_WidgetOptionGet(
    Tko_Widget *widget,
    Tcl_Obj *option)
{
    if (widget->optionsArray == NULL || option ==NULL) return NULL;
    return Tcl_ObjGetVar2(widget->interp, widget->optionsArray, option,
        TCL_GLOBAL_ONLY);
}

/*
 * Tko_WidgetOptionSet --
 *    Set option value.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    Create necessary C-values.
 */
Tcl_Obj *
Tko_WidgetOptionSet(
    Tko_Widget *widget,
    Tcl_Obj * option,
    Tcl_Obj * value)
{
    if (widget->optionsArray == NULL || option==NULL || value == NULL) return NULL;
    return Tcl_ObjSetVar2(widget->interp, widget->optionsArray, option, value,
        TCL_GLOBAL_ONLY);
}

/*
 * WidgetOptionTrace --
 * Write trace on option array variable
 *
 * Results:
 *    Return NULL if successfull and leave error message otherwise.
 *
 * Side effects:
 *    Check on existence of option and call "-option" method with new value.
 */
static char *
WidgetOptionTrace(
    ClientData clientData,
    Tcl_Interp * interp,
    const char *name1,
    const char *name2,
    int flags)
{
    Tko_Widget *widget = (Tko_Widget *) clientData;
    Tcl_HashEntry *entryPtr;
    Tcl_Obj *valuePtr;
    //    const char *result;
    WidgetOption *optionPtr;
    Tcl_Obj *myObjv[2];
    Tcl_Obj *myRet;
    (void)name1;
    (void)flags;

    /* get new value */
    entryPtr = Tcl_FindHashEntry(widget->optionsTable, Tk_GetUid(name2));
    if(entryPtr == NULL) {
        myRet = Tcl_ObjPrintf("option \"%s\" not found", name2);
        Tcl_IncrRefCount(myRet);
        return (char *)myRet;
    }
    optionPtr = (WidgetOption *) Tcl_GetHashValue(entryPtr);
    if(optionPtr->flagbits & TKO_OPTION_READONLY) {
        myRet = Tcl_ObjPrintf("option \"%s\" is readonly", name2);
        Tcl_IncrRefCount(myRet);
        return (char *)myRet;
    }
    myObjv[0] = widget->myCmd;
    myObjv[1] = optionPtr->option;
    if(Tcl_EvalObjv(interp, 2, myObjv, TCL_EVAL_GLOBAL) != TCL_OK) {
        myRet = Tcl_GetObjResult(interp);
        Tcl_IncrRefCount(myRet);
        /* reset to old value TODO checks? */
        if(optionPtr->value != NULL) {
            Tcl_ObjSetVar2(interp, widget->optionsArray, optionPtr->option,
                optionPtr->value, TCL_GLOBAL_ONLY);
            Tcl_EvalObjv(interp, 2, myObjv, TCL_EVAL_GLOBAL);
        }
        return (char *)myRet;
    }
    if(optionPtr->value != NULL) {
        Tcl_DecrRefCount(optionPtr->value);
    }
    valuePtr = Tcl_ObjGetVar2(interp, widget->optionsArray, optionPtr->option, TCL_GLOBAL_ONLY);
    optionPtr->value = valuePtr;
    Tcl_IncrRefCount(optionPtr->value);
    return NULL;
}

/*
 * WidgetOptionDelEntry --
 *    Delete internal entry value.
 *
 * Results:
 *    None.
 *
 * Side effects:
 */
static void
WidgetOptionDelEntry(
    Tcl_HashEntry * entry)
{
    WidgetOption *optionPtr = (WidgetOption *)Tcl_GetHashValue(entry);

    if(optionPtr->option)
        Tcl_DecrRefCount(optionPtr->option);
    if(optionPtr->dbname)
        Tcl_DecrRefCount(optionPtr->dbname);
    if(optionPtr->dbclass)
        Tcl_DecrRefCount(optionPtr->dbclass);
    if(optionPtr->flags)
        Tcl_DecrRefCount(optionPtr->flags);
    if(optionPtr->defvalue)
        Tcl_DecrRefCount(optionPtr->defvalue);
    if(optionPtr->value)
        Tcl_DecrRefCount(optionPtr->value);
    ckfree(optionPtr);
    Tcl_DeleteHashEntry(entry);
}

/*
 * WidgetMethod_tko_configure --
 *    Virtual method called after configuring options.
 *    Should be implemented in derived classes.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 */
static int
WidgetMethod_tko_configure(
    ClientData dummy,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[])
{              /* virtual method */
    (void)dummy;
    (void)interp;
    (void)context;
    (void)objc;
    (void)objv;

    return TCL_OK;
}

/*
 * WidgetMetaDelete --
 *    Delete widget meta data when all preserve calls done.
 *
 * Results:
 *    None.
 *
 * Side effects:
 */
static void
WidgetMetaDelete(
    ClientData clientData)
{
    (void)clientData;
    /* Tcl_EventuallyFree(clientData, (Tcl_FreeProc *)WidgetMetaDestroy); */
}

/*
 * WidgetMethod_ --
 *    Standard option set method.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 */
static int
WidgetMethod_(
    ClientData clientdata,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj * const objv[])
{
    WidgetClientdata *define;
    Tcl_Object object;
    Tko_Widget *widget;
    Tcl_Obj *value;
    char *address = NULL;
    int intVal;
    double dblVal;
    Colormap colormap;
    int *intPtr;
    const char *str;
    int length;
    int pixels[4] = { 0, 0, 0, 0 };
    int myObjc;
    Tcl_Obj **myObjv;
    Visual * visual;
    XColor * color;
    Tk_3DBorder border;
    Tk_Anchor anchor;
    Tk_Cursor cursor;
    Tk_Window newWin;
    Tk_Font newFont;
    Tk_Justify justify;
    (void)objc;

    if ((define = (WidgetClientdata *)clientdata) == NULL
        || (object = Tcl_ObjectContextObject(context)) == NULL
        || (widget = (Tko_Widget *)Tcl_ObjectGetMetadata(object, &tkoWidgetMeta))
            == NULL
        || (value = Tcl_ObjGetVar2(interp, widget->optionsArray, define->option,
            TCL_GLOBAL_ONLY)) == NULL
        || widget->myCmd == NULL) {
        return TCL_ERROR;
    }
    if (define->offset > 0) {
        address = ((char *)widget) + define->offset;
    }

    switch (define->type) {
    case TKO_SET_CLASS:        /* (Tcl_Obj **)address */
        Tk_SetClass(widget->tkWin, Tcl_GetString(value));
        if (address) {
            if (*((Tcl_Obj **)address) != NULL)
                Tcl_DecrRefCount(*((Tcl_Obj **)address));
            *((Tcl_Obj **)address) = value;
            Tcl_IncrRefCount(value);
        }
        return TCL_OK;
    case TKO_SET_VISUAL:       /* (Tcl_Obj **)address */
        visual =
            Tk_GetVisual(interp, widget->tkWin, Tcl_GetString(value), &intVal,
                &colormap);
        if (visual == NULL)
            return TCL_ERROR;
        Tk_SetWindowVisual(widget->tkWin, visual, intVal, colormap);
        if (address) {
            if (*((Tcl_Obj **)address) != NULL)
                Tcl_DecrRefCount(*((Tcl_Obj **)address));
            *((Tcl_Obj **)address) = value;
            Tcl_IncrRefCount(value);
        }
        return TCL_OK;
    case TKO_SET_COLORMAP:     /* (Tcl_Obj **)address */
        str = Tcl_GetStringFromObj(value, &length);
        if (str && length) {
            colormap = Tk_GetColormap(interp, widget->tkWin, str);
            if (colormap == None)
                return TCL_ERROR;
            Tk_SetWindowColormap(widget->tkWin, colormap);
        }
        if (address) {
            if (*((Tcl_Obj **)address) != NULL)
                Tcl_DecrRefCount(*((Tcl_Obj **)address));
            *((Tcl_Obj **)address) = value;
            Tcl_IncrRefCount(value);
        }
        return TCL_OK;
    case TKO_SET_USE:      /* (Tcl_Obj **)address */
        str = Tcl_GetStringFromObj(value, &length);
        if (str && length) {
            if (Tk_UseWindow(interp, widget->tkWin, str) != TCL_OK) {
                return TCL_ERROR;
            }
        }
        else if (!(define->flags & TKO_OPTION_NULL)) {
            return TCL_ERROR;

        }
        if (address) {
            if (*((Tcl_Obj **)address) != NULL)
                Tcl_DecrRefCount(*((Tcl_Obj **)address));
            if (length) {
                *((Tcl_Obj **)address) = value;
                Tcl_IncrRefCount(value);
            }
            else {
                *((Tcl_Obj **)address) = NULL;
            }
        }
        return TCL_OK;
    case TKO_SET_CONTAINER:    /* (int *)address */
        if (Tcl_GetBooleanFromObj(interp, value, &intVal) != TCL_OK)
            return TCL_ERROR;
        if (intVal) {
            Tk_MakeContainer(widget->tkWin);
            Tcl_ObjSetVar2(interp, widget->optionsArray, objv[1], Tcl_NewIntObj(1),
                TCL_GLOBAL_ONLY);
        }
        else {
            Tcl_ObjSetVar2(interp, widget->optionsArray, objv[1], Tcl_NewIntObj(0),
                TCL_GLOBAL_ONLY);
        }
        if (address) {
            *(int *)address = intVal;
        }
        return TCL_OK;
    case TKO_SET_TCLOBJ:       /* (Tcl_Obj **)address */
        if (address) {
            if (*((Tcl_Obj **)address) != NULL)
                Tcl_DecrRefCount(*((Tcl_Obj **)address));
            *((Tcl_Obj **)address) = value;
            Tcl_IncrRefCount(value);
        }
        return TCL_OK;
    case TKO_SET_XCOLOR:       /* (Xcolor **)address */
        color = Tk_AllocColorFromObj(interp, widget->tkWin, value);
        if (color == NULL)
            return TCL_ERROR;
        if (address) {
            if (*((XColor **)address) != NULL) {
                Tk_FreeColor(*((XColor **)address));
            }
            *((XColor **)address) = color;
        }
        else {
            Tk_FreeColor(color);
        }
        return TCL_OK;
    case TKO_SET_3DBORDER:     /* (Tk_3DBorder *)address */
        str = Tcl_GetStringFromObj(value, &length);
        if (str && length) {
            border = Tk_Alloc3DBorderFromObj(interp, widget->tkWin, value);
            if (border == NULL)
                return TCL_ERROR;
        }
        else if (define->flags & TKO_OPTION_NULL) {
            border = NULL;
        } else {
            return TCL_ERROR;
        }
        if (address) {
            if (*(Tk_3DBorder *)address != NULL) {
                Tk_Free3DBorder(*(Tk_3DBorder *)address);
            }
            *(Tk_3DBorder *)address = border;
        }
        else {
            Tk_Free3DBorder(border);
        }
        return TCL_OK;
    case TKO_SET_PIXEL:        /* (int *)address */
        if (Tk_GetPixelsFromObj(interp, widget->tkWin, value, &intVal) != TCL_OK) {
            return TCL_ERROR;
        }
        if (address) {
            *(int *)address = intVal;
        }
        Tcl_ObjSetVar2(interp, widget->optionsArray, objv[1],
            Tcl_NewIntObj(intVal), TCL_GLOBAL_ONLY);
        return TCL_OK;
    case TKO_SET_PIXELNONEGATIV:       /* (int *)address */
        if (Tk_GetPixelsFromObj(interp, widget->tkWin, value, &intVal) != TCL_OK) {
            return TCL_ERROR;
        }
        if (intVal >= SHRT_MAX) {
            Tcl_AppendResult(interp, "bad distance \"", Tcl_GetString(value),
                "\": ", "too big to represent", (char *)NULL);
            return TCL_ERROR;
        }
        if (intVal < 0) {
            Tcl_AppendResult(interp, "bad distance \"", Tcl_GetString(value),
                "\": ", "can't be negative", (char *)NULL);
            return TCL_ERROR;
        }
        if (address) {
            *(int *)address = intVal;
        }
        Tcl_ObjSetVar2(interp, widget->optionsArray, objv[1],
            Tcl_NewIntObj(intVal), TCL_GLOBAL_ONLY);
        return TCL_OK;
    case TKO_SET_PIXELPOSITIV: /* (int *)address */
        if (Tk_GetPixelsFromObj(interp, widget->tkWin, value, &intVal) != TCL_OK) {
            return TCL_ERROR;
        }
        if (intVal >= SHRT_MAX) {
            Tcl_AppendResult(interp, "bad distance \"", Tcl_GetString(value),
                "\": ", "too big to represent", (char *)NULL);
            return TCL_ERROR;
        }
        if (intVal <= 0) {
            Tcl_AppendResult(interp, "bad distance \"", Tcl_GetString(value),
                "\": ", "must be positive", (char *)NULL);
            return TCL_ERROR;
        }
        if (address) {
            *(int *)address = intVal;
        }
        Tcl_ObjSetVar2(interp, widget->optionsArray, objv[1],
            Tcl_NewIntObj(intVal), TCL_GLOBAL_ONLY);
        return TCL_OK;
    case TKO_SET_DOUBLE:       /* (double *)address */
        if (Tcl_GetDoubleFromObj(interp, value, &dblVal) != TCL_OK) {
            return TCL_ERROR;
        }
        if (address) {
            *(double *)address = dblVal;
        }
        Tcl_ObjSetVar2(interp, widget->optionsArray, objv[1],
            Tcl_NewDoubleObj(dblVal), TCL_GLOBAL_ONLY);
        return TCL_OK;
    case TKO_SET_BOOLEAN:      /* (int *)address */
        if (Tcl_GetBooleanFromObj(interp, value, &intVal) != TCL_OK) {
            return TCL_ERROR;
        }
        if (intVal) {
            Tcl_ObjSetVar2(interp, widget->optionsArray, objv[1], Tcl_NewIntObj(1),
                TCL_GLOBAL_ONLY);
        }
        else {
            Tcl_ObjSetVar2(interp, widget->optionsArray, objv[1], Tcl_NewIntObj(0),
                TCL_GLOBAL_ONLY);
        }
        if (address) {
            *(int *)address = intVal;
        }
        Tcl_ObjSetVar2(interp, widget->optionsArray, objv[1],
            Tcl_NewIntObj(intVal), TCL_GLOBAL_ONLY);
        return TCL_OK;
    case TKO_SET_CURSOR:       /* (Tk_Cursor *)address */
        cursor = NULL;
        if (Tcl_GetString(value)[0] != '\0') {
            cursor = Tk_AllocCursorFromObj(interp, widget->tkWin, value);
            if (cursor == NULL) {
                return TCL_ERROR;
            }
            Tk_DefineCursor(widget->tkWin, cursor);
        }
        if (address) {
            if (*(Tk_Cursor *)address != NULL) {
                Tk_FreeCursor(Tk_Display(widget->tkWin),
                    *(Tk_Cursor *)address);
            }
            *(Tk_Cursor *)address = cursor;
        }
        else {
            if (cursor != NULL) {
                Tk_FreeCursor(Tk_Display(widget->tkWin), cursor);/*TODO necessary? */
            }
        }
        return TCL_OK;
    case TKO_SET_INT:  /* (int *)address */
        if (Tcl_GetIntFromObj(interp, value, &intVal) != TCL_OK) {
            return TCL_ERROR;
        }
        if (address) {
            *(int *)address = intVal;
        }
        Tcl_ObjSetVar2(interp, widget->optionsArray, objv[1],
            Tcl_NewIntObj(intVal), TCL_GLOBAL_ONLY);
        return TCL_OK;
    case TKO_SET_RELIEF:       /* (int *)address */
        if (Tk_GetReliefFromObj(interp, value, &intVal) != TCL_OK) {
            return TCL_ERROR;
        }
        if (address) {
            *(int *)address = intVal;
        }
        return TCL_OK;
    case TKO_SET_ANCHOR:       /* (Tk_Anchor *)address */
        if (Tk_GetAnchorFromObj(interp, value, &anchor) != TCL_OK) {
            return TCL_ERROR;
        }
        if (address) {
            *(Tk_Anchor *)address = anchor;
        }
        return TCL_OK;
    case TKO_SET_WINDOW:       /* (Tk_Window *)address */
        if (value == NULL || Tcl_GetCharLength(value) == 0) {
            newWin = NULL;
        }
        else {
            if (TkGetWindowFromObj(interp, widget->tkWin, value,
                &newWin) != TCL_OK) {
                return TCL_ERROR;
            }
        }
        if (address) {
            *(Tk_Window *)address = newWin;
        }
        return TCL_OK;
    case TKO_SET_FONT: /* (Tk_Font *)address */
        newFont = Tk_AllocFontFromObj(interp, widget->tkWin, value);
        if (newFont == NULL) {
            return TCL_ERROR;
        }
        if (address) {
            if (*(Tk_Font *)address != NULL) {
                Tk_FreeFont(*(Tk_Font *)address);
            }
            *(Tk_Font *)address = newFont;
        }
        else {
            Tk_FreeFont(newFont);
        }
        return TCL_OK;
    case TKO_SET_STRING:   /* (char **)address */
        if (address) {
            str = Tcl_GetStringFromObj(value, &length);
            if (*(char **)address != NULL) {
                ckfree(*(char **)address);
            }
            if (length == 0 && define->flags&TKO_OPTION_NULL) {
                *(char **)address = NULL;
            }
            else {
                *(char **)address=(char *)ckalloc(length + 1);
                assert(*(char **)address);
                memcpy(*(char **)address, str, length + 1);
            }
        }
        return TCL_OK;
    case TKO_SET_SCROLLREGION: /* (int *[4])address */
        if (Tcl_ListObjGetElements(interp, value, &myObjc, &myObjv) != TCL_OK) {
            return TCL_ERROR;
        }
        if (myObjc == 4) {
            if (Tk_GetPixelsFromObj(interp, widget->tkWin, myObjv[0],
                &pixels[0]) != TCL_OK
                || Tk_GetPixelsFromObj(interp, widget->tkWin, myObjv[1],
                    &pixels[1]) != TCL_OK
                || Tk_GetPixelsFromObj(interp, widget->tkWin, myObjv[2],
                    &pixels[2]) != TCL_OK
                || Tk_GetPixelsFromObj(interp, widget->tkWin, myObjv[3],
                    &pixels[3]) != TCL_OK) {
                return TCL_ERROR;
            }
        }
        else if (myObjc != 0) {
            Tcl_SetObjResult(interp,
                Tcl_ObjPrintf("found %d instead of 4 values", myObjc));
            return TCL_ERROR;
        }
        if (address) {
            intPtr = (int *)address;
            intPtr[0] = pixels[0];
            intPtr[1] = pixels[1];
            intPtr[2] = pixels[2];
            intPtr[3] = pixels[3];
        }
        return TCL_OK;
    case TKO_SET_JUSTIFY:      /* (Tk_Justify *)address */
        if (Tk_GetJustify(interp, Tk_GetUid(Tcl_GetString(value)),
            &justify) != TCL_OK) {
            return TCL_ERROR;
        }
        if (address) {
            *(Tk_Justify *)address = justify;
        }
        return TCL_OK;
    }

    Tcl_SetObjResult(interp, Tcl_ObjPrintf("unknown type \"%d\"", define->type));
    return TCL_ERROR;
}

/*
* WidgetMethod_ --
*    Check given flagsPtr object and if flags is given set int value from string.
*
* Results:
*    A standard Tcl result.
*
* Side effects:
*/
static int WidgetFlagsObj(Tcl_Obj *flagsPtr, int *flags)
{
    char *ch;
    int retValue = 0;
    if (flagsPtr == NULL) return TCL_ERROR;
    ch = Tcl_GetString(flagsPtr);
    if (ch[0] != '\0') {
        if (ch[0] == 'r') {
            retValue |= TKO_OPTION_READONLY;
            if (ch[1] != '\0') {
                if (ch[1] == 'h') {
                    retValue |= TKO_OPTION_HIDE;
                }
                else {
                    return TCL_ERROR;
                }
            }
        }
        else if (ch[0] == 'h') {
            retValue |= TKO_OPTION_HIDE;
            if (ch[1] != '\0') {
                if (ch[1] == 'r') {
                    retValue |= TKO_OPTION_READONLY;
                }
                else {
                    return TCL_ERROR;
                }
            }
        }
        else {
            return TCL_ERROR;
        }
    }
    if (flags) {
        *flags |= retValue;
    }
    return TCL_OK;
}

/*
* WidgetFlagsHideGet --
*    Return 1 if option is hidden and 0 otherwise.
*
* Results:
*    Return 1 if option is hidden and 0 otherwise.
*
* Side effects:
*/
static int WidgetFlagsHideGet(Tcl_Obj *flags)
{
    const char *ch;

    ch = Tcl_GetString(flags);
    if (ch[0] == 'h' || (ch[0] == 'r' && ch[1] == 'h')) {
        return 1;
    }
    return 0;
}

/*
* WidgetFlagsHideSet --
*    Set hidden option state.
*
* Results:
*    Return object with new state.
*
* Side effects:
*/
static Tcl_Obj *WidgetFlagsHideSet(
    Tcl_Obj *flags) /* last flag value object */
{
    const char *ch;
    TkoThreadData *tkoPtr = (TkoThreadData *)Tcl_GetThreadData(&tkoKey, sizeof(TkoThreadData));

    ch = Tcl_GetString(flags);
    if (ch[0] != '\0' && (ch[0] == 'r' || ch[1] == 'r')) {
        return tkoPtr->Obj_flags_rh;
    }
    return tkoPtr->Obj_flags_h;
}

/*
* WidgetFlagsHideUnset --
*    Unset hidden option state.
*
* Results:
*    Return object with new state.
*
* Side effects:
*/
static Tcl_Obj *WidgetFlagsHideUnset(
    Tcl_Obj *flags) /* last flag value object */
{
    const char *ch;
    TkoThreadData *tkoPtr = (TkoThreadData *)Tcl_GetThreadData(&tkoKey, sizeof(TkoThreadData));

    ch = Tcl_GetString(flags);
    if (ch[0] != '\0') {
        if (ch[0] == 'h') {
            if (ch[1] == 'r') {
                return tkoPtr->Obj_flags_r;
            }
            else {
                return tkoPtr->Obj_empty;
            }
        }
        else {
            if (ch[1] == 'h') {
                return tkoPtr->Obj_flags_r;
            }
        }
    }
    return tkoPtr->Obj_empty;
}

/*
* WidgetClientdataDelete --
*    Delete widget internal method clientdata.
*
* Results:
*    None.
*
* Side effects:
*    Free memory.
*/
static void WidgetClientdataDelete(
    ClientData clientdata)
{
    WidgetClientdata *cd = (WidgetClientdata *)clientdata;
    Tcl_DecrRefCount(cd->option);
    ckfree(cd);
}

/*
* WidgetClientdataClone --
*    Copy widget internal method clientdata.
*
* Results:
*    Return copied clientdata in newPtr.
*
* Side effects:
*/
static int WidgetClientdataClone(
    Tcl_Interp *dummy,
    ClientData clientdata,
    ClientData *newPtr)
{
    WidgetClientdata *cd = (WidgetClientdata *)clientdata;
    (void)dummy;

    if (cd) {
        *newPtr = ckalloc(sizeof(WidgetClientdata));
        assert(*newPtr);
        memcpy(*newPtr, cd, sizeof(WidgetClientdata));
        Tcl_IncrRefCount(cd->option);
    }
    return TCL_OK;
}

/* vim: set ts=4 sw=4 sts=4 ff=unix et : */

/*
 * tkoWidget.h --
 *
 *    Header file for the internals of the tko widget package.
 *
 * Copyright (c) 2019 Rene Zaumseil
 *
 */

#ifndef _TKOWIDGET_H
#define _TKOWIDGET_H

#include "tcl.h"
#include "tclInt.h"
#include "tclOO.h"
#include "tk.h"
#include "default.h"

#ifndef _WIN32
#if !defined(MAC_OSX_TK)
#include <X11/Xproto.h>
#endif
#endif

#if defined(_WIN32)
#include "tkWinInt.h"
#elif defined(MAC_OSX_TK)
#include "tkMacOSXInt.h"
#else
#include "tkUnixInt.h"
#endif

/*
 * For C++ compilers, use extern "C"
 */
#ifdef __cplusplus
extern "C" {
#endif

/*
 * Tko_WidgetOptionType --
 *
 * Supported type in the TkoWidgetOptionSet() function.
 * In comments is the type of the address pointer.
 */
    typedef enum Tko_WidgetOptionType {
        TKO_SET_NONE = 0,     /* Nono */
        TKO_SET_CLASS = 1,     /* (Tcl_Obj **)address */
        TKO_SET_VISUAL, /* (Tcl_Obj **)address */
        TKO_SET_COLORMAP,       /* (Tcl_Obj **)address */
        TKO_SET_USE,        /* (Tcl_Obj **)address */
        TKO_SET_CONTAINER,      /* (int *)address */
        TKO_SET_TCLOBJ, /* (Tcl_Obj **)address */
        TKO_SET_XCOLOR, /* (Xcolor **)address */
        TKO_SET_3DBORDER,       /* (Tk_3DBorder *)address */
        TKO_SET_PIXEL,  /* (int *)address */
        TKO_SET_PIXELNONEGATIV, /* (int *)address */
        TKO_SET_PIXELPOSITIV,   /* (int *)address */
        TKO_SET_DOUBLE, /* (double *)address */
        TKO_SET_BOOLEAN,        /* (int *)address */
        TKO_SET_CURSOR, /* (Tk_Cursor *)address */
        TKO_SET_INT,    /* (int *)address */
        TKO_SET_RELIEF, /* (int *)address */
        TKO_SET_ANCHOR, /* (int *)address */
        TKO_SET_WINDOW, /* (Tk_Window *)address */
        TKO_SET_FONT,   /* (Tk_Font *)address */
        TKO_SET_STRING, /* (char **)address */
        TKO_SET_SCROLLREGION,   /* (int *[4])address */
        TKO_SET_JUSTIFY /* (Tk_Justify *)address */
    } Tko_WidgetOptionType;

/*
* Tko_CreateMode --
*
* Supported values in Tko_WdigetCreate() function call.
*/
    typedef enum Tko_WidgetCreateMode {
        TKO_CREATE_WIDGET, /* Create new widget */
        TKO_CREATE_TOPLEVEL, /* Create new toplevel widget */
        TKO_CREATE_CLASS, /* See "tko initclass" */
        TKO_CREATE_WRAP /* See "tko initwrap" */
    } Tko_WidgetCreateMode;

/*
 * Tko_WidgetOptionDefine --
 *
 * Widget definition data used in class.
 * An option set method "-option" is created in the following order:
 * - "option"=NULL indicate the end of a list of option definitions.
 * - If "method" is given it will be used as option set method.
 * - If "type" is greater 0 a common option set method will be used.
 *   In this case "offset" are used as offset in the widget structure.
 */
    typedef struct Tko_WidgetOptionDefine {
        const char *option;    /* Name of option. Starts with "-" minus sign */
        const char *dbname;    /* Option DB name or synonym option if dbclass is NULL */
        const char *dbclass;   /* Option DB class name or NULL for synonym options. */
        const char *defvalue;  /* Default value. */
        int flags;             /* bit array of TKO_OPTION_* values to configure option behaviour */
        Tcl_MethodCallProc *method;    /* If not NULL it is the function name of the -option method */
        Tko_WidgetOptionType type;  /* if greater 0 then option type used in common option set method */
        size_t offset;            /* offset in meta data struct */
    } Tko_WidgetOptionDefine;
#define TKO_OPTION_READONLY 0x1 /* option is only setable at creation time */
#define TKO_OPTION_HIDE     0x2 /* option is hidden in configure method */
#define TKO_OPTION_NULL      0x4 /* empty values are saved as NULL */
#define TKO_OPTION__USER    0x8 /* internally used */

    /*
    * Widget structure data used in objects.
    * These structure will be filled in the **Tko\_WidgetCreate** call
    * and cleared in the **Tko\_WidgetDestroy** call.
    * Widget methods should check the value of *tkWin* on NULL before using it.
    */
    typedef struct Tko_Widget {
        Tk_Window tkWin;           /* Window that embodies the widget. NULL means
                                   * that the window has been destroyed but the
                                   * data structures haven't yet been cleaned
                                   * up.*/
        Display *display;        /* Display containing widget. Used, among
                                 * other things, so that resources can be
                                 * freed even after tkwin has gone away. */
        Tcl_Interp *interp;        /* Interpreter associated with widget. */
        Tcl_Command widgetCmd;     /* Token for command. */
        Tcl_Object object;         /* our own object */
        Tcl_Obj *myCmd;            /* Objects "my" command. Needed to call internal methods. */
        Tcl_Obj *optionsArray;     /* Name of option array variable */
        Tcl_HashTable *optionsTable; /* Hash table containing all used options */
    } Tko_Widget;

/* tkoFrame.c */
    MODULE_SCOPE int Tko_FrameInit(
        Tcl_Interp * interp);
    MODULE_SCOPE int Tko_VectorInit(
        Tcl_Interp * interp);
    MODULE_SCOPE int Tko_GraphInit(
        Tcl_Interp * interp);
/* tkoWidget.c */
    MODULE_SCOPE int Tko_WidgetClassDefine(
        Tcl_Interp *interp,
        Tcl_Obj *classname,
        const Tcl_MethodType *methods,
        const Tko_WidgetOptionDefine *options);
    MODULE_SCOPE int Tko_WidgetCreate(
        ClientData clientdata,
        Tcl_Interp *interp,
        Tcl_Object object,
        Tko_WidgetCreateMode createmode,
        Tcl_Obj *arglist);
    MODULE_SCOPE void Tko_WidgetDestroy(
        Tcl_ObjectContext context);
    MODULE_SCOPE ClientData Tko_WidgetClientData(
        Tcl_ObjectContext context);
    MODULE_SCOPE Tcl_Obj *Tko_WidgetOptionGet(
        Tko_Widget *widget,
        Tcl_Obj *option);
    MODULE_SCOPE Tcl_Obj *Tko_WidgetOptionSet(
        Tko_Widget *widget,
        Tcl_Obj *option,
        Tcl_Obj *value);

/*
 * end block for C++
 */

#ifdef __cplusplus
}
#endif
#endif                         /* _TKOWIDGET_H */
/* vim: set ts=4 sw=4 sts=4 ff=unix et : */

# all.tcl --
#
# This file contains a top-level script to run all of the Tcl
# tests.  Execute it by invoking "make test"
#

# restart using tclsh \
exec tclsh "$0" "$@"

package require Tk ;# This is for a Tk Widget; fail early if no Tk!
package require tcltest 2

tcltest::configure {*}$argv
tcltest::configure -testdir [file normalize [file dirname [info script]]]
tcltest::configure -singleproc 1
tcltest::runAllTests

# This file is a Tcl script to test out the "frame" and "toplevel"
# commands of Tko. It is organized in the standard fashion for Tcl
# tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest
namespace import ::tcltest::*
namespace eval ::TEST {

proc ::TEST::deleteWindows {} {
    destroy {*}[winfo children .]
}

# ::TEST::eatColors --
# Creates a toplevel window and allocates enough colors in it to
# use up all the slots in the colormap.
#
# Arguments:
# w -		Name of toplevel window to create.

proc ::TEST::eatColors {w} {
    catch {destroy $w}
    ::tko::toplevel $w
    wm geom $w +0+0
    canvas $w.c -width 400 -height 200 -bd 0
    pack $w.c
    for {set y 0} {$y < 8} {incr y} {
	for {set x 0} {$x < 40} {incr x} {
	    set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0]
	    $w.c create rectangle [expr 10*$x] [expr 20*$y] \
		    [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \
		    -fill $color
	}
    }
    update
}

# ::TEST::colorsFree --
#
# Returns 1 if there appear to be free colormap entries in a window,
# 0 otherwise.
#
# Arguments:
# w -			Name of window in which to check.
# red, green, blue -	Intensities to use in a trial color allocation
#			to see if there are colormap entries free.

proc ::TEST::colorsFree {w {red 31} {green 245} {blue 192}} {
    set vals [winfo rgb $w [format #%02x%02x%02x $red $green $blue]]
    expr ([lindex $vals 0]/256 == $red) && ([lindex $vals 1]/256 == $green) \
	    && ([lindex $vals 2]/256 == $blue)
}

#
# Test ::tko::frame configuration options
#
test frame-1.1 {frame configuration options} -setup {
	deleteWindows
} -body {
    ::tko::frame .f -class NewFrame
    .f configure -class
} -cleanup {
    deleteWindows
} -result {-class class Class TkoFrame NewFrame}

test frame-1.2 {frame configuration options} -setup {
    deleteWindows
} -body {
    ::tko::frame .f -class NewFrame
    .f configure -class Different
} -cleanup {
    deleteWindows
} -returnCodes error -match glob -result {*: option "-class" is readonly}

test frame-1.3 {frame configuration options} -setup {
	deleteWindows
} -body {
    ::tko::frame .f -colormap new
    .f configure -colormap
} -cleanup {
    deleteWindows
} -result {-colormap colormap Colormap {} new}

test frame-1.4 {frame configuration options} -setup {
    deleteWindows
} -body {
    ::tko::frame .f -colormap new
    .f configure -colormap .
} -cleanup {
    deleteWindows
} -returnCodes error -match glob -result {*: option "-colormap" is readonly}

test frame-1.5 {frame configuration options} -setup {
	deleteWindows
} -body {
    ::tko::frame .f -visual default
    .f configure -visual
} -cleanup {
    deleteWindows
} -result {-visual visual Visual {} default}

test frame-1.6 {frame configuration options} -setup {
    deleteWindows
} -body {
    ::tko::frame .f -visual default
    .f configure -visual best
} -cleanup {
    deleteWindows
} -returnCodes error -match glob -result {*: option "-visual" is readonly}

test frame-1.7 {frame configuration options} -setup {
	deleteWindows
} -body {
    ::tko::frame .f -screen bogus
} -cleanup {
    deleteWindows
} -returnCodes error -match glob -result {unknown options: -screen bogus}

test frame-1.8 {frame configuration options} -setup {
	deleteWindows
} -body {
    ::tko::frame .f -container true
} -cleanup {
    deleteWindows
} -result {.f}

test frame-1.9 {frame configuration options} -setup {
    deleteWindows
} -body {
    ::tko::frame .f -container true
    .f configure -container
} -cleanup {
    deleteWindows
} -result {-container container Container 0 1}

test frame-1.10 {frame configuration options} -setup {
	deleteWindows
} -body {
    ::tko::frame .f -container bogus
} -cleanup {
    deleteWindows
} -returnCodes error -result {expected boolean value but got "bogus"}

test frame-1.11 {frame configuration options} -setup {
	deleteWindows
} -body {
    ::tko::frame .f
    .f configure -container 1
} -cleanup {
    deleteWindows
} -returnCodes error -match glob -result {*: option "-container" is readonly}

test frame-1.12 {frame configuration options} -setup {
	deleteWindows
} -body {
    # Make sure all options can be set to the default value
    ::tko::frame .f
    set opts {}
    foreach opt [.f configure] {
        if {[llength $opt] == 5} {
            lappend opts [lindex $opt 0] [lindex $opt 4]
        }
    }
    eval ::tko::frame .g $opts
    destroy .f .g
} -cleanup {
    deleteWindows
} -result {}

destroy .f
::tko::frame .f
test frame-1.13 {frame configuration options} -body {
    .f configure -background #ff0000
    lindex [.f configure -background] 4
} -cleanup {
    .f configure -background [lindex [.f configure -background] 3]
} -result {#ff0000}

test frame-1.14 {frame configuration options} -body {
    .f configure -background non-existent
} -returnCodes error -match glob -result {*: unknown color name "non-existent"}

test frame-1.15 {frame configuration options} -body {
    .f configure -bd 4
    lindex [.f configure -bd] 4
} -cleanup {
    .f configure -bd [lindex [.f configure -bd] 3]
} -result {4}

test frame-1.16 {frame configuration options} -body {
    .f configure -bd badValue
} -returnCodes error -match glob -result {*: bad screen distance "badValue"}

test frame-1.17 {frame configuration options} -body {
    .f configure -bg #00ff00
    lindex [.f configure -bg] 4
} -cleanup {
    .f configure -bg [lindex [.f configure -bg] 3]
} -result {#00ff00}

test frame-1.18 {frame configuration options} -body {
    .f configure -bg non-existent
} -returnCodes error -match glob -result {*: unknown color name "non-existent"}

test frame-1.19 {frame configuration options} -body {
    .f configure -borderwidth 1.3
    lindex [.f configure -borderwidth] 4
} -cleanup {
    .f configure -borderwidth [lindex [.f configure -borderwidth] 3]
} -result {1}

test frame-1.20 {frame configuration options} -body {
    .f configure -borderwidth badValue
} -returnCodes error -match glob -result {*: bad screen distance "badValue"}

test frame-1.21 {frame configuration options} -body {
    .f configure -cursor arrow
    lindex [.f configure -cursor] 4
} -cleanup {
    .f configure -cursor [lindex [.f configure -cursor] 3]
} -result {arrow}

test frame-1.22 {frame configuration options} -body {
    .f configure -cursor badValue
} -returnCodes error -match glob -result {*: bad cursor spec "badValue"}

test frame-1.23 {frame configuration options} -body {
    .f configure -height 100
    lindex [.f configure -height] 4
} -cleanup {
    .f configure -height [lindex [.f configure -height] 3]
} -result {100}

test frame-1.24 {frame configuration options} -body {
    .f configure -height not_a_number
} -returnCodes error -match glob -result {*: bad screen distance "not_a_number"}

test frame-1.25 {frame configuration options} -body {
    .f configure -highlightbackground #112233
    lindex [.f configure -highlightbackground] 4
} -cleanup {
    .f configure -highlightbackground [lindex [.f configure -highlightbackground] 3]
} -result {#112233}

test frame-1.26 {frame configuration options} -body {
    .f configure -highlightbackground ugly
} -returnCodes error -match glob -result {*: unknown color name "ugly"}

test frame-1.27 {frame configuration options} -body {
    .f configure -highlightcolor #123456
    lindex [.f configure -highlightcolor] 4
} -cleanup {
    .f configure -highlightcolor [lindex [.f configure -highlightcolor] 3]
} -result {#123456}

test frame-1.28 {frame configuration options} -body {
    .f configure -highlightcolor non-existent
} -returnCodes error -match glob -result {*: unknown color name "non-existent"}

test frame-1.29 {frame configuration options} -body {
    .f configure -highlightthickness 6
    lindex [.f configure -highlightthickness] 4
} -cleanup {
    .f configure -highlightthickness [lindex [.f configure -highlightthickness] 3]
} -result {6}

test frame-1.30 {frame configuration options} -body {
    .f configure -highlightthickness badValue
} -returnCodes error -match glob -result {*: bad screen distance "badValue"}

test frame-1.31 {frame configuration options} -body {
    .f configure -padx 3
    lindex [.f configure -padx] 4
} -cleanup {
    .f configure -padx [lindex [.f configure -padx] 3]
} -result {3}

test frame-1.32 {frame configuration options} -body {
    .f configure -padx badValue
} -returnCodes error -match glob -result {*: bad screen distance "badValue"}

test frame-1.33 {frame configuration options} -body {
    .f configure -pady 4
    lindex [.f configure -pady] 4
} -cleanup {
    .f configure -pady [lindex [.f configure -pady] 3]
} -result {4}

test frame-1.34 {frame configuration options} -body {
    .f configure -pady badValue
} -returnCodes error -match glob -result {*: bad screen distance "badValue"}

test frame-1.35 {frame configuration options} -body {
    .f configure -relief ridge
    lindex [.f configure -relief] 4
} -cleanup {
    .f configure -relief [lindex [.f configure -relief] 3]
} -result {ridge}

test frame-1.36 {frame configuration options} -body {
    .f configure -relief badValue
} -returnCodes error -match glob -result {*: bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}

test frame-1.37 {frame configuration options} -body {
    .f configure -takefocus {any string}
    lindex [.f configure -takefocus] 4
} -cleanup {
    .f configure -takefocus [lindex [.f configure -takefocus] 3]
} -result {any string}

test frame-1.38 {frame configuration options} -body {
    .f configure -width 32
    lindex [.f configure -width] 4
} -cleanup {
    .f configure -width [lindex [.f configure -width] 3]
} -result {32}

test frame-1.39 {frame configuration options} -body {
    .f configure -width badValue
} -returnCodes error -match glob -result {*: bad screen distance "badValue"}
destroy .f

#
# Test ::tko::toplevel configuration options
#

test frame-2.1 {toplevel configuration options} -setup {
	deleteWindows
} -body {
    ::tko::toplevel .t -width 200 -height 100 -class NewClass
    wm geometry .t +0+0
    .t configure -class
} -cleanup {
    deleteWindows
} -result {-class class Class TkoToplevel NewClass}

test frame-2.2 {toplevel configuration options} -setup {
    deleteWindows
} -body {
    ::tko::toplevel .t -width 200 -height 100 -class NewClass
    wm geometry .t +0+0
    .t configure -class Another
} -cleanup {
    deleteWindows
} -returnCodes error -match glob -result {*: option "-class" is readonly}

test frame-2.3 {toplevel configuration options} -setup {
	deleteWindows
} -body {
    ::tko::toplevel .t -width 200 -height 100 -colormap new
    wm geometry .t +0+0
    .t configure -colormap
} -cleanup {
    deleteWindows
} -result {-colormap colormap Colormap {} new}

test frame-2.4 {toplevel configuration options} -setup {
    deleteWindows
} -body {
    ::tko::toplevel .t -width 200 -height 100 -colormap new
    wm geometry .t +0+0
    .t configure -colormap .
} -cleanup {
    deleteWindows
} -returnCodes error -match glob -result {*: option "-colormap" is readonly}

test frame-2.5 {toplevel configuration options} -setup {
	deleteWindows
} -body {
    ::tko::toplevel .t -width 200 -height 100
    wm geometry .t +0+0
    .t configure -container 1
} -cleanup {
    deleteWindows
} -returnCodes error -match glob -result {*: option "-container" is readonly}

test frame-2.6 {toplevel configuration options} -setup {
    deleteWindows
} -body {
    catch {destroy .t}
    ::tko::toplevel .t -width 200 -height 100
    wm geometry .t +0+0
    catch {.t configure -container 1}
    .t configure -container
} -cleanup {
    deleteWindows
} -result {-container container Container 0 0}

test frame-2.7 {toplevel configuration options} -setup {
	deleteWindows
} -body {
    ::tko::toplevel .t -width 200 -height 100 -colormap bogus
} -cleanup {
    deleteWindows
} -returnCodes error -result {bad window path name "bogus"}

test frame-2.8 {toplevel configuration options} -constraints {
    win
} -setup {
	deleteWindows
} -body {
    catch {destroy .t}
    ::tko::toplevel .t -width 200 -height 100 -use 0x44022
#    wm geometry .t +0+0
#    .t configure -use 0x44022
} -cleanup {
    deleteWindows
} -returnCodes error -result {window "0x44022" doesn't exist}

test frame-2.9 {toplevel configuration options} -constraints {
    win
} -setup {
    deleteWindows
} -body {
    catch {destroy .t}
    ::tko::toplevel .t -width 200 -height 100
    wm geometry .t +0+0
    catch {.t configure -use 0x44022}
    .t configure -use
} -cleanup {
    deleteWindows
} -result {-use use Use {} {}}

test frame-2.10 {toplevel configuration options} -constraints {
    nonwin
} -setup {
    deleteWindows
} -body {
    catch {destroy .t}
    ::tko::toplevel .t -width 200 -height 100
    wm geometry .t +0+0
    .t configure -use 0x44022
} -cleanup {
    deleteWindows
} -returnCodes error -result {can't modify -use option after widget is created}

test frame-2.11 {toplevel configuration options} -constraints {
    nonwin
} -setup {
	deleteWindows
} -body {
    catch {destroy .t}
    ::tko::toplevel .t -width 200 -height 100
    wm geometry .t +0+0
    catch {.t configure -use 0x44022}
    .t configure -use
} -cleanup {
    deleteWindows
} -result {-use use Use {} {}}

test frame-2.12 {toplevel configuration options} -setup {
	deleteWindows
} -body {
    catch {destroy .t}
    ::tko::toplevel .t -width 200 -height 100 -visual default
    wm geometry .t +0+0
    .t configure -visual
} -cleanup {
    deleteWindows
} -result {-visual visual Visual {} default}

test frame-2.13 {toplevel configuration options} -setup {
    deleteWindows
} -body {
    catch {destroy .t}
    ::tko::toplevel .t -width 200 -height 100 -visual default
    wm geometry .t +0+0
    .t configure -visual best
} -cleanup {
    deleteWindows
} -returnCodes error -match glob -result {*: option "-visual" is readonly}

test frame-2.14 {toplevel configuration options} -setup {
	deleteWindows
} -body {
    ::tko::toplevel .t -width 200 -height 100 -visual who_knows?
} -cleanup {
    deleteWindows
} -returnCodes error -result {unknown or ambiguous visual name "who_knows?": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}

test frame-2.15 {toplevel configuration options} -constraints haveDISPLAY -setup {
	deleteWindows
} -body {
    ::tko::toplevel .t -width 200 -height 100 -screen $env(DISPLAY)
    wm geometry .t +0+0
    string compare [.t configure -screen] "-screen screen Screen {} $env(DISPLAY)"
} -cleanup {
    deleteWindows
} -result {0}

test frame-2.16 {toplevel configuration options} -constraints haveDISPLAY -setup {
    deleteWindows
} -body {
    ::tko::toplevel .t -width 200 -height 100 -screen $env(DISPLAY)
    wm geometry .t +0+0
    .t configure -screen another
} -cleanup {
    deleteWindows
} -returnCodes error -result {can't modify -screen option after widget is created}

test frame-2.17 {toplevel configuration options} -setup {
	deleteWindows
} -body {
    ::tko::toplevel .t -width 200 -height 100 -screen bogus
} -cleanup {
    deleteWindows
} -returnCodes error -result {couldn't connect to display "bogus"}


test frame-2.18 {toplevel configuration options} -setup {
	deleteWindows
} -body {
    ::tko::toplevel .t -container 1 -width 300 -height 120
    wm geometry .t +0+0
    ::tko::toplevel .x -container 1 -use [winfo id .t]
} -cleanup {
    deleteWindows
} -returnCodes error -result {windows cannot have both the -use and the -container option set}

test frame-2.19 {toplevel configuration options} -setup {
	deleteWindows
    set opts {}
} -body {
    # Make sure all options can be set to the default value
    ::tko::toplevel .f
    foreach opt [.f configure] {
        if {[llength $opt] == 5} {
            lappend opts [lindex $opt 0] [lindex $opt 4]
        }
    }
    eval ::tko::toplevel .g $opts
    destroy .f .g
} -cleanup {
    deleteWindows
} -result {}

destroy .t
::tko::toplevel .t -width 300 -height 150
wm geometry .t +0+0
update
test frame-2.20 {toplevel configuration options} -body {
    .t configure -background #ff0000
    lindex [.t configure -background] 4
} -result {#ff0000}

test frame-2.21 {toplevel configuration options} -body {
    .t configure -background non-existent
} -returnCodes error -match glob -result {*: unknown color name "non-existent"}

test frame-2.22 {toplevel configuration options} -body {
    .t configure -bd 4
    lindex [.t configure -bd] 4
} -result {4}

test frame-2.23 {toplevel configuration options} -body {
    .t configure -bd badValue
} -returnCodes error -match glob -result {*: bad screen distance "badValue"}

test frame-2.24 {toplevel configuration options} -body {
    .t configure -bg #00ff00
    lindex [.t configure -bg] 4
} -result {#00ff00}

test frame-2.25 {toplevel configuration options} -body {
    .t configure -bg non-existent
} -returnCodes error -match glob -result {*: unknown color name "non-existent"}

test frame-2.26 {toplevel configuration options} -body {
    .t configure -borderwidth 1.3
    lindex [.t configure -borderwidth] 4
} -result {1}

test frame-2.27 {toplevel configuration options} -body {
    .t configure -borderwidth badValue
} -returnCodes error -match glob -result {*: bad screen distance "badValue"}

test frame-2.28 {toplevel configuration options} -body {
    .t configure -cursor arrow
    lindex [.t configure -cursor] 4
} -result {arrow}

test frame-2.29 {toplevel configuration options} -body {
    .t configure -cursor badValue
} -returnCodes error -match glob -result {*: bad cursor spec "badValue"}

test frame-2.30 {toplevel configuration options} -body {
    .t configure -height 100
    lindex [.t configure -height] 4
} -result {100}

test frame-2.31 {toplevel configuration options} -body {
    .t configure -height not_a_number
} -returnCodes error -match glob -result {*: bad screen distance "not_a_number"}

test frame-2.32 {toplevel configuration options} -body {
    .t configure -highlightcolor #123456
    lindex [.t configure -highlightcolor] 4
} -result {#123456}

test frame-2.33 {toplevel configuration options} -body {
    .t configure -highlightcolor non-existent
} -returnCodes error -match glob -result {*: unknown color name "non-existent"}

test frame-2.34 {toplevel configuration options} -body {
    .t configure -highlightthickness 3
    lindex [.t configure -highlightthickness] 4
} -result {3}

test frame-2.35 {toplevel configuration options} -body {
    .t configure -highlightthickness badValue
} -returnCodes error -match glob -result {*: bad screen distance "badValue"}

test frame-2.36 {toplevel configuration options} -body {
    .t configure -padx 3
    lindex [.t configure -padx] 4
} -result {3}

test frame-2.37 {toplevel configuration options} -body {
    .t configure -padx badValue
} -returnCodes error -match glob -result {*: bad screen distance "badValue"}

test frame-2.38 {toplevel configuration options} -body {
    .t configure -pady 4
    lindex [.t configure -pady] 4
} -result {4}

test frame-2.39 {toplevel configuration options} -body {
    .t configure -pady badValue
} -returnCodes error -match glob -result {*: bad screen distance "badValue"}

test frame-2.40 {toplevel configuration options} -body {
    .t configure -relief ridge
    lindex [.t configure -relief] 4
} -result {ridge}

test frame-2.41 {toplevel configuration options} -body {
    .t configure -relief badValue
} -returnCodes error -match glob -result {*: bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}

test frame-2.42 {toplevel configuration options} -body {
    .t configure -width 32
    lindex [.t configure -width] 4
} -result {32}

test frame-2.43 {toplevel configuration options} -body {
    .t configure -width badValue
} -returnCodes error -match glob -result {*: bad screen distance "badValue"}
destroy .t

#
# Test ::tko::labelframe configuration options
#
test frame-3.1 {TkCreateFrame procedure} -body {
    ::tko::frame
} -returnCodes error -result {wrong # args: should be "::tko::frame pathName ?arg ...?"}

test frame-3.2 {TkCreateFrame procedure} -setup {
	deleteWindows
    ::tko::frame .f
} -body {
    .f configure -class
} -cleanup {
    deleteWindows
} -result {-class class Class TkoFrame TkoFrame}

test frame-3.3 {TkCreateFrame procedure} -setup {
	deleteWindows
    ::tko::toplevel .t
    wm geometry .t +0+0
} -body {
    .t configure -class
} -cleanup {
    deleteWindows
} -result {-class class Class TkoToplevel TkoToplevel}

test frame-3.4 {TkCreateFrame procedure} -setup {
	deleteWindows
} -body {
    ::tko::toplevel .t -width 350 -class NewClass -bg black -visual default -height 90
    wm geometry .t +0+0
    update
    list [lindex [.t configure -width] 4] \
	    [lindex [.t configure -background] 4] \
	    [lindex [.t configure -height] 4]
} -cleanup {
    deleteWindows
} -result {350 black 90}

# Be sure that the -class, -colormap, and -visual options are processed
# before configuring the widget.

test frame-3.5 {TkCreateFrame procedure} -setup {
	deleteWindows
} -body {
    option add *NewFrame.background #123456
    ::tko::frame .f -class NewFrame
    lindex [.f configure -background] 4
} -cleanup {
    deleteWindows
    option clear
} -result {#123456}

test frame-3.6 {TkCreateFrame procedure} -setup {
	deleteWindows
} -body {
    option add *NewFrame.background #123456
    ::tko::frame .f -class NewFrame
    lindex [.f configure -background] 4
} -cleanup {
    deleteWindows
    option clear
} -result {#123456}

test frame-3.7 {TkCreateFrame procedure} -setup {
	deleteWindows
} -body {
    option add *NewFrame.background #332211
    option add *f.class NewFrame
    ::tko::frame .f
    list [lindex [.f configure -class] 4] [lindex [.f configure -background] 4]
} -cleanup {
    deleteWindows
    option clear
} -result {NewFrame #332211}

test frame-3.8 {TkCreateFrame procedure} -setup {
	deleteWindows
} -body {
    option add *Silly.background #122334
    option add *f.Class Silly
    ::tko::frame .f
    list [lindex [.f configure -class] 4] [lindex [.f configure -background] 4]
} -cleanup {
    deleteWindows
    option clear
} -result {Silly #122334}

test frame-3.9 {TkCreateFrame procedure, -use option} -constraints {
    unix
} -setup {
	deleteWindows
} -body {
    ::tko::toplevel .t -container 1 -width 300 -height 120
    wm geometry .t +0+0
    ::tko::toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green
    tkwait visibility .x
    list [expr {[winfo rootx .x] - [winfo rootx .t]}] \
	    [expr {[winfo rooty .x] - [winfo rooty .t]}] \
	    [winfo width .t] [winfo height .t]
} -cleanup {
    # This call to update idletasks was added to prevent a crash that was
    # observed on OSX 10.12 (Sierra) only.  Any change, such as using the
    # Development version to make debugging symbols available, adding a print
    # statement, or calling update idletasks here, would make the test pass
    # with no segfault.
    update idletasks
    deleteWindows
} -result {0 0 140 300}

test frame-3.10 {TkCreateFrame procedure, -use option} -constraints {
    unix
} -setup {
    deleteWindows
} -body {
    ::tko::toplevel .t -container 1 -width 300 -height 120
    wm geometry .t +0+0
    option add *x.use [winfo id .t]
    ::tko::toplevel .x -width 140 -height 300 -bg green
    tkwait visibility .x
    list [expr {[winfo rootx .x] - [winfo rootx .t]}] \
	    [expr {[winfo rooty .x] - [winfo rooty .t]}] \
	    [winfo width .t] [winfo height .t]
} -cleanup {
    destroy .t
    option clear
} -result {0 0 140 300}

# The tests below require specific display characteristics (i.e. that
# they are run on a pseudocolor display of depth 8).  Even so, they
# are non-portable: some machines don't seem to ever run out of
# colors.
if {[testConstraint defaultPseudocolor8]} {
    ::TEST::eatColors .t1
}
test frame-3.11 {TkCreateFrame procedure} -constraints {
	defaultPseudocolor8 nonPortable
} -setup {
	deleteWindows
} -body {
    ::tko::toplevel .t -width 300 -height 200 -bg #475601
    wm geometry .t +0+0
    update
    ::TEST::colorsFree .t
} -cleanup {
    deleteWindows
} -result {0}

test frame-3.12 {TkCreateFrame procedure} -constraints {
	defaultPseudocolor8 nonPortable
} -setup {
	deleteWindows
} -body {
    ::tko::toplevel .t -width 300 -height 200 -bg #475601 -colormap new
    wm geometry .t +0+0
    update
    ::TEST::colorsFree .t
} -cleanup {
    deleteWindows
} -result {1}

test frame-3.13 {TkCreateFrame procedure} -constraints {
	defaultPseudocolor8 nonPortable
} -setup {
	deleteWindows
} -body {
    option add *t.class Toplevel2
    option add *Toplevel2.colormap new
    ::tko::toplevel .t -width 300 -height 200 -bg #475601
    wm geometry .t +0+0
    update
    option clear
    ::TEST::colorsFree .t
} -cleanup {
    deleteWindows
} -result {1}

test frame-3.14 {TkCreateFrame procedure} -constraints {
	defaultPseudocolor8 nonPortable
} -setup {
	deleteWindows
} -body {
    option add *t.class Toplevel3
    option add *Toplevel3.Colormap new
    ::tko::toplevel .t -width 300 -height 200 -bg #475601 -colormap new
    wm geometry .t +0+0
    update
    option clear
    ::TEST::colorsFree .t
} -cleanup {
    deleteWindows
} -result {1}

test frame-3.15 {TkCreateFrame procedure, -use and -colormap} -constraints {
    defaultPseudocolor8 unix nonPortable
} -setup {
    deleteWindows
} -body {
    ::tko::toplevel .t -container 1 -width 300 -height 120
    wm geometry .t +0+0
    ::tko::toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green -colormap new
    tkwait visibility .x
    list [::TEST::colorsFree .t] [::TEST::colorsFree .x]
} -cleanup {
    destroy .t
} -result {0 1}

test frame-3.16 {TkCreateFrame procedure} -constraints {
	defaultPseudocolor8 nonPortable
} -setup {
	deleteWindows
} -body {
    ::tko::toplevel .t -width 300 -height 200 -bg #475601 -visual default
    wm geometry .t +0+0
    update
    ::TEST::colorsFree .t
} -cleanup {
    deleteWindows
} -result {0}

test frame-3.17 {TkCreateFrame procedure} -constraints {
	defaultPseudocolor8 nonPortable
} -setup {
	deleteWindows
} -body {
    ::tko::toplevel .t -width 300 -height 200 -bg #475601 -visual default \
	    -colormap new
    wm geometry .t +0+0
    update
    ::TEST::colorsFree .t
} -cleanup {
    deleteWindows
} -result {1}

test frame-3.18 {TkCreateFrame procedure} -constraints {
	defaultPseudocolor8 haveGrayscale8 nonPortable
} -setup {
	deleteWindows
} -body {
    ::tko::toplevel .t -visual {grayscale 8} -width 300 -height 200 -bg #434343
    wm geometry .t +0+0
    update
    ::TEST::colorsFree .t 131 131 131
} -cleanup {
    deleteWindows
} -result {1}

test frame-3.19 {TkCreateFrame procedure} -constraints {
	defaultPseudocolor8 haveGrayscale8 nonPortable
} -setup {
	deleteWindows
} -body {
    option add *t.class T4
    option add *T4.visual {grayscale 8}
    ::tko::toplevel .t -width 300 -height 200 -bg #434343
    wm geometry .t +0+0
    update
    option clear
    list [::TEST::colorsFree .t 131 131 131] [lindex [.t configure -visual] 4]
} -cleanup {
    deleteWindows
} -result {1 {grayscale 8}}

test frame-3.20 {TkCreateFrame procedure} -constraints {
	defaultPseudocolor8 haveGrayscale8 nonPortable
} -setup {
	deleteWindows
} -body {
    set x ok
    option add *t.class T5
    option add *T5.Visual {grayscale 8}
    ::tko::toplevel .t -width 300 -height 200 -bg #434343
    wm geometry .t +0+0
    update
    option clear
    list [::TEST::colorsFree .t 131 131 131] [lindex [.t configure -visual] 4]
} -cleanup {
    deleteWindows
} -result {1 {grayscale 8}}

test frame-3.21 {TkCreateFrame procedure} -constraints {
	defaultPseudocolor8 haveGrayscale8 nonPortable
} -setup {
	deleteWindows
} -body {
    set x ok
    ::tko::toplevel .t -visual {grayscale 8} -width 300 -height 200 -bg #434343
    wm geometry .t +0+0
    update
    ::TEST::colorsFree .t 131 131 131
} -cleanup {
    deleteWindows
} -result {1}
if {[testConstraint defaultPseudocolor8]} {
    destroy .t1
}

test frame-3.22 {TkCreateFrame procedure, default dimensions} -setup {
	deleteWindows
} -body {
    ::tko::toplevel .t
    wm geometry .t +0+0
    update
    set result "[winfo reqwidth .t] [winfo reqheight .t]"
    ::tko::frame .t.f -bg red
    pack .t.f
    update
    lappend result [winfo reqwidth .t.f] [winfo reqheight .t.f]
} -cleanup {
    deleteWindows
} -result {200 200 1 1}

test frame-3.23 {TkCreateFrame procedure} -setup {
    deleteWindows
} -body {
    ::tko::frame .f -gorp glob
} -returnCodes error -result {unknown options: -gorp glob}

test frame-3.24 {TkCreateFrame procedure} -setup {
    deleteWindows
} -body {
    ::tko::toplevel .t -width 300 -height 200 -colormap new -bogus option
    wm geometry .t +0+0
} -returnCodes error -result {unknown options: -bogus option}


test frame-4.1 {TkCreateFrame procedure} -setup {
	deleteWindows
} -body {
    catch {::tko::frame .f -gorp glob}
    winfo exists .f
} -result 0

test frame-4.2 {TkCreateFrame procedure} -setup {
	deleteWindows
} -body {
    list [::tko::frame .f -width 200 -height 100] [winfo exists .f]
} -cleanup {
    deleteWindows
} -result {.f 1}


::tko::frame .f -highlightcolor black

test frame-5.1 {FrameWidgetCommand procedure} -body {
    .f
} -returnCodes error -result {wrong # args: should be ".f method ?arg ...?"}

test frame-5.2 {FrameWidgetCommand procedure, cget option} -body {
    .f cget
} -returnCodes error -result {wrong # args: should be ".f cget option"}

test frame-5.3 {FrameWidgetCommand procedure, cget option} -body {
    .f cget a b
} -returnCodes error -result {wrong # args: should be ".f cget option"}

test frame-5.4 {FrameWidgetCommand procedure, cget option} -body {
    .f cget -gorp
} -returnCodes error -result {unknown option "-gorp"}

test frame-5.5 {FrameWidgetCommand procedure, cget option} -body {
    .f cget -highlightcolor
} -result {black}

test frame-5.6 {FrameWidgetCommand procedure, cget option} -body {
    .f cget -screen
} -returnCodes error -result {unknown option "-screen"}

test frame-5.7 {FrameWidgetCommand procedure, cget option} -setup {
    destroy .t
} -body {
    ::tko::toplevel .t
    .t cget -screen
} -cleanup {
    destroy .t
} -returnCodes ok -match glob -result *

test frame-5.8 {FrameWidgetCommand procedure, configure option} -body {
    llength [.f configure]
} -result {21}

test frame-5.9 {FrameWidgetCommand procedure, configure option} -body {
    .f configure -gorp
} -returnCodes error -result {unknown option "-gorp"}

test frame-5.10 {FrameWidgetCommand procedure, configure option} -body {
    .f configure -gorp bogus
} -returnCodes error -result {unknown option "-gorp"}

test frame-5.11 {FrameWidgetCommand procedure, configure option} -body {
    .f configure -width 200 -height
} -returnCodes error -result {wrong # args: should be ".f configure ?-option value ..?"}

test frame-5.12 {FrameWidgetCommand procedure} -body {
    .f swizzle
} -returnCodes error -result {unknown method "swizzle": must be cget or configure}

test frame-5.13 {FrameWidgetCommand procedure, configure option} -body {
    llength [. configure]
} -result {24}
destroy .f

test frame-6.1 {ConfigureFrame procedure} -setup {
	deleteWindows
} -body {
    ::tko::frame .f -width 150
    list [winfo reqwidth .f] [winfo reqheight .f]
} -cleanup {
    deleteWindows
} -result {150 1}

test frame-6.2 {ConfigureFrame procedure} -setup {
	deleteWindows
} -body {
    ::tko::frame .f -height 97
    list [winfo reqwidth .f] [winfo reqheight .f]
} -cleanup {
    deleteWindows
} -result {1 97}

test frame-6.3 {ConfigureFrame procedure} -setup {
	deleteWindows
} -body {
    ::tko::frame .f
    set result {}
    lappend result [winfo reqwidth .f] [winfo reqheight .f]
    .f configure -width 100 -height 180
    lappend result [winfo reqwidth .f] [winfo reqheight .f]
    .f configure -width 0 -height 0
    lappend result [winfo reqwidth .f] [winfo reqheight .f]
} -cleanup {
    deleteWindows
} -result {1 1 100 180 100 180}

test frame-7.1 {FrameEventProc procedure} -setup {
	deleteWindows
} -body {
    ::tko::frame .frame2
    set result [info commands .frame2]
    destroy .frame2
    lappend result [info commands .frame2]
} -result {.frame2 {}}

test frame-7.2 {FrameEventProc procedure} -setup {
	deleteWindows
    set x {}
} -body {
    frame .f1 -bg #543210
    rename .f1 .f2
    lappend x [winfo children .]
    lappend x [.f2 cget -bg]
    destroy .f1
    lappend x [info command .f*] [winfo children .]
} -cleanup {
    deleteWindows
} -result {.f1 #543210 {} {}}

test frame-8.1 {FrameCmdDeletedProc procedure} -setup {
	deleteWindows
} -body {
    ::tko::frame .f1
    rename .f1 {}
    list [info command .f*] [winfo children .]
} -cleanup {
    deleteWindows
} -result {{} {}}

test frame-8.2 {FrameCmdDeletedProc procedure} -setup {
	deleteWindows
} -body {
    ::tko::toplevel .f1 -menu .m
    wm geometry .f1 +0+0
    update
    rename .f1 {}
    update
    list [info command .f*] [winfo children .]
} -cleanup {
    deleteWindows
} -result {{} {}}
#
# This one fails with the dash-patch!!!! Still don't know why  :-(
#
#test frame-8.3 {FrameCmdDeletedProc procedure} -setup {
#    eval destroy [winfo children .]
#    deleteWindows
#} -body {
#    ::tko::toplevel .f1 -menu .m
#    wm geometry .f1 +0+0
#    menu .m
#    update
#    rename .f1 {}
#    update
#    list [info command .f*] [winfo children .]
#} -cleanup {
#    eval destroy [winfo children .]
#    deleteWindows
#} -result {{} .m}

test frame-9.1 {MapFrame procedure} -setup {
	deleteWindows
} -body {
    ::tko::toplevel .t -width 100 -height 400
    wm geometry .t +0+0
    set result [winfo ismapped .t]
    update idletasks
    lappend result [winfo ismapped .t]
} -cleanup {
    deleteWindows
} -result {0 1}

test frame-9.2 {MapFrame procedure} -setup {
	deleteWindows
} -body {
    ::tko::toplevel .t -width 100 -height 400
    wm geometry .t +0+0
    destroy .t
    update
    winfo exists .t
} -result {0}

test frame-9.3 {MapFrame procedure, window deleted while mapping} -setup {
	deleteWindows
} -body {
    ::tko::toplevel .t2 -width 200 -height 200
    wm geometry .t2 +0+0
    tkwait visibility .t2
    ::tko::toplevel .t -width 100 -height 400
    wm geometry .t +0+0
    ::tko::frame .t2.f -width 50 -height 50
    bind .t2.f <Configure> {destroy .t}
    pack .t2.f -side top
    update idletasks
    winfo exists .t
} -cleanup {
    deleteWindows
} -result {0}


test frame-10.1 {frame widget vs hidden commands} -setup {
	deleteWindows
} -body {
    set l [interp hidden]
    ::tko::frame .t
    interp hide {} .t
    destroy .t
    set res1 [list [winfo children .] [interp hidden]]
    set res2 [list {} $l]
    expr {$res1 eq $res2}
} -result 1


test frame-11.1 {TkInstallFrameMenu} -setup {
	deleteWindows
} -body {
    menu .m1
    .m1 add cascade -menu .m1.system
    menu .m1.system -tearoff 0
    .m1.system add command -label foo
    ::tko::toplevel .t -menu .m1
} -cleanup {
#TODO otherwise crash
destroy .t
destroy .m1
    deleteWindows
} -result {.t}

test frame-11.2 {TkInstallFrameMenu - frame renamed} -setup {
	deleteWindows
} -body {
    catch {rename foo {}}
    menu .m1
    .m1 add cascade -menu .m1.system
    menu .m1.system -tearoff 0
    .m1.system add command -label foo
    ::tko::toplevel .t
    rename .t foo
} -cleanup {
#TODO otherwise crash
destroy .t
destroy .m1
    deleteWindows
} -result {}


test frame-12.1 {FrameWorldChanged procedure} -setup {
	deleteWindows
} -body {
    # Test -bd -padx and -pady
    ::tko::frame .f -borderwidth 2 -padx 3 -pady 4
    place .f -x 0 -y 0 -width 40 -height 40
    pack [::tko::frame .f.f] -fill both -expand 1
    update
    list [winfo x .f.f] [winfo y .f.f] [winfo width .f.f] [winfo height .f.f]
} -cleanup {
    deleteWindows
} -result {5 6 30 28}

test frame-12.2 {FrameWorldChanged procedure} -setup {
	deleteWindows
} -body {
    # Test all -labelanchor positions
    set font {helvetica 12}
    ::tko::labelframe .f -highlightthickness 1 -bd 3 -padx 1 -pady 2 -font $font \
            -text "Mupp"
    set fh [expr {[font metrics $font -linespace] + 2 - 3}]
    set fw [expr {[font measure $font "Mupp"] + 2 - 3}]
    if {$fw < 0} {set fw 0}
    if {$fh < 0} {set fh 0}
    place .f -x 0 -y 0 -width 100 -height 100
    pack [::tko::frame .f.f] -fill both -expand 1

    set result {}
    foreach lp {nw n ne en e es se s sw ws w wn} {
        .f configure -labelanchor $lp
        update
        set expx 5
        set expy 6
        set expw 90
        set exph 88
        switch -glob $lp {
            n* {incr expy $fh ; incr exph -$fh}
            s* {incr exph -$fh}
            w* {incr expx $fw ; incr expw -$fw}
            e* {incr expw -$fw}
        }
        lappend result [expr {\
                [winfo x .f.f] == $expx && [winfo y .f.f] == $expy &&\
                [winfo width .f.f] == $expw && [winfo height .f.f] == $exph}]
    }
    return $result
} -cleanup {
    deleteWindows
} -result {1 1 1 1 1 1 1 1 1 1 1 1}

test frame-12.3 {FrameWorldChanged procedure} -setup {
	deleteWindows
} -body {
    # Check reaction on font change
    font create myfont -family courier -size 10
    ::tko::labelframe .f -font myfont -text Mupp
    place .f -x 0 -y 0 -width 40 -height 40
    pack [::tko::frame .f.f] -fill both -expand 1
    update
    set h1 [font metrics myfont -linespace]
    set y1 [winfo y .f.f]
    font configure myfont -size 20
    update
    set h2 [font metrics myfont -linespace]
    set y2 [winfo y .f.f]
    expr {($h2 - $h1) - ($y2 - $y1)}
} -cleanup {
    deleteWindows
    font delete myfont
} -result {0}


test frame-13.1 {labelframe configuration options} -setup {
	deleteWindows
} -body {
    ::tko::labelframe .f -class NewFrame
    .f configure -class
} -cleanup {
    deleteWindows
} -result {-class class Class TkoLabelframe NewFrame}

test frame-13.2 {labelframe configuration options} -setup {
    deleteWindows
} -body {
    ::tko::labelframe .f -class NewFrame
    .f configure -class Different
} -cleanup {
    deleteWindows
} -returnCodes error -match glob -result {*: option "-class" is readonly}

test frame-13.3 {labelframe configuration options} -setup {
	deleteWindows
} -body {
    ::tko::labelframe .f -colormap new
} -cleanup {
    deleteWindows
} -result {.f}

test frame-13.4 {labelframe configuration options} -setup {
	deleteWindows
} -body {
    ::tko::labelframe .f -visual default
} -cleanup {
    deleteWindows
} -result {.f}

test frame-13.5 {labelframe configuration options} -setup {
	deleteWindows
} -body {
    ::tko::labelframe .f -screen bogus
} -cleanup {
    deleteWindows
} -returnCodes error -result {unknown options: -screen bogus}

test frame-13.6 {labelframe configuration options} -setup {
	deleteWindows
} -body {
    labelframe .f -container true
} -cleanup {
    deleteWindows
} -result {.f}

# Removed. Should be deprectaed in frame too.
#test frame-13.7 {labelframe configuration options} -setup {
#    deleteWindows
#} -body {
#    ::tko::labelframe .f -container true
#    .f configure -container
#} -cleanup {
#    deleteWindows
#} -result {-container container Container 0 1}
#
#test frame-13.8 {labelframe configuration options} -setup {
#	deleteWindows
#} -body {
#     ::tko::labelframe .f -container bogus
#} -cleanup {
#    deleteWindows
#} -returnCodes error -result {expected boolean value but got "bogus"}
#
#test frame-13.9 {labelframe configuration options} -setup {
#	deleteWindows
#} -body {
#    ::tko::labelframe .f
#    .f configure -container 1
#} -cleanup {
#    deleteWindows
#} -returnCodes error -result {can't modify -container option after widget is created}

destroy .f
::tko::labelframe .f
test frame-13.10 {labelframe configuration options} -body {
    .f configure -background #ff0000
    lindex [.f configure -background] 4
} -cleanup {
    .f configure -background [lindex [.f configure -background] 3]
} -result {#ff0000}

test frame-13.11 {labelframe configuration options} -body {
        .f configure -background non-existent
} -returnCodes error -match glob -result {*: unknown color name "non-existent"}

test frame-13.12 {labelframe configuration options} -body {
    .f configure -bd 4
    lindex [.f configure -bd] 4
} -cleanup {
    .f configure -bd [lindex [.f configure -bd] 3]
} -result {4}

test frame-13.13 {labelframe configuration options} -body {
        .f configure -bd badValue
} -returnCodes error -match glob -result {*: bad screen distance "badValue"}

test frame-13.14 {labelframe configuration options} -body {
    .f configure -bg #00ff00
    lindex [.f configure -bg] 4
} -cleanup {
    .f configure -bg [lindex [.f configure -bg] 3]
} -result {#00ff00}

test frame-13.15 {labelframe configuration options} -body {
        .f configure -bg non-existent
} -returnCodes error -match glob -result {*: unknown color name "non-existent"}

test frame-13.16 {labelframe configuration options} -body {
    .f configure -borderwidth 1.3
    lindex [.f configure -borderwidth] 4
} -cleanup {
    .f configure -borderwidth [lindex [.f configure -borderwidth] 3]
} -result {1}

test frame-13.17 {labelframe configuration options} -body {
        .f configure -borderwidth badValue
} -returnCodes error -match glob -result {*: bad screen distance "badValue"}

test frame-13.18 {labelframe configuration options} -body {
    .f configure -cursor arrow
    lindex [.f configure -cursor] 4
} -cleanup {
    .f configure -cursor [lindex [.f configure -cursor] 3]
} -result {arrow}

test frame-13.19 {labelframe configuration options} -body {
        .f configure -cursor badValue
} -returnCodes error -match glob -result {*: bad cursor spec "badValue"}

test frame-13.20 {labelframe configuration options} -body {
    .f configure -fg #0000ff
    lindex [.f configure -fg] 4
} -cleanup {
    .f configure -fg [lindex [.f configure -fg] 3]
} -result {#0000ff}

test frame-13.21 {labelframe configuration options} -body {
        .f configure -fg non-existent
} -returnCodes error -match glob -result {*: unknown color name "non-existent"}

test frame-13.22 {labelframe configuration options} -body {
    .f configure -font {courier 8}
    lindex [.f configure -font] 4
} -cleanup {
    .f configure -font [lindex [.f configure -font] 3]
} -result {courier 8}

test frame-13.23 {labelframe configuration options} -body {
    .f configure -foreground #ff0000
    lindex [.f configure -foreground] 4
} -cleanup {
    .f configure -foreground [lindex [.f configure -foreground] 3]
} -result {#ff0000}

test frame-13.24 {labelframe configuration options} -body {
        .f configure -foreground non-existent
} -returnCodes error -match glob -result {*: unknown color name "non-existent"}

test frame-13.25 {labelframe configuration options} -body {
    .f configure -height 100
    lindex [.f configure -height] 4
} -cleanup {
    .f configure -height [lindex [.f configure -height] 3]
} -result {100}

test frame-13.26 {labelframe configuration options} -body {
        .f configure -height not_a_number
} -returnCodes error -match glob -result {*: bad screen distance "not_a_number"}

test frame-13.27 {labelframe configuration options} -body {
    .f configure -highlightbackground #112233
    lindex [.f configure -highlightbackground] 4
} -cleanup {
    .f configure -highlightbackground [lindex [.f configure -highlightbackground] 3]
} -result {#112233}

test frame-13.28 {labelframe configuration options} -body {
        .f configure -highlightbackground ugly
} -returnCodes error -match glob -result {*: unknown color name "ugly"}

test frame-13.29 {labelframe configuration options} -body {
    .f configure -highlightcolor #123456
    lindex [.f configure -highlightcolor] 4
} -cleanup {
    .f configure -highlightcolor [lindex [.f configure -highlightcolor] 3]
} -result {#123456}

test frame-13.30 {labelframe configuration options} -body {
        .f configure -highlightcolor non-existent
} -returnCodes error -match glob -result {*: unknown color name "non-existent"}

test frame-13.31 {labelframe configuration options} -body {
    .f configure -highlightthickness 6
    lindex [.f configure -highlightthickness] 4
} -cleanup {
    .f configure -highlightthickness [lindex [.f configure -highlightthickness] 3]
} -result {6}

test frame-13.32 {labelframe configuration options} -body {
        .f configure -highlightthickness badValue
} -returnCodes error -match glob -result {*: bad screen distance "badValue"}

test frame-13.33 {labelframe configuration options} -body {
    .f configure -labelanchor se
    lindex [.f configure -labelanchor] 4
} -cleanup {
    .f configure -labelanchor [lindex [.f configure -labelanchor] 3]
} -result {se}

test frame-13.34 {labelframe configuration options} -body {
        .f configure -labelanchor badValue
} -returnCodes error -match glob -result {*: bad labelanchor "badValue": must be e, en, es, n, ne, nw, s, se, sw, w, wn, or ws}

test frame-13.35 {labelframe configuration options} -body {
    .f configure -padx 3
    lindex [.f configure -padx] 4
} -cleanup {
    .f configure -padx [lindex [.f configure -padx] 3]
} -result {3}

test frame-13.36 {labelframe configuration options} -body {
        .f configure -padx badValue
} -returnCodes error -match glob -result {*: bad screen distance "badValue"}

test frame-13.37 {labelframe configuration options} -body {
    .f configure -pady 4
    lindex [.f configure -pady] 4
} -cleanup {
    .f configure -pady [lindex [.f configure -pady] 3]
} -result {4}

test frame-13.38 {labelframe configuration options} -body {
        .f configure -pady badValue
} -returnCodes error -match glob -result {*: bad screen distance "badValue"}

test frame-13.39 {labelframe configuration options} -body {
    .f configure -relief ridge
    lindex [.f configure -relief] 4
} -cleanup {
    .f configure -relief [lindex [.f configure -relief] 3]
} -result {ridge}

test frame-13.40 {labelframe configuration options} -body {
        .f configure -relief badValue
} -returnCodes error -match glob -result {*: bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}

test frame-13.41 {labelframe configuration options} -body {
    .f configure -takefocus {any string}
    lindex [.f configure -takefocus] 4
} -cleanup {
    .f configure -takefocus [lindex [.f configure -takefocus] 3]
} -result {any string}

test frame-13.42 {labelframe configuration options} -body {
    .f configure -text {any string}
    lindex [.f configure -text] 4
} -cleanup {
    .f configure -text [lindex [.f configure -text] 3]
} -result {any string}

test frame-13.43 {labelframe configuration options} -body {
    .f configure -width 32
    lindex [.f configure -width] 4
} -cleanup {
    .f configure -width [lindex [.f configure -width] 3]
} -result {32}

test frame-13.44 {labelframe configuration options} -body {
        .f configure -width badValue
} -returnCodes error -match glob -result {*: bad screen distance "badValue"}
destroy .f

test frame-14.1 {labelframe labelwidget option} -setup {
	deleteWindows
} -body {
    # Test that label is moved in stacking order
    label .l -text Mupp -font {helvetica 8}
    ::tko::labelframe .f -labelwidget .l
    pack .f
    ::tko::frame .f.f -width 50 -height 50
    pack .f.f
    update
    list [winfo children .] [winfo width .f] \
        [expr {[winfo height .f] - [winfo height .l]}]
} -cleanup {
    deleteWindows
} -result {{.f .l} 54 52}

test frame-14.2 {labelframe labelwidget option} -setup {
	deleteWindows
} -body {
    # Test the labelframe's reaction if the label is destroyed
    label .l -text Aratherlonglabel
    ::tko::labelframe .f -labelwidget .l
    pack .f
    label .f.l -text Mupp
    pack .f.l
    update
    set res [list [.f cget -labelwidget]]
    lappend res [expr {[winfo width .f] - [winfo width .l]}]
    destroy .l
    lappend res [.f cget -labelwidget]
    update
    lappend res [expr {[winfo width .f] - [winfo width .f.l]}]
} -cleanup {
    deleteWindows
} -result {.l 12 {} 4}

test frame-14.3 {labelframe labelwidget option} -setup {
	deleteWindows
} -body {
    # Test the labelframe's reaction if the label is stolen
    label .l -text Aratherlonglabel
    ::tko::labelframe .f -labelwidget .l
    pack .f
    label .f.l -text Mupp
    pack .f.l
    update
    set res [list [.f cget -labelwidget]]
    lappend res [expr {[winfo width .f] - [winfo width .l]}]
    pack .l
    lappend res [.f cget -labelwidget]
    update
    lappend res [expr {[winfo width .f] - [winfo width .f.l]}]
} -cleanup {
    deleteWindows
} -result {.l 12 {} 4}

test frame-14.4 {labelframe labelwidget option} -setup {
	deleteWindows
} -body {
    # Test the label's reaction if the labelframe is destroyed
    label .l -text Mupp
    ::tko::labelframe .f -labelwidget .l
    pack .f
    update
    set res [list [winfo manager .l]]
    destroy .f
    lappend res [winfo manager .l]
} -cleanup {
    deleteWindows
} -result {labelframe {}}

test frame-14.5 {labelframe labelwidget option} -setup {
	deleteWindows
} -body {
    # Test that the labelframe reacts on changes in label
    label .l -text Aratherlonglabel
    ::tko::labelframe .f -labelwidget .l
    pack .f
    label .f.l -text Mupp
    pack .f.l
    update
    set first [winfo width .f]
    set res [expr {[winfo width .f] - [winfo width .l]}]
    .l configure -text Shorter
    update
    lappend res [expr {[winfo width .f] - [winfo width .l]}]
    lappend res [expr {[winfo width .f] < $first}]
    .l configure -text Alotlongerthananytimebefore
    update
    lappend res [expr {[winfo width .f] - [winfo width .l]}]
    lappend res [expr {[winfo width .f] > $first}]
} -cleanup {
    deleteWindows
} -result {12 12 1 12 1}

test frame-14.6 {labelframe labelwidget option} -setup {
	deleteWindows
} -body {
    # Destroying a labelframe with a child label caused a crash
    # when not handling mapping of the label correctly.
    # This test does not test anything directly, it's just ment
    # to catch if the same mistake is made again.
    ::tko::labelframe .f
    pack .f
    label .f.l -text Mupp
    .f configure -labelwidget .f.l
    update
} -cleanup {
    deleteWindows
} -result {}

test frame-15.1 {TIP 262: frame background images} -setup {
    deleteWindows
    image create photo gorp -width 10 -height 10
    gorp put black -to 2 2 7 7
} -body {
    ::tko::frame .f -width 100 -height 100
    pack .f
    list [image inuse gorp] [.f configure -backgroundimage gorp;update] \
	[image inuse gorp] [winfo width .f] [winfo height .f]
} -cleanup {
    image delete gorp
    deleteWindows
} -result {0 {} 1 100 100}
test frame-15.2 {TIP 262: frame background images} -setup {
    deleteWindows
    catch {rename gorp ""}
} -body {
    ::tko::frame .f -width 100 -height 100
    pack .f
    update
    .f configure -backgroundimage gorp
} -returnCodes error -cleanup {
    deleteWindows
} -match glob -result {* image "gorp" doesn't exist}
test frame-15.3 {TIP 262: frame background images} -setup {
    deleteWindows
    image create photo gorp -width 10 -height 10
    gorp put black -to 2 2 7 7
} -body {
    ::tko::frame .f -width 100 -height 100 -backgroundimage gorp
    pack .f
    .f configure -tile yes
    update
    list [.f cget -bgimg] [.f cget -tile]
} -cleanup {
    image delete gorp
    deleteWindows
} -result {gorp 1}
test frame-15.4 {TIP 262: frame background images} -setup {
    deleteWindows
    image create photo gorp -width 10 -height 10
    gorp put black -to 2 2 7 7
} -body {
    ::tko::frame .f -width 100 -height 100 -backgroundimage gorp
    pack .f
    .f configure -tile yes
    update
    gorp put red -to 15 15 20 20
    update
    list [.f cget -bgimg] [.f cget -tile]
} -cleanup {
    image delete gorp
    deleteWindows
} -result {gorp 1}
test frame-15.5 {TIP 262: frame background images} -setup {
    deleteWindows
    image create photo gorp -width 10 -height 10
    gorp put black -to 2 2 7 7
    set result {}
} -body {
    ::tko::frame .f -width 100 -height 100 -backgroundimage gorp
    pack .f
    .f configure -tile yes
    update
    image delete gorp
    update
    set result [list [.f cget -bgimg] [.f cget -tile]]
    image create photo gorp -width 250 -height 250
    update
    lappend result [.f cget -backgroundimage]
} -cleanup {
    catch {image delete gorp}
    deleteWindows
} -result {gorp 1 gorp}
test frame-15.6 {TIP 262: frame background images} -setup {
    deleteWindows
    set result {}
    . configure -width 200 -height 200
} -constraints testImageType -body {
    image create test gorp -variable result
    pack [::tko::frame .f -width 100 -height 100 -bgimg gorp]
    update idletasks; update
    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 0 0 30 15}}
test frame-15.6a {TIP 262: frame background images (offsets)} -setup {
    deleteWindows
    set result {}
    . configure -width 200 -height 200
} -constraints testImageType -body {
    image create test gorp -variable result
    pack [::tko::frame .f -width 10 -height 10 -bgimg gorp]
    update idletasks; update
    # On MacOS must wait for the test image display procedure to run.
    set timer [after 300 {lappend result "timedout"}]
    while {"timedout" ni $result &&
	   "gorp display 10 2 10 10" ni $result} {
       vwait result
    }
    after cancel $timer
    update idletasks; update
    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 10 2 10 10}}
test frame-15.7 {TIP 262: frame background images} -setup {
    deleteWindows
    set result {}
    . configure -width 200 -height 200
} -constraints testImageType -body {
    image create test gorp -variable result
    pack [::tko::frame .f -width 50 -height 25 -bgimg gorp -tile 1]
    update idletasks; update
    # On MacOS must wait for the test image display procedure to run.
    set timer [after 300 {lappend result "timedout"}]
    while {"timedout" ni $result &&
	   "gorp display 0 0 20 10" ni $result} {
	vwait result
    }
    after cancel $timer
    if {[lindex $result end] eq "timedout"} {
	return [lreplace $result end end]
    }
    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 10} {gorp display 0 0 20 15} {gorp display 0 0 20 10}}
test frame-15.7a {TIP 262: frame background images (offsets)} -setup {
    deleteWindows
    set result {}
    . configure -width 200 -height 200
} -constraints testImageType -body {
    image create test gorp -variable result
    pack [::tko::frame .f -width 50 -height 25 -bgimg gorp -tile 1 -highlightthick 1]
    update idletasks; update
    # On MacOS must wait for the test image display procedure to run.
    set timer [after 300 {lappend result "timedout"}]
    while {"timedout" ni $result &&
	   "gorp display 0 0 18 8" ni $result} {
	vwait result
   }
    after cancel $timer
    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 8} {gorp display 0 0 18 15} {gorp display 0 0 18 8}}
test frame-15.7b {TIP 262: frame background images (offsets)} -setup {
    deleteWindows
    set result {}
    . configure -width 200 -height 200
} -constraints testImageType -body {
    image create test gorp -variable result
    pack [::tko::frame .f -width 50 -height 25 -bgimg gorp -tile 1 -bd 2]
    update idletasks; update
    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 6} {gorp display 0 0 16 15} {gorp display 0 0 16 6}}
test frame-15.7c {TIP 262: frame background images (offsets)} -setup {
    deleteWindows
    set result {}
    . configure -width 200 -height 200
} -constraints testImageType -body {
    image create test gorp -variable result
    pack [::tko::frame .f -width 50 -height 25 -bgimg gorp -tile 1 -bd 2 -highlightthick 1]
    update idletasks; update
    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 4} {gorp display 0 0 14 15} {gorp display 0 0 14 4}}
test frame-15.8 {TIP 262: toplevel background images} -setup {
    deleteWindows
    image create photo gorp -width 10 -height 10
    gorp put black -to 2 2 7 7
} -body {
    ::tko::toplevel .t -width 100 -height 100
    update
    # Used to verify that setting a background image doesn't change the widget size
    set w [winfo width .t]
    set h [winfo height .t]
    list [image inuse gorp] [.t configure -backgroundimage gorp;update] \
	[image inuse gorp] \
	[expr {$w-[winfo width .t]}] [expr {$h-[winfo height .t]}]
} -cleanup {
    image delete gorp
    deleteWindows
} -result {0 {} 1 0 0}
test frame-15.9 {TIP 262: toplevel background images} -setup {
    deleteWindows
    catch {rename gorp ""}
} -body {
    ::tko::toplevel .t -width 100 -height 100
    update
    .t configure -backgroundimage gorp
} -returnCodes error -cleanup {
    deleteWindows
} -match glob -result {* image "gorp" doesn't exist}
test frame-15.10 {TIP 262: toplevel background images} -setup {
    deleteWindows
    image create photo gorp -width 10 -height 10
    gorp put black -to 2 2 7 7
} -body {
    ::tko::toplevel .t -width 100 -height 100 -backgroundimage gorp -tile yes
    update
    list [.t cget -bgimg] [.t cget -tile]
} -cleanup {
    image delete gorp
    deleteWindows
} -result {gorp 1}
test frame-15.11 {TIP 262: toplevel background images} -setup {
    deleteWindows
    image create photo gorp -width 10 -height 10
    gorp put black -to 2 2 7 7
} -body {
    ::tko::toplevel .t -width 100 -height 100 -backgroundimage gorp -tile yes
    update
    gorp put red -to 15 15 20 20
    update
    list [.t cget -bgimg] [.t cget -tile]
} -cleanup {
    image delete gorp
    deleteWindows
} -result {gorp 1}
test frame-15.12 {TIP 262: toplevel background images} -setup {
    deleteWindows
    image create photo gorp -width 10 -height 10
    gorp put black -to 2 2 7 7
    set result {}
} -body {
    ::tko::toplevel .t -width 100 -height 100 -backgroundimage gorp -tile yes
    update
    image delete gorp
    update
    set result [list [.t cget -bgimg] [.t cget -tile]]
    image create photo gorp -width 250 -height 250
    update
    lappend result [.t cget -backgroundimage]
} -cleanup {
    catch {image delete gorp}
    deleteWindows
} -result {gorp 1 gorp}
test frame-15.13 {TIP 262: toplevel background images} -setup {
    deleteWindows
    set result {}
} -constraints testImageType -body {
    image create test gorp -variable result
    ::tko::toplevel .t -width 100 -height 100 -bgimg gorp
    wm overrideredirect .t 1;	# Reduce trouble from window managers
    update idletasks; update
    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 0 0 30 15}}
test frame-15.14 {TIP 262: toplevel background images} -setup {
    deleteWindows
    set result {}
} -constraints testImageType -body {
    image create test gorp -variable result
    ::tko::toplevel .t -width 50 -height 25 -bgimg gorp -tile 1
    wm overrideredirect .t 1;	# Reduce trouble from window managers
    update idletasks; update
    # On MacOS must wait for the test image display procedure to run.
    set timer [after 300 {lappend result "timedout"}]
    while {"timedout" ni $result &&
	   "gorp display 0 0 20 10" ni $result} {
	vwait result
   }
    after cancel $timer
    return [uniq $result]
} -cleanup {
    deleteWindows
    catch {image delete gorp}
} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 10} {gorp display 0 0 20 15} {gorp display 0 0 20 10}}

#
# Test "::tko *"
#
test frame-20.1 {tko wrong args} -setup {
    deleteWindows
} -body {
    ::tko xy
} -cleanup {
    deleteWindows
} -returnCodes error -match glob -result {bad option "xy": *}

test frame-20.2 {tko initfrom with optionget/optionset} -setup {
    deleteWindows
} -body {
    oo::class create C {::tko initfrom ::tko::frame}
    C .c
    llength [.c configure]
} -cleanup {
    deleteWindows
    C destroy
} -match glob -result {21}

test frame-20.3 {tko optiondef} -setup {
    deleteWindows
} -body {
    oo::class create C {
        ::tko initfrom ::tko::frame
        ::tko optiondef [self] -o1 {o1 O1 v1 {}} {set tko(-o1) x}
    }
    C .c
    .c configure -o1
} -cleanup {
    deleteWindows
    C destroy
} -match glob -result {-o1 o1 O1 v1 x}

test frame-20.4 {tko optiondel} -setup {
    deleteWindows
} -body {
    oo::class create C {
        ::tko initfrom ::tko::frame
        ::tko optiondel [self] -bg -width
    }
    C .c
    llength [.c configure]
} -cleanup {
    deleteWindows
    C destroy
} -match glob -result {19}

test frame-20.5 {tko optionhide} -setup {
    deleteWindows
} -body {
    oo::class create C {
        ::tko initfrom ::tko::frame
        ::tko optionhide [self] -bg -width
    }
    C .c
    llength [.c configure]
} -cleanup {
    deleteWindows
    C destroy
} -match glob -result {19}

test frame-20.6 {tko optionshow} -setup {
    deleteWindows
} -body {
    oo::class create C {
        ::tko initfrom ::tko::frame
        ::tko optionhide [self] -background -width
        ::tko optionshow [self] -bg
    }
    C .c
    llength [.c configure]
} -cleanup {
    deleteWindows
    C destroy
} -match glob -result {19}

#
# Test "my _tko .."
#
test frame-21.1 {my _tko .. wrong args} -setup {
    deleteWindows
} -body {
    oo::class create C {
        ::tko initfrom ::tko::frame
        method mycmd {args} {my {*}$args}
    }
    C .c
    .c mycmd _tko xx
} -cleanup {
    deleteWindows
    C destroy
} -returnCodes error -match glob -result {bad option "xx": *}

test frame-21.2 {my _tko optionadd} -setup {
    deleteWindows
} -body {
    oo::class create C {
        ::tko initfrom ::tko::frame
        method mycmd {args} {my {*}$args}
    }
    C .c
    .c mycmd _tko optionadd -o1 {o1 O1 v1 {}} {variable tko; set tko(-o1) x}
    .c configure -o1
} -cleanup {
    deleteWindows
    C destroy
} -match glob -result {-o1 o1 O1 v1 x}

test frame-21.3 {my _tko optiondel} -setup {
    deleteWindows
} -body {
    oo::class create C {
        ::tko initfrom ::tko::frame
        method mycmd {args} {my {*}$args}
    }
    C .c
    .c mycmd _tko optiondel -bg -width
    llength [.c configure]
} -cleanup {
    deleteWindows
    C destroy
} -match glob -result {19}

test frame-21.4 {my _tko optionhide} -setup {
    deleteWindows
} -body {
    oo::class create C {
        ::tko initfrom ::tko::frame
        method mycmd {args} {my {*}$args}
    }
    C .c
    .c mycmd _tko optionhide -bg -width
    llength [.c configure]
} -cleanup {
    deleteWindows
    C destroy
} -match glob -result {19}

test frame-21.5 {my _tko optionshow} -setup {
    deleteWindows
} -body {
    oo::class create C {
        ::tko initfrom ::tko::frame
        method mycmd {args} {my {*}$args}
    }
    C .c
    .c mycmd _tko optionhide -background -width
    .c mycmd _tko optionshow -bg
    llength [.c configure]
} -cleanup {
    deleteWindows
    C destroy
} -match glob -result {19}

test frame-21.6 {my_tko optionadd readonly} -setup {
    deleteWindows
} -body {
    oo::class create ::C {
        ::tko initfrom ::tko::frame
        method mycmd {args} {my {*}$args}
    }
    C .c
    .c mycmd _tko optionadd -o1 {o1 O1 v1 r} {variable tko; set tko(-o1) x}
    .c configure -o1 xx
} -cleanup {
    deleteWindows
    C destroy
} -returnCodes error -match glob -result {*option "-o1" is readonly}

test frame-22.1 {tko initclass} -setup {
    deleteWindows
} -body {
    oo::class create ::C {
        ::tko initclass
        method mycmd {args} {my {*}$args}
    }
    ::C create ::c
    set myList [llength [c configure]]
    ::tko optiondef ::C -o1 {o1 O1 v1 {}} {set tko(-o1) x}
    lappend myList [llength [c configure]]
    c destroy
    ::C create ::c
    lappend myList [llength [c configure]]
    c mycmd _tko optionadd -o2 {o2 O2 v2 {}} {variable tko; set tko(-o2) x}
    lappend myList [llength [c configure]]
} -cleanup {
    C destroy
} -match glob -result {0 0 1 2}

test frame-30.1 {performance comparison} -setup {
    deleteWindows
} -body {
    oo::class create ::wrapframe {::tko initwrap frame {-class -colormap -container -visual} {}}
    oo::class create ::wraplabelframe {::tko initwrap labelframe {-class -colormap -container -visual} {}}
    proc ::TEST::Do {cmd} {set i 0; format %7.1f [lindex [time $cmd 100] 0]}
    proc ::TEST::Test {wdg} {
        set ret [format %15s $wdg]
        append ret [::TEST::Do "$wdg .\[incr i\]"]
        append ret [::TEST::Do {.[incr i] cget -width}]
        append ret [::TEST::Do {.[incr i] configure -width 100}]
        append ret [::TEST::Do {.[incr i] configure}]
        append ret [::TEST::Do {destroy .[incr i]}]
    }
    puts "        command create   cget config   list destroy"
    puts [::TEST::Test ::frame]
    puts [::TEST::Test ::ttk::frame]
    puts [::TEST::Test ::tko::frame]
    puts [::TEST::Test ::wrapframe]
    puts [::TEST::Test ::labelframe]
    puts [::TEST::Test ::ttk::labelframe]
    puts [::TEST::Test ::tko::labelframe]
    puts [::TEST::Test ::wraplabelframe]
    puts [::TEST::Test ::toplevel]
    puts [::TEST::Test ::tko::toplevel]
} -cleanup {
    catch {::wrapframe destroy}
    catch {::wraplabelframe destroy}
    deleteWindows
} -result {}


deleteWindows
rename ::TEST::eatColors {}
rename ::TEST::colorsFree {}

# cleanup
cleanupTests
}
catch {namespace delete ::TEST}

# vim: set ts=4 sw=4 sts=4 ff=unix et :