#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  TkWmProtocol.c patch1.README
# Wrapped by adrianho@barkley.Berkeley.EDU on Thu Dec  5 18:33:24 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'TkWmProtocol.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'TkWmProtocol.c'\"
else
echo shar: Extracting \"'TkWmProtocol.c'\" \(3740 characters\)
sed "s/^X//" >'TkWmProtocol.c' <<'END_OF_FILE'
X/*
X *--------------------------------------------------------------
X *
X * TkWmSetWmProtocols --
X *	Set the ICCCM WM_PROTOCOLS to be honored by this window.
X *	Currently, it is just WM_DELETE_WINDOW.
X *
X * Results:
X *	None.
X *
X * Side effects:
X *	A window property may get updated.
X *
X *--------------------------------------------------------------
X */
X
Xstatic void
XTkWmSetWmProtocols(winPtr)
X    TkWindow *winPtr;		/* Newly-created top-level window. */
X{
X    if (winPtr->wmInfoPtr->flags & WM_NEVER_MAPPED) {
X	return;
X    }
X#ifndef X11R3
X    else {
X	/* assemble the WM_PROTOCOLS that we honor */
X	int count = 0;
X	Atom atomlist[8];
X	atomlist[count++] = Tk_InternAtom(winPtr, "WM_DELETE_WINDOW");
X/* 
X * 	other WM_PROTOCOLS go here -- e.g...
X * 	atomlist[count++] = Tk_InternAtom(winPtr, "WM_SAVE_YOURSELF");
X */
X
X	/* 
X	 * assign the honor list to the window not all X11R4's have 
X	 * XSetWmProtocols() so use XChangeProperty() 
X	 */
X
X	/* XSetWmProtocols(winPtr->display, winPtr->window, atomlist, count); */
X
X	XChangeProperty(winPtr->display, 
X			winPtr->window, 
X			Tk_InternAtom(winPtr, "WM_PROTOCOLS"),
X			XA_ATOM, 32,
X			PropModeReplace,
X			atomlist, 
X			count);
X
X    }
X#endif X11R3
X
X    return;
X}
X
X
X/*
X *----------------------------------------------------------------------
X *
X * TkWmProtocolEventProc --
X *
X *	Handle a WM_PROTOCOL ICCCM event sent by the window manager to
X *	top level window.
X *
X *	The WM_PROTOCOL's currently handled are:
X *
X *		WM_DELETE_PROTOCOL:
X *
X * Results: None
X *
X * Side effects:
X *	for WM_DELETE_WINDOW:
X *		- window may be deleted if specified earlier by a 
X *		wm tcl command
X *		- a tcl command may be executed if sepcified earlier by a
X *		wm tcl command
X *	
X *
X */
Xvoid
XTkWmProtocolEventProc(winPtr, eventPtr)
XTkWindow *winPtr; 
XXEvent *eventPtr;
X{
X    WmInfo *wmPtr = winPtr->wmInfoPtr;
X    if ((Atom)(eventPtr->xclient.data.l)[0] ==
X	Tk_InternAtom(winPtr, "WM_DELETE_WINDOW")) {
X	if (wmPtr->deleteCmd) {
X	    if (*(wmPtr->deleteCmd) == '\0') {
X		/* callback is empty, just delete the window */
X		Tk_DestroyWindow(winPtr);
X	    } else {
X		/* there is a callback so run it */
X		if ((Tcl_Eval(winPtr->mainPtr->interp, 
X		   wmPtr->deleteCmd, 0, (char **)0)) != TCL_OK) {
X		    /* */
X		    char *msg = Tcl_GetVar(winPtr->mainPtr->interp, 
X			"errorInfo", TCL_GLOBAL_ONLY);
X		    if (msg == NULL) {
X			msg = winPtr->mainPtr->interp->result;
X		    }
X		    fprintf(stderr, "TkWmProtocolEvent: %s\n", msg);
X		}
X	    }
X	} else {
X	    Tk_DestroyWindow(winPtr);
X	}
X    }
X    /*
X     * else { .. other WM_<ETC> cases go here ... }
X     */
X    return;
X}
X
X
X/* 
X *----------------------------------------------------------------------
X *
X * WmProtocolCmd
X *
X * implements 
X *
X *	wm protocol <window> delete [command_str] 
X *
X * right now just delete is supported for OPTION
X *
X * Kind of artificial, But makes it easier to merge into new
X * versions of Stock Tk.
X */
Xint
XWmProtocolCmd(interp, CmdPtr, argc, argv)
XTcl_Interp *interp;
Xchar **CmdPtr;
Xint argc;
Xchar **argv;
X{
X#define Cmd (*CmdPtr)
X
X    switch(argc) {
X    case 4:
X	/* 
X	 * return current command 
X	 */
X	if (!Cmd || *Cmd == '\0') {
X	    return TCL_OK;
X	} else {
X	    /* maybe should just have them put the window in the cmd */
X	    Tcl_AppendResult(interp, Cmd, (char *)NULL);
X	    return TCL_OK;
X	}
X    case 5:
X	/* 
X	 * (re)set command 
X	 */
X	if (Cmd) {
X	    ckfree(Cmd);
X	    Cmd = (char *)NULL;
X	}
X	if (*argv[4] != '\0') {
X	    if (!(Cmd = ckalloc(strlen(argv[4])+1))) {
X		perror("wm protocol:");
X	    } else {
X		strcpy(Cmd, argv[4]);
X	    }
X	}
X	return TCL_OK;
X    default:
X	Tcl_AppendResult(interp, "wrong # of arguments: must be \"",
X	    argv[0], " protocol window <attribute> [cmd]\"", (char *) NULL);
X	return TCL_ERROR;
X    }
X
X#undef Cmd
X}
END_OF_FILE
if test 3740 -ne `wc -c <'TkWmProtocol.c'`; then
    echo shar: \"'TkWmProtocol.c'\" unpacked with wrong size!
fi
# end of 'TkWmProtocol.c'
fi
if test -f 'patch1.README' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'patch1.README'\"
else
echo shar: Extracting \"'patch1.README'\" \(1825 characters\)
sed "s/^X//" >'patch1.README' <<'END_OF_FILE'
XReturn-Path: mh%awds@WLV.IMSD.CONTEL.COM
XReceived: from sprite.Berkeley.EDU (allspice.Berkeley.EDU) by barkley.Berkeley.EDU (4.1/1.42)
X	id AA02342; Thu, 5 Dec 91 18:00:55 PST
XReceived: from WLV.IMSD.CONTEL.COM by sprite.Berkeley.EDU (5.59/1.29)
X	id AA724589; Thu, 5 Dec 91 16:00:11 PST
XReceived: from AWDS27.IMSD.CONTEL.COM by WLV.IMSD.CONTEL.COM (5.65/1.25)
X	id AA04104; Thu, 5 Dec 91 15:58:24 -0800
XReceived: from roger.imsd.contel.com.awds_dev by awds27.imsd.contel.com (4.1/SMI-4.1)
X	id AA28211; Thu, 5 Dec 91 15:55:04 PST
XDate: Thu, 5 Dec 91 15:55:04 PST
XFrom: mh%awds@WLV.IMSD.CONTEL.COM (Mike Hoegeman)
XMessage-Id: <9112052355.AA28211@awds27.imsd.contel.com>
XTo: tcl@sprite.Berkeley.EDU
XSubject: more patches to TK for WM_DELETE (quit)
X
X
Xsomeone sent me this message. i thought it would be of general interest..
X
X -- Here is a very simple example that fails:
X -- wish: wm protocol . delete {destroy .}
X -- 
X -- wish: wm protocol . delete
X -- destroy .
X -- 
X -- When I use my 'quit' menu selection, which is mapped to vtwm's f.delete,
X -- nothing happens.  Note that vtwm's 'quit' works fine with openwindows
X -- application, like contool or xrolo, so I don't think that vtwm is messed up.
X -- 
X
XThe problem here is you need to define the command to run as just {delete}
X
Xlike this
X
Xwm protocol . delete {destroy}
X
Xthe wm protocol cmd automatically adds the window name to the end of
Xthe command.  I realize that adding the window name at the end is not
Xtoo intuitive.  so this version below takes out that feature. so now you
Xuse the more obvious
X
Xwm protocol . delete {destroy .}
X
X
XAnd out and out bug however is that it did not report any errors that may
Xhave happened while running the {destroy .} fragment so i also fixed that. 
X
Xmh@awds.imsd.contel.com
X
X[uudecoded file deleted -- see replacement TkWmProtocol.c]
END_OF_FILE
if test 1825 -ne `wc -c <'patch1.README'`; then
    echo shar: \"'patch1.README'\" unpacked with wrong size!
fi
# end of 'patch1.README'
fi
echo shar: End of shell archive.
exit 0
