diff options
| author | stanton <stanton> | 1998-11-25 21:16:28 (GMT) |
|---|---|---|
| committer | stanton <stanton> | 1998-11-25 21:16:28 (GMT) |
| commit | 0fe03c2e56a2ab06690ea189ab1136b35f5f80b6 (patch) | |
| tree | 4ad0c5e136a5786750291df60b74a1358a56c774 | |
| parent | cfaf90b6bd984f4e72ed307384968bcad79500d5 (diff) | |
| download | tk-0fe03c2e56a2ab06690ea189ab1136b35f5f80b6.zip tk-0fe03c2e56a2ab06690ea189ab1136b35f5f80b6.tar.gz tk-0fe03c2e56a2ab06690ea189ab1136b35f5f80b6.tar.bz2 | |
* integrated tk8.0.4 changes.
* generic/tkBind.c: fixed deletion order bug where a crash would
result if a binding deleted "."
40 files changed, 866 insertions, 252 deletions
@@ -2,7 +2,7 @@ This file summarizes all changes made to Tk since version 1.0 was released on March 13, 1991. Changes that aren't backward compatible are marked specially. -RCS: @(#) $Id: changes,v 1.1.4.3 1998/11/25 04:10:24 stanton Exp $ +RCS: @(#) $Id: changes,v 1.1.4.4 1998/11/25 21:16:28 stanton Exp $ 3/16/91 (bug fix) Modified tkWindow.c to remove Tk's Tcl commands from the interpreter when the main window is deleted (otherwise there will @@ -4251,6 +4251,40 @@ need to compile and link this yourself. (SKS) -------- Released 8.0.3 to the Tcl Consortium CD-ROM project, 8/13/98 ------ +10/5/98 (new feature) Added the event "MouseWheel" that will fire on +Windows applications in response to mouse wheel movement. You can +bind to the MouseWheel event and use the %D substitution to get the +delta the wheel moved. The "event generate" command has also been +enhanced with the -delta flag so you can generate these events from +Tcl. See the bind and event man pages for more details. The listbox +and text widgets' default bindings have been updated to understand +MouseWheel events. (RJ) + +10/12/98 (performance improvement) Added hash table to canvas widget +that holds numeric ids for items. The hash table makes item lookup +almost constant time which improves certain canvas operations +(exspecially for canvases with large number items). Thanks to Mark +Weissman <weissman@gte.com> and Jan Nijtmans <Jan.Nijtmans@wxs.nl> +for submitting this improvement. (RJ) + +10/15/98 (bug fix) The -fill option to text items in the canvas did +not allow the empty string as an argument (meaning transparent) even +though every other item type did. Thanks to Sebastian Wangnick +<sebastian.wangnick@eurocontrol.be> for supplying this patch. (RJ) + +10/20/98 (feature change) The Makefile and configure scripts have been +changed for IRIX to build n32 binaries instead of the old 32 abi +format. If you have extensions built with the o32 abi's you will need +to update them to n32 for them to work with Tcl. (RJ) +*** POTENTIAL INCOMPATIBILITY *** + +11/10/98 (feature change) The Macintosh menus will use the Appearance Theme +backgrounds, separators and menu shape, if Appearance version 1.0.1 or +greater is installed. The version of Appearance that shipped with MacOS 8.0 +so it will not work with a straight 8.0, but it will with MacOS 8.1 or later. (JI) + +----------------- Released 8.0.4, 11/20/98 ----------------------- + ---------------------------------------------------------- Changes for Tk 8.0 go above this line. Changes for Tk 8.1 go below this line. @@ -1,14 +1,15 @@ '\" '\" Copyright (c) 1990 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. +'\" Copyright (c) 1998 by Scriptics Corporation. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: bind.n,v 1.1.4.1 1998/09/30 02:16:11 stanton Exp $ +'\" RCS: @(#) $Id: bind.n,v 1.1.4.2 1998/11/25 21:16:29 stanton Exp $ '\" .so man.macros -.TH bind n 4.1 Tk "Tk Built-In Commands" +.TH bind n 8.0 Tk "Tk Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -158,20 +159,59 @@ time and space requirement. .SH "EVENT TYPES" .PP The \fItype\fR field may be any of the standard X event types, with a -few extra abbreviations. Below is a list of all the valid types; -where two names appear together, they are synonyms. +few extra abbreviations. The \fItype\fR field will also accept a +couple non-standard X event types that were added to better support +the Macintosh and Windows platforms. Below is a list of all the valid +types; where two names appear together, they are synonyms. .DS C .ta 5c 10c -\fBButtonPress, Button Expose Map -ButtonRelease FocusIn Motion -Circulate FocusOut Property +\fBActivate Enter Map +ButtonPress, Button Expose Motion +.VS +ButtonRelease FocusIn MouseWheel +.VE +Circulate FocusOut Property Colormap Gravity Reparent Configure KeyPress, Key Unmap -Destroy KeyRelease Visibility -Enter Leave Activate -Deactivate\fR +Deactivate KeyRelease Visibility +Destroy Leave\fR .DE .PP +.VS +Most of the above events have the same fields and behaviors as events +in the X Windowing system. You can find more detailed descriptions of +these events in any X window programming book. A couple of the events +are extensions to the X event system to support features unique to the +Macintosh and Windows platforms. We provide a little more detail on +these events here. These include: +.IP \fBActivate\fR 5 +.IP \fBDeactivate\fR 5 +These two events are sent to every sub-window of a toplevel when they +change state. In addition to the focus Window, the Macintosh platform +and Windows platforms have a notion of an active window (which often +has but is not required to have the focus). On the Macintosh, widgets +in the active window have a different appearance than widgets in +deactive windows. The \fBActivate\fR event is sent to all the +sub-windows in a toplevel when it changes from being deactive to +active. Likewise, the \fBDeactive\fR event is sent when the window's +state changes from active to deactive. There are no useful percent +substitutions you would make when binding to these events. +.IP \fBMouseWheel\fR 5 +Some mice on the Windows platform support a mouse wheel which is used +for scrolling documents without using the scrollbars. By rolling the +wheel, the system will generate \fBMouseWheel\fR events that the +application can use to scroll. Like \fBKey\fR events the event is +always routed to the window that currently has focus. When the event +is received you can use the \fB%D\fR substitution to get the +\fIdelta\fR field for the event which is a integer value of motion +that the mouse wheel has moved. The smallest value for which the +system will report is defined by the OS. On Windows 95 & 98 machines +this value is at least 120 before it is reported. However, higher +resolution devices may be available in the future. The sign of the +value determines which direction your widget should scroll. Positive +values should scroll up and negative values should scroll down. +.VE +.PP The last part of a long event specification is \fIdetail\fR. In the case of a \fBButtonPress\fR or \fBButtonRelease\fR event, it is the number of a button (1-5). If a button number is given, then only an @@ -258,7 +298,7 @@ The \fIfocus\fR field from the event (\fB0\fR or \fB1\fR). Valid only for \fBEnter\fR and \fBLeave\fR events. .IP \fB%h\fR 5 .VS -The \fIheight\fR field from the event. Valid only for \fBConfigure\fR and +The \fIheight\fR field from the event. Valid for the \fBConfigure\fR and \fBExpose\fR events. .VE .IP \fB%k\fR 5 @@ -308,6 +348,15 @@ Valid only for \fBKeyPress\fR and \fBKeyRelease\fR events. .IP \fB%B\fR 5 The \fIborder_width\fR field from the event. Valid only for \fBConfigure\fR events. +.VS +.IP \fB%D\fR 5 +This reports the \fIdelta\fR value of a \fBMouseWheel\fR event. The +\fIdelta\fR value represents the rotation units the mouse wheel has +been moved. On Windows 95 & 98 systems the smallest value for the +delta is 120. Future systems may support higher resolution values for +the delta. The sign of the value represents the direction the mouse +wheel was scrolled. +.VE .IP \fB%E\fR 5 The \fIsend_event\fR field from the event. Valid for all event types. .IP \fB%K\fR 5 diff --git a/doc/canvas.n b/doc/canvas.n index 3d9d384..c9077a7 100644 --- a/doc/canvas.n +++ b/doc/canvas.n @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: canvas.n,v 1.1.4.1 1998/09/30 02:16:12 stanton Exp $ +'\" RCS: @(#) $Id: canvas.n,v 1.1.4.2 1998/11/25 21:16:29 stanton Exp $ '\" .so man.macros .TH canvas n 4.0 Tk "Tk Built-In Commands" @@ -1446,6 +1446,7 @@ This option defaults to \fBcenter\fR. \fB\-fill \fIcolor\fR \fIColor\fR specifies a color to use for filling the text characters; it may have any of the forms accepted by \fBTk_GetColor\fR. +If \fIcolor\fR is an empty string then the text will be transparent. If this option isn't specified then it defaults to \fBblack\fR. .TP \fB\-font \fIfontName\fR diff --git a/doc/event.n b/doc/event.n index 82811d4..6d6a5b8 100644 --- a/doc/event.n +++ b/doc/event.n @@ -1,13 +1,14 @@ '\" '\" Copyright (c) 1996 Sun Microsystems, Inc. +'\" Copyright (c) 1998 by Scriptics Corporation. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: event.n,v 1.1.4.1 1998/09/30 02:16:16 stanton Exp $ +'\" RCS: @(#) $Id: event.n,v 1.1.4.2 1998/11/25 21:16:29 stanton Exp $ '\" .so man.macros -.TH event n 4.4 Tk "Tk Built-In Commands" +.TH event n 8.0 Tk "Tk Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -105,6 +106,19 @@ Corresponds to the \fB%b\fR substitution for binding scripts. for the event. Valid for \fBExpose\fR events. Corresponds to the \fB%c\fR substitution for binding scripts. .TP +\fB\-delta\fI number\fR +.VS +\fINumber\fR must be an integer; it specifies the \fIdelta\fR field +for the \fBMouseWheel\fR event. The \fIdelta\fR refers to the +direction and magnitude the mouse wheel was rotated. Note the value +is not a screen distance but are units of motion in the mouse wheel. +Typically these values are multiples of 120. For example, 120 should +scroll the text widget up 4 lines and -240 would scroll the text +widget down 8 lines. Of course, other widgets may define different +behaviors for mouse wheel motion. This field corresponds to the +\fB%D\fR substitution for binding scripts. +.VE +.TP \fB\-detail\fI detail\fR \fIDetail\fR specifies the \fIdetail\fR field for the event and must be one of the following: diff --git a/generic/tk.h b/generic/tk.h index bee1073..3fb719d 100644 --- a/generic/tk.h +++ b/generic/tk.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tk.h,v 1.1.4.2 1998/09/30 02:16:35 stanton Exp $ + * RCS: @(#) $Id: tk.h,v 1.1.4.3 1998/11/25 21:16:29 stanton Exp $ */ #ifndef _TK @@ -25,6 +25,7 @@ * unix/configure.in * win/makefile.bc (Not for patch release updates) * win/makefile.vc (Not for patch release updates) + * win/README * library/tk.tcl * README, win/README, unix/README, and mac/README * @@ -546,11 +547,14 @@ typedef struct Tk_GeomMgr { #define VirtualEvent (LASTEvent) #define ActivateNotify (LASTEvent + 1) #define DeactivateNotify (LASTEvent + 2) -#define TK_LASTEVENT (LASTEvent + 3) +#define MouseWheelEvent (LASTEvent + 3) +#define TK_LASTEVENT (LASTEvent + 4) + +#define MouseWheelMask (1L << 28) -#define VirtualEventMask (1L << 30) #define ActivateMask (1L << 29) -#define TK_LASTEVENT (LASTEvent + 3) +#define VirtualEventMask (1L << 30) +#define TK_LASTEVENT (LASTEvent + 4) /* @@ -797,10 +801,13 @@ typedef struct Tk_Item { * pixel drawn in item. Item area * includes x1 and y1 but not x2 * and y2. */ + struct Tk_Item *prevPtr; /* Previous in display list of all + * items in this canvas. Later items + * in list are drawn just below earlier + * ones. */ int reserved1; /* This padding is for compatibility */ char *reserved2; /* with Jan Nijtmans dash patch */ int reserved3; - char *reserved4; /* *------------------------------------------------------------------ diff --git a/generic/tkBind.c b/generic/tkBind.c index 7237b04..e74cdb7 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.c @@ -6,11 +6,12 @@ * * Copyright (c) 1989-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 1998 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkBind.c,v 1.1.4.2 1998/09/30 02:16:38 stanton Exp $ + * RCS: @(#) $Id: tkBind.c,v 1.1.4.3 1998/11/25 21:16:30 stanton Exp $ */ #include "tkPort.h" @@ -339,6 +340,8 @@ typedef struct BindInfo { PendingBinding *pendingList;/* The list of pending C bindings, kept in * case a C or Tcl binding causes the target * window to be deleted. */ + int deleted; /* 1 the application has been deleted but + * the structure has been preserved. */ } BindInfo; /* @@ -495,6 +498,7 @@ static EventInfo eventArray[] = { {"Colormap", ColormapNotify, ColormapChangeMask}, {"Activate", ActivateNotify, ActivateMask}, {"Deactivate", DeactivateNotify, ActivateMask}, + {"MouseWheel", MouseWheelEvent, MouseWheelMask}, {(char *) NULL, 0, 0} }; static Tcl_HashTable eventTable; @@ -567,7 +571,8 @@ static int flagArray[TK_LASTEVENT] = { /* MappingNotify */ 0, /* VirtualEvent */ VIRTUAL, /* Activate */ ACTIVATE, - /* Deactivate */ ACTIVATE + /* Deactivate */ ACTIVATE, + /* MouseWheel */ KEY }; /* @@ -763,6 +768,7 @@ TkBindInit(mainPtr) bindInfoPtr->screenInfo.curScreenIndex = -1; bindInfoPtr->screenInfo.bindingDepth = 0; bindInfoPtr->pendingList = NULL; + bindInfoPtr->deleted = 0; mainPtr->bindInfo = (TkBindInfo) bindInfoPtr; TkpInitializeMenuBindings(mainPtr->interp, mainPtr->bindingTable); @@ -796,7 +802,8 @@ TkBindFree(mainPtr) bindInfoPtr = (BindInfo *) mainPtr->bindInfo; DeleteVirtualEventTable(&bindInfoPtr->virtualEventTable); - ckfree((char *) bindInfoPtr); + bindInfoPtr->deleted = 1; + Tcl_EventuallyFree((ClientData) bindInfoPtr, Tcl_Free); mainPtr->bindInfo = NULL; } @@ -1735,10 +1742,11 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr) * winPtr->mainPtr == NULL. */ + Tcl_Preserve((ClientData) bindInfoPtr); while (p < end) { int code; - if (winPtr->mainPtr != NULL) { + if (!bindInfoPtr->deleted) { screenPtr->bindingDepth++; } Tcl_AllowExceptions(interp); @@ -1767,7 +1775,7 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr) } p++; - if (winPtr->mainPtr != NULL) { + if (!bindInfoPtr->deleted) { screenPtr->bindingDepth--; } if (code != TCL_OK) { @@ -1799,8 +1807,7 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr) } } - if ((winPtr->mainPtr != NULL) - && (screenPtr->bindingDepth != 0) + if (!bindInfoPtr->deleted && (screenPtr->bindingDepth != 0) && ((oldDispPtr != screenPtr->curDispPtr) || (oldScreen != screenPtr->curScreenIndex))) { @@ -1818,7 +1825,7 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr) Tcl_DStringFree(&scripts); if (matchCount > 0) { - if (winPtr->mainPtr != NULL) { + if (!bindInfoPtr->deleted) { /* * Delete the pending list from the list of pending scripts * for this window. @@ -1838,6 +1845,7 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr) ckfree((char *) pendingPtr); } } + Tcl_Release((ClientData) bindInfoPtr); } /* @@ -2417,6 +2425,13 @@ ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr) case 'B': number = eventPtr->xcreatewindow.border_width; goto doNumber; + case 'D': + /* + * This is used only by the MouseWheel event. + */ + + number = eventPtr->xkey.keycode; + goto doNumber; case 'E': number = (int) eventPtr->xany.send_event; goto doNumber; @@ -3155,7 +3170,8 @@ HandleEventGenerate(interp, mainWin, objc, objv) unsigned long eventMask; static char *fieldStrings[] = { "-when", "-above", "-borderwidth", "-button", - "-count", "-detail", "-focus", "-height", + "-count", "-delta", "-detail", "-focus", + "-height", "-keycode", "-keysym", "-mode", "-override", "-place", "-root", "-rootx", "-rooty", "-sendevent", "-serial", "-state", "-subwindow", @@ -3164,7 +3180,8 @@ HandleEventGenerate(interp, mainWin, objc, objv) }; enum field { EVENT_WHEN, EVENT_ABOVE, EVENT_BORDER, EVENT_BUTTON, - EVENT_COUNT, EVENT_DETAIL, EVENT_FOCUS, EVENT_HEIGHT, + EVENT_COUNT, EVENT_DELTA, EVENT_DETAIL, EVENT_FOCUS, + EVENT_HEIGHT, EVENT_KEYCODE, EVENT_KEYSYM, EVENT_MODE, EVENT_OVERRIDE, EVENT_PLACE, EVENT_ROOT, EVENT_ROOTX, EVENT_ROOTY, EVENT_SEND, EVENT_SERIAL, EVENT_STATE, EVENT_SUBWINDOW, @@ -3190,6 +3207,7 @@ HandleEventGenerate(interp, mainWin, objc, objv) name = Tcl_GetStringFromObj(objv[1], NULL); p = name; + eventMask = 0; count = ParseEventDescription(interp, &p, &pat, &eventMask); if (count == 0) { return TCL_ERROR; @@ -3215,7 +3233,7 @@ HandleEventGenerate(interp, mainWin, objc, objv) flags = flagArray[event.xany.type]; if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) { event.xkey.state = pat.needMods; - if (flags & KEY) { + if ((flags & KEY) && (event.xany.type != MouseWheelEvent)) { SetKeycodeAndState(tkwin, pat.detail.keySym, &event); } else if (flags & BUTTON) { event.xbutton.button = pat.detail.button; @@ -3316,6 +3334,17 @@ HandleEventGenerate(interp, mainWin, objc, objv) } break; } + case EVENT_DELTA: { + if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { + return TCL_ERROR; + } + if ((flags & KEY) && (event.xkey.type == MouseWheelEvent)) { + event.xkey.keycode = number; + } else { + goto badopt; + } + break; + } case EVENT_DETAIL: { number = TkFindStateNumObj(interp, optionPtr, notifyDetail, valuePtr); @@ -3359,7 +3388,7 @@ HandleEventGenerate(interp, mainWin, objc, objv) if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { return TCL_ERROR; } - if (flags & KEY) { + if ((flags & KEY) && (event.xkey.type != MouseWheelEvent)) { event.xkey.keycode = number; } else { goto badopt; @@ -3384,7 +3413,7 @@ HandleEventGenerate(interp, mainWin, objc, objv) "\"", (char *) NULL); return TCL_ERROR; } - if ((flags & KEY) == 0) { + if (!(flags & KEY) || (event.xkey.type == MouseWheelEvent)) { goto badopt; } break; @@ -3662,14 +3691,13 @@ NameToWindow(interp, mainWin, objPtr, tkwinPtr) return TCL_OK; } - /* - * When mapping from a keysym to a keycode, need - * information about the modifier state that should be used - * so that when they call XKeycodeToKeysym taking into - * account the xkey.state, they will get back the original - * keysym. - */ - +/* + * When mapping from a keysym to a keycode, need + * information about the modifier state that should be used + * so that when they call XKeycodeToKeysym taking into + * account the xkey.state, they will get back the original + * keysym. + */ static void SetKeycodeAndState(tkwin, keySym, eventPtr) diff --git a/generic/tkCanvText.c b/generic/tkCanvText.c index a0cbfd3..fbda648 100644 --- a/generic/tkCanvText.c +++ b/generic/tkCanvText.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCanvText.c,v 1.1.4.2 1998/09/30 02:16:46 stanton Exp $ + * RCS: @(#) $Id: tkCanvText.c,v 1.1.4.3 1998/11/25 21:16:31 stanton Exp $ */ #include <stdio.h> @@ -86,7 +86,7 @@ static Tk_ConfigSpec configSpecs[] = { "center", Tk_Offset(TextItem, anchor), TK_CONFIG_DONT_SET_DEFAULT}, {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL, - "black", Tk_Offset(TextItem, color), 0}, + "black", Tk_Offset(TextItem, color), TK_CONFIG_NULL_OK}, {TK_CONFIG_FONT, "-font", (char *) NULL, (char *) NULL, DEF_CANVTEXT_FONT, Tk_Offset(TextItem, tkfont), 0}, {TK_CONFIG_JUSTIFY, "-justify", (char *) NULL, (char *) NULL, diff --git a/generic/tkCanvas.c b/generic/tkCanvas.c index af3c101..20c0e71 100644 --- a/generic/tkCanvas.c +++ b/generic/tkCanvas.c @@ -7,11 +7,12 @@ * * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 1998 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCanvas.c,v 1.1.4.2 1998/09/30 02:16:48 stanton Exp $ + * RCS: @(#) $Id: tkCanvas.c,v 1.1.4.3 1998/11/25 21:16:31 stanton Exp $ */ #include "default.h" @@ -25,18 +26,19 @@ /* * The structure defined below is used to keep track of a tag search - * in progress. Only the "prevPtr" field should be accessed by anyone - * other than StartTagSearch and NextItem. + * in progress. No field should be accessed by anyone other than + * StartTagSearch and NextItem. */ typedef struct TagSearch { TkCanvas *canvasPtr; /* Canvas widget being searched. */ Tk_Uid tag; /* Tag to search for. 0 means return * all items. */ - Tk_Item *prevPtr; /* Item just before last one found (or NULL - * if last one found was first in the item - * list of canvasPtr). */ Tk_Item *currentPtr; /* Pointer to last item returned. */ + Tk_Item *lastPtr; /* The item right before the currentPtr + * is tracked so if the currentPtr is + * deleted we don't have to start from the + * beginning. */ int searchOver; /* Non-zero means NextItem should always * return NULL. */ } TagSearch; @@ -353,6 +355,7 @@ Tk_CanvasCmd(clientData, interp, argc, argv) canvasPtr->flags = 0; canvasPtr->nextId = 1; canvasPtr->psInfoPtr = NULL; + Tcl_InitHashTable(&canvasPtr->idTable, TCL_ONE_WORD_KEYS); Tk_SetClass(canvasPtr->tkwin, "Canvas"); TkSetClassProcs(canvasPtr->tkwin, &canvasClass, (ClientData) canvasPtr); @@ -497,18 +500,18 @@ CanvasWidgetCmd(clientData, interp, argc, argv) if (isdigit(UCHAR(argv[2][0]))) { int id; char *end; + Tcl_HashEntry *entryPtr; id = strtoul(argv[2], &end, 0); if (*end != 0) { goto bindByTag; } - for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; - itemPtr = itemPtr->nextPtr) { - if (itemPtr->id == id) { - object = (ClientData) itemPtr; - break; - } + entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) id); + if (entryPtr != NULL) { + itemPtr = (Tk_Item *) Tcl_GetHashValue(entryPtr); + object = (ClientData) itemPtr; } + if (object == 0) { Tcl_AppendResult(interp, "item \"", argv[2], "\" doesn't exist", (char *) NULL); @@ -686,6 +689,8 @@ CanvasWidgetCmd(clientData, interp, argc, argv) Tk_ItemType *matchPtr = NULL; Tk_Item *itemPtr; char buf[TCL_INTEGER_SPACE]; + int isNew = 0; + Tcl_HashEntry *entryPtr; if (argc < 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", @@ -724,6 +729,10 @@ CanvasWidgetCmd(clientData, interp, argc, argv) goto error; } itemPtr->nextPtr = NULL; + entryPtr = Tcl_CreateHashEntry(&canvasPtr->idTable, + (char *) itemPtr->id, &isNew); + Tcl_SetHashValue(entryPtr, itemPtr); + itemPtr->prevPtr = canvasPtr->lastItemPtr; canvasPtr->hotPtr = itemPtr; canvasPtr->hotPrevPtr = canvasPtr->lastItemPtr; if (canvasPtr->lastItemPtr == NULL) { @@ -783,6 +792,7 @@ CanvasWidgetCmd(clientData, interp, argc, argv) } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0) && (length >= 2)) { int i; + Tcl_HashEntry *entryPtr; for (i = 2; i < argc; i++) { for (itemPtr = StartTagSearch(canvasPtr, argv[i], &search); @@ -798,16 +808,23 @@ CanvasWidgetCmd(clientData, interp, argc, argv) if (itemPtr->tagPtr != itemPtr->staticTagSpace) { ckfree((char *) itemPtr->tagPtr); } - if (search.prevPtr == NULL) { + entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, + (char *) itemPtr->id); + Tcl_DeleteHashEntry(entryPtr); + if (itemPtr->nextPtr != NULL) { + itemPtr->nextPtr->prevPtr = itemPtr->prevPtr; + } + if (itemPtr->prevPtr != NULL) { + itemPtr->prevPtr->nextPtr = itemPtr->nextPtr; + } + if (canvasPtr->firstItemPtr == itemPtr) { canvasPtr->firstItemPtr = itemPtr->nextPtr; if (canvasPtr->firstItemPtr == NULL) { canvasPtr->lastItemPtr = NULL; } - } else { - search.prevPtr->nextPtr = itemPtr->nextPtr; } if (canvasPtr->lastItemPtr == itemPtr) { - canvasPtr->lastItemPtr = search.prevPtr; + canvasPtr->lastItemPtr = itemPtr->prevPtr; } ckfree((char *) itemPtr); if (itemPtr == canvasPtr->currentItemPtr) { @@ -1055,7 +1072,7 @@ CanvasWidgetCmd(clientData, interp, argc, argv) } } } else if ((c == 'l') && (strncmp(argv[1], "lower", length) == 0)) { - Tk_Item *prevPtr; + Tk_Item *itemPtr; if ((argc != 3) && (argc != 4)) { Tcl_AppendResult(interp, "wrong # args: should be \"", @@ -1070,18 +1087,17 @@ CanvasWidgetCmd(clientData, interp, argc, argv) */ if (argc == 3) { - prevPtr = NULL; + itemPtr = NULL; } else { - prevPtr = StartTagSearch(canvasPtr, argv[3], &search); - if (prevPtr != NULL) { - prevPtr = search.prevPtr; - } else { + itemPtr = StartTagSearch(canvasPtr, argv[3], &search); + if (itemPtr == NULL) { Tcl_AppendResult(interp, "tag \"", argv[3], "\" doesn't match any items", (char *) NULL); goto error; } + itemPtr = itemPtr->prevPtr; } - RelinkItems(canvasPtr, argv[2], prevPtr); + RelinkItems(canvasPtr, argv[2], itemPtr); } else if ((c == 'm') && (strncmp(argv[1], "move", length) == 0)) { double xAmount, yAmount; @@ -1464,6 +1480,7 @@ DestroyCanvas(memPtr) * stuff. */ + Tcl_DeleteHashTable(&canvasPtr->idTable); if (canvasPtr->pixmapGC != None) { Tk_FreeGC(canvasPtr->display, canvasPtr->pixmapGC); } @@ -2192,7 +2209,7 @@ StartTagSearch(canvasPtr, tag, searchPtr) * will be initialized here. */ { int id; - Tk_Item *itemPtr, *prevPtr; + Tk_Item *itemPtr, *lastPtr; Tk_Uid *tagPtr; Tk_Uid uid; int count; @@ -2213,27 +2230,28 @@ StartTagSearch(canvasPtr, tag, searchPtr) if (isdigit(UCHAR(*tag))) { char *end; - + Tcl_HashEntry *entryPtr; + numIdSearches++; id = strtoul(tag, &end, 0); if (*end == 0) { itemPtr = canvasPtr->hotPtr; - prevPtr = canvasPtr->hotPrevPtr; - if ((itemPtr == NULL) || (itemPtr->id != id) || (prevPtr == NULL) - || (prevPtr->nextPtr != itemPtr)) { + lastPtr = canvasPtr->hotPrevPtr; + if ((itemPtr == NULL) || (itemPtr->id != id) || (lastPtr == NULL) + || (lastPtr->nextPtr != itemPtr)) { numSlowSearches++; - for (prevPtr = NULL, itemPtr = canvasPtr->firstItemPtr; - itemPtr != NULL; - prevPtr = itemPtr, itemPtr = itemPtr->nextPtr) { - if (itemPtr->id == id) { - break; - } + entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) id); + if (entryPtr != NULL) { + itemPtr = (Tk_Item *)Tcl_GetHashValue(entryPtr); + lastPtr = itemPtr->prevPtr; + } else { + lastPtr = itemPtr = NULL; } } - searchPtr->prevPtr = prevPtr; + searchPtr->lastPtr = lastPtr; searchPtr->searchOver = 1; canvasPtr->hotPtr = itemPtr; - canvasPtr->hotPrevPtr = prevPtr; + canvasPtr->hotPrevPtr = lastPtr; return itemPtr; } } @@ -2246,7 +2264,7 @@ StartTagSearch(canvasPtr, tag, searchPtr) */ searchPtr->tag = NULL; - searchPtr->prevPtr = NULL; + searchPtr->lastPtr = NULL; searchPtr->currentPtr = canvasPtr->firstItemPtr; return canvasPtr->firstItemPtr; } @@ -2255,18 +2273,18 @@ StartTagSearch(canvasPtr, tag, searchPtr) * None of the above. Search for an item with a matching tag. */ - for (prevPtr = NULL, itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; - prevPtr = itemPtr, itemPtr = itemPtr->nextPtr) { + for (lastPtr = NULL, itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; + lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) { for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags; count > 0; tagPtr++, count--) { if (*tagPtr == uid) { - searchPtr->prevPtr = prevPtr; + searchPtr->lastPtr = lastPtr; searchPtr->currentPtr = itemPtr; return itemPtr; } } } - searchPtr->prevPtr = prevPtr; + searchPtr->lastPtr = lastPtr; searchPtr->searchOver = 1; return NULL; } @@ -2297,7 +2315,7 @@ NextItem(searchPtr) TagSearch *searchPtr; /* Record describing search in * progress. */ { - Tk_Item *itemPtr, *prevPtr; + Tk_Item *itemPtr, *lastPtr; int count; Tk_Uid uid; Tk_Uid *tagPtr; @@ -2307,11 +2325,11 @@ NextItem(searchPtr) * one to return), and return if there are no items left. */ - prevPtr = searchPtr->prevPtr; - if (prevPtr == NULL) { + lastPtr = searchPtr->lastPtr; + if (lastPtr == NULL) { itemPtr = searchPtr->canvasPtr->firstItemPtr; } else { - itemPtr = prevPtr->nextPtr; + itemPtr = lastPtr->nextPtr; } if ((itemPtr == NULL) || (searchPtr->searchOver)) { searchPtr->searchOver = 1; @@ -2321,12 +2339,12 @@ NextItem(searchPtr) /* * The structure of the list has changed. Probably the * previously-returned item was removed from the list. - * In this case, don't advance prevPtr; just return + * In this case, don't advance lastPtr; just return * its new successor (i.e. do nothing here). */ } else { - prevPtr = itemPtr; - itemPtr = prevPtr->nextPtr; + lastPtr = itemPtr; + itemPtr = lastPtr->nextPtr; } /* @@ -2335,7 +2353,7 @@ NextItem(searchPtr) uid = searchPtr->tag; if (uid == NULL) { - searchPtr->prevPtr = prevPtr; + searchPtr->lastPtr = lastPtr; searchPtr->currentPtr = itemPtr; return itemPtr; } @@ -2344,17 +2362,17 @@ NextItem(searchPtr) * Look for an item with a particular tag. */ - for ( ; itemPtr != NULL; prevPtr = itemPtr, itemPtr = itemPtr->nextPtr) { + for ( ; itemPtr != NULL; lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) { for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags; count > 0; tagPtr++, count--) { if (*tagPtr == uid) { - searchPtr->prevPtr = prevPtr; + searchPtr->lastPtr = lastPtr; searchPtr->currentPtr = itemPtr; return itemPtr; } } } - searchPtr->prevPtr = prevPtr; + searchPtr->lastPtr = lastPtr; searchPtr->searchOver = 1; return NULL; } @@ -2524,14 +2542,16 @@ FindItems(interp, canvasPtr, argc, argv, newTag, cmdName, option) DoItem(interp, itemPtr, uid); } } else if ((c == 'b') && (strncmp(argv[0], "below", length) == 0)) { + Tk_Item *itemPtr; + if (argc != 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", cmdName, option, " below tagOrId", (char *) NULL); return TCL_ERROR; } - (void) StartTagSearch(canvasPtr, argv[1], &search); - if (search.prevPtr != NULL) { - DoItem(interp, search.prevPtr, uid); + itemPtr = StartTagSearch(canvasPtr, argv[1], &search); + if (itemPtr->prevPtr != NULL) { + DoItem(interp, itemPtr->prevPtr, uid); } } else if ((c == 'c') && (strncmp(argv[0], "closest", length) == 0)) { double closestDist; @@ -2804,19 +2824,27 @@ RelinkItems(canvasPtr, tag, prevPtr) * moved! Switch to insert after its predecessor. */ - prevPtr = search.prevPtr; + prevPtr = prevPtr->prevPtr; } - if (search.prevPtr == NULL) { + if (itemPtr->prevPtr == NULL) { + if (itemPtr->nextPtr != NULL) { + itemPtr->nextPtr->prevPtr = NULL; + } canvasPtr->firstItemPtr = itemPtr->nextPtr; } else { - search.prevPtr->nextPtr = itemPtr->nextPtr; + if (itemPtr->nextPtr != NULL) { + itemPtr->nextPtr->prevPtr = itemPtr->prevPtr; + } + itemPtr->prevPtr->nextPtr = itemPtr->nextPtr; } if (canvasPtr->lastItemPtr == itemPtr) { - canvasPtr->lastItemPtr = search.prevPtr; + canvasPtr->lastItemPtr = itemPtr->prevPtr; } if (firstMovePtr == NULL) { + itemPtr->prevPtr = NULL; firstMovePtr = itemPtr; } else { + itemPtr->prevPtr = lastMovePtr; lastMovePtr->nextPtr = itemPtr; } lastMovePtr = itemPtr; @@ -2834,10 +2862,19 @@ RelinkItems(canvasPtr, tag, prevPtr) return; } if (prevPtr == NULL) { + if (canvasPtr->firstItemPtr != NULL) { + canvasPtr->firstItemPtr->prevPtr = lastMovePtr; + } lastMovePtr->nextPtr = canvasPtr->firstItemPtr; canvasPtr->firstItemPtr = firstMovePtr; } else { + if (prevPtr->nextPtr != NULL) { + prevPtr->nextPtr->prevPtr = lastMovePtr; + } lastMovePtr->nextPtr = prevPtr->nextPtr; + if (firstMovePtr != NULL) { + firstMovePtr->prevPtr = prevPtr; + } prevPtr->nextPtr = firstMovePtr; } if (canvasPtr->lastItemPtr == prevPtr) { diff --git a/generic/tkCanvas.h b/generic/tkCanvas.h index 7c40113..d349e2b 100644 --- a/generic/tkCanvas.h +++ b/generic/tkCanvas.h @@ -6,11 +6,12 @@ * * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1998 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCanvas.h,v 1.1.4.1 1998/09/30 02:16:49 stanton Exp $ + * RCS: @(#) $Id: tkCanvas.h,v 1.1.4.2 1998/11/25 21:16:31 stanton Exp $ */ #ifndef _TKCANVAS @@ -208,6 +209,7 @@ typedef struct TkCanvas { * Postscript for the canvas. NULL means * no Postscript is currently being * generated. */ + Tcl_HashTable idTable; /* Table of integer indices. */ } TkCanvas; /* diff --git a/generic/tkEvent.c b/generic/tkEvent.c index 5d5f7ec..01aa75e 100644 --- a/generic/tkEvent.c +++ b/generic/tkEvent.c @@ -6,11 +6,12 @@ * * Copyright (c) 1990-1994 The Regents of the University of California. * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1998 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkEvent.c,v 1.1.4.1 1998/09/30 02:16:55 stanton Exp $ + * RCS: @(#) $Id: tkEvent.c,v 1.1.4.2 1998/11/25 21:16:31 stanton Exp $ */ #include "tkPort.h" @@ -129,7 +130,8 @@ static unsigned long eventMasks[TK_LASTEVENT] = { 0, /* Mapping Notify */ VirtualEventMask, /* VirtualEvents */ ActivateMask, /* ActivateNotify */ - ActivateMask /* DeactivateNotify */ + ActivateMask, /* DeactivateNotify */ + MouseWheelMask /* MouseWheelEvent */ }; /* @@ -546,10 +548,13 @@ Tk_HandleEvent(eventPtr) /* * Redirect KeyPress and KeyRelease events to the focus window, - * or ignore them entirely if there is no focus window. + * or ignore them entirely if there is no focus window. We also + * route the MouseWheel event to the focus window. The MouseWheel + * event is an extension to the X event set. Currently, it is only + * available on the Windows version of Tk. */ - if (mask & (KeyPressMask|KeyReleaseMask)) { + if (mask & (KeyPressMask|KeyReleaseMask|MouseWheelMask)) { winPtr->dispPtr->lastEventTime = eventPtr->xkey.time; winPtr = TkFocusKeyEvent(winPtr, eventPtr); if (winPtr == NULL) { diff --git a/generic/tkFont.c b/generic/tkFont.c index 3a8d655..6340c76 100644 --- a/generic/tkFont.c +++ b/generic/tkFont.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkFont.c,v 1.1.4.3 1998/10/21 22:12:43 stanton Exp $ + * RCS: @(#) $Id: tkFont.c,v 1.1.4.4 1998/11/25 21:16:31 stanton Exp $ */ #include "tkPort.h" @@ -1993,31 +1993,6 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags, } } - /* - * Using maximum line length, shift all the chunks so that the lines are - * all justified correctly. - */ - - curLine = 0; - chunkPtr = layoutPtr->chunks; - y = chunkPtr->y; - lineLengths = (int *) Tcl_DStringValue(&lineBuffer); - for (n = 0; n < layoutPtr->numChunks; n++) { - int extra; - - if (chunkPtr->y != y) { - curLine++; - y = chunkPtr->y; - } - extra = maxWidth - lineLengths[curLine]; - if (justify == TK_JUSTIFY_CENTER) { - chunkPtr->x += extra / 2; - } else if (justify == TK_JUSTIFY_RIGHT) { - chunkPtr->x += extra; - } - chunkPtr++; - } - layoutPtr->width = maxWidth; layoutHeight = baseline - fmPtr->ascent; if (layoutPtr->numChunks == 0) { @@ -2037,6 +2012,31 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags, layoutPtr->chunks[0].y = fmPtr->ascent; layoutPtr->chunks[0].totalWidth = 0; layoutPtr->chunks[0].displayWidth = 0; + } else { + /* + * Using maximum line length, shift all the chunks so that the lines + * are all justified correctly. + */ + + curLine = 0; + chunkPtr = layoutPtr->chunks; + y = chunkPtr->y; + lineLengths = (int *) Tcl_DStringValue(&lineBuffer); + for (n = 0; n < layoutPtr->numChunks; n++) { + int extra; + + if (chunkPtr->y != y) { + curLine++; + y = chunkPtr->y; + } + extra = maxWidth - lineLengths[curLine]; + if (justify == TK_JUSTIFY_CENTER) { + chunkPtr->x += extra / 2; + } else if (justify == TK_JUSTIFY_RIGHT) { + chunkPtr->x += extra; + } + chunkPtr++; + } } if (widthPtr != NULL) { diff --git a/library/listbox.tcl b/library/listbox.tcl index 0002502..c19afdc 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -3,10 +3,11 @@ # This file defines the default bindings for Tk listbox widgets # and provides procedures that help in implementing those bindings. # -# RCS: @(#) $Id: listbox.tcl,v 1.1.4.2 1998/09/30 02:17:33 stanton Exp $ +# RCS: @(#) $Id: listbox.tcl,v 1.1.4.3 1998/11/25 21:16:33 stanton Exp $ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1995 Sun Microsystems, Inc. +# Copyright (c) 1998 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -171,6 +172,14 @@ bind Listbox <B2-Motion> { %W scan dragto %x %y } +# The MouseWheel will typically only fire on Windows. However, +# someone could use the "event generate" command to produce one +# on other platforms. + +bind Listbox <MouseWheel> { + %W yview scroll [expr - (%D / 120) * 4] units +} + # tkListboxBeginSelect -- # # This procedure is typically invoked on button-1 presses. It begins diff --git a/library/msgbox.tcl b/library/msgbox.tcl index 41a0403..257c7d3 100644 --- a/library/msgbox.tcl +++ b/library/msgbox.tcl @@ -3,7 +3,7 @@ # Implements messageboxes for platforms that do not have native # messagebox support. # -# RCS: @(#) $Id: msgbox.tcl,v 1.1.4.2 1998/09/30 02:17:34 stanton Exp $ +# RCS: @(#) $Id: msgbox.tcl,v 1.1.4.3 1998/11/25 21:16:33 stanton Exp $ # # Copyright (c) 1994-1997 Sun Microsystems, Inc. # @@ -65,7 +65,7 @@ proc tkMessageBox {args} { error "bad window path name \"$data(-parent)\"" } - case $data(-type) { + switch -- $data(-type) { abortretryignore { set buttons { {abort -width 6 -text Abort -under 0} diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index ebf880d..779ddeb 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -3,7 +3,7 @@ # This file defines the default bindings for Tk scrollbar widgets. # It also provides procedures that help in implementing the bindings. # -# RCS: @(#) $Id: scrlbar.tcl,v 1.1.4.2 1998/09/30 02:17:37 stanton Exp $ +# RCS: @(#) $Id: scrlbar.tcl,v 1.1.4.3 1998/11/25 21:16:33 stanton Exp $ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -312,7 +312,7 @@ proc tkScrollByUnits {w orient amount} { if {[llength $info] == 2} { uplevel #0 $cmd scroll $amount units } else { - uplevel #0 $cmd [expr [lindex $info 2] + $amount] + uplevel #0 $cmd [expr {[lindex $info 2] + $amount}] } } @@ -337,7 +337,7 @@ proc tkScrollByPages {w orient amount} { if {[llength $info] == 2} { uplevel #0 $cmd scroll $amount pages } else { - uplevel #0 $cmd [expr [lindex $info 2] + $amount*([lindex $info 1] - 1)] + uplevel #0 $cmd [expr {[lindex $info 2] + $amount*([lindex $info 1] - 1)}] } } @@ -360,7 +360,7 @@ proc tkScrollToPos {w pos} { if {[llength $info] == 2} { uplevel #0 $cmd moveto $pos } else { - uplevel #0 $cmd [expr round([lindex $info 0]*$pos)] + uplevel #0 $cmd [expr {round([lindex $info 0]*$pos)}] } } diff --git a/library/text.tcl b/library/text.tcl index 69dfb00..50eb437 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -3,10 +3,11 @@ # This file defines the default bindings for Tk text widgets and provides # procedures that help in implementing the bindings. # -# RCS: @(#) $Id: text.tcl,v 1.1.4.2 1998/09/30 02:17:37 stanton Exp $ +# RCS: @(#) $Id: text.tcl,v 1.1.4.3 1998/11/25 21:16:33 stanton Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. +# Copyright (c) 1998 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -447,6 +448,14 @@ bind Text <B2-Motion> { } set tkPriv(prevPos) {} +# The MouseWheel will typically only fire on Windows. However, +# someone could use the "event generate" command to produce one +# on other platforms. + +bind Text <MouseWheel> { + %W yview scroll [expr - (%D / 120) * 4] units +} + # tkTextClosestGap -- # Given x and y coordinates, this procedure finds the closest boundary # between characters to the given coordinates and returns the index diff --git a/library/tk.tcl b/library/tk.tcl index 1a128b9..bb7c6c6 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -3,7 +3,7 @@ # Initialization script normally executed in the interpreter for each # Tk-based application. Arranges class bindings for widgets. # -# RCS: @(#) $Id: tk.tcl,v 1.1.4.2 1998/09/30 02:17:38 stanton Exp $ +# RCS: @(#) $Id: tk.tcl,v 1.1.4.3 1998/11/25 21:16:33 stanton Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -179,13 +179,13 @@ switch $tcl_platform(platform) { # ---------------------------------------------------------------------- if {$tcl_platform(platform) != "macintosh"} { - source $tk_library/button.tcl - source $tk_library/entry.tcl - source $tk_library/listbox.tcl - source $tk_library/menu.tcl - source $tk_library/scale.tcl - source $tk_library/scrlbar.tcl - source $tk_library/text.tcl + source [file join $tk_library button.tcl] + source [file join $tk_library entry.tcl] + source [file join $tk_library listbox.tcl] + source [file join $tk_library menu.tcl] + source [file join $tk_library scale.tcl] + source [file join $tk_library scrlbar.tcl] + source [file join $tk_library text.tcl] } # ---------------------------------------------------------------------- diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl index 881e87a..fa59661 100644 --- a/library/tkfbox.tcl +++ b/library/tkfbox.tcl @@ -11,7 +11,7 @@ # files by clicking on the file icons or by entering a filename # in the "Filename:" entry. # -# RCS: @(#) $Id: tkfbox.tcl,v 1.1.4.2 1998/09/30 02:17:38 stanton Exp $ +# RCS: @(#) $Id: tkfbox.tcl,v 1.1.4.3 1998/11/25 21:16:34 stanton Exp $ # # Copyright (c) 1994-1998 Sun Microsystems, Inc. # @@ -1261,7 +1261,7 @@ proc tkFDialog_ActivateEnt {w} { set path [lindex $list 1] set file [lindex $list 2] - case $flag { + switch -- $flag { OK { if {![string compare $file ""]} { # user has entered an existing (sub)directory diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl index 8b6f478..4865e9b 100644 --- a/library/xmfbox.tcl +++ b/library/xmfbox.tcl @@ -4,7 +4,7 @@ # Unix platform. This implementation is used only if the # "tk_strictMotif" flag is set. # -# RCS: @(#) $Id: xmfbox.tcl,v 1.1.4.2 1998/09/30 02:17:39 stanton Exp $ +# RCS: @(#) $Id: xmfbox.tcl,v 1.1.4.3 1998/11/25 21:16:34 stanton Exp $ # # Copyright (c) 1996 Sun Microsystems, Inc. # @@ -529,7 +529,7 @@ proc tkMotifFDialog_BrowseDList {w} { set list [tkMotifFDialog_InterpFilter $w] set data(filter) [lindex $list 1] - case $subdir { + switch -- $subdir { . { set newSpec [tkFDialog_JoinFile $data(selectPath) $data(filter)] } @@ -571,7 +571,7 @@ proc tkMotifFDialog_ActivateDList {w} { $data(fList) selection clear 0 end - case $subdir { + switch -- $subdir { . { set newDir $data(selectPath) } diff --git a/mac/MW_TkHeader.pch b/mac/MW_TkHeader.pch index 5cf03fb..4047d0a 100644 --- a/mac/MW_TkHeader.pch +++ b/mac/MW_TkHeader.pch @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: MW_TkHeader.pch,v 1.1.4.2 1998/09/30 02:17:58 stanton Exp $ + * RCS: @(#) $Id: MW_TkHeader.pch,v 1.1.4.3 1998/11/25 21:16:35 stanton Exp $ */ /* @@ -31,10 +31,10 @@ #pragma precompile_target "MW_TkHeader68K" #endif -#include "tclMacCommonDefines.h" +#include "tclMacCommonPch.h" #ifdef TCL_DEBUG -#define TK_TEST + #define TK_TEST #endif /* @@ -8,7 +8,7 @@ Jim Ingham Cygnus Solutions jingham@cygnus.com -RCS: @(#) $Id: README,v 1.1.4.2 1998/09/30 02:17:59 stanton Exp $ +RCS: @(#) $Id: README,v 1.1.4.3 1998/11/25 21:16:35 stanton Exp $ 1. Introduction --------------- @@ -96,12 +96,6 @@ mactk-source-8.1.sea.hqx are included. However, you must already have the More Files package to compile this code. -UNIX Tar file distribution. - The standard Tcl/Tk source distribution has Mac project files - in it. Be warned that the Tk project file is lacking one minor - change compared to the ones in the installers listed above - having to do with locking down the MDEF resource. - 5. Documentation ---------------- @@ -163,7 +157,14 @@ Special notes: * We are starting to support the new Appearance Manager that shipped with MacOS 8.0. The Tk 8.0.3 release is the first Tk release - that supports the Appearance Manager well. + that supports the Appearance Manager well. Tk 8.0.4 extends this support + to the menu system, though you have to have Appearance 1.0.1 or later + installed for this to work. + +* If you get the Unix tar file, it will untar into a directory tcl8.0.4. However, + the Macintosh project files expect the folder to be called tcl8.0. You will need + to rename the folder to tcl8.0, or change all the paths in the project files. + 7. About Dialog --------------- diff --git a/mac/bugs.doc b/mac/bugs.doc index d51afc8..fb368d9 100644 --- a/mac/bugs.doc +++ b/mac/bugs.doc @@ -4,7 +4,7 @@ by Ray Johnson Sun Microsystems Laboratories rjohnson@eng.sun.com -RCS: @(#) $Id: bugs.doc,v 1.1.4.2 1998/09/30 02:17:59 stanton Exp $ +RCS: @(#) $Id: bugs.doc,v 1.1.4.3 1998/11/25 21:16:35 stanton Exp $ We are now very close to passing the test suite for Tk. We are very interested in finding remaining bugs that still linger. Please let us @@ -35,6 +35,11 @@ Known bugs: * Drawing is not really correct. This shows up mostly in the canvas when line widths are greater than one. Unfortunantly, this will not be easy to fix. + +* The active menu highlight color in Tearoff menus will not match the system-wide + menu highlight color under Appearance. It will be black instead. This is not + easy to fix, since the Appearance API's don't really allow you to get your hands + on this information... There are many other bugs. However, will no get listed until they are reported at least once. Send those bug reports in! diff --git a/mac/tkMacAppInit.c b/mac/tkMacAppInit.c index c254835..49fc109 100644 --- a/mac/tkMacAppInit.c +++ b/mac/tkMacAppInit.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacAppInit.c,v 1.1.4.2 1998/09/30 02:18:01 stanton Exp $ + * RCS: @(#) $Id: tkMacAppInit.c,v 1.1.4.3 1998/11/25 21:16:35 stanton Exp $ */ #include <Gestalt.h> @@ -30,6 +30,8 @@ EXTERN int Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp)); #endif /* TK_TEST */ #ifdef TCL_TEST +EXTERN int Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN int Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp)); EXTERN int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp)); EXTERN int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp)); #endif /* TCL_TEST */ @@ -149,6 +151,11 @@ Tcl_AppInit( if (TclObjTest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } + if (Procbodytest_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init, + Procbodytest_SafeInit); #endif /* TCL_TEST */ #ifdef TK_TEST diff --git a/mac/tkMacColor.c b/mac/tkMacColor.c index 35fc4ab..2455c47 100644 --- a/mac/tkMacColor.c +++ b/mac/tkMacColor.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacColor.c,v 1.1.4.1 1998/09/30 02:18:03 stanton Exp $ + * RCS: @(#) $Id: tkMacColor.c,v 1.1.4.2 1998/11/25 21:16:36 stanton Exp $ */ #include <tkColor.h> @@ -90,6 +90,8 @@ TkSetMacColor( case MENU_TEXT_PIXEL: GetMenuPartColor((pixel >> 24), macColor); return true; + case APPEARANCE_PIXEL: + return false; case PIXEL_MAGIC: default: macColor->blue = (unsigned short) ((pixel & 0xFF) << 8); @@ -252,6 +254,12 @@ TkpGetColor( GetMenuPartColor(MENU_TEXT_PIXEL, &rgbValue); pixelCode = MENU_TEXT_PIXEL; foundSystemColor = true; + } else if (!strcasecmp(name+6, "AppearanceColor")) { + color.red = 0; + color.green = 0; + color.blue = 0; + pixelCode = APPEARANCE_PIXEL; + foundSystemColor = true; } if (foundSystemColor) { diff --git a/mac/tkMacMenu.c b/mac/tkMacMenu.c index 0097c3f..cc46f2a 100644 --- a/mac/tkMacMenu.c +++ b/mac/tkMacMenu.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacMenu.c,v 1.1.4.3 1998/11/24 21:42:44 stanton Exp $ + * RCS: @(#) $Id: tkMacMenu.c,v 1.1.4.4 1998/11/25 21:16:36 stanton Exp $ */ #include <Menus.h> @@ -18,11 +18,13 @@ #include <string.h> #include <ToolUtils.h> #include <Balloons.h> -#include "tkMenu.h" -#include "tkMacInt.h" -#include "tkMenubutton.h" +#include <Appearance.h> #undef Status #include <Devices.h> +#include "tkMenu.h" +#include "tkMacInt.h" +#include "tkMenuButton.h" +#include "tkColor.h" typedef struct MacMenu { MenuHandle menuHdl; /* The Menu Manager data structure. */ @@ -33,6 +35,12 @@ typedef struct MacMenu { * through. */ } MacMenu; +typedef struct MenuEntryUserData { + Drawable mdefDrawable; + TkMenuEntry *mePtr; + Tk_Font tkfont; + Tk_FontMetrics *fmPtr; +} MenuEntryUserData; /* * Various geometry definitions: */ @@ -207,6 +215,14 @@ static RgnHandle utilRgn = NULL;/* Used when creating the region that is to static TopLevelMenubarList *windowListPtr; /* A list of windows that have menubars set. */ +static MenuItemDrawingUPP tkThemeMenuItemDrawingUPP; + /* Points to the UPP for theme Item drawing. */ + +static GC appearanceGC = NULL; /* The fake appearance GC. If you + pass the foreground of this to TkMacSetColor, + it will return false, so you will know + not to set the foreground color */ + /* * Forward declarations for procedures defined later in this file: @@ -215,6 +231,8 @@ static TopLevelMenubarList *windowListPtr; static void CompleteIdlers _ANSI_ARGS_((TkMenu *menuPtr)); static void DrawMenuBarWhenIdle _ANSI_ARGS_(( ClientData clientData)); +static void DrawMenuBackground _ANSI_ARGS_(( + Rect *menuRectPtr, Drawable d, ThemeMenuType type)); static void DrawMenuEntryAccelerator _ANSI_ARGS_(( TkMenu *menuPtr, TkMenuEntry *mePtr, Drawable d, GC gc, Tk_Font tkfont, @@ -294,6 +312,13 @@ static int SetMenuCascade _ANSI_ARGS_((TkMenu *menuPtr)); static void SetMenuIndicator _ANSI_ARGS_((TkMenuEntry *mePtr)); static void SetMenuTitle _ANSI_ARGS_((MenuHandle menuHdl, Tcl_Obj *titlePtr)); +static void AppearanceEntryDrawWrapper _ANSI_ARGS_((TkMenuEntry *mePtr, + Rect * menuRectPtr, TkMenuLowMemGlobals *globalsPtr, + Drawable d, Tk_FontMetrics *fmPtr, Tk_Font tkfont, + int x, int y, int width, int height)); +pascal void tkThemeMenuItemDrawingProc _ANSI_ARGS_ ((const Rect *inBounds, + SInt16 inDepth, Boolean inIsColorDevice, + SInt32 inUserData)); /* @@ -1129,10 +1154,15 @@ ReconfigureIndividualMenu( ->menuPtr->platformData)->menuHdl; } if (childMenuHdl != NULL) { + if (TkMacHaveAppearance() > 1) { + SetMenuItemHierarchicalID(macMenuHdl, base + index, + (*childMenuHdl)->menuID); + } else { SetItemMark(macMenuHdl, base + index, (*childMenuHdl)->menuID); SetItemCmd(macMenuHdl, base + index, CASCADE_CMD); } + } /* * If we changed the highligthing of this menu, its * children all have to be reconfigured so that @@ -2200,8 +2230,16 @@ GetMenuSeparatorGeometry( int *widthPtr, /* The resulting width */ int *heightPtr) /* The resulting height */ { - *widthPtr = 0; - *heightPtr = fmPtr->linespace; + if (TkMacHaveAppearance() > 1) { + SInt16 outHeight; + + GetThemeMenuSeparatorHeight(&outHeight); + *widthPtr = 0; + *heightPtr = outHeight; + } else { + *widthPtr = 0; + *heightPtr = fmPtr->linespace; + } } /* @@ -2263,6 +2301,46 @@ DrawMenuEntryIndicator( /* *---------------------------------------------------------------------- * + * DrawMenuBackground -- + * + * If Appearance is present, draws the Appearance background + * + * Results: + * Nothing + * + * Side effects: + * Commands are output to X to display the menu in its + * current mode. + * + *---------------------------------------------------------------------- + */ +static void +DrawMenuBackground( + Rect *menuRectPtr, /* The menu rect */ + Drawable d, /* What we are drawing into */ + ThemeMenuType type /* Type of menu */ + ) +{ + if (!TkMacHaveAppearance()) { + return; + } else { + CGrafPtr saveWorld; + GDHandle saveDevice; + GWorldPtr destPort; + + destPort = TkMacGetDrawablePort(d); + GetGWorld(&saveWorld, &saveDevice); + SetGWorld(destPort, NULL); + TkMacSetUpClippingRgn(d); + DrawThemeMenuBackground (menuRectPtr, type); + SetGWorld(saveWorld, saveDevice); + return; + } +} + +/* + *---------------------------------------------------------------------- + * * DrawSICN -- * * Given a resource id and an index, loads the appropriate SICN @@ -2372,6 +2450,11 @@ DrawMenuEntryAccelerator( Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr, &activeBorderWidth); if (mePtr->type == CASCADE_ENTRY) { + /* + * Under Appearance, we let the Appearance Manager draw the icon + */ + + if (!TkMacHaveAppearance()) { if (0 == DrawSICN(SICN_RESOURCE_NUMBER, CASCADE_ARROW, d, gc, x + width - SICN_HEIGHT, (y + (height / 2)) - (SICN_HEIGHT / 2))) { @@ -2390,6 +2473,7 @@ DrawMenuEntryAccelerator( 3, DECORATION_BORDER_WIDTH, TK_RELIEF_FLAT); } } + } } else if (mePtr->accelLength != 0) { int leftEdge = x + width; int baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2; @@ -2480,7 +2564,15 @@ DrawMenuSeparator( GetGWorld(&saveWorld, &saveDevice); SetGWorld(destPort, NULL); TkMacSetUpClippingRgn(d); - + if (TkMacHaveAppearance() > 1) { + Rect r; + r.top = y; + r.left = x; + r.bottom = y + height; + r.right = x + width; + + DrawThemeMenuSeparator(&r); + } else { /* * We don't want to use the text GC for drawing the separator. It * needs to be the same color as disabled items. @@ -2492,6 +2584,7 @@ DrawMenuSeparator( Line(width, 0); SetGWorld(saveWorld, saveDevice); } +} /* *---------------------------------------------------------------------- @@ -2610,10 +2703,29 @@ MenuDefProc( SetEmptyRgn(utilRgn); /* + * Now draw the background if Appearance is present... + */ + + GetGWorld(&macMDEFDrawable.portPtr, &device); + if (TkMacHaveAppearance() > 1) { + ThemeMenuType menuType; + + if (menuPtr->menuRefPtr->topLevelListPtr != NULL) { + menuType = kThemeMenuTypePullDown; + } else if (menuPtr->menuRefPtr->parentEntryPtr != NULL) { + menuType = kThemeMenuTypeHierarchical; + } else { + menuType = kThemeMenuTypePopUp; + } + + DrawMenuBackground(menuRectPtr, (Drawable) &macMDEFDrawable, + menuType); + } + + /* * Next, figure out scrolling information. */ - GetGWorld(&macMDEFDrawable.portPtr, &device); menuClipRect = *menuRectPtr; if ((menuClipRect.bottom - menuClipRect.top) < menuPtr->totalHeight) { @@ -2656,7 +2768,7 @@ MenuDefProc( > menuClipRect.bottom) { continue; } - ClipRect(&menuClipRect); + /* ClipRect(&menuClipRect); */ if (mePtr->fontPtr == NULL) { fmPtr = &fontMetrics; tkfont = menuFont; @@ -2665,12 +2777,13 @@ MenuDefProc( Tk_GetFontMetrics(tkfont, &entryMetrics); fmPtr = &entryMetrics; } - TkpDrawMenuEntry(mePtr, (Drawable) &macMDEFDrawable, - tkfont, fmPtr, menuRectPtr->left + mePtr->x, - globalsPtr->menuTop + mePtr->y, - (mePtr->entryFlags & ENTRY_LAST_COLUMN) ? - menuPtr->totalWidth - mePtr->x : mePtr->width, - menuPtr->entries[i]->height, 0, 1); + AppearanceEntryDrawWrapper(mePtr, menuRectPtr, globalsPtr, + (Drawable) &macMDEFDrawable, fmPtr, tkfont, + menuRectPtr->left + mePtr->x, + globalsPtr->menuTop + mePtr->y, + (mePtr->entryFlags & ENTRY_LAST_COLUMN) ? + menuPtr->totalWidth - mePtr->x : mePtr->width, + menuPtr->entries[i]->height); } globalsPtr->menuBottom = globalsPtr->menuTop + menuPtr->totalHeight; @@ -2696,11 +2809,15 @@ MenuDefProc( if (TkSetMacColor(menuPtr->textGC->foreground, &foreColor) == true) { - RGBForeColor(&foreColor); + if (!TkMacHaveAppearance()) { + RGBForeColor(&foreColor); + } } if (TkSetMacColor(menuPtr->textGC->background, &backColor) == true) { - RGBBackColor(&backColor); + if (!TkMacHaveAppearance()) { + RGBBackColor(&backColor); + } } /* @@ -2804,13 +2921,13 @@ MenuDefProc( mePtr->fontPtr); } Tk_GetFontMetrics(tkfont, &fontMetrics); - TkpDrawMenuEntry(mePtr, (Drawable) &macMDEFDrawable, - tkfont, &fontMetrics, - menuRectPtr->left + mePtr->x, - globalsPtr->menuTop + mePtr->y, - (mePtr->entryFlags & ENTRY_LAST_COLUMN) - ? menuPtr->totalWidth - mePtr->x - : mePtr->width, mePtr->height, 0, 1); + AppearanceEntryDrawWrapper(mePtr, menuRectPtr, globalsPtr, + (Drawable) &macMDEFDrawable, &fontMetrics, tkfont, + menuRectPtr->left + mePtr->x, + globalsPtr->menuTop + mePtr->y, + (mePtr->entryFlags & ENTRY_LAST_COLUMN) ? + menuPtr->totalWidth - mePtr->x : mePtr->width, + mePtr->height); } if (newItem != -1) { int oldActiveItem = menuPtr->active; @@ -2827,14 +2944,13 @@ MenuDefProc( mePtr->fontPtr); } Tk_GetFontMetrics(tkfont, &fontMetrics); - TkpDrawMenuEntry(mePtr, (Drawable) &macMDEFDrawable, - tkfont, &fontMetrics, - menuRectPtr->left + mePtr->x, - globalsPtr->menuTop + mePtr->y, - (mePtr->entryFlags & ENTRY_LAST_COLUMN) - ? menuPtr->totalWidth - mePtr->x - : mePtr->width, mePtr->height, - 0, 1); + AppearanceEntryDrawWrapper(mePtr, menuRectPtr, globalsPtr, + (Drawable) &macMDEFDrawable, &fontMetrics, tkfont, + menuRectPtr->left + mePtr->x, + globalsPtr->menuTop + mePtr->y, + (mePtr->entryFlags & ENTRY_LAST_COLUMN) ? + menuPtr->totalWidth - mePtr->x : mePtr->width, + mePtr->height); } tkUseMenuCascadeRgn = 1; @@ -2922,12 +3038,13 @@ MenuDefProc( Tk_GetFontMetrics(tkfont, &entryMetrics); fmPtr = &entryMetrics; } - TkpDrawMenuEntry(mePtr, (Drawable) &macMDEFDrawable, - tkfont, fmPtr, menuRectPtr->left + mePtr->x, - globalsPtr->menuTop + mePtr->y, - (mePtr->entryFlags & ENTRY_LAST_COLUMN) ? - menuPtr->totalWidth - mePtr->x : mePtr->width, - menuPtr->entries[i]->height, 0, 1); + AppearanceEntryDrawWrapper(mePtr, menuRectPtr, globalsPtr, + (Drawable) &macMDEFDrawable, fmPtr, tkfont, + menuRectPtr->left + mePtr->x, + globalsPtr->menuTop + mePtr->y, + (mePtr->entryFlags & ENTRY_LAST_COLUMN) ? + menuPtr->totalWidth - mePtr->x : mePtr->width, + menuPtr->entries[i]->height); } } @@ -3071,6 +3188,108 @@ MenuDefProc( /* *---------------------------------------------------------------------- * + * AppearanceEntryDrawWrapper -- + * + * This routine wraps the TkpDrawMenuEntry function. Under Appearance, + * it routes to the Appearance Managers DrawThemeEntry, otherwise it + * just goes straight to TkpDrawMenuEntry. + * + * Results: + * A menu entry is drawn + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ +static void +AppearanceEntryDrawWrapper( + TkMenuEntry *mePtr, + Rect *menuRectPtr, + TkMenuLowMemGlobals *globalsPtr, + Drawable d, + Tk_FontMetrics *fmPtr, + Tk_Font tkfont, + int x, + int y, + int width, + int height) +{ + if (TkMacHaveAppearance() > 1) { + MenuEntryUserData meData; + Rect itemRect; + ThemeMenuState theState; + ThemeMenuItemType theType; + + meData.mePtr = mePtr; + meData.mdefDrawable = d; + meData.fmPtr = fmPtr; + meData.tkfont = tkfont; + + itemRect.top = y; + itemRect.left = x; + itemRect.bottom = itemRect.top + height; + itemRect.right = itemRect.left + width; + + if (mePtr->state == tkActiveUid) { + theState = kThemeMenuSelected; + } else if (mePtr->state == tkDisabledUid) { + theState = kThemeMenuDisabled; + } else { + theState = kThemeMenuActive; + } + + if (mePtr->type == CASCADE_ENTRY) { + theType = kThemeMenuItemHierarchical; + } else { + theType = kThemeMenuItemPlain; + } + + DrawThemeMenuItem (menuRectPtr, &itemRect, + globalsPtr->menuTop, globalsPtr->menuBottom, theState, + theType, tkThemeMenuItemDrawingUPP, + (unsigned long) &meData); + + } else { + TkpDrawMenuEntry(mePtr, d, tkfont, fmPtr, + x, y, width, height, 0, 1); + } +} + +/* + *---------------------------------------------------------------------- + * + * tkThemeMenuItemDrawingProc -- + * + * This routine is called from the Appearance DrawThemeMenuEntry + * + * Results: + * A menu entry is drawn + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ +pascal void +tkThemeMenuItemDrawingProc ( + const Rect *inBounds, + SInt16 inDepth, + Boolean inIsColorDevice, + SInt32 inUserData) +{ + MenuEntryUserData *meData = (MenuEntryUserData *) inUserData; + + TkpDrawMenuEntry(meData->mePtr, meData->mdefDrawable, + meData->tkfont, meData->fmPtr, inBounds->left, + inBounds->top, inBounds->right - inBounds->left, + inBounds->bottom - inBounds->top, 0, 1); + +} + +/* + *---------------------------------------------------------------------- + * * TkMacHandleTearoffMenu() -- * * This routine sees if the MDEF has set a menu and a mouse position @@ -3202,8 +3421,7 @@ DrawTearoffEntry( int margin, segmentWidth, maxX; Tk_3DBorder border; - if ((menuPtr->menuType != MASTER_MENU) - || (GetResource('MDEF', 591) != NULL)) { + if ((menuPtr->menuType != MASTER_MENU) || (FixMDEF() != NULL)) { return; } @@ -3343,12 +3561,19 @@ TkpDrawMenuEntry( /* * Choose the gc for drawing the foreground part of the entry. + * Under Appearance, we pass a null (appearanceGC) to tell + * ourselves not to change whatever color the appearance manager has set. */ if ((mePtr->state == ENTRY_ACTIVE) && !strictMotif) { gc = mePtr->activeGC; if (gc == NULL) { - gc = menuPtr->activeGC; + if ((TkMacHaveAppearance() > 1) && (menuPtr->menuType != TEAROFF_MENU)) { + SetThemeTextColor(kThemeSelectedMenuItemTextColor,32,true); + gc = appearanceGC; + } else { + gc = menuPtr->activeGC; + } } } else { TkMenuEntry *cascadeEntryPtr; @@ -3372,15 +3597,26 @@ TkpDrawMenuEntry( && (menuPtr->disabledFgPtr != NULL)) { gc = mePtr->disabledGC; if (gc == NULL) { + if ((TkMacHaveAppearance() > 1) && (mePtr->bitmap == NULL)) { + SetThemeTextColor(kThemeDisabledMenuItemTextColor,32,true); + gc = appearanceGC; + } else { gc = menuPtr->disabledGC; } + } } else { gc = mePtr->textGC; if (gc == NULL) { - gc = menuPtr->textGC; + if ((TkMacHaveAppearance() > 1) && (mePtr->bitmap == NULL)) { + SetThemeTextColor(kThemeActiveMenuItemTextColor,32,true); + gc = appearanceGC; + } else { + gc = menuPtr->textGC; + } } - } + } } + indicatorGC = mePtr->indicatorGC; if (indicatorGC == NULL) { indicatorGC = menuPtr->indicatorGC; @@ -3429,6 +3665,7 @@ TkpDrawMenuEntry( DrawMenuEntryIndicator(menuPtr, mePtr, d, gc, indicatorGC, tkfont, fmPtr, x, adjustedY, width, adjustedHeight); } + } } @@ -3746,8 +3983,10 @@ DrawMenuEntryLabel( if (mePtr->state == ENTRY_DISABLED) { if (menuPtr->disabledFgPtr == NULL) { - XFillRectangle(menuPtr->display, d, menuPtr->disabledGC, x, y, - (unsigned) width, (unsigned) height); + if (!TkMacHaveAppearance()) { + XFillRectangle(menuPtr->display, d, menuPtr->disabledGC, x, y, + (unsigned) width, (unsigned) height); + } } else if ((mePtr->image != NULL) && (menuPtr->disabledImageGC != None)) { XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC, @@ -3763,7 +4002,9 @@ DrawMenuEntryLabel( * * DrawMenuEntryBackground -- * - * This procedure draws the background part of a menu. + * This procedure draws the background part of a menu entry. + * Under Appearance, we only draw the background if the entry's + * border is set, we DO NOT inherit it from the menu... * * Results: * None. @@ -3787,11 +4028,17 @@ DrawMenuEntryBackground( int width, /* width of rectangle to draw */ int height) /* height of rectangle to draw */ { - if (mePtr->state == ENTRY_ACTIVE) { - bgBorder = activeBorder; + if (!TkMacHaveAppearance() + || (menuPtr->menuType == TEAROFF_MENU) + || ((mePtr->state == ENTRY_ACTIVE) + && (mePtr->activeBorder != NULL)) + || ((mePtr->state != ENTRY_ACTIVE) && (mePtr->border != NULL))) { + if (mePtr->state == ENTRY_ACTIVE) { + bgBorder = activeBorder; + } + Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder, + x, y, width, height, 0, TK_RELIEF_FLAT); } - Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder, - x, y, width, height, 0, TK_RELIEF_FLAT); } /* @@ -4000,8 +4247,7 @@ TkMacClearMenubarActive(void) { if ((menuBarRefPtr != NULL) && (menuBarRefPtr->menuPtr != NULL)) { TkMenu *menuPtr; - for (menuPtr = menuBarRefPtr->menuPtr->masterMenuPtr; - menuPtr != NULL; + for (menuPtr = menuBarRefPtr->menuPtr->masterMenuPtr; menuPtr != NULL; menuPtr = menuPtr->nextInstancePtr) { if (menuPtr->menuType == MENUBAR) { RecursivelyClearActiveMenu(menuPtr); @@ -4117,6 +4363,24 @@ TkpMenuInit(void) currentMenuBarInterp = NULL; currentMenuBarName = NULL; windowListPtr = NULL; + + /* + * Get the GC that we will use as the sign to the font + * routines that they should not muck with the foreground color... + */ + + if (TkMacHaveAppearance() > 1) { + XGCValues tmpValues; + TkColor *tmpColorPtr; + + tmpColorPtr = TkpGetColor(NULL, "systemAppearanceColor"); + tmpValues.foreground = tmpColorPtr->color.pixel; + tmpValues.background = tmpColorPtr->color.pixel; + appearanceGC = XCreateGC(NULL, NULL, GCForeground | GCBackground, &tmpValues); + ckfree((char *) tmpColorPtr); + + tkThemeMenuItemDrawingUPP = NewMenuItemDrawingProc(tkThemeMenuItemDrawingProc); + } FixMDEF(); diff --git a/mac/tkMacPort.h b/mac/tkMacPort.h index beb6979..5d2f524 100644 --- a/mac/tkMacPort.h +++ b/mac/tkMacPort.h @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacPort.h,v 1.1.4.2 1998/09/30 02:18:13 stanton Exp $ + * RCS: @(#) $Id: tkMacPort.h,v 1.1.4.3 1998/11/25 21:16:37 stanton Exp $ */ #ifndef _TKMACPORT @@ -142,5 +142,6 @@ extern int strncasecmp _ANSI_ARGS_((CONST char *s1, #define MENU_BACKGROUND_PIXEL 47 #define MENU_DISABLED_PIXEL 49 #define MENU_TEXT_PIXEL 51 +#define APPEARANCE_PIXEL 52 #endif /* _TKMACPORT */ diff --git a/mac/tkMacWm.c b/mac/tkMacWm.c index 7435fe2..810688d 100644 --- a/mac/tkMacWm.c +++ b/mac/tkMacWm.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacWm.c,v 1.1.4.2 1998/09/30 02:18:18 stanton Exp $ + * RCS: @(#) $Id: tkMacWm.c,v 1.1.4.3 1998/11/25 21:16:37 stanton Exp $ */ #include <Gestalt.h> @@ -4229,10 +4229,13 @@ TkpWmSetState(winPtr, state) * TkMacHaveAppearance -- * * Determine if the appearance manager is available on this Mac. - * We cache the result so future calls are fast. + * We cache the result so future calls are fast. Return a different + * value if 1.0.1 is present, since many interfaces were added in + * 1.0.1 * * Results: - * True if the appearance manager is present, false otherwise. + * 1 if the appearance manager is present, 2 if the appearance + * manager version is 1.0.1 or greater, 0 if it is not present. * * Side effects: * Calls Gestalt to query system values. @@ -4244,14 +4247,18 @@ int TkMacHaveAppearance() { static initialized = false; - static int TkMacHaveAppearance = false; + static int TkMacHaveAppearance = 0; long response = 0; OSErr err = noErr; if (!initialized) { err = Gestalt(gestaltAppearanceAttr, &response); if (err == noErr) { - TkMacHaveAppearance = true; + TkMacHaveAppearance = 1; + } + err = Gestalt(gestaltAppearanceVersion, &response); + if (err == noErr) { + TkMacHaveAppearance = 2; } } diff --git a/tests/bind.test b/tests/bind.test index 74a0877..581abac 100644 --- a/tests/bind.test +++ b/tests/bind.test @@ -4,11 +4,12 @@ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1995 Sun Microsystems, Inc. +# Copyright (c) 1998 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: bind.test,v 1.1.4.2 1998/09/30 02:18:24 stanton Exp $ +# RCS: @(#) $Id: bind.test,v 1.1.4.3 1998/11/25 21:16:39 stanton Exp $ if {[string compare test [info procs test]] != 0} { source defs @@ -2134,7 +2135,7 @@ foreach check { {<Reparent> %y {-y 2i} {[winfo pixels .b.f 2i]}} {<Map> %y {-y 2i} {{1 {<Map> event doesn't accept "-y" option}}}} - {<Key> %k {-xyz 1} {{1 {bad option "-xyz": must be -when, -above, -borderwidth, -button, -count, -detail, -focus, -height, -keycode, -keysym, -mode, -override, -place, -root, -rootx, -rooty, -sendevent, -serial, -state, -subwindow, -time, -width, -window, -x, or -y}}}} + {<Key> %k {-xyz 1} {{1 {bad option "-xyz": must be -when, -above, -borderwidth, -button, -count, -delta, -detail, -focus, -height, -keycode, -keysym, -mode, -override, -place, -root, -rootx, -rooty, -sendevent, -serial, -state, -subwindow, -time, -width, -window, -x, or -y}}}} } { set event [lindex $check 0] test bind-22.$i "HandleEventGenerate: options $event [lindex $check 2]" { @@ -2544,5 +2545,27 @@ test bind-30.2 {Tk_BackgroundError procedure} { (command bound to event)}} rename bgerror {} +test bind-31.1 {MouseWheel events} { + setup + set x {} + bind .b.f <MouseWheel> {set x Wheel} + event gen .b.f <MouseWheel> + set x +} {Wheel} +test bind-31.2 {MouseWheel events} { + setup + set x {} + bind .b.f <MouseWheel> {set x %D} + event gen .b.f <MouseWheel> -delta 120 + set x +} {120} +test bind-31.2 {MouseWheel events} { + setup + set x {} + bind .b.f <MouseWheel> {set x "%D %x %y"} + event gen .b.f <MouseWheel> -delta 240 -x 10 -y 30 + set x +} {240 10 30} + destroy .b diff --git a/tests/canvText.test b/tests/canvText.test index b0879b1..3de8813 100644 --- a/tests/canvText.test +++ b/tests/canvText.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: canvText.test,v 1.1.4.2 1998/09/30 02:18:30 stanton Exp $ +# RCS: @(#) $Id: canvText.test,v 1.1.4.3 1998/11/25 21:16:40 stanton Exp $ if {"[info procs test]" != "test"} { source defs @@ -34,6 +34,7 @@ set ax [font measure $font 0] foreach test { {-anchor nw nw xyz {bad anchor position "xyz": must be n, ne, e, se, s, sw, w, nw, or center}} {-fill #ff0000 #ff0000 xyz {unknown color name "xyz"}} + {-fill {} {} {} {}} {-font {Times 40} {Times 40} {} {font "" doesn't exist}} {-justify left left xyz {bad justification "xyz": must be left, right, or center}} {-stipple gray50 gray50 xyz {bitmap "xyz" not defined}} diff --git a/tests/canvas.test b/tests/canvas.test index 79d3d18..5807b52 100644 --- a/tests/canvas.test +++ b/tests/canvas.test @@ -3,11 +3,12 @@ # standard fashion for Tcl tests. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. +# Copyright (c) 1998 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: canvas.test,v 1.1.4.2 1998/09/30 02:18:30 stanton Exp $ +# RCS: @(#) $Id: canvas.test,v 1.1.4.3 1998/11/25 21:16:40 stanton Exp $ if {[info procs test] != "test"} { source defs @@ -211,3 +212,36 @@ test canvas-8.1 {canvas arc bbox} { set pieBox [.c bbox arc3] list $arcBox $coordBox $pieBox } {{48 21 100 94} {248 21 300 94} {398 21 500 112}} +test canvas-9.1 {canvas id creation and deletion} { + # With Tk 8.0.4 the ids are now stored in a hash table. You + # can use this test as a performance test with older versions + # by changing the value of size. + set size 15 + + catch {destroy .c} + set c [canvas .c] + for {set i 0} {$i < $size} {incr i} { + set x [expr {-10 + 3*$i}] + for {set j 0; set y -10} {$j < 10} {incr j; incr y 3} { + $c create rect ${x}c ${y}c [expr $x+2]c [expr $y+2]c \ + -outline black -fill blue -tags rect + $c create text [expr $x+1]c [expr $y+1]c -text "$i,$j" \ + -anchor center -tags text + } + } + + # The actual bench mark - this code also exercises all the hash + # table changes. + + set time [lindex [time { + foreach id [$c find withtag all] { + $c lower $id + $c raise $id + $c find withtag $id + $c bind <Return> $id {} + $c delete $id + } + }] 0] + + set x "" +} {} diff --git a/tests/scale.test b/tests/scale.test index 1a172dc..f1b773a 100644 --- a/tests/scale.test +++ b/tests/scale.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: scale.test,v 1.1.4.2 1998/09/30 02:18:53 stanton Exp $ +# RCS: @(#) $Id: scale.test,v 1.1.4.3 1998/11/25 21:16:40 stanton Exp $ if {[info procs test] != "test"} { source defs @@ -330,7 +330,7 @@ test scale-6.7 {ComputeFormat procedure} { .s configure -from 1000000000 -to 10000000000 -resolution 1000000000 .s set 4930000000 expr {[.s get] == 5.0e+09} -} {1} +} 1 test scale-6.8 {ComputeFormat procedure} { .s configure -from .1 -to 1 -resolution .1 .s set .6 diff --git a/tests/winClipboard.test b/tests/winClipboard.test index 059232a..b07fcdf 100644 --- a/tests/winClipboard.test +++ b/tests/winClipboard.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: winClipboard.test,v 1.1.4.1 1998/09/30 02:19:05 stanton Exp $ +# RCS: @(#) $Id: winClipboard.test,v 1.1.4.2 1998/11/25 21:16:40 stanton Exp $ if {$tcl_platform(platform)!="windows"} { return @@ -21,6 +21,9 @@ if {[string compare test [info procs test]] == 1} { source defs } +# Note that these tests may fail if another application is grabbing the +# clipboard (e.g. an X server) + test winClipboard-1.1 {TkSelGetSelection} { clipboard clear catch {selection get -selection CLIPBOARD} msg diff --git a/unix/Makefile.in b/unix/Makefile.in index 038bd2c..59f5e1d 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -5,7 +5,7 @@ # "autoconf" program (constructs like "@foo@" will get replaced in the # actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.1.4.2 1998/09/30 02:19:10 stanton Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.1.4.3 1998/11/25 21:16:40 stanton Exp $ # Current Tk version; used in various names. @@ -194,7 +194,7 @@ TK_LD_SEARCH_FLAGS = @TK_LD_SEARCH_FLAGS@ # modify any of this stuff by hand. #---------------------------------------------------------------- -AC_FLAGS = @DEFS@ +AC_FLAGS = @EXTRA_CFLAGS@ @DEFS@ RANLIB = @RANLIB@ SRC_DIR = @srcdir@/.. TOP_DIR = @srcdir@/.. diff --git a/unix/configure.in b/unix/configure.in index 920a0f5..d0a45a9 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -3,7 +3,7 @@ dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tk installation dnl to configure the system for the local environment. AC_INIT(../generic/tk.h) -# RCS: @(#) $Id: configure.in,v 1.1.4.2 1998/09/30 02:19:11 stanton Exp $ +# RCS: @(#) $Id: configure.in,v 1.1.4.3 1998/11/25 21:16:41 stanton Exp $ TK_VERSION=8.1 TK_MAJOR_VERSION=8 @@ -89,6 +89,7 @@ DL_LIBS=$TCL_DL_LIBS LD_FLAGS=$TCL_LD_FLAGS CFLAGS_DEBUG=$TCL_CFLAGS_DEBUG CFLAGS_OPTIMIZE=$TCL_CFLAGS_OPTIMIZE +EXTRA_CFLAGS=$TCL_EXTRA_CFLAGS LIB_RUNTIME_DIR='${LIB_RUNTIME_DIR}' @@ -408,6 +409,7 @@ AC_SUBST(CFLAGS_OPTIMIZE) AC_SUBST(CFLAGS_WARNING) AC_SUBST(TK_DBGX) AC_SUBST(DL_LIBS) +AC_SUBST(EXTRA_CFLAGS) AC_SUBST(LD_FLAGS) AC_SUBST(MATH_LIBS) AC_SUBST(MAKE_LIB) diff --git a/unix/tkUnixFont.c b/unix/tkUnixFont.c index 88f31a0..2478af3 100644 --- a/unix/tkUnixFont.c +++ b/unix/tkUnixFont.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUnixFont.c,v 1.1.4.2 1998/09/30 02:19:18 stanton Exp $ + * RCS: @(#) $Id: tkUnixFont.c,v 1.1.4.3 1998/11/25 21:16:41 stanton Exp $ */ #include "tkUnixInt.h" @@ -420,6 +420,35 @@ TkpGetNativeFont(tkwin, name) UnixFont *fontPtr; XFontStruct *fontStructPtr; FontAttributes fa; + char *p; + int hasSpace, dashes, hasWild; + + /* + * The behavior of X when given a name that isn't an XLFD is unspecified. + * For example, Exceed 6 returns a valid font for any random string. This + * is awkward since system names have higher priority than the other Tk + * font syntaxes. So, we need to perform a quick sanity check on the + * name and fail if it looks suspicious. We fail if the name: + * - contains a space immediately before a dash + * - contains a space, but no '*' characters and fewer than 14 dashes + */ + + hasSpace = dashes = hasWild = 0; + for (p = name; *p != '\0'; p++) { + if (*p == ' ') { + if (p[1] == '-') { + return NULL; + } + hasSpace = 1; + } else if (*p == '-') { + dashes++; + } else if (*p == '*') { + hasWild = 1; + } + } + if ((dashes < 14) && !hasWild && hasSpace) { + return NULL; + } fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), name); if (fontStructPtr == NULL) { @@ -4,7 +4,7 @@ by Scott Stanton Scriptics Corporation scott.stanton@scriptics.com -RCS: @(#) $Id: README,v 1.1.4.2 1998/09/30 02:19:25 stanton Exp $ +RCS: @(#) $Id: README,v 1.1.4.3 1998/11/25 21:16:42 stanton Exp $ 1. Introduction --------------- diff --git a/win/makefile.bc b/win/makefile.bc index 8c59bb1..e27362a 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -5,7 +5,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: makefile.bc,v 1.1.4.2 1998/09/30 02:19:26 stanton Exp $ +# RCS: @(#) $Id: makefile.bc,v 1.1.4.3 1998/11/25 21:16:42 stanton Exp $ # diff --git a/win/makefile.vc b/win/makefile.vc index 0f9e971..1f98001 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -4,7 +4,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # Copyright (c) 1995-1997 Sun Microsystems, Inc. -# RCS: @(#) $Id: makefile.vc,v 1.1.4.4 1998/10/06 20:34:11 stanton Exp $ +# RCS: @(#) $Id: makefile.vc,v 1.1.4.5 1998/11/25 21:16:42 stanton Exp $ # Does not depend on the presence of any environment variables in # order to compile tcl; all needed information is derived from @@ -233,11 +233,11 @@ guilflags = $(lflags) -subsystem:windows -entry:WinMainCRTStartup dlllflags = $(lflags) -entry:_DllMainCRTStartup$(DLLENTRY) -dll !IF "$(MACHINE)" == "PPC" -libc = libc.lib -libcdll = crtdll.lib +libc = libc$(DBGX).lib +libcdll = crtdll$(DBGX).lib !ELSE -libc = libc.lib oldnames.lib -libcdll = msvcrt.lib oldnames.lib +libc = libc$(DBGX).lib oldnames.lib +libcdll = msvcrt$(DBGX).lib oldnames.lib !ENDIF baselibs = kernel32.lib $(optlibs) advapi32.lib diff --git a/win/tkWinMenu.c b/win/tkWinMenu.c index ddb7caf..cf81655 100644 --- a/win/tkWinMenu.c +++ b/win/tkWinMenu.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinMenu.c,v 1.1.4.5 1998/11/24 21:42:48 stanton Exp $ + * RCS: @(#) $Id: tkWinMenu.c,v 1.1.4.6 1998/11/25 21:16:42 stanton Exp $ */ #define OEMRESOURCE @@ -600,14 +600,21 @@ ReconfigureWindowsMenu( if ((menuPtr->menuType == MENUBAR) && !(mePtr->childMenuRefPtr->menuPtr->menuFlags & MENU_SYSTEM_MENU)) { + Tcl_DString ds; TkMenuReferences *menuRefPtr; TkMenu *systemMenuPtr = mePtr->childMenuRefPtr ->menuPtr; - char *systemMenuName = ckalloc(strlen( - Tk_PathName(menuPtr->masterMenuPtr->tkwin)) - + strlen(".system") + 1); + + Tcl_DStringInit(&ds); + Tcl_DStringAppend(&ds, + Tk_PathName(menuPtr->masterMenuPtr->tkwin), -1); + Tcl_DStringAppend(&ds, ".system", 7); + menuRefPtr = TkFindMenuReferences(menuPtr->interp, - systemMenuName); + Tcl_DStringValue(&ds)); + + Tcl_DStringFree(&ds); + if ((menuRefPtr != NULL) && (menuRefPtr->menuPtr != NULL) && (menuPtr->parentTopLevelPtr != NULL) @@ -632,7 +639,6 @@ ReconfigureWindowsMenu( } } } - ckfree(systemMenuName); } if (mePtr->childMenuRefPtr->menuPtr->menuFlags & MENU_SYSTEM_MENU) { diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 92ce55e..97d3c07 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -7,11 +7,12 @@ * to the window manager. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. + * Copyright (c) 1998 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinWm.c,v 1.1.4.4 1998/11/20 02:35:12 stanton Exp $ + * RCS: @(#) $Id: tkWinWm.c,v 1.1.4.5 1998/11/25 21:16:43 stanton Exp $ */ #include "tkWinInt.h" diff --git a/win/tkWinX.c b/win/tkWinX.c index a47b78a..b4ffa17 100644 --- a/win/tkWinX.c +++ b/win/tkWinX.c @@ -5,16 +5,23 @@ * * Copyright (c) 1995-1996 Sun Microsystems, Inc. * Copyright (c) 1994 Software Research Associates, Inc. + * Copyright (c) 1998 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinX.c,v 1.1.4.4 1998/11/20 02:35:15 stanton Exp $ + * RCS: @(#) $Id: tkWinX.c,v 1.1.4.5 1998/11/25 21:16:44 stanton Exp $ */ #include "tkWinInt.h" /* + * The zmouse.h file includes the definition for WM_MOUSEWHEEL. + */ + +#include <zmouse.h> + +/* * Definitions of extern variables supplied by this file. */ @@ -590,6 +597,7 @@ Tk_TranslateWinEvent(hwnd, message, wParam, lParam, resultPtr) case WM_SYSKEYUP: case WM_KEYDOWN: case WM_KEYUP: + case WM_MOUSEWHEEL: GenerateXEvent(hwnd, message, wParam, lParam); return 1; case WM_MENUCHAR: @@ -697,6 +705,13 @@ GenerateXEvent(hwnd, message, wParam, lParam) event.xselectionclear.time = TkpGetMS(); break; + case WM_MOUSEWHEEL: + /* + * The mouse wheel event is closer to a key event than a + * mouse event in that the message is sent to the window + * that has focus. + */ + case WM_CHAR: case WM_SYSKEYDOWN: case WM_SYSKEYUP: @@ -738,6 +753,18 @@ GenerateXEvent(hwnd, message, wParam, lParam) */ switch (message) { + case WM_MOUSEWHEEL: + /* + * We have invented a new X event type to handle + * this event. It still uses the KeyPress struct. + * However, the keycode field has been overloaded + * to hold the zDelta of the wheel. + */ + + event.type = MouseWheelEvent; + event.xany.send_event = -1; + event.xkey.keycode = (short) HIWORD(wParam); + break; case WM_SYSKEYDOWN: case WM_KEYDOWN: /* |