Tk Source Code

source of the window's current position, or an empty string if
no source has been specified yet.  Most window managers interpret
.QW "no source"
as equivalent to \fBprogram\fR.
Tk will automatically set the position source to \fBuser\fR
when a \fBwm geometry\fR command is invoked, unless the source has
been set explicitly to \fBprogram\fR.
.TP
\fBwm property \fIwindow\fR ?\fIname\fR? ?\fIvalue\fR? ?\fItype\fR? ?\fIwidth\fR?
.
This command provides access to the X properties of a Tk toplevel window.
The command is only available on the x11 windowing system.
If \fIname\fR and \fIvalue\fR are specified, the property is updated. The
\fItype\fR and \fIwidth\fR arguments may be used to specify in which format
the property value is to be stored.
Any valid atom name can be used for \fItype\fR. Common values include
\fBSTRING\fR, \fBINTEGER\fR, \fBCARDINAL\fR (i.e. unsigned integer), and
\fBATOM\fR. The special type \fBNone\fR causes the property to be deleted.
The default for \fItype\fR is \fBSTRING\fR.
Note that type names are case sensitive.
Allowed values for \fIwidth\fR are 8, 16, and 32. If omitted, \fIwidth\fR
defaults to 8 for \fBSTRING\fR and \fBUTF8-STRING\fR types, and to 32 for
all other types.
For properties consisting of 8-bit fields, \fIvalue\fR is interpreted as a
byte array. For 16-bit fields it must be specified as a list of integers.
For 32-bit fields, \fIvalue\fR is parsed as a list, where each element may
either be an integer or an atom name.
If \fIname\fR is specified, but no \fIvalue\fR, the current value of the
named property is returned, if set. The type and width of the property value
are returned in the \fB-propertytype\fR and \fB-propertyformat\fR return
options.
If not even the \fIname\fR argument is present, the command returns a list
of the names of all properties that currently exist for the toplevel window.
.TP
\fBwm protocol \fIwindow\fR ?\fIname\fR? ?\fIcommand\fR?
.
This command is used to manage window manager protocols. The \fIname\fR
argument in the \fBwm protocol\fR command is the name of an atom corresponding
to a window manager protocol.  Examples include \fBWM_DELETE_WINDOW\fR or
\fBWM_SAVE_YOURSELF\fR or \fBWM_TAKE_FOCUS\fR.

stdWindow

test wm-1.1 {Tk_WmObjCmd procedure, miscellaneous errors} -returnCodes error -body {
    wm
} -result {wrong # args: should be "wm option window ?arg ...?"}
# Next test will fail every time set of subcommands is changed
if {[testConstraint x11]} {
test wm-1.2 {Tk_WmObjCmd procedure, miscellaneous errors} -returnCodes error -body {
    wm foo
} -result {bad option "foo": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, forget, frame, geometry, grid, group, iconbadge, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, manage, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}
    test wm-1.2 {Tk_WmObjCmd procedure, miscellaneous errors} -returnCodes error -body {
	wm foo
    } -result {bad option "foo": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, forget, frame, geometry, grid, group, iconbadge, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, manage, maxsize, minsize, overrideredirect, positionfrom, property, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}
} else {
    test wm-1.2 {Tk_WmObjCmd procedure, miscellaneous errors} -returnCodes error -body {
	wm foo
    } -result {bad option "foo": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, forget, frame, geometry, grid, group, iconbadge, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, manage, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}
}
test wm-1.3 {Tk_WmObjCmd procedure, miscellaneous errors} -returnCodes error -body {
    wm command
} -result {wrong # args: should be "wm option window ?arg ...?"}
test wm-1.4 {Tk_WmObjCmd procedure, miscellaneous errors} -returnCodes error -body {
    wm aspect bogus
} -result {bad window path name "bogus"}
test wm-1.5 {Tk_WmObjCmd procedure, miscellaneous errors} -body {

    wm positionfrom .t {}
    lappend result [wm positionfrom .t]
} -cleanup {
    destroy .t2
} -result {user program {}}


### wm property ###
test wm-property-1.1 {usage} -returnCodes error -constraints x11 -body {
    wm property
} -result {wrong # args: should be "wm option window ?arg ...?"}
test wm-property-1.2 {usage} -returnCodes error -constraints x11 -body {
    wm property .t 1 2 3 4 5
} -result {wrong # args: should be "wm property window ?name? ?value? ?type? ?width?"}
test wm-property-1.3 {usage} -returnCodes error -constraints x11 -body {
    wm property .t _TCL_TEST 42 CARDINAL 24
} -result {invalid width: 24}
test wm-property-1.4 {usage} -returnCodes error -constraints x11 -body {
    wm property .t _TCL_TEST "Some string" STRING 16
} -result {invalid width: 16}
test wm-property-1.5 {usage} -returnCodes error -constraints x11 -body {
    wm property .t _TCL_TEST {invalid "list''} INTEGER 16
} -result {unmatched open quote in list}
test wm-property-1.6 {usage} -returnCodes error -constraints x11 -body {
    wm property .t _TCL_TEST {xx yy zz} INTEGER 16
} -result {expected integer but got "xx"}
test wm-property-1.7 {usage} -returnCodes error -constraints x11 -body {
    wm property .t _TCL_TEST [lrepeat 66 99] INTEGER
} -result {too many elements}
test wm-property-1.8 {usage} -returnCodes error -constraints x11 -body {
    wm property .t WM_NAME "New name"
} -result {changing reserved property "WM_NAME" is not allowed}

test wm-property-2.1 {reading values} -constraints x11 -body {
    expr {"WM_NAME" in [wm property .t]}
} -result 1
test wm-property-2.2 {reading values} -constraints x11 -body {
    wm property .t WM_NAME
} -result "t"
test wm-property-2.3 {reading values} -constraints x11 -body {
    catch {wm property .t WM_NAME} data opts
    dict values [dict filter $opts key -property*]
} -result "STRING 8"
test wm-property-2.4 {reading values} -constraints x11 -body {
    catch {wm property .t WM_PROTOCOLS} data opts
    dict values [dict filter $opts key -property*]
} -result "ATOM 32"

test wm-property-3.1 {setting values} -constraints x11 -body {
    wm property .t _TCL_TEST "Some string"
    catch {wm property .t _TCL_TEST} data opts
    linsert [dict values [dict filter $opts key -property*]] 0 $data
} -result {{Some string} STRING 8}
test wm-property-3.2 {setting values} -constraints x11 -body {
    wm property .t _TCL_TEST [lrepeat 64 88] CARDINAL
    catch {wm property .t _TCL_TEST} data opts
    linsert [dict values [dict filter $opts key -property*]] 0 \
      [llength $data] [lsort -unique -integer $data]
} -result {64 88 CARDINAL 32}
test wm-property-3.3 {setting values} -constraints x11 -body {
    wm property .t _TCL_TEST {WM_STATE WM_PROTOCOLS _TCL_TEST_ATOM} ATOM
    lmap n [wm property .t _TCL_TEST] {winfo atomname $n}
} -result {WM_STATE WM_PROTOCOLS _TCL_TEST_ATOM}

test wm-property-4.1 {deleting values} -constraints x11 -body {
    wm property .t _TCL_TEST "Some string"
    wm property .t _TCL_TEST "Delete" None
    try {wm property .t _TCL_TEST} on ok {data opts} {
	linsert [dict values [dict filter $opts key -property*]] 0 $data
    }
} -result {{}}
test wm-property-4.2 {deleting values} -constraints x11 -body {
    wm property .t _TCL_TEST_NOTSET "Delete" None
    try {wm property .t _TCL_TEST_NOTSET} on ok {data opts} {
	linsert [dict values [dict filter $opts key -property*]] 0 $data
    }
} -result {{}}

test wm-property-5.1 {unmapped window} -constraints x11 -body {
    toplevel .t1
    wm property .t1
} -cleanup {
    destroy .t1
} -result {}
test wm-property-5.2 {unmapped window} -constraints x11 -body {
    toplevel .t1
    wm property .t1 WM_NAME
} -cleanup {
    destroy .t1
} -result {}
test wm-property-5.3 {unmapped window} -constraints x11 -body {
    toplevel .t1
    wm property .t1 _TCL_TEST "Some string"
    catch {wm property .t1 _TCL_TEST} data opts
    linsert [dict values [dict filter $opts key -property*]] 0 $data
} -cleanup {
    destroy .t1
} -result {{Some string} STRING 8}

### wm protocol ###
test wm-protocol-1.1 {usage} -returnCodes error -body {
    wm protocol
} -result {wrong # args: should be "wm option window ?arg ...?"}
test wm-protocol-1.2 {usage} -returnCodes error -body {
    wm protocol .t 1 2 3
} -result {wrong # args: should be "wm protocol window ?name? ?command?"}

				 * needs of the actual command. THIS MUST BE
				 * THE LAST FIELD OF THE STRUCTURE. */
} ProtocolHandler;

#define HANDLER_SIZE(cmdLength) \
    (offsetof(ProtocolHandler, command) + 1 + cmdLength)

#define PROPMAXELEMENTS 64

/*
 * Data for [wm attributes] command:
 */

typedef struct {
    double alpha;		/* Transparency; 0.0=transparent, 1.0=opaque */
    int topmost;		/* Flag: true=>stay-on-top */

			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		WmOverrideredirectCmd(Tk_Window tkwin,
			    TkWindow *winPtr, Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		WmPositionfromCmd(Tk_Window tkwin, TkWindow *winPtr,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		WmPropertyCmd(Tk_Window tkwin, TkWindow *winPtr,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		WmProtocolCmd(Tk_Window tkwin, TkWindow *winPtr,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		WmResizableCmd(Tk_Window tkwin, TkWindow *winPtr,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

    Tk_Window tkwin = (Tk_Window)clientData;
    static const char *const optionStrings[] = {
	"aspect", "attributes", "client", "colormapwindows",
	"command", "deiconify", "focusmodel", "forget",
	"frame", "geometry", "grid", "group", "iconbadge", "iconbitmap",
	"iconify", "iconmask", "iconname", "iconphoto",
	"iconposition", "iconwindow", "manage", "maxsize",
	"minsize", "overrideredirect", "positionfrom",
	"minsize", "overrideredirect", "positionfrom", "property",
	"protocol", "resizable", "sizefrom", "stackorder",
	"state", "title", "transient", "withdraw", NULL };
    enum options {
	WMOPT_ASPECT, WMOPT_ATTRIBUTES, WMOPT_CLIENT, WMOPT_COLORMAPWINDOWS,
	WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FORGET,
	WMOPT_FRAME, WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP,
	WMOPT_ICONBADGE, WMOPT_ICONBITMAP,
	WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME, WMOPT_ICONPHOTO,
	WMOPT_ICONPOSITION, WMOPT_ICONWINDOW, WMOPT_MANAGE, WMOPT_MAXSIZE,
	WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT, WMOPT_POSITIONFROM,
	WMOPT_PROPERTY,
	WMOPT_PROTOCOL, WMOPT_RESIZABLE, WMOPT_SIZEFROM, WMOPT_STACKORDER,
	WMOPT_STATE, WMOPT_TITLE, WMOPT_TRANSIENT, WMOPT_WITHDRAW };
    int index;
    const char *argv1;
    TkWindow *winPtr;
    Tk_Window targetWin;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;

	return WmMaxsizeCmd(tkwin, winPtr, interp, objc, objv);
    case WMOPT_MINSIZE:
	return WmMinsizeCmd(tkwin, winPtr, interp, objc, objv);
    case WMOPT_OVERRIDEREDIRECT:
	return WmOverrideredirectCmd(tkwin, winPtr, interp, objc, objv);
    case WMOPT_POSITIONFROM:
	return WmPositionfromCmd(tkwin, winPtr, interp, objc, objv);
    case WMOPT_PROPERTY:
	return WmPropertyCmd(tkwin, winPtr, interp, objc, objv);
    case WMOPT_PROTOCOL:
	return WmProtocolCmd(tkwin, winPtr, interp, objc, objv);
    case WMOPT_RESIZABLE:
	return WmResizableCmd(tkwin, winPtr, interp, objc, objv);
    case WMOPT_SIZEFROM:
	return WmSizefromCmd(tkwin, winPtr, interp, objc, objv);
    case WMOPT_STACKORDER:

	memcpy(protPtr->command, cmd, cmdLength + 1);
    }
    if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
	UpdateWmProtocols(wmPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * WmPropertyCmd --
 *
 *	This function is invoked to process the "wm property" Tcl command. See
 *	the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
WmPropertyCmd(
    TCL_UNUSED(Tk_Window),	/* Main window of the application. */
    TkWindow *winPtr,		/* Toplevel to work with */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    WmInfo *wmPtr = winPtr->wmInfoPtr;
    Atom property, type = XA_STRING;
    Atom XA_UTF8_STRING = Tk_InternAtom((Tk_Window)winPtr, "UTF8_STRING");
    int i, count, value, width = 0;
    const char *name;
    const unsigned char *bytes;
    unsigned char data8[PROPMAXELEMENTS * sizeof(long)];
    unsigned short *data16;
    unsigned long *data32;
    Tcl_Size length;
    Tcl_Obj **elements;

    if ((objc < 3) || (objc > 7)) {
	Tcl_WrongNumArgs(interp, 2, objv,
          "window ?name? ?value? ?type? ?width?");
	return TCL_ERROR;
    }
    if (objc == 3) {
	/*
	 * Return a list of all defined properties for the window.
	 */
	Tcl_Obj *resultObj = Tcl_NewObj();
        Atom *atoms;

        if (wmPtr->wrapperPtr != NULL) {
            atoms = XListProperties(wmPtr->wrapperPtr->display,
              wmPtr->wrapperPtr->window, &count);
        } else {
            count = 0;
        }

        for (i = 0; i < count; i++) {
            Tcl_ListObjAppendElement(NULL, resultObj, 
              Tcl_NewStringObj(Tk_GetAtomName((Tk_Window)winPtr,
                atoms[i]), -1));
        }
	Tcl_SetObjResult(interp, resultObj);
	return TCL_OK;
    }

    name = Tcl_GetString(objv[3]);
    property = Tk_InternAtom((Tk_Window)winPtr, name);

    if (objc == 4) {
	/*
	 * Return the value of a given property.
	 */

        int format;
        unsigned long nitems, remain;
        unsigned char *data;
        long maxLength = PROPMAXELEMENTS;

        if (wmPtr->wrapperPtr == NULL) return TCL_OK;

        if (GetWindowProperty(wmPtr->wrapperPtr, property, maxLength,
          AnyPropertyType, &type, &format, &nitems, &remain, &data)) {
            Tcl_Obj *options = Tcl_NewDictObj();
            Tcl_Obj *resultObj;
            const char *typeStr;

            count = nitems;
            switch (format) {
             case 8:
                Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(data, count));
                break;
             case 16:
                data16 = (unsigned short *)data;
                resultObj = Tcl_NewListObj(count, NULL);
                for (i = 0; i < count; i++) {
                    Tcl_ListObjAppendElement(NULL, resultObj,
                      Tcl_NewIntObj(data16[i]));
                }
                Tcl_SetObjResult(interp, resultObj);
                break;
             case 32:
                data32 = (unsigned long *)data;
                resultObj = Tcl_NewListObj(count, NULL);
                for (i = 0; i < count; i++) {
                    Tcl_ListObjAppendElement(NULL, resultObj,
                      Tcl_NewIntObj(data32[i]));
                }
                Tcl_SetObjResult(interp, resultObj);
                break;
            }
            XFree(data);
            if (type != None) {
                typeStr = Tk_GetAtomName((Tk_Window)winPtr, type);
                Tcl_DictObjPut(NULL, options,
                  Tcl_NewStringObj("-propertytype", -1), 
                  Tcl_NewStringObj(typeStr, -1));
                Tcl_DictObjPut(NULL, options,
                  Tcl_NewStringObj("-propertyformat", -1), Tcl_NewIntObj(format));
                Tcl_SetReturnOptions(interp, options);
            }
        }
	return TCL_OK;
    }

    /* Properties starting with WM_ or _NET_WM_ are considered reserved */
    /* Those properties may only be changed using dedicated wm commands */
    if (strncmp(name, "WM_", 3) == 0 || strncmp(name, "_NET_WM_", 8) == 0) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("changing reserved property "
          "\"%s\" is not allowed", name));
        return TCL_ERROR;
    }

    if (objc >= 6) {
        if (strcmp(Tcl_GetString(objv[5]), "None") == 0) {
            /* Delete the property */
            if (wmPtr->wrapperPtr != NULL) {
                XDeleteProperty(wmPtr->wrapperPtr->display,
                  wmPtr->wrapperPtr->window, property);
            }
            return TCL_OK;
        }
        type = Tk_InternAtom((Tk_Window)winPtr, Tcl_GetString(objv[5]));
    }

    if (objc >= 7) {
        if (Tcl_GetIntFromObj(interp, objv[6], &width) != TCL_OK) {
            return TCL_ERROR;
        }
    }

    if (width == 0) {
        width = type == XA_STRING || type == XA_UTF8_STRING ? 8 : 32;
    }

    if ((width != 8 && width != 16 && width != 32)
      || ((type == XA_ATOM || type == XA_BITMAP) && width != 32)
      || ((type == XA_STRING || type == XA_UTF8_STRING) && width != 8)) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid width: %d", width));
        return TCL_ERROR;
    }

    switch (width) {
     case 8:
        bytes = Tcl_GetByteArrayFromObj(objv[4], &length);
        if (length <= PROPMAXELEMENTS) {
            memcpy(data8, bytes, length);
        }
        break;
     case 16:
        data16 = (unsigned short *) data8;
        if (Tcl_ListObjGetElements(interp, objv[4],
          &length, &elements) != TCL_OK) return TCL_ERROR;
        if (length <= PROPMAXELEMENTS) {
            for (i = 0; i < length; i++) {
                if (Tcl_GetIntFromObj(interp, elements[i], &value) != TCL_OK) {
                    return TCL_ERROR;
                }
                data16[i] = value;
            }
        }
        break;
     case 32:
        data32 = (unsigned long *) data8;
        if (Tcl_ListObjGetElements(interp, objv[4],
          &length, &elements) != TCL_OK) return TCL_ERROR;
        if (length <= PROPMAXELEMENTS) {
            for (i = 0; i < length; i++) {
                if (Tcl_GetIntFromObj(NULL, elements[i], &value) != TCL_OK) {
                    data32[i] = Tk_InternAtom((Tk_Window)winPtr,
                      Tcl_GetString(elements[i]));
                } else {
                    data32[i] = value;
                }
            }
        }
    }

    if (length > PROPMAXELEMENTS) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj("too many elements", -1));
        return TCL_ERROR;
    }

    /* Create the wrapper window, if necessary */
    if (wmPtr->wrapperPtr == NULL) CreateWrapper(wmPtr);
    /* Create or update the property */
    SetWindowProperty(wmPtr->wrapperPtr, name, type, width, data8, length);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * WmResizableCmd --
 *
 *	This function is invoked to process the "wm resizable" Tcl command.