diff options
| author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2024-09-28 16:45:53 (GMT) |
|---|---|---|
| committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2024-09-28 16:45:53 (GMT) |
| commit | a34fd3085615080a6429555cfe2b544cfa824ac6 (patch) | |
| tree | 437cc2092c55cc0610a4e1632bc792265364299e | |
| parent | 80c81befbaba38185268f5369f0de957aa3210e2 (diff) | |
| parent | 5fa0db91e29e9ec7e0b97ab26455d303d2c3d7a2 (diff) | |
| download | tk-a34fd3085615080a6429555cfe2b544cfa824ac6.zip tk-a34fd3085615080a6429555cfe2b544cfa824ac6.tar.gz tk-a34fd3085615080a6429555cfe2b544cfa824ac6.tar.bz2 | |
Merge 9.0
99 files changed, 1179 insertions, 1065 deletions
@@ -1,6 +1,6 @@ # README: Tk -This is the **Tk 9.0b4** source distribution. +This is the **Tk 9.0.1** source distribution. You can get any source release of Tk from [our distribution site](https://sourceforge.net/projects/tcl/files/Tcl/). @@ -4,7 +4,14 @@ changes to the Tk source code at > [Tk Source Code](https://core.tcl-lang.org/tk/) -Release Tk 9.0b4 arises from the check-in with tag core-9-0-b4. +Release Tk 9.0.1 arises from the check-in with tag `core-9-0-1`. + +The changes since Tk 9.0.0 include... + + + + +Release Tk 9.0.0 arises from the check-in with tag `core-9-0-0`. Highlighted differences between Tk 9.0 and Tk 8.6 are summarized below, with focus on changes important to programmers using the Tk library and @@ -16,9 +23,9 @@ writing Tcl scripts containing Tk commands. - The `tk windowingsystem` "aqua" needs macOS 10.10 or later ## New commands and options - - `tk sysnotify`: access to the OS notifications system - - `tk systray`: access to the OS tray facility - - `tk print`: access to the OS printing facility + - `tk sysnotify` — Access to the OS notifications system + - `tk systray` — Access to the OS tray facility + - `tk print` — Access to the OS printing facility ## Widget options - New `ttk::progressbar` option: **-text** @@ -34,3 +41,17 @@ writing Tcl scripts containing Tk commands. - Partial SVG support - Read/write access to photo image metadata +## Known bugs + - [Use of Tcl_Obj vs char * in Widget storage](https://core.tcl-lang.org/tk/tktview/f91aa2) + - [Tilde file syntax not available on 9.0 but used by "~/.Xdefaults"](https://core.tcl-lang.org/tk/tktview/fcfddc) + - [many PIXEL options don't keep their configured value](https://core.tcl-lang.org/tk/tktview/29ba53) + - [Canvas widget handles pixel objects incorrectly in Tk 9.0](https://core.tcl-lang.org/tk/tktview/610a73) + - [Inconsistent reporting of child geometry changes to grid container](https://core.tcl-lang.org/tk/tktview/beaa8e) + - [Inconsistency in whether widgets allow negative borderwidths](https://core.tcl-lang.org/tk/tktview/5f739d) + - [Enter key works differently in Windows and Linux](https://core.tcl-lang.org/tk/tktview/b3a1b9) + - [slow widget creation if default font is not used](https://core.tcl-lang.org/tk/tktview/8da7af) + - [The wm manage command does not work on current macOS versions](https://core.tcl-lang.org/tk/tktview/8a6012) + - [Slow processing irregular transparencies](https://core.tcl-lang.org/tk/tktview/919066) + - [text's cursor width on 0th column](https://core.tcl-lang.org/tk/tktview/47fbfc) + - [text widget breaks graphemes with combining diacritical marks](https://core.tcl-lang.org/tk/tktview/442208) + diff --git a/doc/CrtPhImgFmt.3 b/doc/CrtPhImgFmt.3 index ff6f839..6f89ef7 100644 --- a/doc/CrtPhImgFmt.3 +++ b/doc/CrtPhImgFmt.3 @@ -9,7 +9,7 @@ '\" Department of Computer Science, '\" Australian National University. '\" -.TH Tk_CreatePhotoImageFormat 3 8.7 Tk "Tk Library Procedures" +.TH Tk_CreatePhotoImageFormat 3 9.0 Tk "Tk Library Procedures" .so man.macros .BS .SH NAME @@ -264,7 +264,7 @@ its descendants. It also makes sure it's not possible to leave button \fB.cancel\fR using the keyboard. .SH PORTABILITY .PP -Note that the \fBtk busy\fR command does not currently have any effect on OSX +Note that the \fBtk busy\fR command does not currently have any effect on macOS when Tk is built using Aqua support. .SH "SEE ALSO" grab(n) diff --git a/doc/button.n b/doc/button.n index 9850670..cbbd704 100644 --- a/doc/button.n +++ b/doc/button.n @@ -183,7 +183,7 @@ The behavior of buttons can be changed by defining new bindings for individual widgets or by redefining the class bindings. .SH "PLATFORM NOTES" .PP -On Aqua/Mac OS X, some configuration options are ignored for the purpose of +On Aqua/macOS, some configuration options are ignored for the purpose of drawing of the widget because they would otherwise conflict with platform guidelines. The \fBconfigure\fR and \fBcget\fR subcommands can still manipulate the values, but do not cause any variation to the look of the diff --git a/doc/chooseDirectory.n b/doc/chooseDirectory.n index 44e9530..a12207b 100644 --- a/doc/chooseDirectory.n +++ b/doc/chooseDirectory.n @@ -24,7 +24,7 @@ Specifies the prefix of a Tcl command to invoke when the user closes the dialog after having selected an item. This callback is not called if the user cancelled the dialog. The actual command consists of \fIstring\fR followed by a space and the value selected by the user in the dialog. This -is only available on Mac OS X. +is only available on macOS. .\" OPTION: -initialdir .TP \fB\-initialdir\fI dirname\fR @@ -42,7 +42,7 @@ relative path to an absolute path. \fB\-message\fI string\fR . Specifies a message to include in the client area of the dialog. -This is only available on Mac OS X. +This is only available on macOS. .\" OPTION: -mustexist .TP \fB\-mustexist\fI boolean\fR @@ -55,7 +55,7 @@ already exist. The default value is \fIfalse\fR. \fB\-parent\fI window\fR . Makes \fIwindow\fR the logical parent of the dialog. The dialog -is displayed on top of its parent window. On Mac OS X, this +is displayed on top of its parent window. On macOS, this turns the file dialog into a sheet attached to the parent window. .\" OPTION: -title .TP diff --git a/doc/colors.n b/doc/colors.n index 09c2289..1150956 100644 --- a/doc/colors.n +++ b/doc/colors.n @@ -782,7 +782,7 @@ YellowGreen 154 205 50 .DE .SH "PORTABILITY ISSUES" .TP -\fBMac OS X\fR +\fBmacOS\fR . On macOS, the following additional system colors are available. This first group contains all of the HIBrush colors available in the @@ -870,7 +870,7 @@ systemWindowBody . Tk supports all of the NSColors in the macOS System ColorList. The convention for naming these colors is that the Tk name is generated by -capitalizing the macOS name and adding the prefix "system". On OSX +capitalizing the macOS name and adding the prefix "system". On macOS 10.14 (Mojave) and later many of these "semantic" colors will appear differently depending on whether the NSWindow in which they are used has the Aqua or DarkAqua appearance. The System ColorList differs between diff --git a/doc/cursors.n b/doc/cursors.n index 7a757f5..df60ea3 100644 --- a/doc/cursors.n +++ b/doc/cursors.n @@ -131,9 +131,9 @@ wait .CE .RE .TP -\fBMac OS X\fR +\fBmacOS\fR . -On Mac OS X systems, the following cursors are mapped to native cursors: +On macOS, the following cursors are mapped to native cursors: .RS .CS arrow @@ -54,7 +54,7 @@ new attributes for the font. See \fBFONT OPTIONS\fR below for a list of the possible attributes. .RS .PP -Note that on Aqua/Mac OS X, the system fonts (see +Note that on Aqua/macOS, the system fonts (see \fBPLATFORM SPECIFIC FONTS\fR below) may not be actually altered because they are implemented by the system theme. To achieve the effect of modification, use \fBfont actual\fR to get their configuration and \fBfont create\fR to @@ -362,7 +362,7 @@ style defaults. .DE .RE .TP -\fBMac OS X\fR +\fBmacOS\fR . The following fonts are supported, and are mapped to the user's style defaults. diff --git a/doc/fontchooser.n b/doc/fontchooser.n index 4e667e5..3dbafa2 100644 --- a/doc/fontchooser.n +++ b/doc/fontchooser.n @@ -24,7 +24,7 @@ the native platform font selection dialog where available, or a dialog implemented in Tcl otherwise. .PP Unlike most of the other Tk dialog commands, \fBtk fontchooser\fR does not -return an immediate result, as on some platforms (Mac OS X) the standard font +return an immediate result, as on some platforms (macOS) the standard font dialog is modeless while on others (Windows) it is modal. To accommodate this difference, all user interaction with the dialog will be communicated to the caller via callbacks or virtual events. @@ -121,7 +121,7 @@ It is implementation dependent which exact user actions result in the callback being called resp. the virtual events being sent. Where an Apply or OK button is present in the dialog, that button will trigger the \fB\-command\fR callback and \fB<<TkFontchooserFontChanged>>\fR virtual event. On some implementations -other user actions may also have that effect; on Mac OS X for instance, the +other user actions may also have that effect; on macOS for instance, the standard font selection dialog immediately reflects all user choices to the caller. .PP diff --git a/doc/getOpenFile.n b/doc/getOpenFile.n index 757d91f..70adf70 100644 --- a/doc/getOpenFile.n +++ b/doc/getOpenFile.n @@ -42,7 +42,7 @@ Specifies the prefix of a Tcl command to invoke when the user closes the dialog after having selected an item. This callback is not called if the user cancelled the dialog. The actual command consists of \fIstring\fR followed by a space and the value selected by the user in the dialog. This -is only available on Mac OS X. +is only available on macOS. .\" OPTION: -confirmoverwrite .TP \fB\-confirmoverwrite\fI boolean\fR @@ -58,7 +58,7 @@ that the overwrite take place without confirmation. Default value is true. Specifies a string that will be appended to the filename if the user enters a filename without an extension. The default value is the empty string, which means no extension will be appended to the filename in -any case. This option is ignored on Mac OS X, which +any case. This option is ignored on macOS, which does not require extensions to filenames, and the UNIX implementation guesses reasonable values for this from the \fB\-filetypes\fR option when this is not supplied. @@ -96,7 +96,7 @@ Specifies a filename to be displayed in the dialog when it pops up. \fB\-message\fI string\fR . Specifies a message to include in the client area of the dialog. -This is only available on Mac OS X. +This is only available on macOS. .\" OPTION: -multiple .TP \fB\-multiple\fI boolean\fR @@ -107,7 +107,7 @@ Allows the user to choose multiple files from the Open dialog. \fB\-parent\fI window\fR . Makes \fIwindow\fR the logical parent of the file dialog. The file -dialog is displayed on top of its parent window. On Mac OS X, this +dialog is displayed on top of its parent window. On macOS, this turns the file dialog into a sheet attached to the parent window. .\" OPTION: -title .TP @@ -41,7 +41,7 @@ entry at the top. If so, it will exist as entry 0 of the menu and the other entries will number starting at 1. The default menu bindings arrange for the menu to be torn off when the tear-off entry is invoked. -This option is ignored under Aqua/MacOS, where menus cannot +This option is ignored under Aqua/macOS, where menus cannot be torn off. .OP \-tearoffcommand tearOffCommand TearOffCommand If this option has a non-empty value, then it specifies a Tcl command @@ -55,7 +55,7 @@ and menu \fB.x.y\fR is torn off to create a new menu \fB.x.tearoff1\fR, then the command .QW "\fBa b .x.y .x.tearoff1\fR" will be invoked. -This option is ignored under Aqua/MacOS, where menus cannot +This option is ignored under Aqua/macOS, where menus cannot be torn off. .OP \-title title Title The string will be used to title the window created when this menu is @@ -263,7 +263,7 @@ becoming the Application menu. When Tk sees a .menubar.window menu on the Macintosh, the menu's contents are inserted into the standard Window menu of the user's menubar whenever the window's menubar is in front. The first items in -the menu are provided by Mac OS X, and the names of the current +the menu are provided by macOS, and the names of the current toplevels are automatically appended after all the Tk-defined items and a separator. The Window menu on the Mac also allows toggling the window into a fullscreen state, and managing a tabbed window interface @@ -273,7 +273,7 @@ version of the operating system. When Tk sees a .menubar.help menu on the Macintosh, the menu's contents are appended to the standard Help menu of the user's menubar whenever the window's menubar is in front. The first items in the menu -are provided by Mac OS X. +are provided by macOS. .PP When Tk sees a System menu on Windows, its items are appended to the system menu that the menubar is attached to. This menu is tied to the @@ -545,7 +545,7 @@ supported by all entry types. \fB\-activebackground \fIvalue\fR . Specifies a background color to use for displaying this entry when it -is active. This option is ignored on Aqua/MacOS. +is active. This option is ignored on Aqua/macOS. If it is specified as an empty string (the default), then the \fB\-activebackground\fR option for the overall menu is used. If the \fBtk_strictMotif\fR variable has been set to request strict diff --git a/doc/menubutton.n b/doc/menubutton.n index 375b69a..6252374 100644 --- a/doc/menubutton.n +++ b/doc/menubutton.n @@ -95,7 +95,7 @@ is released, the menu is unposted. .PP Menubuttons are used to construct a \fBtk_optionMenu\fR, which is the preferred mechanism for allowing a user to select one item from a list -on Mac OS X. +on macOS. .PP Menubuttons were also typically organized into groups called menu bars that allow scanning: diff --git a/doc/messageBox.n b/doc/messageBox.n index 33825dc..cf878e1 100644 --- a/doc/messageBox.n +++ b/doc/messageBox.n @@ -30,7 +30,7 @@ The following option-value pairs are supported: Specifies the prefix of a Tcl command to invoke when the user closes the dialog. The actual command consists of \fIstring\fR followed by a space and the name of the button clicked by the user to close the dialog. This -is only available on Mac OS X. +is only available on macOS. .\" OPTION: -default .TP \fB\-default\fI name\fR @@ -87,7 +87,7 @@ following values are possible for \fIpredefinedType\fR: Displays three buttons whose symbolic names are \fBabort\fR, \fBretry\fR and \fBignore\fR. .IP \fBok\fR 18 -Displays one button whose symbolic name is \fBok\fR. +Displays one button whose symbolic name is \fBok\fR. This is the default. .IP \fBokcancel\fR 18 Displays two buttons whose symbolic names are \fBok\fR and \fBcancel\fR. .IP \fBretrycancel\fR 18 diff --git a/doc/nsimage.n b/doc/nsimage.n index d62416f..76e5c9a 100644 --- a/doc/nsimage.n +++ b/doc/nsimage.n @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.TH nsimage n 8.7 Tk "Tk Built-In Commands" +.TH nsimage n 9.0 Tk "Tk Built-In Commands" .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! @@ -156,7 +156,7 @@ state is returned. This is turned on by default for the main display. . Returns the current Tk windowing system, one of \fBx11\fR (X11-based), \fBwin32\fR (MS Windows), -or \fBaqua\fR (Mac OS X Aqua). +or \fBaqua\fR (macOS Aqua). .SH "SEE ALSO" busy(n), fontchooser(n), print(n), send(n), sysnotify(n), systray(n), winfo(n) .SH KEYWORDS diff --git a/doc/tk_mac.n b/doc/tk_mac.n index 18b6336..7af9606 100644 --- a/doc/tk_mac.n +++ b/doc/tk_mac.n @@ -10,7 +10,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -tk::mac \- Access Mac-Specific Functionality on OS X from Tk +tk::mac \- Access Mac-Specific Functionality on macOS from Tk .SH SYNOPSIS .nf \fB::tk::mac::DoScriptFile\fR @@ -40,7 +40,7 @@ tk::mac \- Access Mac-Specific Functionality on OS X from Tk .BE .SH "EVENT HANDLER CALLBACKS" .PP -The Aqua/Mac OS X application environment defines a number of additional +The Aqua/macOS application environment defines a number of additional events that applications should respond to. These events are mapped by Tk to calls to commands in the \fB::tk::mac\fR namespace; unless otherwise noted, if the command is absent, no action will be taken. @@ -223,7 +223,7 @@ Returns the current applications's file path. .PP .SH "ADDITIONAL DIALOGS" .PP -The Aqua/Mac OS X defines additional dialogs that applications should +Aqua/macOS defines additional dialogs that applications should support. .\" COMMAND: standardAboutPanel .TP diff --git a/doc/ttk_sizegrip.n b/doc/ttk_sizegrip.n index 050d0bf..9992234 100644 --- a/doc/ttk_sizegrip.n +++ b/doc/ttk_sizegrip.n @@ -29,7 +29,7 @@ Sizegrip widgets support the standard commands (see \fBttk::widget\fR). .SH "PLATFORM-SPECIFIC NOTES" .PP -On Mac OSX, toplevel windows automatically include a built-in +On macOS, toplevel windows automatically include a built-in size grip by default. Adding a \fBttk::sizegrip\fR there is harmless, since the built-in grip will just mask the widget. @@ -74,7 +74,7 @@ remains at \fB1.0\fR. . Places the window in a mode that takes up the entire screen, has no borders, and covers the general use area (i.e. Start menu and taskbar on -Windows, dock and menubar on OSX, general window decorations on X11). +Windows, dock and menubar on macOS, general window decorations on X11). .\" OPTION: -topmost .TP \fB\-topmost\fR @@ -102,7 +102,7 @@ value accepted by \fBTk_GetColor\fR. If the empty string is specified 2000/XP+. Where not supported, the \fB\-transparentcolor\fR value remains at \fB{}\fR. .PP -On MacOS, the following attributes may be set. +On macOS, the following attributes may be set. .\" OPTION: -appearance .TP \fB\-appearance\fR @@ -261,7 +261,7 @@ indicates a window that has no special interpretation. \fB\-zoomed\fR . Requests that the window should be maximized. This is the same as \fBwm state -zoomed\fR on Windows and Mac OS X. +zoomed\fR on Windows and macOS. .PP On X11, changes to window attributes are performed asynchronously. Querying the value of an attribute returns the current state, which will not be the @@ -592,7 +592,7 @@ simultaneously. It is recommended to use not more than 2 icons, placing the larger icon first. This command also sets the panel icon for the application if the window manager or desktop environment supports it. .PP -On Macintosh, the first image called is loaded into an OSX-native icon +On Macintosh, the first image called is loaded into an OS-native icon format, and becomes the application icon in dialogs, the Dock, and other contexts. At the script level the command will accept only the first image passed in the @@ -821,8 +821,8 @@ window in the stacking order. . If \fInewstate\fR is specified, the window will be set to the new state, otherwise it returns the current state of \fIwindow\fR: either -\fBnormal\fR, \fBiconic\fR, \fBwithdrawn\fR, \fBicon\fR, or (Windows and Mac -OS X only) \fBzoomed\fR. +\fBnormal\fR, \fBiconic\fR, \fBwithdrawn\fR, \fBicon\fR, or (Windows and macOS +only) \fBzoomed\fR. The difference between \fBiconic\fR and \fBicon\fR is that \fBiconic\fR refers to a window that has been iconified (e.g., with the \fBwm iconify\fR command) while \fBicon\fR refers to a window whose only diff --git a/generic/tk.h b/generic/tk.h index 57fcfaf..2f0f42e 100644 --- a/generic/tk.h +++ b/generic/tk.h @@ -70,11 +70,11 @@ extern "C" { #endif #if TK_MAJOR_VERSION == 9 # define TK_MINOR_VERSION 0 -# define TK_RELEASE_LEVEL TCL_BETA_RELEASE -# define TK_RELEASE_SERIAL 4 +# define TK_RELEASE_LEVEL TCL_FINAL_RELEASE +# define TK_RELEASE_SERIAL 1 # define TK_VERSION "9.0" -# define TK_PATCH_LEVEL "9.0b4" +# define TK_PATCH_LEVEL "9.0.1" #endif /* TK_MAJOR_VERSION */ /* diff --git a/generic/tkIntPlatDecls.h b/generic/tkIntPlatDecls.h index 3a8edce..7d55a30 100644 --- a/generic/tkIntPlatDecls.h +++ b/generic/tkIntPlatDecls.h @@ -246,7 +246,6 @@ EXTERN int TkGenerateButtonEvent(int x, int y, Window window, unsigned int state); /* 51 */ EXTERN void TkGenWMDestroyEvent(Tk_Window tkwin); -/* Slot 52 is reserved */ #endif /* AQUA */ #if !(defined(_WIN32) || defined(__CYGWIN__) || defined(MAC_OSX_TK)) /* X11 */ /* 0 */ @@ -419,7 +418,6 @@ typedef struct TkIntPlatStubs { Tk_Window (*tkMacOSXGetContainer) (TkWindow *winPtr); /* 49 */ int (*tkGenerateButtonEvent) (int x, int y, Window window, unsigned int state); /* 50 */ void (*tkGenWMDestroyEvent) (Tk_Window tkwin); /* 51 */ - void (*reserved52)(void); #endif /* AQUA */ #if !(defined(_WIN32) || defined(__CYGWIN__) || defined(MAC_OSX_TK)) /* X11 */ void (*tkCreateXEventSource) (void); /* 0 */ @@ -672,7 +670,6 @@ extern const TkIntPlatStubs *tkIntPlatStubsPtr; (tkIntPlatStubsPtr->tkGenerateButtonEvent) /* 50 */ #define TkGenWMDestroyEvent \ (tkIntPlatStubsPtr->tkGenWMDestroyEvent) /* 51 */ -/* Slot 52 is reserved */ #endif /* AQUA */ #if !(defined(_WIN32) || defined(__CYGWIN__) || defined(MAC_OSX_TK)) /* X11 */ #define TkCreateXEventSource \ diff --git a/generic/tkMenubutton.c b/generic/tkMenubutton.c index 433cbf1..a185b08 100644 --- a/generic/tkMenubutton.c +++ b/generic/tkMenubutton.c @@ -93,7 +93,7 @@ static const Tk_OptionSpec optionSpecs[] = { "HighlightThickness", DEF_MENUBUTTON_HIGHLIGHT_WIDTH, offsetof(TkMenuButton, highlightWidthObj), offsetof(TkMenuButton, highlightWidth), 0, 0, 0}, {TK_OPTION_STRING, "-image", "image", "Image", - DEF_MENUBUTTON_IMAGE, TCL_INDEX_NONE, offsetof(TkMenuButton, imageString), + DEF_MENUBUTTON_IMAGE, offsetof(TkMenuButton, imageObj), TCL_INDEX_NONE, TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn", DEF_MENUBUTTON_INDICATOR, TCL_INDEX_NONE, offsetof(TkMenuButton, indicatorOn), @@ -101,7 +101,7 @@ static const Tk_OptionSpec optionSpecs[] = { {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify", DEF_MENUBUTTON_JUSTIFY, TCL_INDEX_NONE, offsetof(TkMenuButton, justify), TK_OPTION_ENUM_VAR, 0, 0}, {TK_OPTION_STRING, "-menu", "menu", "Menu", - DEF_MENUBUTTON_MENU, TCL_INDEX_NONE, offsetof(TkMenuButton, menuName), + DEF_MENUBUTTON_MENU, offsetof(TkMenuButton, menuNameObj), TCL_INDEX_NONE, TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_PIXELS, "-padx", "padX", "Pad", DEF_MENUBUTTON_PADX, offsetof(TkMenuButton, padXObj), offsetof(TkMenuButton, padX), @@ -122,10 +122,10 @@ static const Tk_OptionSpec optionSpecs[] = { DEF_MENUBUTTON_TAKE_FOCUS, offsetof(TkMenuButton, takeFocusObj), TCL_INDEX_NONE, TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-text", "text", "Text", - DEF_MENUBUTTON_TEXT, TCL_INDEX_NONE, offsetof(TkMenuButton, text), 0, 0, 0}, + DEF_MENUBUTTON_TEXT, offsetof(TkMenuButton, textObj), TCL_INDEX_NONE, 0, 0, 0}, {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable", - DEF_MENUBUTTON_TEXT_VARIABLE, TCL_INDEX_NONE, - offsetof(TkMenuButton, textVarName), TK_OPTION_NULL_OK, 0, 0}, + DEF_MENUBUTTON_TEXT_VARIABLE, offsetof(TkMenuButton, textVarNameObj), + TCL_INDEX_NONE, TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_INDEX, "-underline", "underline", "Underline", TK_OPTION_UNDERLINE_DEF(TkMenuButton, underline), 0}, {TK_OPTION_STRING, "-width", "width", "Width", @@ -238,12 +238,12 @@ Tk_MenubuttonObjCmd( Tk_PathName(mbPtr->tkwin), MenuButtonWidgetObjCmd, mbPtr, MenuButtonCmdDeletedProc); mbPtr->optionTable = optionTable; - mbPtr->menuName = NULL; - mbPtr->text = NULL; + mbPtr->menuNameObj = NULL; + mbPtr->textObj = NULL; mbPtr->underline = INT_MIN; - mbPtr->textVarName = NULL; + mbPtr->textVarNameObj = NULL; mbPtr->bitmap = None; - mbPtr->imageString = NULL; + mbPtr->imageObj = NULL; mbPtr->image = NULL; mbPtr->state = STATE_NORMAL; mbPtr->normalBorder = NULL; @@ -419,8 +419,8 @@ DestroyMenuButton( */ Tcl_DeleteCommandFromToken(mbPtr->interp, mbPtr->widgetCmd); - if (mbPtr->textVarName != NULL) { - Tcl_UntraceVar2(mbPtr->interp, mbPtr->textVarName, NULL, + if (mbPtr->textVarNameObj != NULL) { + Tcl_UntraceVar2(mbPtr->interp, Tcl_GetString(mbPtr->textVarNameObj), NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, MenuButtonTextVarProc, mbPtr); } @@ -489,8 +489,8 @@ ConfigureMenuButton( * Eliminate any existing trace on variables monitored by the menubutton. */ - if (mbPtr->textVarName != NULL) { - Tcl_UntraceVar2(interp, mbPtr->textVarName, NULL, + if (mbPtr->textVarNameObj != NULL) { + Tcl_UntraceVar2(interp, Tcl_GetString(mbPtr->textVarNameObj), NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, MenuButtonTextVarProc, mbPtr); } @@ -568,9 +568,9 @@ ConfigureMenuButton( * doesn't go to zero and cause image data to be discarded. */ - if (mbPtr->imageString != NULL) { + if (mbPtr->imageObj != NULL) { image = Tk_GetImage(mbPtr->interp, mbPtr->tkwin, - mbPtr->imageString, MenuButtonImageProc, mbPtr); + Tcl_GetString(mbPtr->imageObj), MenuButtonImageProc, mbPtr); if (image == NULL) { return TCL_ERROR; } @@ -616,7 +616,7 @@ ConfigureMenuButton( Tk_FreeSavedOptions(&savedOptions); } - if (mbPtr->textVarName != NULL) { + if (mbPtr->textVarNameObj != NULL) { /* * If no image or -compound is used, display the value of a variable. * Set up a trace to watch for any changes in it, create the variable @@ -624,18 +624,18 @@ ConfigureMenuButton( */ const char *value; - value = Tcl_GetVar2(interp, mbPtr->textVarName, NULL, TCL_GLOBAL_ONLY); + value = Tcl_GetVar2(interp, Tcl_GetString(mbPtr->textVarNameObj), NULL, TCL_GLOBAL_ONLY); if (value == NULL) { - Tcl_SetVar2(interp, mbPtr->textVarName, NULL, mbPtr->text, + Tcl_SetVar2(interp, Tcl_GetString(mbPtr->textVarNameObj), NULL, mbPtr->textObj ? Tcl_GetString(mbPtr->textObj) : "", TCL_GLOBAL_ONLY); } else { - if (mbPtr->text != NULL) { - ckfree(mbPtr->text); + if (mbPtr->textObj != NULL) { + Tcl_DecrRefCount(mbPtr->textObj); } - mbPtr->text = (char *)ckalloc(strlen(value) + 1); - strcpy(mbPtr->text, value); + mbPtr->textObj = Tcl_NewStringObj(value, TCL_INDEX_NONE); + Tcl_IncrRefCount(mbPtr->textObj); } - Tcl_TraceVar2(interp, mbPtr->textVarName, NULL, + Tcl_TraceVar2(interp, Tcl_GetString(mbPtr->textVarNameObj), NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, MenuButtonTextVarProc, mbPtr); } @@ -871,15 +871,12 @@ static char * MenuButtonTextVarProc( void *clientData, /* Information about button. */ Tcl_Interp *interp, /* Interpreter containing variable. */ - const char *name1, /* Name of variable. */ - const char *name2, /* Second part of variable name. */ + TCL_UNUSED(const char *), /* Name of variable. */ + TCL_UNUSED(const char *), /* Second part of variable name. */ int flags) /* Information about what happened. */ { TkMenuButton *mbPtr = (TkMenuButton *)clientData; const char *value; - size_t len; - (void)name1; - (void)name2; /* * If the variable is unset, then immediately recreate it unless the whole @@ -887,12 +884,12 @@ MenuButtonTextVarProc( */ if (flags & TCL_TRACE_UNSETS) { - if (!Tcl_InterpDeleted(interp) && mbPtr->textVarName) { + if (!Tcl_InterpDeleted(interp) && mbPtr->textVarNameObj) { void *probe = NULL; do { probe = Tcl_VarTraceInfo(interp, - mbPtr->textVarName, + Tcl_GetString(mbPtr->textVarNameObj), TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, MenuButtonTextVarProc, probe); if (probe == (void *)mbPtr) { @@ -908,25 +905,24 @@ MenuButtonTextVarProc( */ return NULL; } - Tcl_SetVar2(interp, mbPtr->textVarName, NULL, mbPtr->text, + Tcl_SetVar2(interp, Tcl_GetString(mbPtr->textVarNameObj), NULL, mbPtr->textObj ? Tcl_GetString(mbPtr->textObj) : "", TCL_GLOBAL_ONLY); - Tcl_TraceVar2(interp, mbPtr->textVarName, NULL, + Tcl_TraceVar2(interp, Tcl_GetString(mbPtr->textVarNameObj), NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, MenuButtonTextVarProc, clientData); } return NULL; } - value = Tcl_GetVar2(interp, mbPtr->textVarName, NULL, TCL_GLOBAL_ONLY); + value = Tcl_GetVar2(interp, Tcl_GetString(mbPtr->textVarNameObj), NULL, TCL_GLOBAL_ONLY); if (value == NULL) { value = ""; } - if (mbPtr->text != NULL) { - ckfree(mbPtr->text); + if (mbPtr->textObj != NULL) { + Tcl_DecrRefCount(mbPtr->textObj); } - len = 1 + strlen(value); - mbPtr->text = (char *)ckalloc(len); - memcpy(mbPtr->text, value, len); + mbPtr->textObj= Tcl_NewStringObj(value, TCL_INDEX_NONE); + Tcl_IncrRefCount(mbPtr->textObj); TkpComputeMenuButtonGeometry(mbPtr); if ((mbPtr->tkwin != NULL) && Tk_IsMapped(mbPtr->tkwin) diff --git a/generic/tkMenubutton.h b/generic/tkMenubutton.h index 60cc83a..06502df 100644 --- a/generic/tkMenubutton.h +++ b/generic/tkMenubutton.h @@ -55,23 +55,21 @@ typedef struct { Tcl_Command widgetCmd; /* Token for menubutton's widget command. */ Tk_OptionTable optionTable; /* Table that defines configuration options * available for this widget. */ - char *menuName; /* Name of menu associated with widget. - * Malloc-ed. */ + Tcl_Obj *menuNameObj; /* Name of menu associated with widget. */ /* * Information about what's displayed in the menu button: */ - char *text; /* Text to display in button (malloc'ed) or - * NULL. */ + Tcl_Obj *textObj; /* Text to display in button. May be NULL. */ int underline; /* Index of character to underline. INT_MIN means no underline */ - char *textVarName; /* Name of variable (malloc'ed) or NULL. If + Tcl_Obj *textVarNameObj; /* Name of variable or NULL. If * non-NULL, button displays the contents of * this variable. */ Pixmap bitmap; /* Bitmap to display or None. If not None then * text and textVar and underline are * ignored. */ - char *imageString; /* Name of image to display (malloc'ed), or + Tcl_Obj *imageObj; /* Name of image to display, or * NULL. If non-NULL, bitmap, text, and * textVarName are ignored. */ Tk_Image image; /* Image to display in window, or NULL if diff --git a/generic/tkPointer.c b/generic/tkPointer.c index 1bc8411..03dbf1c 100644 --- a/generic/tkPointer.c +++ b/generic/tkPointer.c @@ -181,7 +181,7 @@ GenerateEnterLeave( */ InitializeEvent(&event, targetPtr, LeaveNotify, x, y, state, - NotifyNormal); + NotifyAncestor); TkInOutEvents(&event, lastWinPtr, winPtr, LeaveNotify, EnterNotify, TCL_QUEUE_TAIL); @@ -386,7 +386,7 @@ Tk_UpdatePointer( if (targetWinPtr != NULL) { InitializeEvent(&event, targetWinPtr, MotionNotify, x, y, - tsdPtr->lastState, NotifyNormal); + tsdPtr->lastState, NotifyAncestor); Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL); } tsdPtr->lastPos = pos; diff --git a/generic/tkStubInit.c b/generic/tkStubInit.c index bb8ef65..e909128 100644 --- a/generic/tkStubInit.c +++ b/generic/tkStubInit.c @@ -532,7 +532,6 @@ static const TkIntPlatStubs tkIntPlatStubs = { TkMacOSXGetContainer, /* 49 */ TkGenerateButtonEvent, /* 50 */ TkGenWMDestroyEvent, /* 51 */ - 0, /* 52 */ #endif /* AQUA */ #if !(defined(_WIN32) || defined(__CYGWIN__) || defined(MAC_OSX_TK)) /* X11 */ TkCreateXEventSource, /* 0 */ diff --git a/generic/ttk/ttkDefaultTheme.c b/generic/ttk/ttkDefaultTheme.c index 5c72773..b5500b7 100644 --- a/generic/ttk/ttkDefaultTheme.c +++ b/generic/ttk/ttkDefaultTheme.c @@ -1237,6 +1237,7 @@ static void TreeitemIndicatorSize( Ttk_Padding margins; Tk_GetPixelsFromObj(NULL, tkwin, indicator->sizeObj, &size); + if (size % 2 == 0) --size; /* An odd size is better for the indicator. */ Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginObj, &margins); *widthPtr = size + Ttk_PaddingWidth(margins); *heightPtr = size + Ttk_PaddingHeight(margins); @@ -1259,7 +1260,7 @@ static void TreeitemIndicatorDraw( return; } - Ttk_GetPaddingFromObj(NULL,tkwin,indicator->marginObj,&padding); + Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginObj, &padding); b = Ttk_PadBox(b, padding); XDrawRectangle(Tk_Display(tkwin), d, gc, diff --git a/generic/ttk/ttkTheme.c b/generic/ttk/ttkTheme.c index 645889f..2004e8c 100644 --- a/generic/ttk/ttkTheme.c +++ b/generic/ttk/ttkTheme.c @@ -536,9 +536,10 @@ void Ttk_TkDestroyedHandler( StylePackageData* pkgPtr = GetStylePackageData(interp); /* - * Cancel any pending ThemeChanged calls: + * Cancel any pending ThemeChanged calls. We might be called + * before Ttk is initialized. See bug [3981091ed336]. */ - if (pkgPtr->themeChangePending) { + if (pkgPtr && pkgPtr->themeChangePending) { Tcl_CancelIdleCall(ThemeChangedProc, pkgPtr); } } @@ -1327,7 +1328,9 @@ static int StyleLookupCmd( } style = Ttk_GetStyle(theme, Tcl_GetString(objv[2])); - + if (!style) { + return TCL_ERROR; + } optionName = Tcl_GetString(objv[3]); if (objc >= 5) { @@ -1352,7 +1355,7 @@ static int StyleLookupCmd( } static int StyleThemeCurrentCmd( - void *clientData, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj * const objv[]) + void *clientData, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]) { StylePackageData *pkgPtr = (StylePackageData *)clientData; Tcl_HashSearch search; diff --git a/generic/ttk/ttkTreeview.c b/generic/ttk/ttkTreeview.c index 60e3147..6cd73a9 100644 --- a/generic/ttk/ttkTreeview.c +++ b/generic/ttk/ttkTreeview.c @@ -1741,6 +1741,26 @@ static int DisplayRow(int row, Treeview *tv) return row - tv->tree.yscroll.first + tv->tree.titleRows; } +/* Is an item detached? The root is never detached. */ +static int IsDetached(Treeview* tv, TreeItem* item) +{ + return item->next == NULL && item->prev == NULL && + item->parent == NULL && item != tv->tree.root; +} + +/* Is an item or one of its ancestors detached? */ +static int IsItemOrAncestorDetached(Treeview* tv, TreeItem* item) +{ + TreeItem *parent; + + for (parent = item; parent; parent = parent->parent) { + if (IsDetached(tv, parent)) { + return 1; + } + } + return 0; +} + /* + BoundingBox -- * Compute the parcel of the specified column of the specified item, * (or the entire item if column is NULL) @@ -1767,6 +1787,9 @@ static int BoundingBox( /* not viewable, or off-screen */ return 0; } + if (IsItemOrAncestorDetached(tv, item)) { + return 0; + } bbox.y += dispRow * tv->tree.rowHeight; bbox.height = tv->tree.rowHeight * item->height; @@ -3347,13 +3370,6 @@ static int TreeviewDetachCommand( return TCL_OK; } -/* Is an item detached? The root is never detached. */ -static int IsDetached(Treeview *tv, TreeItem *item) -{ - return item->next == NULL && item->prev == NULL && - item->parent == NULL && item != tv->tree.root; -} - /* + $tv detached ?$item? -- * List detached items (in arbitrary order) or query the detached state of * $item. @@ -3567,6 +3583,12 @@ static int TreeviewSeeCommand( return TCL_ERROR; } + /* The item cannot be moved into view if any ancestor (or itself) is detached. + */ + if (IsItemOrAncestorDetached(tv, item)) { + return TCL_OK; + } + /* Make sure all ancestors are open: */ for (parent = item->parent; parent; parent = parent->parent) { @@ -4625,12 +4647,12 @@ static void TreeitemIndicatorSize( TCL_UNUSED(Ttk_Padding *)) { TreeitemIndicator *indicator = (TreeitemIndicator *)elementRecord; - Ttk_Padding margins; int size = 0; + Ttk_Padding margins; - Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginsObj, &margins); Tk_GetPixelsFromObj(NULL, tkwin, indicator->sizeObj, &size); - if (size % 2 == 0) --size; /* An odd size is better for the arrow. */ + if (size % 2 == 0) --size; /* An odd size is better for the indicator. */ + Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginsObj, &margins); *widthPtr = size + Ttk_PaddingWidth(margins); *heightPtr = size + Ttk_PaddingHeight(margins); @@ -4648,15 +4670,34 @@ static void TreeitemIndicatorDraw( ArrowDirection direction = (state & TTK_STATE_OPEN) ? ARROW_DOWN : ARROW_RIGHT; Ttk_Padding margins; + int cx, cy; XColor *borderColor = Tk_GetColorFromObj(tkwin, indicator->colorObj); XGCValues gcvalues; GC gc; unsigned mask; if (state & TTK_STATE_LEAF) /* don't draw anything */ return; - Ttk_GetPaddingFromObj(NULL,tkwin,indicator->marginsObj,&margins); + Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginsObj, &margins); b = Ttk_PadBox(b, margins); + switch (direction) { + case ARROW_DOWN: + TtkArrowSize(b.width/2, direction, &cx, &cy); + if ((b.height - cy) % 2 == 1) { + ++cy; + } + break; + case ARROW_RIGHT: + default: + TtkArrowSize(b.height/2, direction, &cx, &cy); + if ((b.width - cx) % 2 == 1) { + ++cx; + } + break; + } + + b = Ttk_AnchorBox(b, cx, cy, TK_ANCHOR_CENTER); + gcvalues.foreground = borderColor->pixel; gcvalues.line_width = 1; mask = GCForeground | GCLineWidth; diff --git a/library/bgerror.tcl b/library/bgerror.tcl index 0dd04a1..e74faf2 100644 --- a/library/bgerror.tcl +++ b/library/bgerror.tcl @@ -22,7 +22,7 @@ namespace eval ::tk::dialog::error { option add *ErrorDialog*background systemAlertBackgroundActive \ widgetDefault option add *ErrorDialog*info.text.background \ - systemTextBackgroundColor widgetDefault + systemTextBackgroundColor widgetDefault option add *ErrorDialog*Button.highlightBackground \ systemAlertBackgroundActive widgetDefault } @@ -63,9 +63,9 @@ proc ::tk::dialog::error::SaveToLog {text} { set filename [tk_getSaveFile -title [mc "Select Log File"] \ -filetypes $types -defaultextension .log -parent .bgerrorDialog] if {$filename ne {}} { - set f [open $filename w] - puts -nonewline $f $text - close $f + set f [open $filename w] + puts -nonewline $f $text + close $f } return } @@ -131,7 +131,7 @@ proc ::tk::dialog::error::bgerror {err {flag 1}} { set maxRows 5 foreach line [split $err \n] { if {$lines > $maxRows - 1} { - # No more lines. Append to previous line. + # No more lines. Append to previous line. append displayedErr { ...} break } @@ -143,7 +143,7 @@ proc ::tk::dialog::error::bgerror {err {flag 1}} { append displayedErr "[string range $line 0 $maxLine-3]..." break } elseif {$lines > $maxRows - 2} { - # Last line, but no break or newline. Room to add 4 chars. + # Last line, but no break or newline. Room to add 4 chars. append displayedErr "${line}" } else { append displayedErr "${line}\n" @@ -255,7 +255,7 @@ proc ::tk::dialog::error::bgerror {err {flag 1}} { # order to ensure that it's seen if {[lindex [wm stackorder .] end] ne "$dlg"} { wm attributes $dlg -topmost 1 - } + } } # 9. Wait for the user to respond, then restore the focus and diff --git a/library/choosedir.tcl b/library/choosedir.tcl index c583215..b7225b6 100644 --- a/library/choosedir.tcl +++ b/library/choosedir.tcl @@ -28,9 +28,9 @@ proc ::tk::dialog::file::chooseDir:: {args} { Config $dataName $args if {$data(-parent) eq "."} { - set w .$dataName + set w .$dataName } else { - set w $data(-parent).$dataName + set w $data(-parent).$dataName } # (re)create the dialog box if necessary diff --git a/library/comdlg.tcl b/library/comdlg.tcl index 7eb0550..25e1b1f 100644 --- a/library/comdlg.tcl +++ b/library/comdlg.tcl @@ -65,9 +65,9 @@ proc tclParseConfigSpec {w specs flags argList} { # 2: set the default values # if {"DONTSETDEFAULTS" ni $flags} { - foreach cmdsw [array names cmd] { + foreach cmdsw [array names cmd] { set data($cmdsw) $def($cmdsw) - } + } } # 3: parse the argument list diff --git a/library/demos/fontchoose.tcl b/library/demos/fontchoose.tcl index de9e854..6ae5479 100644 --- a/library/demos/fontchoose.tcl +++ b/library/demos/fontchoose.tcl @@ -20,7 +20,7 @@ catch {font create FontchooseDemoFont {*}[font actual TkDefaultFont]} # The font chooser needs to be configured and then shown. proc SelectFont {parent} { tk fontchooser configure -font FontchooseDemoFont \ - -command ApplyFont -parent $parent + -command ApplyFont -parent $parent tk fontchooser show } @@ -33,9 +33,9 @@ proc ApplyFont {font} { # bind $w <<TkFontchooserVisibility>> { if {[tk fontchooser configure -visible]} { - %W.f.font state disabled + %W.f.font state disabled } else { - %W.f.font state !disabled + %W.f.font state !disabled } } diff --git a/library/demos/goldberg.tcl b/library/demos/goldberg.tcl index 5a5b462..5323cce 100644 --- a/library/demos/goldberg.tcl +++ b/library/demos/goldberg.tcl @@ -1923,7 +1923,7 @@ proc scl {lst} { proc PlacedDialog {w msg {labelFnt {Helvetica 10}}} { if {[grab current] ne {}} { - return + return } destroy $w @@ -1954,7 +1954,7 @@ proc PlacedDialog {w msg {labelFnt {Helvetica 10}}} { proc ClosePlacedDialog {w} { set tl [winfo toplevel $w] if {![winfo exists $::PlacedDialogOldFocus]} { - set ::PlacedDialogOldFocus $tl + set ::PlacedDialogOldFocus $tl } focus $::PlacedDialogOldFocus set ::PlacedDialogOldFocus {} diff --git a/library/demos/knightstour.tcl b/library/demos/knightstour.tcl index 76b6a4f..d6a58d6 100644 --- a/library/demos/knightstour.tcl +++ b/library/demos/knightstour.tcl @@ -27,11 +27,11 @@ package require tk proc ValidMoves {square} { set moves {} foreach pair {{-1 -2} {-2 -1} {-2 1} {-1 2} {1 2} {2 1} {2 -1} {1 -2}} { - set col [expr {($square % 8) + [lindex $pair 0]}] - set row [expr {($square / 8) + [lindex $pair 1]}] - if {$row >= 0 && $row < 8 && $col >= 0 && $col < 8} { - lappend moves [expr {$row * 8 + $col}] - } + set col [expr {($square % 8) + [lindex $pair 0]}] + set row [expr {($square / 8) + [lindex $pair 1]}] + if {$row >= 0 && $row < 8 && $col >= 0 && $col < 8} { + lappend moves [expr {$row * 8 + $col}] + } } return $moves } @@ -41,9 +41,9 @@ proc CheckSquare {square} { variable visited set moves 0 foreach test [ValidMoves $square] { - if {[lsearch -exact -integer $visited $test] < 0} { - incr moves - } + if {[lsearch -exact -integer $visited $test] < 0} { + incr moves + } } return $moves } @@ -55,17 +55,17 @@ proc Next {square} { set minimum 9 set nextSquare -1 foreach testSquare [ValidMoves $square] { - if {[lsearch -exact -integer $visited $testSquare] < 0} { - set count [CheckSquare $testSquare] - if {$count < $minimum} { - set minimum $count - set nextSquare $testSquare - } elseif {$count == $minimum} { - # to remove the enhancement to Warnsdorff's rule - # remove the next line: - set nextSquare [Edgemost $nextSquare $testSquare] - } - } + if {[lsearch -exact -integer $visited $testSquare] < 0} { + set count [CheckSquare $testSquare] + if {$count < $minimum} { + set minimum $count + set nextSquare $testSquare + } elseif {$count == $minimum} { + # to remove the enhancement to Warnsdorff's rule + # remove the next line: + set nextSquare [Edgemost $nextSquare $testSquare] + } + } } return $nextSquare } @@ -98,23 +98,23 @@ proc MovePiece {dlg last square} { lappend visited $square set next [Next $square] if {$next ne -1} { - variable aid [after $delay [list MovePiece $dlg $square $next]] + variable aid [after $delay [list MovePiece $dlg $square $next]] } else { - $dlg.tf.b1 configure -state normal - if {[llength $visited] == 64} { - variable initial - if {$initial == $square} { - $dlg.f.txt insert end "Closed tour!" - } else { - $dlg.f.txt insert end "Success" - if {$continuous} { - after [expr {$delay * 2}] [namespace code \ - [list Tour $dlg [expr {int(rand() * 64)}]]] - } - } - } else { - $dlg.f.txt insert end "FAILED!" - } + $dlg.tf.b1 configure -state normal + if {[llength $visited] == 64} { + variable initial + if {$initial == $square} { + $dlg.f.txt insert end "Closed tour!" + } else { + $dlg.f.txt insert end "Success" + if {$continuous} { + after [expr {$delay * 2}] [namespace code \ + [list Tour $dlg [expr {int(rand() * 64)}]]] + } + } + } else { + $dlg.f.txt insert end "FAILED!" + } } } @@ -124,11 +124,11 @@ proc Tour {dlg {square {}}} { $dlg.f.txt delete 1.0 end $dlg.tf.b1 configure -state disabled for {set n 0} {$n < 64} {incr n} { - $dlg.f.c itemconfigure $n -state disabled -outline black + $dlg.f.c itemconfigure $n -state disabled -outline black } if {$square eq {}} { - set coords [lrange [$dlg.f.c coords knight] 0 1] - set square [expr {[$dlg.f.c find closest {*}$coords 0 65]-1}] + set coords [lrange [$dlg.f.c coords knight] 0 1] + set square [expr {[$dlg.f.c find closest {*}$coords 0 65]-1}] } variable initial $square after idle [list MovePiece $dlg $initial $initial] @@ -157,9 +157,9 @@ proc DragStart {w x y} { proc DragMotion {w x y} { variable dragging if {[info exists dragging]} { - $w move selected [expr {$x - [lindex $dragging 0]}] \ - [expr {$y - [lindex $dragging 1]}] - variable dragging [list $x $y] + $w move selected [expr {$x - [lindex $dragging 0]}] \ + [expr {$y - [lindex $dragging 1]}] + variable dragging [list $x $y] } } proc DragEnd {w x y} { @@ -177,7 +177,7 @@ proc CreateGUI {} { set f [ttk::frame $dlg.f] set c [canvas $f.c -width 192p -height 192p] text $f.txt -width 12 -height 1 -padx 3p \ - -yscrollcommand [list $f.vs set] -font TkFixedFont + -yscrollcommand [list $f.vs set] -font TkFixedFont ttk::scrollbar $f.vs -command [list $f.txt yview] variable speed 1400 @@ -185,41 +185,41 @@ proc CreateGUI {} { variable continuous 0 ttk::frame $dlg.tf ttk::checkbutton $dlg.tf.cc -text Repeat \ - -variable [namespace which -variable continuous] + -variable [namespace which -variable continuous] ttk::scale $dlg.tf.sc -from 0 -to 1992 -command [list SetDelay] \ - -variable [namespace which -variable speed] + -variable [namespace which -variable speed] ttk::label $dlg.tf.ls -text Speed ttk::button $dlg.tf.b1 -text Start -command [list Tour $dlg] ttk::button $dlg.tf.b2 -text Exit -command [list Exit $dlg] set square 0 for {set row 7} {$row >= 0} {incr row -1} { - for {set col 0} {$col < 8} {incr col} { - if {(($col & 1) ^ ($row & 1))} { - set fill tan3 ; set dfill tan4 - } else { - set fill bisque ; set dfill bisque3 - } - set coords [list [expr {$col * 24 + 3}]p \ + for {set col 0} {$col < 8} {incr col} { + if {(($col & 1) ^ ($row & 1))} { + set fill tan3 ; set dfill tan4 + } else { + set fill bisque ; set dfill bisque3 + } + set coords [list [expr {$col * 24 + 3}]p \ [expr {$row * 24 + 3}]p \ - [expr {$col * 24 + 24}]p \ + [expr {$col * 24 + 24}]p \ [expr {$row * 24 + 24}]p] - $c create rectangle $coords -fill $fill -disabledfill $dfill \ - -width 1.5p -state disabled -outline black - } + $c create rectangle $coords -fill $fill -disabledfill $dfill \ + -width 1.5p -state disabled -outline black + } } if {[tk windowingsystem] ne "x11"} { - catch {eval font create KnightFont -size 18} - $c create text 0 0 -font KnightFont -text "♞" \ - -anchor nw -tags knight -fill black -activefill "#600000" + catch {eval font create KnightFont -size 18} + $c create text 0 0 -font KnightFont -text "♞" \ + -anchor nw -tags knight -fill black -activefill "#600000" } else { - # On X11 we cannot reliably tell if the ♞ glyph is available - # so just use a polygon - set pts { - 2 25 24 25 21 19 20 8 14 0 10 0 0 13 0 16 - 2 17 4 14 5 15 3 17 5 17 9 14 10 15 5 21 - } - $c create polygon $pts -tag knight -offset 8 \ - -fill black -activefill "#600000" + # On X11 we cannot reliably tell if the ♞ glyph is available + # so just use a polygon + set pts { + 2 25 24 25 21 19 20 8 14 0 10 0 0 13 0 16 + 2 17 4 14 5 15 3 17 5 17 9 14 10 15 5 21 + } + $c create polygon $pts -tag knight -offset 8 \ + -fill black -activefill "#600000" set scaleFactor [expr {$tk::scalingPct / 100.0}] $c scale knight 0 0 $scaleFactor $scaleFactor } @@ -248,7 +248,7 @@ proc CreateGUI {} { } grid $dlg.tf - - - - - -sticky ew if {[info exists ::widgetDemo]} { - grid [addSeeDismiss $dlg.buttons $dlg] - - - - - -sticky ew + grid [addSeeDismiss $dlg.buttons $dlg] - - - - - -sticky ew } grid rowconfigure $dlg 0 -weight 1 diff --git a/library/demos/labelframe.tcl b/library/demos/labelframe.tcl index 08e8a23..0f400ed 100644 --- a/library/demos/labelframe.tcl +++ b/library/demos/labelframe.tcl @@ -40,7 +40,7 @@ grid $w.f -row 0 -column 0 -pady 2m -padx 2m foreach value {1 2 3 4} { radiobutton $w.f.b$value -text "This is value $value" \ - -variable lfdummy -value $value + -variable lfdummy -value $value pack $w.f.b$value -side top -fill x -pady 1.5p } @@ -49,18 +49,18 @@ foreach value {1 2 3 4} { proc lfEnableButtons {w} { foreach child [winfo children $w] { - if {$child == "$w.cb"} continue - if {$::lfdummy2} { - $child configure -state normal - } else { - $child configure -state disabled - } + if {$child == "$w.cb"} continue + if {$::lfdummy2} { + $child configure -state normal + } else { + $child configure -state disabled + } } } labelframe $w.f2 -pady 1.5p -padx 1.5p checkbutton $w.f2.cb -text "Use this option." -variable lfdummy2 \ - -command "lfEnableButtons $w.f2" -padx 0 + -command "lfEnableButtons $w.f2" -padx 0 $w.f2 configure -labelwidget $w.f2.cb grid $w.f2 -row 0 -column 1 -pady 2m -padx 2m diff --git a/library/demos/mac_wm.tcl b/library/demos/mac_wm.tcl index 105c12c..eba4f03 100644 --- a/library/demos/mac_wm.tcl +++ b/library/demos/mac_wm.tcl @@ -46,23 +46,23 @@ proc launch {name windowInfo class} { # titled if {$class == "nswindow"} { ttk::checkbutton $f.stylemask.titled -text titled -variable $name.titled \ - -command [list setbit $name $f.stylemask.titled titled] + -command [list setbit $name $f.stylemask.titled titled] $f.stylemask.titled state selected grid $f.stylemask.titled -row 0 -column 0 -sticky w } # closable ttk::checkbutton $f.stylemask.closable -text closable -variable $name.closable \ - -command [list setbit $name $f.stylemask.closable closable] + -command [list setbit $name $f.stylemask.closable closable] $f.stylemask.closable state selected grid $f.stylemask.closable -row 1 -column 0 -sticky w # miniaturizableable ttk::checkbutton $f.stylemask.miniaturizable -text miniaturizable \ -variable $name.miniaturizable \ - -command [list setbit $name $f.stylemask.miniaturizable miniaturizable] + -command [list setbit $name $f.stylemask.miniaturizable miniaturizable] if {$class == "nswindow"} { - $f.stylemask.miniaturizable state selected + $f.stylemask.miniaturizable state selected } else { - $f.stylemask.miniaturizable state !alternate + $f.stylemask.miniaturizable state !alternate } grid $f.stylemask.miniaturizable -row 2 -column 0 -sticky w # resizable @@ -124,10 +124,10 @@ proc setbit {win cb bitname} { set bits [wm attributes $win -stylemask] set index [lsearch $bits $bitname] if {$index >= 0 && !$state} { - set bits [lreplace $bits $index $index] + set bits [lreplace $bits $index $index] } if {$index < 0 && $state} { - lappend bits $bitname + lappend bits $bitname } wm attributes $win -stylemask $bits } @@ -192,8 +192,8 @@ proc launchModernWindow {} { frame .mod.left -width 220 -height 400 -background systemWindowBackgroundColor catch { font create leftFont -family .AppleSystemUIFont -size 11 - font create rightFont -family .AppleSystemUIFont -size 16 - font create codeFont -family Courier -size 16 + font create rightFont -family .AppleSystemUIFont -size 16 + font create codeFont -family Courier -size 16 } grid [ttk::label .mod.left.spacer -padding {220 30 0 0}] -row 0 -column 0 grid [ttk::radiobutton .mod.left.about -text About -style SidebarButton \ diff --git a/library/demos/mclist.tcl b/library/demos/mclist.tcl index a60a00f..5335490 100644 --- a/library/demos/mclist.tcl +++ b/library/demos/mclist.tcl @@ -157,14 +157,14 @@ proc SortBy {tree col direction} { set mclistGrid 0 proc tglGrid {} { if {$::mclistGrid} { - .mclist.tree configure -stripe 1 - foreach col [.mclist.tree cget -columns] { - .mclist.tree column $col -separator 1 - } + .mclist.tree configure -stripe 1 + foreach col [.mclist.tree cget -columns] { + .mclist.tree column $col -separator 1 + } } else { - .mclist.tree configure -stripe 0 - foreach col [.mclist.tree cget -columns] { - .mclist.tree column $col -separator 0 - } + .mclist.tree configure -stripe 0 + foreach col [.mclist.tree cget -columns] { + .mclist.tree column $col -separator 0 + } } } diff --git a/library/demos/nl.msg b/library/demos/nl.msg index dc80c15..60ca47c 100644 --- a/library/demos/nl.msg +++ b/library/demos/nl.msg @@ -66,15 +66,15 @@ ::msgcat::mcset nl "Listboxes" "Keuzelijsten" ::msgcat::mcset nl "The 50 states" "De 50 staten van de VS" ::msgcat::mcset nl "Colors: change the color scheme for the application" \ - "Kleuren: verander het kleurenschema voor het programma" + "Kleuren: verander het kleurenschema voor het programma" ::msgcat::mcset nl "A collection of famous and infamous sayings" \ - "Beroemde en beruchte citaten en gezegden" + "Beroemde en beruchte citaten en gezegden" ::msgcat::mcset nl "Entries and Spin-boxes" "Invulvelden en Spinboxen" ::msgcat::mcset nl "Entries without scrollbars" "Invulvelden zonder schuifbalk" ::msgcat::mcset nl "Entries with scrollbars" "Invulvelden met schuifbalk" ::msgcat::mcset nl "Validated entries and password fields" \ - "Invulvelden met controle of wachtwoorden" + "Invulvelden met controle of wachtwoorden" ::msgcat::mcset nl "Spin-boxes" "Spinboxen" ::msgcat::mcset nl "Simple Rolodex-like form" "Simpel kaartsysteem" diff --git a/library/demos/states.tcl b/library/demos/states.tcl index 4e14fd5..e25ee81 100644 --- a/library/demos/states.tcl +++ b/library/demos/states.tcl @@ -23,9 +23,9 @@ labelframe $w.justif -text Justification foreach c {Left Center Right} { set lower [string tolower $c] radiobutton $w.justif.$lower -text $c -variable just \ - -relief flat -value $lower -anchor w \ - -command "$w.frame.list configure -justify \$just" \ - -tristatevalue "multi" + -relief flat -value $lower -anchor w \ + -command "$w.frame.list configure -justify \$just" \ + -tristatevalue "multi" pack $w.justif.$lower -side left -pady 1.5p -fill x } pack $w.justif diff --git a/library/demos/systray.tcl b/library/demos/systray.tcl index 6954143..3406f0c 100644 --- a/library/demos/systray.tcl +++ b/library/demos/systray.tcl @@ -26,10 +26,10 @@ $iconmenu add command -label "Status" -command { puts "status icon clicked" } $iconmenu add command -label "Exit" -command exit pack [label $w.l -text "This demonstration showcases - the tk systray and tk sysnotify commands. - Running this demo creates the systray icon. - Clicking the buttons below modifies and destroys the icon - and displays the notification."] + the tk systray and tk sysnotify commands. + Running this demo creates the systray icon. + Clicking the buttons below modifies and destroys the icon + and displays the notification."] image create photo book -data R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAACwAAAAADwAPAAADSQhA2u5ksPeKABKSCaya29d4WKgERFF0l1IMQCAKatvBJ0OTdzzXI1xMB3TBZAvATtB6NSLKleXi3OBoLqrVgc0yv+DVSEUuFxIAOw== @@ -45,20 +45,20 @@ pack $w.f $w.b3 -fill x -padx 3p -pady 3p proc create {} { global trayIconExists if {$trayIconExists} { - tk_messageBox -message "Systray icon already exists" - return + tk_messageBox -message "Systray icon already exists" + return } tk systray create -image book -text "Systray sample" \ - -button1 {puts "foo"} \ - -button3 {tk_popup $iconmenu [winfo pointerx .] [winfo pointery .]} + -button1 {puts "foo"} \ + -button3 {tk_popup $iconmenu [winfo pointerx .] [winfo pointery .]} set trayIconExists true } proc modify {} { global trayIconExists if {!$trayIconExists} { - tk_messageBox -message "Please create systray icon first" - return + tk_messageBox -message "Please create systray icon first" + return } image create photo page -data R0lGODlhCwAPAKIAAP//////AMDAwICAgAAA/wAAAAAAAAAAACwAAAAACwAPAAADMzi6CzAugiAgDGE68aB0RXgRJBFVX0SNpQlUWfahQOvSsgrX7eZJMlQMWBEYj8iQchlKAAA7 tk systray configure -image page @@ -70,8 +70,8 @@ proc modify {} { proc notify {} { global trayIconExists if {!$trayIconExists} { - tk_messageBox -message "Please create systray icon first" - return + tk_messageBox -message "Please create systray icon first" + return } tk sysnotify "Alert" "This is an alert" } @@ -79,8 +79,8 @@ proc notify {} { proc remove {} { global trayIconExists if {!$trayIconExists} { - tk_messageBox -message "Systray icon was already destroyed" - return + tk_messageBox -message "Systray icon was already destroyed" + return } tk systray destroy set trayIconExists false diff --git a/library/demos/text.tcl b/library/demos/text.tcl index 130a4a5..189cb2d 100644 --- a/library/demos/text.tcl +++ b/library/demos/text.tcl @@ -30,11 +30,11 @@ pack $w.text -expand yes -fill both # TIP 324 Demo: [tk fontchooser] proc fontchooserToggle {} { tk fontchooser [expr {[tk fontchooser configure -visible] ? - "hide" : "show"}] + "hide" : "show"}] } proc fontchooserVisibility {w} { $w configure -text [expr {[tk fontchooser configure -visible] ? - "Hide Font Dialog" : "Show Font Dialog"}] + "Hide Font Dialog" : "Show Font Dialog"}] } proc fontchooserFocus {w} { tk fontchooser configure -font [$w cget -font] \ diff --git a/library/demos/ttkpane.tcl b/library/demos/ttkpane.tcl index 749f940..87c7b6d 100644 --- a/library/demos/ttkpane.tcl +++ b/library/demos/ttkpane.tcl @@ -67,7 +67,7 @@ set testzones { set zones {} foreach zone $testzones { if {![catch {clock format 0 -timezone $zone}]} { - lappend zones $zone + lappend zones $zone } } if {[llength $zones] < 2} { lappend zones -0200 :GMT :UTC +0200 } diff --git a/library/demos/twind.tcl b/library/demos/twind.tcl index b974456..ddfc30e 100644 --- a/library/demos/twind.tcl +++ b/library/demos/twind.tcl @@ -353,6 +353,6 @@ proc textSplitWindow {textW} { $w.pane add $t -stretch always } } else { - return + return } } diff --git a/library/demos/widget b/library/demos/widget index 18a287e..5e3373c 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -31,26 +31,26 @@ if {[tk windowingsystem] eq "x11"} { if {"defaultFont" ni [font names]} { # TIP #145 defines some standard named fonts if {"TkDefaultFont" in [font names] && "TkFixedFont" in [font names]} { - # FIX ME: the following technique of cloning the font to copy it works - # fine but means that if the system font is changed by Tk - # cannot update the copied font. font alias might be useful - # here -- or fix the app to use TkDefaultFont etc. - font create mainFont {*}[font configure TkDefaultFont] - font create fixedFont {*}[font configure TkFixedFont] - font create boldFont {*}[font configure TkDefaultFont] -weight bold - font create titleFont {*}[font configure TkDefaultFont] -weight bold - font create statusFont {*}[font configure TkDefaultFont] - font create varsFont {*}[font configure TkDefaultFont] + # FIX ME: the following technique of cloning the font to copy it works + # fine but means that if the system font is changed by Tk + # cannot update the copied font. font alias might be useful + # here -- or fix the app to use TkDefaultFont etc. + font create mainFont {*}[font configure TkDefaultFont] + font create fixedFont {*}[font configure TkFixedFont] + font create boldFont {*}[font configure TkDefaultFont] -weight bold + font create titleFont {*}[font configure TkDefaultFont] -weight bold + font create statusFont {*}[font configure TkDefaultFont] + font create varsFont {*}[font configure TkDefaultFont] if {[tk windowingsystem] eq "aqua"} { font configure titleFont -size 17 } } else { - font create mainFont -family Helvetica -size 12 - font create fixedFont -family Courier -size 10 - font create boldFont -family Helvetica -size 12 -weight bold - font create titleFont -family Helvetica -size 18 -weight bold - font create statusFont -family Helvetica -size 10 - font create varsFont -family Helvetica -size 14 + font create mainFont -family Helvetica -size 12 + font create fixedFont -family Courier -size 10 + font create boldFont -family Helvetica -size 12 -weight bold + font create titleFont -family Helvetica -size 18 -weight bold + font create statusFont -family Helvetica -size 10 + font create varsFont -family Helvetica -size 14 } } diff --git a/library/demos/windowicons.tcl b/library/demos/windowicons.tcl index 0c1e0c0..13c514d 100644 --- a/library/demos/windowicons.tcl +++ b/library/demos/windowicons.tcl @@ -99,7 +99,7 @@ image create photo icon2 icon2 copy icon -zoom [expr {$tk::scalingPct / 100}] pack [button $w.i -text "Set Window Icon to Globe" -image icon2 \ - -compound top -command {wm iconphoto . icon}] -fill x -padx 3p + -compound top -command {wm iconphoto . icon}] -fill x -padx 3p pack [button $w.b -text "Set Badge to 3" -command {wm iconbadge . 3}] \ -fill x -padx 3p pack [button $w.e -text "Set Badge to 11" -command {wm iconbadge . 11}] \ diff --git a/library/dialog.tcl b/library/dialog.tcl index 16ba128..f5a771a 100644 --- a/library/dialog.tcl +++ b/library/dialog.tcl @@ -149,9 +149,9 @@ proc ::tk_dialog {w title text bitmap default args} { # 7. Set a grab and claim the focus too. if {$default >= 0} { - set focus $w.button$default + set focus $w.button$default } else { - set focus $w + set focus $w } tk::SetFocusGrab $w $focus diff --git a/library/entry.tcl b/library/entry.tcl index b344a63..bdd9fda 100644 --- a/library/entry.tcl +++ b/library/entry.tcl @@ -308,12 +308,12 @@ proc ::tk::EntryEndIMEMarkedText {w} { bind Entry <Button-2> { if {!$tk_strictMotif} { - ::tk::EntryScanMark %W %x + ::tk::EntryScanMark %W %x } } bind Entry <B2-Motion> { if {!$tk_strictMotif} { - ::tk::EntryScanDrag %W %x + ::tk::EntryScanDrag %W %x } } @@ -415,7 +415,7 @@ proc ::tk::EntryMouseSelect {w x} { } } if {$Priv(mouseMoved)} { - $w icursor $cur + $w icursor $cur } update idletasks } diff --git a/library/fontchooser.tcl b/library/fontchooser.tcl index 3aaa6b7..b1b9d08 100644 --- a/library/fontchooser.tcl +++ b/library/fontchooser.tcl @@ -14,10 +14,10 @@ namespace eval ::tk::fontchooser { set S(W) .__tk__fontchooser set S(fonts) [lsort -dictionary -unique [font families]] set S(styles) [list \ - [::msgcat::mc Regular] \ - [::msgcat::mc Italic] \ - [::msgcat::mc Bold] \ - [::msgcat::mc {Bold Italic}] \ + [::msgcat::mc Regular] \ + [::msgcat::mc Italic] \ + [::msgcat::mc Bold] \ + [::msgcat::mc {Bold Italic}] \ ] set S(sizes) {8 9 10 11 12 14 16 18 20 22 24 26 28 36 48 72} set S(strike) 0 @@ -34,7 +34,7 @@ proc ::tk::fontchooser::Canonical {} { variable S foreach style $S(styles) { - lappend S(styles,lcase) [string tolower $style] + lappend S(styles,lcase) [string tolower $style] } set S(sizes,lcase) $S(sizes) set S(sampletext) [::msgcat::mc "AaBbYyZz01"] @@ -42,11 +42,11 @@ proc ::tk::fontchooser::Canonical {} { # Canonical versions of font families, styles, etc. for easier searching set S(fonts,lcase) {} foreach font $S(fonts) { - lappend S(fonts,lcase) [string tolower $font] + lappend S(fonts,lcase) [string tolower $font] } set S(styles,lcase) {} foreach style $S(styles) { - lappend S(styles,lcase) [string tolower $style] + lappend S(styles,lcase) [string tolower $style] } } @@ -56,18 +56,18 @@ proc ::tk::fontchooser::Setup {} { Canonical ::ttk::style layout FontchooserFrame { - Entry.field -sticky news -border true -children { - FontchooserFrame.padding -sticky news - } + Entry.field -sticky news -border true -children { + FontchooserFrame.padding -sticky news + } } bind [winfo class .] <<ThemeChanged>> \ - [list +ttk::style layout FontchooserFrame \ - [ttk::style layout FontchooserFrame]] + [list +ttk::style layout FontchooserFrame \ + [ttk::style layout FontchooserFrame]] namespace ensemble create -map { - show ::tk::fontchooser::Show - hide ::tk::fontchooser::Hide - configure ::tk::fontchooser::Configure + show ::tk::fontchooser::Show + hide ::tk::fontchooser::Hide + configure ::tk::fontchooser::Configure } } ::tk::fontchooser::Setup @@ -78,19 +78,19 @@ proc ::tk::fontchooser::Show {} { Canonical if {![winfo exists $S(W)]} { - Create - wm transient $S(W) [winfo toplevel $S(-parent)] - tk::PlaceWindow $S(W) widget $S(-parent) - if {[string trim $S(-title)] eq ""} { - wm title $S(W) [::msgcat::mc "Font"] - } else { - wm title $S(W) $S(-title) - } + Create + wm transient $S(W) [winfo toplevel $S(-parent)] + tk::PlaceWindow $S(W) widget $S(-parent) + if {[string trim $S(-title)] eq ""} { + wm title $S(W) [::msgcat::mc "Font"] + } else { + wm title $S(W) $S(-title) + } } set S(fonts) [lsort -dictionary -unique [font families]] set S(fonts,lcase) {} foreach font $S(fonts) { - lappend S(fonts,lcase) [string tolower $font] + lappend S(fonts,lcase) [string tolower $font] } wm deiconify $S(W) } @@ -104,57 +104,57 @@ proc ::tk::fontchooser::Configure {args} { variable S set specs { - {-parent "" "" . } - {-title "" "" ""} - {-font "" "" ""} - {-command "" "" ""} + {-parent "" "" . } + {-title "" "" ""} + {-font "" "" ""} + {-command "" "" ""} } if {[llength $args] == 0} { - set result {} - foreach spec $specs { - foreach {name xx yy default} $spec break - lappend result $name \ - [expr {[info exists S($name)] ? $S($name) : $default}] - } - lappend result -visible \ - [expr {[winfo exists $S(W)] && [winfo ismapped $S(W)]}] - return $result + set result {} + foreach spec $specs { + foreach {name xx yy default} $spec break + lappend result $name \ + [expr {[info exists S($name)] ? $S($name) : $default}] + } + lappend result -visible \ + [expr {[winfo exists $S(W)] && [winfo ismapped $S(W)]}] + return $result } if {[llength $args] == 1} { - set option [lindex $args 0] - if {[string equal $option "-visible"]} { - return [expr {[winfo exists $S(W)] && [winfo ismapped $S(W)]}] - } elseif {[info exists S($option)]} { - return $S($option) - } - return -code error -errorcode [list TK LOOKUP OPTION $option] \ - "bad option \"$option\": must be\ - -command, -font, -parent, -title or -visible" + set option [lindex $args 0] + if {[string equal $option "-visible"]} { + return [expr {[winfo exists $S(W)] && [winfo ismapped $S(W)]}] + } elseif {[info exists S($option)]} { + return $S($option) + } + return -code error -errorcode [list TK LOOKUP OPTION $option] \ + "bad option \"$option\": must be\ + -command, -font, -parent, -title or -visible" } set cache [dict create -parent $S(-parent) -title $S(-title) \ - -font $S(-font) -command $S(-command)] + -font $S(-font) -command $S(-command)] set r [tclParseConfigSpec [namespace which -variable S] $specs DONTSETDEFAULTS $args] if {![winfo exists $S(-parent)]} { - set code [list TK LOOKUP WINDOW $S(-parent)] - set err "bad window path name \"$S(-parent)\"" - array set S $cache - return -code error -errorcode $code $err + set code [list TK LOOKUP WINDOW $S(-parent)] + set err "bad window path name \"$S(-parent)\"" + array set S $cache + return -code error -errorcode $code $err } if {[winfo exists $S(W)]} { - if {{-font} in $args} { - Init $S(-font) - event generate $S(-parent) <<TkFontchooserFontChanged>> - } - - if {[string trim $S(-title)] eq {}} { - wm title $S(W) [::msgcat::mc Font] - } else { - wm title $S(W) $S(-title) - } - $S(W).ok configure -state $S(nstate) - $S(W).apply configure -state $S(nstate) + if {{-font} in $args} { + Init $S(-font) + event generate $S(-parent) <<TkFontchooserFontChanged>> + } + + if {[string trim $S(-title)] eq {}} { + wm title $S(W) [::msgcat::mc Font] + } else { + wm title $S(W) $S(-title) + } + $S(W).ok configure -state $S(nstate) + $S(W).apply configure -state $S(nstate) } return $r } @@ -163,144 +163,144 @@ proc ::tk::fontchooser::Create {} { variable S set windowName __tk__fontchooser if {$S(-parent) eq "."} { - set S(W) .$windowName + set S(W) .$windowName } else { - set S(W) $S(-parent).$windowName + set S(W) $S(-parent).$windowName } # Now build the dialog if {![winfo exists $S(W)]} { - toplevel $S(W) -class TkFontDialog - if {[package provide tcltest] ne {}} { - set ::tk_dialog $S(W) - } - wm withdraw $S(W) - wm title $S(W) $S(-title) - wm transient $S(W) [winfo toplevel $S(-parent)] - - set outer [::ttk::frame $S(W).outer -padding {7.5p 7.5p}] - ::tk::AmpWidget ::ttk::label $S(W).font -text [::msgcat::mc "&Font:"] - ::tk::AmpWidget ::ttk::label $S(W).style -text [::msgcat::mc "Font st&yle:"] - ::tk::AmpWidget ::ttk::label $S(W).size -text [::msgcat::mc "&Size:"] - ttk::entry $S(W).efont -width 18 \ - -textvariable [namespace which -variable S](font) - ttk::entry $S(W).estyle -width 10 \ - -textvariable [namespace which -variable S](style) - ttk::entry $S(W).esize -textvariable [namespace which -variable S](size) \ - -width 3 -validate key -validatecommand {regexp -- {^-*[0-9]*$} %P} - - ttk_slistbox $S(W).lfonts -height 7 -exportselection 0 \ - -selectmode browse -activestyle none \ - -listvariable [namespace which -variable S](fonts) - ttk_slistbox $S(W).lstyles -width 5 -height 7 -exportselection 0 \ - -selectmode browse -activestyle none \ - -listvariable [namespace which -variable S](styles) - ttk_slistbox $S(W).lsizes -width 4 -height 7 -exportselection 0 \ - -selectmode browse -activestyle none \ - -listvariable [namespace which -variable S](sizes) - - set WE $S(W).effects - ::ttk::labelframe $WE -text [::msgcat::mc "Effects"] - ::tk::AmpWidget ::ttk::checkbutton $WE.strike \ - -variable [namespace which -variable S](strike) \ - -text [::msgcat::mc "Stri&keout"] \ - -command [namespace code [list Click strike]] - ::tk::AmpWidget ::ttk::checkbutton $WE.under \ - -variable [namespace which -variable S](under) \ - -text [::msgcat::mc "&Underline"] \ - -command [namespace code [list Click under]] - - set bbox [::ttk::frame $S(W).bbox] - ::ttk::button $S(W).ok -text [::msgcat::mc OK] -default active\ - -command [namespace code [list Done 1]] - ::ttk::button $S(W).cancel -text [::msgcat::mc Cancel] \ - -command [namespace code [list Done 0]] - ::tk::AmpWidget ::ttk::button $S(W).apply -text [::msgcat::mc "&Apply"] \ - -command [namespace code [list Apply]] - wm protocol $S(W) WM_DELETE_WINDOW [namespace code [list Done 0]] - - # Calculate minimum sizes - ttk::scrollbar $S(W).tmpvs - set scroll_width [winfo reqwidth $S(W).tmpvs] - destroy $S(W).tmpvs - set minsize(gap) [::tk::ScaleNum 10] - set minsize(bbox) [winfo reqwidth $S(W).ok] - set minsize(fonts) \ - [expr {[font measure TkDefaultFont "Helvetica"] + $scroll_width}] - set minsize(styles) \ - [expr {[font measure TkDefaultFont "Bold Italic"] + $scroll_width}] - set minsize(sizes) \ - [expr {[font measure TkDefaultFont "-99"] + $scroll_width}] - set min [expr {$minsize(gap) * 4}] - foreach {what width} [array get minsize] { - incr min $width - } - wm minsize $S(W) $min [::tk::ScaleNum 260] - - bind $S(W) <Return> [namespace code [list Done 1]] - bind $S(W) <Escape> [namespace code [list Done 0]] - bind $S(W) <Map> [namespace code [list Visibility %W 1]] - bind $S(W) <Unmap> [namespace code [list Visibility %W 0]] - bind $S(W) <Destroy> [namespace code [list Visibility %W 0]] - bind $S(W).lfonts.list <<ListboxSelect>> [namespace code [list Click font]] - bind $S(W).lstyles.list <<ListboxSelect>> [namespace code [list Click style]] - bind $S(W).lsizes.list <<ListboxSelect>> [namespace code [list Click size]] - bind $S(W) <Alt-Key> [list ::tk::AltKeyInDialog $S(W) %A] - bind $S(W).font <<AltUnderlined>> [list ::focus $S(W).efont] - bind $S(W).style <<AltUnderlined>> [list ::focus $S(W).estyle] - bind $S(W).size <<AltUnderlined>> [list ::focus $S(W).esize] - bind $S(W).apply <<AltUnderlined>> [namespace code [list Apply]] - bind $WE.strike <<AltUnderlined>> [list $WE.strike invoke] - bind $WE.under <<AltUnderlined>> [list $WE.under invoke] - - set WS $S(W).sample - ::ttk::labelframe $WS -text [::msgcat::mc "Sample"] - ::ttk::label $WS.sample -relief sunken -anchor center \ - -textvariable [namespace which -variable S](sampletext) - set S(sample) $WS.sample - grid $WS.sample -sticky news -padx 4.5p -pady 3p - grid rowconfigure $WS 0 -weight 1 - grid columnconfigure $WS 0 -weight 1 - grid propagate $WS 0 - - grid $S(W).ok -in $bbox -sticky new -pady {0 1.5p} - grid $S(W).cancel -in $bbox -sticky new -pady 1.5p - grid $S(W).apply -in $bbox -sticky new -pady 1.5p - grid columnconfigure $bbox 0 -weight 1 - - grid $WE.strike -sticky w -padx 7.5p - grid $WE.under -sticky w -padx 7.5p -pady {0 22.5p} - grid columnconfigure $WE 1 -weight 1 - - grid $S(W).font x $S(W).style x $S(W).size x -in $outer -sticky w - grid $S(W).efont x $S(W).estyle x $S(W).esize x $bbox -in $outer -sticky ew - grid $S(W).lfonts x $S(W).lstyles x $S(W).lsizes x ^ -in $outer -sticky news - grid $WE x $WS - - x ^ -in $outer -sticky news -pady {11p 22.5p} - grid configure $bbox -sticky n - grid rowconfigure $outer 2 -weight 1 - grid columnconfigure $outer {1 3 5} -minsize $minsize(gap) - grid columnconfigure $outer {0 2 4} -weight 1 - grid columnconfigure $outer 0 -minsize $minsize(fonts) - grid columnconfigure $outer 2 -minsize $minsize(styles) - grid columnconfigure $outer 4 -minsize $minsize(sizes) - grid columnconfigure $outer 6 -minsize $minsize(bbox) - - grid $outer -sticky news - grid rowconfigure $S(W) 0 -weight 1 - grid columnconfigure $S(W) 0 -weight 1 - - Init $S(-font) - - trace add variable [namespace which -variable S](size) \ - write [namespace code [list Tracer]] - trace add variable [namespace which -variable S](style) \ - write [namespace code [list Tracer]] - trace add variable [namespace which -variable S](font) \ - write [namespace code [list Tracer]] - trace add variable [namespace which -variable S](strike) \ - write [namespace code [list Tracer]] - trace add variable [namespace which -variable S](under) \ - write [namespace code [list Tracer]] + toplevel $S(W) -class TkFontDialog + if {[package provide tcltest] ne {}} { + set ::tk_dialog $S(W) + } + wm withdraw $S(W) + wm title $S(W) $S(-title) + wm transient $S(W) [winfo toplevel $S(-parent)] + + set outer [::ttk::frame $S(W).outer -padding {7.5p 7.5p}] + ::tk::AmpWidget ::ttk::label $S(W).font -text [::msgcat::mc "&Font:"] + ::tk::AmpWidget ::ttk::label $S(W).style -text [::msgcat::mc "Font st&yle:"] + ::tk::AmpWidget ::ttk::label $S(W).size -text [::msgcat::mc "&Size:"] + ttk::entry $S(W).efont -width 18 \ + -textvariable [namespace which -variable S](font) + ttk::entry $S(W).estyle -width 10 \ + -textvariable [namespace which -variable S](style) + ttk::entry $S(W).esize -textvariable [namespace which -variable S](size) \ + -width 3 -validate key -validatecommand {regexp -- {^-*[0-9]*$} %P} + + ttk_slistbox $S(W).lfonts -height 7 -exportselection 0 \ + -selectmode browse -activestyle none \ + -listvariable [namespace which -variable S](fonts) + ttk_slistbox $S(W).lstyles -width 5 -height 7 -exportselection 0 \ + -selectmode browse -activestyle none \ + -listvariable [namespace which -variable S](styles) + ttk_slistbox $S(W).lsizes -width 4 -height 7 -exportselection 0 \ + -selectmode browse -activestyle none \ + -listvariable [namespace which -variable S](sizes) + + set WE $S(W).effects + ::ttk::labelframe $WE -text [::msgcat::mc "Effects"] + ::tk::AmpWidget ::ttk::checkbutton $WE.strike \ + -variable [namespace which -variable S](strike) \ + -text [::msgcat::mc "Stri&keout"] \ + -command [namespace code [list Click strike]] + ::tk::AmpWidget ::ttk::checkbutton $WE.under \ + -variable [namespace which -variable S](under) \ + -text [::msgcat::mc "&Underline"] \ + -command [namespace code [list Click under]] + + set bbox [::ttk::frame $S(W).bbox] + ::ttk::button $S(W).ok -text [::msgcat::mc OK] -default active\ + -command [namespace code [list Done 1]] + ::ttk::button $S(W).cancel -text [::msgcat::mc Cancel] \ + -command [namespace code [list Done 0]] + ::tk::AmpWidget ::ttk::button $S(W).apply -text [::msgcat::mc "&Apply"] \ + -command [namespace code [list Apply]] + wm protocol $S(W) WM_DELETE_WINDOW [namespace code [list Done 0]] + + # Calculate minimum sizes + ttk::scrollbar $S(W).tmpvs + set scroll_width [winfo reqwidth $S(W).tmpvs] + destroy $S(W).tmpvs + set minsize(gap) [::tk::ScaleNum 10] + set minsize(bbox) [winfo reqwidth $S(W).ok] + set minsize(fonts) \ + [expr {[font measure TkDefaultFont "Helvetica"] + $scroll_width}] + set minsize(styles) \ + [expr {[font measure TkDefaultFont "Bold Italic"] + $scroll_width}] + set minsize(sizes) \ + [expr {[font measure TkDefaultFont "-99"] + $scroll_width}] + set min [expr {$minsize(gap) * 4}] + foreach {what width} [array get minsize] { + incr min $width + } + wm minsize $S(W) $min [::tk::ScaleNum 260] + + bind $S(W) <Return> [namespace code [list Done 1]] + bind $S(W) <Escape> [namespace code [list Done 0]] + bind $S(W) <Map> [namespace code [list Visibility %W 1]] + bind $S(W) <Unmap> [namespace code [list Visibility %W 0]] + bind $S(W) <Destroy> [namespace code [list Visibility %W 0]] + bind $S(W).lfonts.list <<ListboxSelect>> [namespace code [list Click font]] + bind $S(W).lstyles.list <<ListboxSelect>> [namespace code [list Click style]] + bind $S(W).lsizes.list <<ListboxSelect>> [namespace code [list Click size]] + bind $S(W) <Alt-Key> [list ::tk::AltKeyInDialog $S(W) %A] + bind $S(W).font <<AltUnderlined>> [list ::focus $S(W).efont] + bind $S(W).style <<AltUnderlined>> [list ::focus $S(W).estyle] + bind $S(W).size <<AltUnderlined>> [list ::focus $S(W).esize] + bind $S(W).apply <<AltUnderlined>> [namespace code [list Apply]] + bind $WE.strike <<AltUnderlined>> [list $WE.strike invoke] + bind $WE.under <<AltUnderlined>> [list $WE.under invoke] + + set WS $S(W).sample + ::ttk::labelframe $WS -text [::msgcat::mc "Sample"] + ::ttk::label $WS.sample -relief sunken -anchor center \ + -textvariable [namespace which -variable S](sampletext) + set S(sample) $WS.sample + grid $WS.sample -sticky news -padx 4.5p -pady 3p + grid rowconfigure $WS 0 -weight 1 + grid columnconfigure $WS 0 -weight 1 + grid propagate $WS 0 + + grid $S(W).ok -in $bbox -sticky new -pady {0 1.5p} + grid $S(W).cancel -in $bbox -sticky new -pady 1.5p + grid $S(W).apply -in $bbox -sticky new -pady 1.5p + grid columnconfigure $bbox 0 -weight 1 + + grid $WE.strike -sticky w -padx 7.5p + grid $WE.under -sticky w -padx 7.5p -pady {0 22.5p} + grid columnconfigure $WE 1 -weight 1 + + grid $S(W).font x $S(W).style x $S(W).size x -in $outer -sticky w + grid $S(W).efont x $S(W).estyle x $S(W).esize x $bbox -in $outer -sticky ew + grid $S(W).lfonts x $S(W).lstyles x $S(W).lsizes x ^ -in $outer -sticky news + grid $WE x $WS - - x ^ -in $outer -sticky news -pady {11p 22.5p} + grid configure $bbox -sticky n + grid rowconfigure $outer 2 -weight 1 + grid columnconfigure $outer {1 3 5} -minsize $minsize(gap) + grid columnconfigure $outer {0 2 4} -weight 1 + grid columnconfigure $outer 0 -minsize $minsize(fonts) + grid columnconfigure $outer 2 -minsize $minsize(styles) + grid columnconfigure $outer 4 -minsize $minsize(sizes) + grid columnconfigure $outer 6 -minsize $minsize(bbox) + + grid $outer -sticky news + grid rowconfigure $S(W) 0 -weight 1 + grid columnconfigure $S(W) 0 -weight 1 + + Init $S(-font) + + trace add variable [namespace which -variable S](size) \ + write [namespace code [list Tracer]] + trace add variable [namespace which -variable S](style) \ + write [namespace code [list Tracer]] + trace add variable [namespace which -variable S](font) \ + write [namespace code [list Tracer]] + trace add variable [namespace which -variable S](strike) \ + write [namespace code [list Tracer]] + trace add variable [namespace which -variable S](under) \ + write [namespace code [list Tracer]] } Init $S(-font) @@ -319,7 +319,7 @@ proc ::tk::fontchooser::Done {ok} { variable S if {! $ok} { - set S(result) "" + set S(result) "" } trace remove variable S(size) write [namespace code [list Tracer]] trace remove variable S(style) write [namespace code [list Tracer]] @@ -328,10 +328,10 @@ proc ::tk::fontchooser::Done {ok} { trace remove variable S(under) write [namespace code [list Tracer]] destroy $S(W) if {$ok} { - if {$S(-command) ne ""} { - uplevel #0 $S(-command) [list $S(result)] - } - event generate $S(-parent) <<TkFontchooserFontChanged>> + if {$S(-command) ne ""} { + uplevel #0 $S(-command) [list $S(result)] + } + event generate $S(-parent) <<TkFontchooserFontChanged>> } } @@ -343,9 +343,9 @@ proc ::tk::fontchooser::Done {ok} { proc ::tk::fontchooser::Apply {} { variable S if {$S(-command) ne ""} { - if {[catch {uplevel #0 $S(-command) [list $S(result)]} err]} { - ::bgerror $err - } + if {[catch {uplevel #0 $S(-command) [list $S(result)]} err]} { + ::bgerror $err + } } event generate $S(-parent) <<TkFontchooserFontChanged>> } @@ -361,25 +361,25 @@ proc ::tk::fontchooser::Init {{defaultFont ""}} { variable S if {$S(first) || $defaultFont ne ""} { - Canonical - if {$defaultFont eq ""} { - set defaultFont [[entry .___e] cget -font] - destroy .___e - } - array set F [font actual $defaultFont] - set S(font) $F(-family) - set S(style) [::msgcat::mc "Regular"] - set S(size) $F(-size) - set S(strike) $F(-overstrike) - set S(under) $F(-underline) - if {$F(-weight) eq "bold" && $F(-slant) eq "italic"} { - set S(style) [::msgcat::mc "Bold Italic"] - } elseif {$F(-weight) eq "bold"} { - set S(style) [::msgcat::mc "Bold"] - } elseif {$F(-slant) eq "italic"} { - set S(style) [::msgcat::mc "Italic"] - } - set S(first) 0 + Canonical + if {$defaultFont eq ""} { + set defaultFont [[entry .___e] cget -font] + destroy .___e + } + array set F [font actual $defaultFont] + set S(font) $F(-family) + set S(style) [::msgcat::mc "Regular"] + set S(size) $F(-size) + set S(strike) $F(-overstrike) + set S(under) $F(-underline) + if {$F(-weight) eq "bold" && $F(-slant) eq "italic"} { + set S(style) [::msgcat::mc "Bold Italic"] + } elseif {$F(-weight) eq "bold"} { + set S(style) [::msgcat::mc "Bold"] + } elseif {$F(-slant) eq "italic"} { + set S(style) [::msgcat::mc "Italic"] + } + set S(first) 0 } } @@ -393,11 +393,11 @@ proc ::tk::fontchooser::Init {{defaultFont ""}} { proc ::tk::fontchooser::Click {who} { variable S if {$who eq "font"} { - set S(font) [$S(W).lfonts get [$S(W).lfonts curselection]] + set S(font) [$S(W).lfonts get [$S(W).lfonts curselection]] } elseif {$who eq "style"} { - set S(style) [$S(W).lstyles get [$S(W).lstyles curselection]] + set S(style) [$S(W).lstyles get [$S(W).lstyles curselection]] } elseif {$who eq "size"} { - set S(size) [$S(W).lsizes get [$S(W).lsizes curselection]] + set S(size) [$S(W).lsizes get [$S(W).lsizes curselection]] } } @@ -412,38 +412,38 @@ proc ::tk::fontchooser::Tracer {var1 var2 op} { variable S # We don't need to process strike and under if {$var2 ni [list strike under]} { - # Make selection in listbox - set value [string tolower $S($var2)] - $S(W).l${var2}s selection clear 0 end - set n [lsearch -exact $S(${var2}s,lcase) $value] - $S(W).l${var2}s selection set $n - if {$n >= 0} { - set S($var2) [lindex $S(${var2}s) $n] - $S(W).e$var2 icursor end - $S(W).e$var2 selection clear - if {[set i [lsearch $S(bad) $var2]] >= 0} { - set S(bad) [lreplace $S(bad) $i $i] - } - } else { - # No match, try prefix - set n [lsearch -glob $S(${var2}s,lcase) "$value*"] - if {$var2 ne "size" || !([regexp -- {^(-[0-9]+|[0-9]+)$} $value] && $value >= -4096 && $value <= 4096)} { - if {[lsearch $S(bad) $var2] < 0} { - lappend S(bad) $var2 - } - } else { - if {[set i [lsearch $S(bad) $var2]] >= 0} { - set S(bad) [lreplace $S(bad) $i $i] - } - } - } - $S(W).l${var2}s see $n + # Make selection in listbox + set value [string tolower $S($var2)] + $S(W).l${var2}s selection clear 0 end + set n [lsearch -exact $S(${var2}s,lcase) $value] + $S(W).l${var2}s selection set $n + if {$n >= 0} { + set S($var2) [lindex $S(${var2}s) $n] + $S(W).e$var2 icursor end + $S(W).e$var2 selection clear + if {[set i [lsearch $S(bad) $var2]] >= 0} { + set S(bad) [lreplace $S(bad) $i $i] + } + } else { + # No match, try prefix + set n [lsearch -glob $S(${var2}s,lcase) "$value*"] + if {$var2 ne "size" || !([regexp -- {^(-[0-9]+|[0-9]+)$} $value] && $value >= -4096 && $value <= 4096)} { + if {[lsearch $S(bad) $var2] < 0} { + lappend S(bad) $var2 + } + } else { + if {[set i [lsearch $S(bad) $var2]] >= 0} { + set S(bad) [lreplace $S(bad) $i $i] + } + } + } + $S(W).l${var2}s see $n } if {[llength $S(bad)] == 0} { - set S(nstate) normal - Update + set S(nstate) normal + Update } else { - set S(nstate) disabled + set S(nstate) disabled } $S(W).ok configure -state $S(nstate) $S(W).apply configure -state $S(nstate) @@ -458,19 +458,19 @@ proc ::tk::fontchooser::Update {} { set S(result) [list $S(font) $S(size)] if {$S(style) eq [::msgcat::mc "Bold"]} { - lappend S(result) bold + lappend S(result) bold } if {$S(style) eq [::msgcat::mc "Italic"]} { - lappend S(result) italic + lappend S(result) italic } if {$S(style) eq [::msgcat::mc "Bold Italic"]} { - lappend S(result) bold italic + lappend S(result) bold italic } if {$S(strike)} { - lappend S(result) overstrike + lappend S(result) overstrike } if {$S(under)} { - lappend S(result) underline + lappend S(result) underline } $S(sample) configure -font $S(result) @@ -484,7 +484,7 @@ proc ::tk::fontchooser::Update {} { proc ::tk::fontchooser::Visibility {w visible} { variable S if {$w eq $S(W)} { - event generate $S(-parent) <<TkFontchooserVisibility>> + event generate $S(-parent) <<TkFontchooserVisibility>> } } @@ -496,17 +496,17 @@ proc ::tk::fontchooser::Visibility {w visible} { proc ::tk::fontchooser::ttk_slistbox {w args} { set f [ttk::frame $w -style FontchooserFrame -padding 1.5p] if {[catch { - listbox $f.list -relief flat -highlightthickness 0 -borderwidth 0 {*}$args - ttk::scrollbar $f.vs -command [list $f.list yview] - $f.list configure -yscrollcommand [list $f.vs set] - grid $f.list $f.vs -sticky news - grid rowconfigure $f 0 -weight 1 - grid columnconfigure $f 0 -weight 1 - interp hide {} $w - interp alias {} $w {} $f.list + listbox $f.list -relief flat -highlightthickness 0 -borderwidth 0 {*}$args + ttk::scrollbar $f.vs -command [list $f.list yview] + $f.list configure -yscrollcommand [list $f.vs set] + grid $f.list $f.vs -sticky news + grid rowconfigure $f 0 -weight 1 + grid columnconfigure $f 0 -weight 1 + interp hide {} $w + interp alias {} $w {} $f.list } err opt]} { - destroy $f - return -options $opt $err + destroy $f + return -options $opt $err } return $w } diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index b6fd8da..42ff2f7 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -220,7 +220,7 @@ if {[tk windowingsystem] eq "x11"} { } if {!([string is integer -strict $badgenumber] && $badgenumber > 0) - && $badgenumber ne "!" && $badgenumber ne ""} { + && $badgenumber ne "!" && $badgenumber ne ""} { return -code error "can't use \"$badgenumber\" as icon badge" } @@ -243,7 +243,7 @@ if {[tk windowingsystem] eq "x11"} { set badge ::tk::icons::9plus-badge } - } + } overlay copy $::tk::icons::base_icon($win) overlay copy $badge -from 0 0 18 18 -to 18 0 diff --git a/library/listbox.tcl b/library/listbox.tcl index 1f93673..5a3acb6 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -163,7 +163,7 @@ bind Listbox <<SelectAll>> { bind Listbox <<SelectNone>> { if {[%W cget -selectmode] ne "browse"} { %W selection clear 0 end - tk::FireListboxSelectEvent %W + tk::FireListboxSelectEvent %W } } @@ -443,7 +443,7 @@ proc ::tk::ListboxDataExtend {w el} { if {$mode eq "extended"} { $w activate $el $w see $el - if {[$w selection includes anchor]} { + if {[$w selection includes anchor]} { ListboxMotion $w $el } } elseif {$mode eq "multiple"} { @@ -518,6 +518,6 @@ proc ::tk::ListboxSelectAll w { proc ::tk::FireListboxSelectEvent w { if {[$w cget -state] eq "normal"} { - event generate $w <<ListboxSelect>> + event generate $w <<ListboxSelect>> } } diff --git a/library/menu.tcl b/library/menu.tcl index 57dc963..9e58749 100644 --- a/library/menu.tcl +++ b/library/menu.tcl @@ -1199,18 +1199,18 @@ if {[tk windowingsystem] eq "aqua"} { incr x [expr {[winfo width $button]}] } default { # flush - if {[$button cget -indicatoron]} { - if {$cx ne ""} { - set x [expr {$cx - [winfo reqwidth $menu] / 2}] - set l [font metrics [$menu cget -font] -linespace] - set y [expr {$cy - $l/2 - 2}] - } else { - incr x [expr {([winfo width $button] - \ + if {[$button cget -indicatoron]} { + if {$cx ne ""} { + set x [expr {$cx - [winfo reqwidth $menu] / 2}] + set l [font metrics [$menu cget -font] -linespace] + set y [expr {$cy - $l/2 - 2}] + } else { + incr x [expr {([winfo width $button] - \ [winfo reqwidth $menu])/ 2}] - } - } else { - incr y [winfo height $button] - } + } + } else { + incr y [winfo height $button] + } } } PostOverPoint $menu $x $y $entry diff --git a/library/msgbox.tcl b/library/msgbox.tcl index 3757019..1ea5833 100644 --- a/library/msgbox.tcl +++ b/library/msgbox.tcl @@ -147,11 +147,11 @@ proc ::tk::MessageBox {args} { set specs { {-default "" "" ""} {-detail "" "" ""} - {-icon "" "" "info"} - {-message "" "" ""} - {-parent "" "" .} - {-title "" "" " "} - {-type "" "" "ok"} + {-icon "" "" "info"} + {-message "" "" ""} + {-parent "" "" .} + {-title "" "" " "} + {-type "" "" "ok"} } tclParseConfigSpec $w $specs "" $args @@ -297,7 +297,7 @@ proc ::tk::MessageBox {args} { if {$windowingsystem eq "aqua"} { ::tk::unsupported::MacWindowStyle style $w moveableModal {} } elseif {$windowingsystem eq "x11"} { - wm attributes $w -type dialog + wm attributes $w -type dialog } ttk::frame $w.bot @@ -325,18 +325,18 @@ proc ::tk::MessageBox {args} { label $w.bitmap -bitmap $data(-icon) -background $bg } else { switch $data(-icon) { - error { - ttk::label $w.bitmap -image ::tk::icons::error - } - info { - ttk::label $w.bitmap -image ::tk::icons::information - } - question { - ttk::label $w.bitmap -image ::tk::icons::question - } - default { - ttk::label $w.bitmap -image ::tk::icons::warning - } + error { + ttk::label $w.bitmap -image ::tk::icons::error + } + info { + ttk::label $w.bitmap -image ::tk::icons::information + } + question { + ttk::label $w.bitmap -image ::tk::icons::question + } + default { + ttk::label $w.bitmap -image ::tk::icons::warning + } } } } @@ -382,16 +382,16 @@ proc ::tk::MessageBox {args} { } grid configure $w.$name -pady 7 } - incr i + incr i # create the binding for the key accelerator, based on the underline # - # set underIdx [$w.$name cget -under] - # if {$underIdx >= 0} { - # set key [string index [$w.$name cget -text] $underIdx] - # bind $w <Alt-[string tolower $key]> [list $w.$name invoke] - # bind $w <Alt-[string toupper $key]> [list $w.$name invoke] - # } + # set underIdx [$w.$name cget -under] + # if {$underIdx >= 0} { + # set key [string index [$w.$name cget -text] $underIdx] + # bind $w <Alt-[string tolower $key]> [list $w.$name invoke] + # bind $w <Alt-[string toupper $key]> [list $w.$name invoke] + # } } bind $w <Alt-Key> [list ::tk::AltKeyInDialog $w %A] diff --git a/library/palette.tcl b/library/palette.tcl index d07f894..43dccc5 100644 --- a/library/palette.tcl +++ b/library/palette.tcl @@ -250,19 +250,19 @@ proc ::tk::RecolorTree {w colors} { proc ::tk::Darken {color percent} { if {$percent < 0} { - return #000000 + return #000000 } elseif {$percent > 200} { - return #ffffff + return #ffffff } elseif {$percent <= 100} { - lassign [winfo rgb . $color] r g b - set r [expr {($r/256)*$percent/100}] - set g [expr {($g/256)*$percent/100}] - set b [expr {($b/256)*$percent/100}] + lassign [winfo rgb . $color] r g b + set r [expr {($r/256)*$percent/100}] + set g [expr {($g/256)*$percent/100}] + set b [expr {($b/256)*$percent/100}] } elseif {$percent > 100} { - lassign [winfo rgb . $color] r g b - set r [expr {255 - ((65535-$r)/256)*(200-$percent)/100}] - set g [expr {255 - ((65535-$g)/256)*(200-$percent)/100}] - set b [expr {255 - ((65535-$b)/256)*(200-$percent)/100}] + lassign [winfo rgb . $color] r g b + set r [expr {255 - ((65535-$r)/256)*(200-$percent)/100}] + set g [expr {255 - ((65535-$g)/256)*(200-$percent)/100}] + set b [expr {255 - ((65535-$b)/256)*(200-$percent)/100}] } return [format #%02x%02x%02x $r $g $b] } diff --git a/library/panedwindow.tcl b/library/panedwindow.tcl index d3dfabc..4dfd671 100644 --- a/library/panedwindow.tcl +++ b/library/panedwindow.tcl @@ -188,7 +188,7 @@ proc ::tk::panedwindow::Cursor {w} { proc ::tk::panedwindow::Leave {w} { variable ::tk::Priv if {[info exists Priv($w,panecursor)]} { - $w configure -cursor $Priv($w,panecursor) - unset Priv($w,panecursor) + $w configure -cursor $Priv($w,panecursor) + unset Priv($w,panecursor) } } diff --git a/library/print.tcl b/library/print.tcl index 3319306..d7fc772 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -76,7 +76,7 @@ namespace eval ::tk::print { #Next, set values. Some are taken from the printer, #some are sane defaults. - if {[info exists printer_name] && $printer_name ne ""} { + if {[info exists printer_name] && $printer_name ne ""} { set printargs(hDC) $printer_name set printargs(pw) $paper_width set printargs(pl) $paper_height diff --git a/library/scale.tcl b/library/scale.tcl index 74d6449..e2b5941 100644 --- a/library/scale.tcl +++ b/library/scale.tcl @@ -143,10 +143,10 @@ proc ::tk::ScaleButtonDown {w x y} { set coords [$w coords] set Priv(deltaX) [expr {$x - [lindex $coords 0]}] set Priv(deltaY) [expr {$y - [lindex $coords 1]}] - switch -exact -- $Priv($w,relief) { - "raised" { $w configure -sliderrelief sunken } - "ridge" { $w configure -sliderrelief groove } - } + switch -exact -- $Priv($w,relief) { + "raised" { $w configure -sliderrelief sunken } + "ridge" { $w configure -sliderrelief groove } + } } } @@ -179,8 +179,8 @@ proc ::tk::ScaleEndDrag {w} { variable ::tk::Priv set Priv(dragging) 0 if {[info exists Priv($w,relief)]} { - $w configure -sliderrelief $Priv($w,relief) - unset Priv($w,relief) + $w configure -sliderrelief $Priv($w,relief) + unset Priv($w,relief) } } @@ -209,8 +209,8 @@ proc ::tk::ScaleIncrement {w dir big repeat} { # the -command script lasts longer than -repeatdelay set clockms [clock milliseconds] if {$repeat eq "again" && - [expr {$clockms - $Priv(clockms)}] > [expr {[$w cget -repeatinterval] * 1.1}]} { - set Priv(clockms) $clockms + [expr {$clockms - $Priv(clockms)}] > [expr {[$w cget -repeatinterval] * 1.1}]} { + set Priv(clockms) $clockms set Priv(afterId) [after [$w cget -repeatinterval] \ [list tk::ScaleIncrement $w $dir $big again]] return @@ -228,20 +228,20 @@ proc ::tk::ScaleIncrement {w dir big repeat} { set inc [$w cget -resolution] } if {([$w cget -from] > [$w cget -to]) ^ ($dir eq "up")} { - if {$inc > 0} { - set inc [expr {-$inc}] - } + if {$inc > 0} { + set inc [expr {-$inc}] + } } else { - if {$inc < 0} { - set inc [expr {-$inc}] - } + if {$inc < 0} { + set inc [expr {-$inc}] + } } # this will run the -command script (if any) during the redrawing # of the scale at idle time $w set [expr {[$w get] + $inc}] if {$repeat eq "again"} { - set Priv(clockms) $clockms + set Priv(clockms) $clockms set Priv(afterId) [after [$w cget -repeatinterval] \ [list tk::ScaleIncrement $w $dir $big again]] } elseif {$repeat eq "initial"} { diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index 29d892f..960eb44 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -477,7 +477,7 @@ proc ::tk::ScrollTopBottom {w x y} { proc ::tk::ScrollButton2Down {w x y} { variable ::tk::Priv if {![winfo exists $w]} { - return + return } set element [$w identify $x $y] if {[string match {arrow[12]} $element]} { @@ -493,8 +493,8 @@ proc ::tk::ScrollButton2Down {w x y} { update idletasks if {[winfo exists $w]} { - $w configure -activerelief sunken - $w activate slider - ScrollStartDrag $w $x $y + $w configure -activerelief sunken + $w activate slider + ScrollStartDrag $w $x $y } } diff --git a/library/spinbox.tcl b/library/spinbox.tcl index 4303141..d29ceb6 100644 --- a/library/spinbox.tcl +++ b/library/spinbox.tcl @@ -347,19 +347,19 @@ proc ::tk::spinbox::ArrowPress {w x y} { variable ::tk::Priv if {[$w cget -state] ne "disabled" && \ - [string match "button*" $Priv(element)]} { - $w selection element $Priv(element) - set Priv(repeated) 0 - set Priv(relief) [$w cget -$Priv(element)relief] - catch {after cancel $Priv(afterId)} - set delay [$w cget -repeatdelay] - if {$delay > 0} { - set Priv(afterId) [after $delay \ - [list ::tk::spinbox::Invoke $w $Priv(element)]] - } - if {[info exists Priv(outsideElement)]} { - unset Priv(outsideElement) - } + [string match "button*" $Priv(element)]} { + $w selection element $Priv(element) + set Priv(repeated) 0 + set Priv(relief) [$w cget -$Priv(element)relief] + catch {after cancel $Priv(afterId)} + set delay [$w cget -repeatdelay] + if {$delay > 0} { + set Priv(afterId) [after $delay \ + [list ::tk::spinbox::Invoke $w $Priv(element)]] + } + if {[info exists Priv(outsideElement)]} { + unset Priv(outsideElement) + } } } diff --git a/library/systray.tcl b/library/systray.tcl index 56cfbf9..eae3183 100644 --- a/library/systray.tcl +++ b/library/systray.tcl @@ -196,7 +196,7 @@ namespace eval ::tk::sysnotify:: { # Fade the window into view. proc _fadeIn {w} { variable defaults - if {![winfo exists $w]} {return} + if {![winfo exists $w]} {return} if {[set alpha [option get $w alpha ""]] eq ""} { set alpha [dict get $defaults alpha] } @@ -214,7 +214,7 @@ namespace eval ::tk::sysnotify:: { # Fade out and destroy window. proc _fadeOut {w} { - if {![winfo exists $w]} {return} + if {![winfo exists $w]} {return} set before [wm attributes $w -alpha] set new [expr { $before - 0.02 }] wm attributes $w -alpha $new @@ -432,16 +432,16 @@ proc ::tk::systray::_check_options {argsList singleOk} { set len [llength $argsList] while {[llength $argsList] > 0} { - set opt [lindex $argsList 0] - if {![dict exists $_options $opt]} { - tailcall return -code error -errorcode {TK SYSTRAY OPTION} \ + set opt [lindex $argsList 0] + if {![dict exists $_options $opt]} { + tailcall return -code error -errorcode {TK SYSTRAY OPTION} \ "unknown option \"$opt\": must be -image, -text, -button1 or -button3" - } - if {[llength $argsList] == 1 && !($len == 1 && $singleOk)} { - tailcall return -code error -errorcode {TK SYSTRAY OPTION} \ + } + if {[llength $argsList] == 1 && !($len == 1 && $singleOk)} { + tailcall return -code error -errorcode {TK SYSTRAY OPTION} \ "missing value for option \"$opt\"" - } - set argsList [lrange $argsList 2 end] + } + set argsList [lrange $argsList 2 end] } } @@ -479,5 +479,5 @@ proc ::tk::sysnotify::sysnotify {title message} { #Thanks to Christian Gollwitzer for the guidance here namespace ensemble configure tk -map \ [dict merge [namespace ensemble configure tk -map] \ - {systray ::tk::systray sysnotify ::tk::sysnotify::sysnotify}] + {systray ::tk::systray sysnotify ::tk::sysnotify::sysnotify}] diff --git a/library/text.tcl b/library/text.tcl index 37aa387..bdaa18d 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -498,7 +498,7 @@ proc ::tk::TextClosestGap {w x y} { # [a9cf210a42] to properly handle selecting and moving the mouse # out of the widget. if {$y < [lindex [$w dlineinfo $pos] 1] || - $x - [lindex $bbox 0] < [lindex $bbox 2]/2} { + $x - [lindex $bbox 0] < [lindex $bbox 2]/2} { return $pos } $w index "$pos + 1 char" @@ -559,7 +559,7 @@ set ::tk::Priv(textanchoruid) 0 proc ::tk::TextAnchor {w} { variable Priv if {![info exists Priv(textanchor,$w)]} { - set Priv(textanchor,$w) tk::anchor[incr Priv(textanchoruid)] + set Priv(textanchor,$w) tk::anchor[incr Priv(textanchoruid)] } return $Priv(textanchor,$w) } @@ -759,9 +759,9 @@ proc ::tk::TextKeySelect {w new} { } $w mark set $anchorname insert } else { - if {[catch {$w index $anchorname}]} { - $w mark set $anchorname insert - } + if {[catch {$w index $anchorname}]} { + $w mark set $anchorname insert + } if {[$w compare $new < $anchorname]} { set first $new set last $anchorname @@ -904,8 +904,8 @@ proc ::tk::TextUpDownLine {w n} { "$Priv(textPosOrig) + [expr {$lines + $n}] displaylines"] set Priv(prevPos) $new if {[$w compare $new == "end display lineend"] \ - || [$w compare $new == "insert display linestart"]} { - set Priv(textPosOrig) $new + || [$w compare $new == "insert display linestart"]} { + set Priv(textPosOrig) $new } return $new } @@ -1045,8 +1045,8 @@ proc ::tk_textCopy w { proc ::tk_textCut w { if {![catch {set data [$w get sel.first sel.last]}]} { - # make <<Cut>> an atomic operation on the Undo stack, - # i.e. separate it from other delete operations on either side + # make <<Cut>> an atomic operation on the Undo stack, + # i.e. separate it from other delete operations on either side set oldSeparator [$w cget -autoseparators] if {([$w cget -state] eq "normal") && $oldSeparator} { $w edit separator @@ -1217,9 +1217,9 @@ proc ::tk::TextUndoRedoProcessMarks {w} { # only consider the temporary marks set by an undo/redo action foreach mark [$w mark names] { - if {[string range $mark 0 11] eq "tk::undoMark"} { - lappend undoMarks $mark - } + if {[string range $mark 0 11] eq "tk::undoMark"} { + lappend undoMarks $mark + } } # transform marks into indices @@ -1248,8 +1248,8 @@ proc ::tk::TextUndoRedoProcessMarks {w} { } set Rmarks [lrange $undoMarks $n [llength $undoMarks]] foreach Lmark $Lmarks Rmark $Rmarks { - lappend indices [$w index $Lmark] [$w index $Rmark] - $w mark unset $Lmark $Rmark + lappend indices [$w index $Lmark] [$w index $Rmark] + $w mark unset $Lmark $Rmark } # process ranges to: @@ -1259,36 +1259,36 @@ proc ::tk::TextUndoRedoProcessMarks {w} { set indices {} for {set i 0} {$i < $nUndoMarks} {incr i 2} { - set il1 [lindex $ind $i] - set ir1 [lindex $ind [expr {$i + 1}]] - lappend indices $il1 $ir1 - - for {set j [expr {$i + 2}]} {$j < $nUndoMarks} {incr j 2} { - set il2 [lindex $ind $j] - set ir2 [lindex $ind [expr {$j + 1}]] - - if {[$w compare $il2 > $ir1]} { - # second range starts after the end of first range - # -> further second ranges do not need to be considered - # because ranges were sorted by increasing first index - set j $nUndoMarks - } else { - if {[$w compare $ir2 > $ir1]} { - # second range overlaps first range - # -> merge them into a single range - set indices [lreplace $indices end-1 end] - lappend indices $il1 $ir2 - } else { - # second range is fully included in first range - # -> ignore it - } - # in both cases above, the second range shall be - # trimmed out from the list of ranges - set ind [lreplace $ind $j [expr {$j + 1}]] - incr j -2 - incr nUndoMarks -2 - } - } + set il1 [lindex $ind $i] + set ir1 [lindex $ind [expr {$i + 1}]] + lappend indices $il1 $ir1 + + for {set j [expr {$i + 2}]} {$j < $nUndoMarks} {incr j 2} { + set il2 [lindex $ind $j] + set ir2 [lindex $ind [expr {$j + 1}]] + + if {[$w compare $il2 > $ir1]} { + # second range starts after the end of first range + # -> further second ranges do not need to be considered + # because ranges were sorted by increasing first index + set j $nUndoMarks + } else { + if {[$w compare $ir2 > $ir1]} { + # second range overlaps first range + # -> merge them into a single range + set indices [lreplace $indices end-1 end] + lappend indices $il1 $ir2 + } else { + # second range is fully included in first range + # -> ignore it + } + # in both cases above, the second range shall be + # trimmed out from the list of ranges + set ind [lreplace $ind $j [expr {$j + 1}]] + incr j -2 + incr nUndoMarks -2 + } + } } return $indices diff --git a/library/tk.tcl b/library/tk.tcl index 3818a73..38c7031 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -11,7 +11,7 @@ # this file, and for a DISCLAIMER OF ALL WARRANTIES. # Verify that we have Tk binary and script components from the same release -package require -exact tk 9.0b4 +package require -exact tk 9.0.1 # Create a ::tk namespace namespace eval ::tk { diff --git a/library/ttk/altTheme.tcl b/library/ttk/altTheme.tcl index 1874e43..156e3c2 100644 --- a/library/ttk/altTheme.tcl +++ b/library/ttk/altTheme.tcl @@ -32,7 +32,7 @@ namespace eval ttk::theme::alt { ttk::style map "." -background \ [list disabled $colors(-frame) active $colors(-activebg)] ttk::style map "." -foreground [list disabled $colors(-disabledfg)] - ttk::style map "." -embossed [list disabled 1] + ttk::style map "." -embossed [list disabled 1] ttk::style configure TButton \ -anchor center -width -11 -padding 0.75p \ @@ -49,12 +49,12 @@ namespace eval ttk::theme::alt { -indicatormargin {0 1.5p 3p 1.5p} -padding 1.5p ttk::style map TCheckbutton -indicatorcolor \ [list pressed $colors(-frame) \ - alternate $colors(-altindicator) \ - disabled $colors(-frame)] + alternate $colors(-altindicator) \ + disabled $colors(-frame)] ttk::style map TRadiobutton -indicatorcolor \ [list pressed $colors(-frame) \ - alternate $colors(-altindicator) \ - disabled $colors(-frame)] + alternate $colors(-altindicator) \ + disabled $colors(-frame)] ttk::style configure TMenubutton \ -width -11 -padding 2.25p -arrowsize 3.75p -relief raised diff --git a/library/ttk/aquaTheme.tcl b/library/ttk/aquaTheme.tcl index a631376..b2c6992 100644 --- a/library/ttk/aquaTheme.tcl +++ b/library/ttk/aquaTheme.tcl @@ -30,8 +30,8 @@ namespace eval ttk::theme::aqua { ttk::style map TButton \ -foreground { pressed white - {alternate !pressed !background} white - disabled systemDisabledControlTextColor} + {alternate !pressed !background} white + disabled systemDisabledControlTextColor} # Menubutton ttk::style configure TMenubutton -anchor center -padding {2 0 0 2} @@ -152,7 +152,7 @@ namespace eval ttk::theme::aqua { ttk::style configure Treeview -rowheight 18 \ -background systemControlBackgroundColor \ -stripedbackground systemControlAlternatingRowColor \ - -foreground systemTextColor \ + -foreground systemTextColor \ -fieldbackground systemTextBackgroundColor ttk::style map Treeview \ -background { diff --git a/library/ttk/clamTheme.tcl b/library/ttk/clamTheme.tcl index f571136..e15d7f3 100644 --- a/library/ttk/clamTheme.tcl +++ b/library/ttk/clamTheme.tcl @@ -115,7 +115,7 @@ namespace eval ttk::theme::clam { ttk::style configure TSpinbox -arrowsize 7.5p -padding {1.5p 0 7.5p 0} ttk::style map TSpinbox \ -background [list readonly $colors(-frame)] \ - -arrowcolor [list disabled $colors(-disabledfg)] \ + -arrowcolor [list disabled $colors(-disabledfg)] \ -bordercolor [list focus $colors(-selectbg)] ttk::style configure TNotebook.Tab -padding {4.5p 1.5p 4.5p 1.5p} diff --git a/library/ttk/combobox.tcl b/library/ttk/combobox.tcl index d593eb1..7590bd2 100644 --- a/library/ttk/combobox.tcl +++ b/library/ttk/combobox.tcl @@ -158,7 +158,7 @@ proc ttk::combobox::Motion {w x y} { variable State ttk::saveCursor $w State(userConfCursor) [ttk::cursor text] if { [$w identify $x $y] eq "textarea" - && [$w instate {!readonly !disabled}] + && [$w instate {!readonly !disabled}] } { ttk::setCursor $w text } else { @@ -367,10 +367,10 @@ proc ttk::combobox::ConfigureListbox {cb} { if {$height > [$cb cget -height]} { set height [$cb cget -height] grid $popdown.sb - grid configure $popdown.l -padx {1 0} + grid configure $popdown.l -padx {1 0} } else { grid remove $popdown.sb - grid configure $popdown.l -padx 1 + grid configure $popdown.l -padx 1 } $popdown.l configure -height $height } diff --git a/library/ttk/cursors.tcl b/library/ttk/cursors.tcl index 9d1e1ae..f284fd5 100644 --- a/library/ttk/cursors.tcl +++ b/library/ttk/cursors.tcl @@ -138,12 +138,12 @@ proc ttk::cursor {name} { proc ttk::setCursor {w name} { variable Cursors if {[info exists Cursors($name)]} { - set cursorname $Cursors($name) + set cursorname $Cursors($name) } else { - set cursorname $name + set cursorname $name } if {[$w cget -cursor] ne $cursorname} { - $w configure -cursor $cursorname + $w configure -cursor $cursorname } } @@ -157,10 +157,10 @@ proc ttk::setCursor {w name} { proc ttk::saveCursor {w saveVar excludeList} { upvar $saveVar sv if {![info exists sv]} { - set sv [$w cget -cursor] + set sv [$w cget -cursor] } if {[$w cget -cursor] ni $excludeList} { - set sv [$w cget -cursor] + set sv [$w cget -cursor] } } diff --git a/library/ttk/fonts.tcl b/library/ttk/fonts.tcl index 5138c89..2210e78 100644 --- a/library/ttk/fonts.tcl +++ b/library/ttk/fonts.tcl @@ -67,20 +67,20 @@ if {!$tip145} {apply {{} { global tcl_platform switch -- [tk windowingsystem] { win32 { - # In safe interps there is no osVersion element. + # In safe interps there is no osVersion element. if {[info exists tcl_platform(osVersion)]} { - if {$tcl_platform(osVersion) >= 5.0} { - set family "Tahoma" - } else { - set family "MS Sans Serif" - } - } else { - if {[lsearch -exact [font families] Tahoma] >= 0} { - set family "Tahoma" - } else { - set family "MS Sans Serif" - } - } + if {$tcl_platform(osVersion) >= 5.0} { + set family "Tahoma" + } else { + set family "MS Sans Serif" + } + } else { + if {[lsearch -exact [font families] Tahoma] >= 0} { + set family "Tahoma" + } else { + set family "MS Sans Serif" + } + } set size 8 font configure TkDefaultFont -family $family -size $size diff --git a/library/ttk/menubutton.tcl b/library/ttk/menubutton.tcl index 8ef8937..4f51549 100644 --- a/library/ttk/menubutton.tcl +++ b/library/ttk/menubutton.tcl @@ -138,7 +138,7 @@ if {[tk windowingsystem] eq "aqua"} { # if we go offscreen to the top, show as 'below' if {$y < [winfo vrooty $mb]} { set y [expr {[winfo vrooty $mb] + [winfo rooty $mb]\ - + [winfo reqheight $mb]}] + + [winfo reqheight $mb]}] } } below { diff --git a/library/ttk/notebook.tcl b/library/ttk/notebook.tcl index 1d59d1e..f896f36 100644 --- a/library/ttk/notebook.tcl +++ b/library/ttk/notebook.tcl @@ -199,7 +199,7 @@ proc ttk::notebook::Cleanup {nb} { set top [winfo toplevel $nb] if {[info exists TLNotebooks($top)]} { set index [lsearch -exact $TLNotebooks($top) $nb] - set TLNotebooks($top) [lreplace $TLNotebooks($top) $index $index] + set TLNotebooks($top) [lreplace $TLNotebooks($top) $index $index] } } diff --git a/library/ttk/panedwindow.tcl b/library/ttk/panedwindow.tcl index d5e25cd..b9a0368 100644 --- a/library/ttk/panedwindow.tcl +++ b/library/ttk/panedwindow.tcl @@ -62,7 +62,7 @@ proc ttk::panedwindow::ResetCursor {w} { variable State ttk::saveCursor $w State(userConfCursor) \ - [list [ttk::cursor hresize] [ttk::cursor vresize]] + [list [ttk::cursor hresize] [ttk::cursor vresize]] if {!$State(pressed)} { ttk::setCursor $w $State(userConfCursor) @@ -73,7 +73,7 @@ proc ttk::panedwindow::SetCursor {w x y} { variable State ttk::saveCursor $w State(userConfCursor) \ - [list [ttk::cursor hresize] [ttk::cursor vresize]] + [list [ttk::cursor hresize] [ttk::cursor vresize]] set cursor $State(userConfCursor) if {[llength [$w identify $x $y]]} { diff --git a/library/ttk/scale.tcl b/library/ttk/scale.tcl index a97440d..1b6882a 100644 --- a/library/ttk/scale.tcl +++ b/library/ttk/scale.tcl @@ -41,14 +41,14 @@ proc ttk::scale::Press {w x y} { switch -glob -- [$w identify $x $y] { *track - - *trough { - set inc [expr {([$w get $x $y] <= [$w get]) ^ ([$w cget -from] > [$w cget -to]) ? -1 : 1}] - ttk::Repeatedly Increment $w $inc - } - *slider { - set State(dragging) 1 - set State(initial) [$w get] - } + *trough { + set inc [expr {([$w get $x $y] <= [$w get]) ^ ([$w cget -from] > [$w cget -to]) ? -1 : 1}] + ttk::Repeatedly Increment $w $inc + } + *slider { + set State(dragging) 1 + set State(initial) [$w get] + } } } @@ -61,14 +61,14 @@ proc ttk::scale::Jump {w x y} { switch -glob -- [$w identify $x $y] { *track - - *trough { - $w set [$w get $x $y] - set State(dragging) 1 - set State(initial) [$w get] - } - *slider { - Press $w $x $y - } + *trough { + $w set [$w get $x $y] + set State(dragging) 1 + set State(initial) [$w get] + } + *slider { + Press $w $x $y + } } } diff --git a/library/ttk/sizegrip.tcl b/library/ttk/sizegrip.tcl index 2a49451..e7b96b2 100644 --- a/library/ttk/sizegrip.tcl +++ b/library/ttk/sizegrip.tcl @@ -26,8 +26,8 @@ namespace eval ttk::sizegrip { height 0 widthInc 1 heightInc 1 - resizeX 1 - resizeY 1 + resizeX 1 + resizeY 1 toplevel {} } } @@ -46,7 +46,7 @@ proc ttk::sizegrip::Press {W X Y} { # If the toplevel is not resizable then bail foreach {State(resizeX) State(resizeY)} [wm resizable $top] break if {!$State(resizeX) && !$State(resizeY)} { - return + return } # Sanity-checks: @@ -83,10 +83,10 @@ proc ttk::sizegrip::Drag {W X Y} { set w $State(width) set h $State(height) if {$State(resizeX)} { - set w [expr {$w + ($X - $State(pressX))/$State(widthInc)}] + set w [expr {$w + ($X - $State(pressX))/$State(widthInc)}] } if {$State(resizeY)} { - set h [expr {$h + ($Y - $State(pressY))/$State(heightInc)}] + set h [expr {$h + ($Y - $State(pressY))/$State(heightInc)}] } if {$w <= 0} { set w 1 } if {$h <= 0} { set h 1 } diff --git a/library/ttk/treeview.tcl b/library/ttk/treeview.tcl index e9fc5ad..02ac4e0 100644 --- a/library/ttk/treeview.tcl +++ b/library/ttk/treeview.tcl @@ -66,17 +66,17 @@ proc ttk::treeview::Keynav {w dir} { set cells [expr {[$w cget -selecttype] eq "cell"}] if {$cells} { - lassign $State(cellAnchor) _ colAnchor - # Just in case, give it a valid value - if {$colAnchor eq ""} { - set colAnchor "#1" - } + lassign $State(cellAnchor) _ colAnchor + # Just in case, give it a valid value + if {$colAnchor eq ""} { + set colAnchor "#1" + } } switch -- $dir { up { if {[set up [$w prev $focus]] eq ""} { - set focus [$w parent $focus] + set focus [$w parent $focus] } else { while {[$w item $up -open] && [llength [$w children $up]]} { set up [lindex [$w children $up] end] @@ -86,7 +86,7 @@ proc ttk::treeview::Keynav {w dir} { } down { if {[$w item $focus -open] && [llength [$w children $focus]]} { - set focus [lindex [$w children $focus] 0] + set focus [lindex [$w children $focus] 0] } else { set up $focus while {$up ne "" && [set down [$w next $up]] eq ""} { @@ -96,46 +96,46 @@ proc ttk::treeview::Keynav {w dir} { } } left { - if {$cells} { - # This assumes that colAnchor is of the "#N" format. - set colNo [string range $colAnchor 1 end] - set firstCol [expr {"tree" ni [$w cget -show]}] - if {$colNo > $firstCol} { - incr colNo -1 - set colAnchor "#$colNo" - } - } elseif {[$w item $focus -open] && [llength [$w children $focus]]} { + if {$cells} { + # This assumes that colAnchor is of the "#N" format. + set colNo [string range $colAnchor 1 end] + set firstCol [expr {"tree" ni [$w cget -show]}] + if {$colNo > $firstCol} { + incr colNo -1 + set colAnchor "#$colNo" + } + } elseif {[$w item $focus -open] && [llength [$w children $focus]]} { CloseItem $w $focus } else { set focus [$w parent $focus] } } right { - if {$cells} { - set colNo [string range $colAnchor 1 end] - set dispCol [$w cget -displaycolumns] - if {$dispCol eq "#all"} { - set lastCol [llength [$w cget -columns]] - } else { - set lastCol [llength $dispCol] - } - if {$colNo < ($lastCol - 1)} { - incr colNo - set colAnchor "#$colNo" - } - } else { - OpenItem $w $focus - } + if {$cells} { + set colNo [string range $colAnchor 1 end] + set dispCol [$w cget -displaycolumns] + if {$dispCol eq "#all"} { + set lastCol [llength [$w cget -columns]] + } else { + set lastCol [llength $dispCol] + } + if {$colNo < ($lastCol - 1)} { + incr colNo + set colAnchor "#$colNo" + } + } else { + OpenItem $w $focus + } } } if {$focus != {}} { - if {$cells} { - set cell [list $focus $colAnchor] - SelectOp $w $focus $cell choose - } else { - SelectOp $w $focus "" choose - } + if {$cells} { + set cell [list $focus $colAnchor] + SelectOp $w $focus $cell choose + } else { + SelectOp $w $focus "" choose + } } } @@ -192,9 +192,9 @@ proc ttk::treeview::ActivateHeading {w heading} { proc ttk::treeview::IdentifyCell {w x y} { set cell {} if {[$w cget -selecttype] eq "cell"} { - # Later handling assumes that the column in the cell ID is of the - # format #N, which is always the case from "identify cell" - set cell [$w identify cell $x $y] + # Later handling assumes that the column in the cell ID is of the + # format #N, which is always the case from "identify cell" + set cell [$w identify cell $x $y] } return $cell } @@ -205,7 +205,7 @@ proc ttk::treeview::IdentifyCell {w x y} { # proc ttk::treeview::Select {w x y op} { if {[set item [$w identify row $x $y]] ne "" } { - set cell [IdentifyCell $w $x $y] + set cell [IdentifyCell $w $x $y] SelectOp $w $item $cell $op } } @@ -231,7 +231,7 @@ proc ttk::treeview::Press {w x y} { tree - cell { set item [$w identify item $x $y] - set cell [IdentifyCell $w $x $y] + set cell [IdentifyCell $w $x $y] SelectOp $w $item $cell choose switch -glob -- [$w identify element $x $y] { @@ -293,7 +293,7 @@ proc ttk::treeview::heading.press {w x y} { proc ttk::treeview::heading.drag {w x y} { variable State if { [$w identify region $x $y] eq "heading" - && [$w identify column $x $y] eq $State(heading) + && [$w identify column $x $y] eq $State(heading) } { $w heading $State(heading) state pressed } else { @@ -340,27 +340,27 @@ proc ttk::treeview::select.choose.extended {w item cell} { proc ttk::treeview::select.toggle.extended {w item cell} { variable State if {$cell ne ""} { - $w cellselection toggle [list $cell] - set State(cellAnchor) $cell - set State(cellAnchorOp) add + $w cellselection toggle [list $cell] + set State(cellAnchor) $cell + set State(cellAnchorOp) add } else { - $w selection toggle [list $item] + $w selection toggle [list $item] } } proc ttk::treeview::select.extend.extended {w item cell} { variable State if {$cell ne ""} { - if {$State(cellAnchor) ne ""} { - $w cellselection $State(cellAnchorOp) $State(cellAnchor) $cell - } else { - BrowseTo $w $item $cell - } + if {$State(cellAnchor) ne ""} { + $w cellselection $State(cellAnchorOp) $State(cellAnchor) $cell + } else { + BrowseTo $w $item $cell + } } else { - if {[set anchor [$w focus]] ne ""} { - $w selection set [between $w $anchor $item] - } else { - BrowseTo $w $item $cell - } + if {[set anchor [$w focus]] ne ""} { + $w selection set [between $w $anchor $item] + } else { + BrowseTo $w $item $cell + } } } @@ -426,7 +426,7 @@ proc ttk::treeview::Toggle {w item} { # don't allow toggling on indicators that # are not present in front of leaf items if {[$w children $item] == {}} { - return + return } # not a leaf, toggle! if {[$w item $item -open]} { @@ -455,9 +455,9 @@ proc ttk::treeview::BrowseTo {w item cell} { set State(cellAnchor) $cell set State(cellAnchorOp) set if {$cell ne ""} { - $w cellselection set [list $cell] + $w cellselection set [list $cell] } else { - $w selection set [list $item] + $w selection set [list $item] } } diff --git a/library/ttk/ttk.tcl b/library/ttk/ttk.tcl index f30788e..debbc0e 100644 --- a/library/ttk/ttk.tcl +++ b/library/ttk/ttk.tcl @@ -177,9 +177,9 @@ proc ttk::LoadThemes {} { aqua aquaTheme.tcl } { if {[lsearch -exact $builtinThemes $theme] >= 0} { - foreach script $scripts { - uplevel #0 [list source -encoding utf-8 [file join $library $script]] - } + foreach script $scripts { + uplevel #0 [list source -encoding utf-8 [file join $library $script]] + } } } } diff --git a/library/ttk/utils.tcl b/library/ttk/utils.tcl index ea0082f..a211b27 100644 --- a/library/ttk/utils.tcl +++ b/library/ttk/utils.tcl @@ -305,7 +305,7 @@ bind TtkScrollable <Shift-Option-MouseWheel> \ # bind TtkScrollable <TouchpadScroll> { if {%# %% 5 != 0} { - return + return } lassign [tk::PreciseScrollDeltas %D] tk::Priv(deltaX) tk::Priv(deltaY) if {$tk::Priv(deltaX) != 0} { diff --git a/library/ttk/vistaTheme.tcl b/library/ttk/vistaTheme.tcl index d5ec4d2..bbddb8c 100644 --- a/library/ttk/vistaTheme.tcl +++ b/library/ttk/vistaTheme.tcl @@ -42,49 +42,49 @@ namespace eval ttk::theme::vista { # Treeview: ttk::style configure Heading -font TkHeadingFont ttk::style configure Treeview -background SystemWindow \ - -stripedbackground System3dLight + -stripedbackground System3dLight ttk::style configure Treeview.Separator \ - -background System3dLight + -background System3dLight ttk::style map Treeview \ -background [list disabled SystemButtonFace \ selected SystemHighlight] \ -foreground [list disabled SystemGrayText \ selected SystemHighlightText] - # Label and Toolbutton + # Label and Toolbutton ttk::style configure TLabelframe.Label -foreground SystemButtonText ttk::style configure Toolbutton -padding 3p - # Combobox + # Combobox ttk::style configure TCombobox -padding 1.5p - ttk::style element create Combobox.border vsapi \ - COMBOBOX 4 {disabled 4 focus 3 active 2 hover 2 {} 1} - ttk::style element create Combobox.background vsapi \ - EDIT 3 {disabled 3 readonly 5 focus 4 hover 2 {} 1} - ttk::style element create Combobox.rightdownarrow vsapi \ - COMBOBOX 6 {disabled 4 pressed 3 active 2 {} 1} \ - -syssize {SM_CXVSCROLL SM_CYVSCROLL} - ttk::style layout TCombobox { - Combobox.border -sticky nswe -border 0 -children { - Combobox.rightdownarrow -side right -sticky ns - Combobox.padding -sticky nswe -children { - Combobox.background -sticky nswe -children { - Combobox.focus -sticky nswe -children { - Combobox.textarea -sticky nswe - } - } - } - } - } - # Vista.Combobox droplist frame - ttk::style element create ComboboxPopdownFrame.background vsapi\ - LISTBOX 3 {disabled 4 active 3 focus 2 {} 1} - ttk::style layout ComboboxPopdownFrame { - ComboboxPopdownFrame.background -sticky news -border 1 -children { - ComboboxPopdownFrame.padding -sticky news - } - } + ttk::style element create Combobox.border vsapi \ + COMBOBOX 4 {disabled 4 focus 3 active 2 hover 2 {} 1} + ttk::style element create Combobox.background vsapi \ + EDIT 3 {disabled 3 readonly 5 focus 4 hover 2 {} 1} + ttk::style element create Combobox.rightdownarrow vsapi \ + COMBOBOX 6 {disabled 4 pressed 3 active 2 {} 1} \ + -syssize {SM_CXVSCROLL SM_CYVSCROLL} + ttk::style layout TCombobox { + Combobox.border -sticky nswe -border 0 -children { + Combobox.rightdownarrow -side right -sticky ns + Combobox.padding -sticky nswe -children { + Combobox.background -sticky nswe -children { + Combobox.focus -sticky nswe -children { + Combobox.textarea -sticky nswe + } + } + } + } + } + # Vista.Combobox droplist frame + ttk::style element create ComboboxPopdownFrame.background vsapi\ + LISTBOX 3 {disabled 4 active 3 focus 2 {} 1} + ttk::style layout ComboboxPopdownFrame { + ComboboxPopdownFrame.background -sticky news -border 1 -children { + ComboboxPopdownFrame.padding -sticky news + } + } ttk::style map TCombobox \ -selectbackground [list !focus SystemWindow] \ -selectforeground [list !focus SystemWindowText] \ @@ -94,136 +94,136 @@ namespace eval ttk::theme::vista { ] \ -focusfill [list {readonly focus} SystemHighlight] - # Entry - ttk::style configure TEntry -padding {1 1 1 1} ;# Needs lookup - ttk::style element create Entry.field vsapi \ - EDIT 6 {disabled 4 focus 3 hover 2 {} 1} -padding {2 2 2 2} - ttk::style element create Entry.background vsapi \ - EDIT 3 {disabled 3 readonly 3 focus 4 hover 2 {} 1} - ttk::style layout TEntry { - Entry.field -sticky news -border 0 -children { - Entry.background -sticky news -children { - Entry.padding -sticky news -children { - Entry.textarea -sticky news - } - } - } - } + # Entry + ttk::style configure TEntry -padding {1 1 1 1} ;# Needs lookup + ttk::style element create Entry.field vsapi \ + EDIT 6 {disabled 4 focus 3 hover 2 {} 1} -padding {2 2 2 2} + ttk::style element create Entry.background vsapi \ + EDIT 3 {disabled 3 readonly 3 focus 4 hover 2 {} 1} + ttk::style layout TEntry { + Entry.field -sticky news -border 0 -children { + Entry.background -sticky news -children { + Entry.padding -sticky news -children { + Entry.textarea -sticky news + } + } + } + } ttk::style map TEntry \ -selectbackground [list !focus SystemWindow] \ -selectforeground [list !focus SystemWindowText] - # Spinbox - ttk::style configure TSpinbox -padding 0 - ttk::style element create Spinbox.field vsapi \ - EDIT 9 {disabled 4 focus 3 hover 2 {} 1} -padding {1 1 1 2} - ttk::style element create Spinbox.background vsapi \ - EDIT 3 {disabled 3 readonly 3 focus 4 hover 2 {} 1} - ttk::style element create Spinbox.innerbg vsapi \ - EDIT 3 {disabled 3 readonly 3 focus 4 hover 2 {} 1}\ - -padding {2 0 15 2} - ttk::style element create Spinbox.uparrow vsapi \ - SPIN 1 {disabled 4 pressed 3 active 2 {} 1} \ - -padding 1 -halfheight 1 \ - -syssize { SM_CXVSCROLL SM_CYVSCROLL } - ttk::style element create Spinbox.downarrow vsapi \ - SPIN 2 {disabled 4 pressed 3 active 2 {} 1} \ - -padding 1 -halfheight 1 \ - -syssize { SM_CXVSCROLL SM_CYVSCROLL } - ttk::style layout TSpinbox { - Spinbox.field -sticky nswe -children { - Spinbox.background -sticky news -children { - Spinbox.padding -sticky news -children { - Spinbox.innerbg -sticky news -children { - Spinbox.textarea - } - } - Spinbox.uparrow -side top -sticky ens - Spinbox.downarrow -side bottom -sticky ens - } - } - } + # Spinbox + ttk::style configure TSpinbox -padding 0 + ttk::style element create Spinbox.field vsapi \ + EDIT 9 {disabled 4 focus 3 hover 2 {} 1} -padding {1 1 1 2} + ttk::style element create Spinbox.background vsapi \ + EDIT 3 {disabled 3 readonly 3 focus 4 hover 2 {} 1} + ttk::style element create Spinbox.innerbg vsapi \ + EDIT 3 {disabled 3 readonly 3 focus 4 hover 2 {} 1}\ + -padding {2 0 15 2} + ttk::style element create Spinbox.uparrow vsapi \ + SPIN 1 {disabled 4 pressed 3 active 2 {} 1} \ + -padding 1 -halfheight 1 \ + -syssize { SM_CXVSCROLL SM_CYVSCROLL } + ttk::style element create Spinbox.downarrow vsapi \ + SPIN 2 {disabled 4 pressed 3 active 2 {} 1} \ + -padding 1 -halfheight 1 \ + -syssize { SM_CXVSCROLL SM_CYVSCROLL } + ttk::style layout TSpinbox { + Spinbox.field -sticky nswe -children { + Spinbox.background -sticky news -children { + Spinbox.padding -sticky news -children { + Spinbox.innerbg -sticky news -children { + Spinbox.textarea + } + } + Spinbox.uparrow -side top -sticky ens + Spinbox.downarrow -side bottom -sticky ens + } + } + } ttk::style map TSpinbox \ -selectbackground [list !focus SystemWindow] \ -selectforeground [list !focus SystemWindowText] - # SCROLLBAR elements (Vista includes a state for 'hover') - ttk::style element create Vertical.Scrollbar.uparrow vsapi \ - SCROLLBAR 1 {disabled 4 pressed 3 active 2 hover 17 {} 1} \ - -syssize {SM_CXVSCROLL SM_CYVSCROLL} - ttk::style element create Vertical.Scrollbar.downarrow vsapi \ - SCROLLBAR 1 {disabled 8 pressed 7 active 6 hover 18 {} 5} \ - -syssize {SM_CXVSCROLL SM_CYVSCROLL} - ttk::style element create Vertical.Scrollbar.trough vsapi \ - SCROLLBAR 7 {disabled 4 pressed 3 active 2 hover 5 {} 1} - ttk::style element create Vertical.Scrollbar.thumb vsapi \ - SCROLLBAR 3 {disabled 4 pressed 3 active 2 hover 5 {} 1} \ - -syssize {SM_CXVSCROLL SM_CYVSCROLL} - ttk::style element create Vertical.Scrollbar.grip vsapi \ - SCROLLBAR 9 {disabled 4 pressed 3 active 2 hover 5 {} 1} \ - -syssize {SM_CXVSCROLL SM_CYVSCROLL} - ttk::style element create Horizontal.Scrollbar.leftarrow vsapi \ - SCROLLBAR 1 {disabled 12 pressed 11 active 10 hover 19 {} 9} \ - -syssize {SM_CXHSCROLL SM_CYHSCROLL} - ttk::style element create Horizontal.Scrollbar.rightarrow vsapi \ - SCROLLBAR 1 {disabled 16 pressed 15 active 14 hover 20 {} 13} \ - -syssize {SM_CXHSCROLL SM_CYHSCROLL} - ttk::style element create Horizontal.Scrollbar.trough vsapi \ - SCROLLBAR 5 {disabled 4 pressed 3 active 2 hover 5 {} 1} - ttk::style element create Horizontal.Scrollbar.thumb vsapi \ - SCROLLBAR 2 {disabled 4 pressed 3 active 2 hover 5 {} 1} \ - -syssize {SM_CXHSCROLL SM_CYHSCROLL} - ttk::style element create Horizontal.Scrollbar.grip vsapi \ - SCROLLBAR 8 {disabled 4 pressed 3 active 2 hover 5 {} 1} + # SCROLLBAR elements (Vista includes a state for 'hover') + ttk::style element create Vertical.Scrollbar.uparrow vsapi \ + SCROLLBAR 1 {disabled 4 pressed 3 active 2 hover 17 {} 1} \ + -syssize {SM_CXVSCROLL SM_CYVSCROLL} + ttk::style element create Vertical.Scrollbar.downarrow vsapi \ + SCROLLBAR 1 {disabled 8 pressed 7 active 6 hover 18 {} 5} \ + -syssize {SM_CXVSCROLL SM_CYVSCROLL} + ttk::style element create Vertical.Scrollbar.trough vsapi \ + SCROLLBAR 7 {disabled 4 pressed 3 active 2 hover 5 {} 1} + ttk::style element create Vertical.Scrollbar.thumb vsapi \ + SCROLLBAR 3 {disabled 4 pressed 3 active 2 hover 5 {} 1} \ + -syssize {SM_CXVSCROLL SM_CYVSCROLL} + ttk::style element create Vertical.Scrollbar.grip vsapi \ + SCROLLBAR 9 {disabled 4 pressed 3 active 2 hover 5 {} 1} \ + -syssize {SM_CXVSCROLL SM_CYVSCROLL} + ttk::style element create Horizontal.Scrollbar.leftarrow vsapi \ + SCROLLBAR 1 {disabled 12 pressed 11 active 10 hover 19 {} 9} \ + -syssize {SM_CXHSCROLL SM_CYHSCROLL} + ttk::style element create Horizontal.Scrollbar.rightarrow vsapi \ + SCROLLBAR 1 {disabled 16 pressed 15 active 14 hover 20 {} 13} \ + -syssize {SM_CXHSCROLL SM_CYHSCROLL} + ttk::style element create Horizontal.Scrollbar.trough vsapi \ + SCROLLBAR 5 {disabled 4 pressed 3 active 2 hover 5 {} 1} + ttk::style element create Horizontal.Scrollbar.thumb vsapi \ + SCROLLBAR 2 {disabled 4 pressed 3 active 2 hover 5 {} 1} \ + -syssize {SM_CXHSCROLL SM_CYHSCROLL} + ttk::style element create Horizontal.Scrollbar.grip vsapi \ + SCROLLBAR 8 {disabled 4 pressed 3 active 2 hover 5 {} 1} - # Progressbar - ttk::style element create Horizontal.Progressbar.pbar vsapi \ - PROGRESS 3 {{} 1} -padding 8 - ttk::style layout Horizontal.TProgressbar { - Horizontal.Progressbar.trough -sticky nswe -children { - Horizontal.Progressbar.pbar -side left -sticky ns - Horizontal.Progressbar.ctext -sticky nesw - } - } - ttk::style element create Vertical.Progressbar.pbar vsapi \ - PROGRESS 3 {{} 1} -padding 8 - ttk::style layout Vertical.TProgressbar { - Vertical.Progressbar.trough -sticky nswe -children { - Vertical.Progressbar.pbar -side bottom -sticky we - } - } + # Progressbar + ttk::style element create Horizontal.Progressbar.pbar vsapi \ + PROGRESS 3 {{} 1} -padding 8 + ttk::style layout Horizontal.TProgressbar { + Horizontal.Progressbar.trough -sticky nswe -children { + Horizontal.Progressbar.pbar -side left -sticky ns + Horizontal.Progressbar.ctext -sticky nesw + } + } + ttk::style element create Vertical.Progressbar.pbar vsapi \ + PROGRESS 3 {{} 1} -padding 8 + ttk::style layout Vertical.TProgressbar { + Vertical.Progressbar.trough -sticky nswe -children { + Vertical.Progressbar.pbar -side bottom -sticky we + } + } - # Scale - ttk::style element create Horizontal.Scale.slider vsapi \ - TRACKBAR 3 {disabled 5 focus 4 pressed 3 active 2 {} 1} \ - -width 6 -height 12 - ttk::style layout Horizontal.TScale { - Scale.focus -sticky nswe -children { - Horizontal.Scale.trough -sticky nswe -children { - Horizontal.Scale.track -sticky we - Horizontal.Scale.slider -side left -sticky {} - } - } - } - ttk::style element create Vertical.Scale.slider vsapi \ - TRACKBAR 6 {disabled 5 focus 4 pressed 3 active 2 {} 1} \ - -width 12 -height 6 - ttk::style layout Vertical.TScale { - Scale.focus -sticky nswe -children { - Vertical.Scale.trough -sticky nswe -children { - Vertical.Scale.track -sticky ns - Vertical.Scale.slider -side top -sticky {} - } - } - } + # Scale + ttk::style element create Horizontal.Scale.slider vsapi \ + TRACKBAR 3 {disabled 5 focus 4 pressed 3 active 2 {} 1} \ + -width 6 -height 12 + ttk::style layout Horizontal.TScale { + Scale.focus -sticky nswe -children { + Horizontal.Scale.trough -sticky nswe -children { + Horizontal.Scale.track -sticky we + Horizontal.Scale.slider -side left -sticky {} + } + } + } + ttk::style element create Vertical.Scale.slider vsapi \ + TRACKBAR 6 {disabled 5 focus 4 pressed 3 active 2 {} 1} \ + -width 12 -height 6 + ttk::style layout Vertical.TScale { + Scale.focus -sticky nswe -children { + Vertical.Scale.trough -sticky nswe -children { + Vertical.Scale.track -sticky ns + Vertical.Scale.slider -side top -sticky {} + } + } + } - # Treeview - ttk::style configure Item -padding {3p 0 0 0} + # Treeview + ttk::style configure Item -padding {3p 0 0 0} ttk::style configure Treeview -indent 15p ttk::setTreeviewRowHeight - package provide ttk::theme::vista 1.0 + package provide ttk::theme::vista 1.0 } } diff --git a/library/ttk/winTheme.tcl b/library/ttk/winTheme.tcl index b0e4701..9b9812a 100644 --- a/library/ttk/winTheme.tcl +++ b/library/ttk/winTheme.tcl @@ -17,7 +17,7 @@ namespace eval ttk::theme::winnative { -font TkDefaultFont ttk::style map "." -foreground {disabled SystemGrayText} - ttk::style map "." -embossed {disabled 1} + ttk::style map "." -embossed {disabled 1} ttk::style configure TButton \ -anchor center -width -11 -relief raised -shiftrelief 1 @@ -81,7 +81,7 @@ namespace eval ttk::theme::winnative { -foreground [list disabled SystemGrayText \ selected SystemHighlightText] - ttk::style configure TProgressbar \ + ttk::style configure TProgressbar \ -background SystemHighlight -borderwidth 0 \ -barsize 22.5p -thickness 11.25p } diff --git a/macosx/tkMacOSXMenubutton.c b/macosx/tkMacOSXMenubutton.c index 6d71ffc..c50eaba 100644 --- a/macosx/tkMacOSXMenubutton.c +++ b/macosx/tkMacOSXMenubutton.c @@ -266,11 +266,11 @@ TkpComputeMenuButtonGeometry( haveImage = 1; } - if (butPtr->text && strlen(butPtr->text) > 0) { + if (butPtr->textObj && Tcl_GetString(butPtr->textObj)[0]) { haveText = 1; Tk_FreeTextLayout(butPtr->textLayout); butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont, - butPtr->text, TCL_INDEX_NONE, butPtr->wrapLength, + Tcl_GetString(butPtr->textObj), TCL_INDEX_NONE, butPtr->wrapLength, butPtr->justify, 0, &butPtr->textWidth, &butPtr->textHeight); txtWidth = butPtr->textWidth; txtHeight = butPtr->textHeight; @@ -731,7 +731,7 @@ TkMacOSXComputeMenuButtonParams( { MacMenuButton *mbPtr = (MacMenuButton *) butPtr; - if (butPtr->image || butPtr->bitmap || butPtr->text) { + if (butPtr->image || butPtr->bitmap || butPtr->textObj) { /* TODO: allow for Small and Mini menubuttons. */ *btnkind = kThemePopupButton; } else { /* This should never happen. */ diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index 3aa6d5b..c20cc81 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -7459,8 +7459,6 @@ ApplyWindowAttributeFlagChanges( } if ((changedAttributes & (kWindowResizableAttribute | kWindowFullZoomAttribute)) || initial) { - [macWindow setShowsResizeIndicator: - !!(newAttributes & kWindowResizableAttribute)]; [[macWindow standardWindowButton:NSWindowZoomButton] setEnabled:(newAttributes & kWindowResizableAttribute) && (newAttributes & kWindowFullZoomAttribute)]; diff --git a/tests/bind.test b/tests/bind.test index 5421e62..efccdf3 100644 --- a/tests/bind.test +++ b/tests/bind.test @@ -6857,7 +6857,7 @@ test bind-34.1 {-warp works relatively to a window} -setup { # pointer should have moved the same amount as the window moved set res 1 foreach pos1 $pointerPos1 pos2 $pointerPos2 { - if {$pos1 != [expr {$pos2 - 400}]} { + if {$pos1 != ($pos2 - 400)} { set res [list $pointerPos1 $pointerPos2] } } diff --git a/tests/canvPsImg.tcl b/tests/canvPsImg.tcl index 1f46eca..273ca7d 100644 --- a/tests/canvPsImg.tcl +++ b/tests/canvPsImg.tcl @@ -53,9 +53,9 @@ foreach v [winfo visualsavailable .] { # The hack below is necessary for some systems, which have more than one # visual of the same type... if {![winfo exists .t.$v]} { - radiobutton .t.$v -text $v -variable visual -value $v \ + radiobutton .t.$v -text $v -variable visual -value $v \ -command BuildTestImage - pack .t.$v -in .t.top.l -anchor w + pack .t.$v -in .t.top.l -anchor w } } diff --git a/tests/constraints.tcl b/tests/constraints.tcl index 8cc1a18..6c671f5 100644 --- a/tests/constraints.tcl +++ b/tests/constraints.tcl @@ -132,51 +132,51 @@ namespace eval tk { namespace export fixfocus proc fixfocus {} { - catch {destroy .focus} - toplevel .focus - wm geometry .focus +0+0 - entry .focus.e - .focus.e insert 0 "fixfocus" - pack .focus.e - update - focus -force .focus.e - destroy .focus + catch {destroy .focus} + toplevel .focus + wm geometry .focus +0+0 + entry .focus.e + .focus.e insert 0 "fixfocus" + pack .focus.e + update + focus -force .focus.e + destroy .focus } - namespace export imageInit imageFinish imageCleanup imageNames - variable ImageNames - proc imageInit {} { - variable ImageNames - if {![info exists ImageNames]} { - set ImageNames [lsearch -all -inline -glob -not [lsort [image names]] ::tk::icons::indicator*] - } - imageCleanup - if {[lsort [image names]] ne $ImageNames} { - return -code error "IMAGE NAMES mismatch: [image names] != $ImageNames" - } - } - proc imageFinish {} { - variable ImageNames + namespace export imageInit imageFinish imageCleanup imageNames + variable ImageNames + proc imageInit {} { + variable ImageNames + if {![info exists ImageNames]} { + set ImageNames [lsearch -all -inline -glob -not [lsort [image names]] ::tk::icons::indicator*] + } + imageCleanup + if {[lsort [image names]] ne $ImageNames} { + return -code error "IMAGE NAMES mismatch: [image names] != $ImageNames" + } + } + proc imageFinish {} { + variable ImageNames set imgs [lsearch -all -inline -glob -not [lsort [image names]] ::tk::icons::indicator*] - if {$imgs ne $ImageNames} { - return -code error "images remaining: [image names] != $ImageNames" - } - imageCleanup - } - proc imageCleanup {} { - variable ImageNames - foreach img [image names] { - if {$img ni $ImageNames} {image delete $img} - } - } - proc imageNames {} { - variable ImageNames - set r {} - foreach img [image names] { - if {$img ni $ImageNames} {lappend r $img} - } - return $r - } + if {$imgs ne $ImageNames} { + return -code error "images remaining: [image names] != $ImageNames" + } + imageCleanup + } + proc imageCleanup {} { + variable ImageNames + foreach img [image names] { + if {$img ni $ImageNames} {image delete $img} + } + } + proc imageNames {} { + variable ImageNames + set r {} + foreach img [image names] { + if {$img ni $ImageNames} {lappend r $img} + } + return $r + } # # CONTROL TIMING ASPECTS OF POINTER WARPING @@ -368,8 +368,8 @@ testConstraint secureserver 0 if {[llength [info commands send]]} { testConstraint secureserver 1 if {[catch {send $app set a 0} msg] == 1} { - if {[string match "X server insecure *" $msg]} { - testConstraint secureserver 0 + if {[string match "X server insecure *" $msg]} { + testConstraint secureserver 0 } } } diff --git a/tests/entry.test b/tests/entry.test index 1be9b7e..82259b1 100644 --- a/tests/entry.test +++ b/tests/entry.test @@ -11,8 +11,6 @@ namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }] - # For xscrollcommand set scrollInfo {} proc scroll args { @@ -893,7 +891,7 @@ test entry-3.23 {EntryWidgetCmd procedure, "delete" widget command} -setup { } -cleanup { destroy .e } -result 0123457890 -test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} -constraints failsOnXQuarz -setup { +test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} -setup { entry .e pack .e ; update idletasks update @@ -1011,7 +1009,7 @@ test entry-3.34 {EntryWidgetCmd procedure, "index" widget command} -setup { } -cleanup { destroy .e } -returnCodes {ok} -match glob -result {*} -test entry-3.35 {EntryWidgetCmd procedure, "index" widget command} -constraints failsOnXQuarz -setup { +test entry-3.35 {EntryWidgetCmd procedure, "index" widget command} -setup { entry .e pack .e ; update idletasks update diff --git a/tests/event.test b/tests/event.test index cd07e95..051894d 100644 --- a/tests/event.test +++ b/tests/event.test @@ -804,7 +804,7 @@ test event-8 {event generate with keysyms corresponding to # (system-independent) known keysym, unless the system # running the test does not have a keyboard with a # diaeresis key. - if {[expr {[lindex $res 3] ne "??"}]} { + if {[lindex $res 3] ne "??"} { # keyboard has a physical diaeresis key and bug is fixed return "OK" } else { diff --git a/tests/spinbox.test b/tests/spinbox.test index 06359bc..87fb946 100644 --- a/tests/spinbox.test +++ b/tests/spinbox.test @@ -11,8 +11,6 @@ namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }] - # For xscrollcommand set scrollInfo {} proc scroll args { @@ -1231,7 +1229,7 @@ test spinbox-3.23 {SpinboxWidgetCmd procedure, "delete" widget command} -setup { } -cleanup { destroy .e } -result 0123457890 -test spinbox-3.24 {SpinboxWidgetCmd procedure, "delete" widget command} -constraints failsOnXQuarz -setup { +test spinbox-3.24 {SpinboxWidgetCmd procedure, "delete" widget command} -setup { spinbox .e pack .e update @@ -1349,7 +1347,7 @@ test spinbox-3.34 {SpinboxWidgetCmd procedure, "index" widget command} -setup { } -cleanup { destroy .e } -returnCodes {ok} -match glob -result {*} -test spinbox-3.35 {SpinboxWidgetCmd procedure, "index" widget command} -constraints failsOnXQuarz -setup { +test spinbox-3.35 {SpinboxWidgetCmd procedure, "index" widget command} -setup { spinbox .e pack .e update diff --git a/tests/textDisp.test b/tests/textDisp.test index 67df965..f39909f 100644 --- a/tests/textDisp.test +++ b/tests/textDisp.test @@ -2222,7 +2222,7 @@ update set totpix [.t count -update -ypixels 1.0 end] # check that the wrapping lines wrap exactly 6 times in total (4 times for line 151, and twice for line 153), # this is an assumption of the upcoming tests -if {[expr {double(($totpix-5*$heightDiff)/$fixedHeight)}] != 206.0} { +if {double(($totpix-5*$heightDiff)/$fixedHeight) != 206.0} { puts "---> Warning: the font actually used by the tests, which is \"[font actual [.t cget -font]]\",\ is too different from the requested \"[.t cget -font]\". Some of the upcoming tests will probably fail." } diff --git a/tests/ttk/treeview.test b/tests/ttk/treeview.test index d92a979..2dc3d17 100644 --- a/tests/ttk/treeview.test +++ b/tests/ttk/treeview.test @@ -688,10 +688,39 @@ test treeview-9.3 {scrolling on see command, requested item is closed} -setup { .top.tree see e update idletasks set after [lindex [.top.vs get] 1] - expr $after < $before + expr ($after < $before) } -cleanup { destroy .top } -result 1 +test treeview-9.4 {no scrolling on see command on an item below a detached item; bbox on such item is empty} -setup { + toplevel .top + ttk::treeview .top.tree -show tree -height 10 -columns {label} \ + -yscrollcommand [list .top.vs set] + ttk::scrollbar .top.vs -command {.top.tree yview} + grid .top.tree -row 0 -column 0 -sticky ns + grid .top.vs -row 0 -column 1 -sticky ns + + foreach dir {A B C D E F G H} { + set id [string cat dir $dir] + .top.tree insert {} end -id $id -text "dir $dir" -open 1 + for {set i 1} {$i <= 10} {incr i} { + .top.tree insert $id end -id $id-$i -text "dir $dir item $i" + } + } + update + .top.tree detach dirD + .top.tree item dirC -open 0 + update +} -body { + set before [lindex [.top.vs get] 1] + .top.tree see dirD-4 + update + set after [lindex [.top.vs get] 1] + set res [expr ($after == $before)] + lappend res [.top.tree bbox dirD-4] +} -cleanup { + destroy .top +} -result {1 {}} test treeview-10.0 "See command" -setup { # Setup common for all 10.* tests diff --git a/tests/ttk/ttk.test b/tests/ttk/ttk.test index 090dab6..afe147e 100644 --- a/tests/ttk/ttk.test +++ b/tests/ttk/ttk.test @@ -345,7 +345,7 @@ test ttk-8.1 "Test -compound options" -body { # Exhaustively test each combination. # Main goal is to make sure no code paths crash. foreach image {icon ""} { - foreach text {"Hi!" ""} { + foreach text {"Hi!" ""} { foreach compound $::compoundStrings { .ctb configure -image $image -text $text -compound $compound update; tick @@ -360,7 +360,7 @@ test ttk-8.2 "Test -compound options with regular button" -body { pack .rtb foreach image {"" icon} { - foreach text {"Hi!" ""} { + foreach text {"Hi!" ""} { foreach compound [lrange $::compoundStrings 2 end] { .rtb configure -image $image -text $text -compound $compound update; tick @@ -372,7 +372,7 @@ tock test ttk-8.3 "Rerun test 8.1" -body { foreach image {icon ""} { - foreach text {"Hi!" ""} { + foreach text {"Hi!" ""} { foreach compound $::compoundStrings { .ctb configure -image $image -text $text -compound $compound update; tick diff --git a/tests/ttk/vsapi.test b/tests/ttk/vsapi.test index 076a815..02f6309 100644 --- a/tests/ttk/vsapi.test +++ b/tests/ttk/vsapi.test @@ -11,7 +11,7 @@ testConstraint xpnative \ test vsapi-1.1 "WINDOW WP_SMALLCLOSEBUTTON" -constraints {xpnative} -body { ttk::style element create smallclose vsapi \ - WINDOW 19 {disabled 4 pressed 3 active 2 {} 1} + WINDOW 19 {disabled 4 pressed 3 active 2 {} 1} ttk::style layout CloseButton {CloseButton.smallclose -sticky news} ttk::button .b -style CloseButton pack .b -expand true -fill both @@ -20,14 +20,14 @@ test vsapi-1.1 "WINDOW WP_SMALLCLOSEBUTTON" -constraints {xpnative} -body { test vsapi-1.2 "EXPLORERBAR EBP_HEADERPIN" -constraints {xpnative} -body { ttk::style element create pin vsapi \ - EXPLORERBAR 3 { - {pressed !selected} 3 - {active !selected} 2 - {pressed selected} 6 - {active selected} 5 - {selected} 4 - {} 1 - } + EXPLORERBAR 3 { + {pressed !selected} 3 + {active !selected} 2 + {pressed selected} 6 + {active selected} 5 + {selected} 4 + {} 1 + } ttk::style layout Explorer.Pin {Explorer.Pin.pin -sticky news} ttk::checkbutton .pin -style Explorer.Pin pack .pin -expand true -fill both @@ -36,9 +36,9 @@ test vsapi-1.2 "EXPLORERBAR EBP_HEADERPIN" -constraints {xpnative} -body { test vsapi-1.3 "EXPLORERBAR EBP_HEADERCLOSE" -constraints {xpnative} -body { ttk::style element create headerclose vsapi \ - EXPLORERBAR 2 {pressed 3 active 2 {} 1} + EXPLORERBAR 2 {pressed 3 active 2 {} 1} ttk::style layout Explorer.CloseButton { - Explorer.CloseButton.headerclose -sticky news + Explorer.CloseButton.headerclose -sticky news } ttk::button .b -style Explorer.CloseButton pack .b -expand true -fill both diff --git a/unix/configure b/unix/configure index 48a2229..2fc6ddd 100755 --- a/unix/configure +++ b/unix/configure @@ -2607,7 +2607,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TK_VERSION=9.0 TK_MAJOR_VERSION=9 TK_MINOR_VERSION=0 -TK_PATCH_LEVEL="b4" +TK_PATCH_LEVEL=".1" VERSION=${TK_VERSION} LOCALES="cs da de el en en_gb eo es fr hu it nl pl pt ru sv" diff --git a/unix/configure.ac b/unix/configure.ac index 10d9a78..b561434 100644 --- a/unix/configure.ac +++ b/unix/configure.ac @@ -26,7 +26,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ TK_VERSION=9.0 TK_MAJOR_VERSION=9 TK_MINOR_VERSION=0 -TK_PATCH_LEVEL="b4" +TK_PATCH_LEVEL=".1" VERSION=${TK_VERSION} LOCALES="cs da de el en en_gb eo es fr hu it nl pl pt ru sv" diff --git a/unix/installManPage b/unix/installManPage index 1e29bb0..f2e2f53 100755 --- a/unix/installManPage +++ b/unix/installManPage @@ -12,8 +12,8 @@ Suffix="" while true; do case $1 in - -s | --symlinks ) Sym="-s " ;; - -z | --compress ) Gzip=$2; shift ;; + -s | --symlinks ) Sym="-s " ;; + -z | --compress ) Gzip=$2; shift ;; -e | --extension ) Gz=$2; shift ;; -x | --suffix ) Suffix=$2; shift ;; -*) cat <<EOF diff --git a/unix/tk.spec b/unix/tk.spec index 1a4b3f3..248b38a 100644 --- a/unix/tk.spec +++ b/unix/tk.spec @@ -4,7 +4,7 @@ Name: tk Summary: Tk graphical toolkit for the Tcl scripting language. -Version: 9.0b4 +Version: 9.0.1 Release: 2 License: BSD Group: Development/Languages diff --git a/unix/tkConfig.h.in b/unix/tkConfig.h.in index ffc0e06..5123575 100644 --- a/unix/tkConfig.h.in +++ b/unix/tkConfig.h.in @@ -19,28 +19,28 @@ /* Compiler support for module scope symbols */ #undef HAVE_HIDDEN -/* Define to 1 if the system has the type `intptr_t'. */ +/* Define to 1 if the system has the type 'intptr_t'. */ #undef HAVE_INTPTR_T /* Define to 1 if you have the <inttypes.h> header file. */ #undef HAVE_INTTYPES_H -/* Define to 1 if you have the `Xft' library (-lXft). */ +/* Define to 1 if you have the 'Xft' library (-lXft). */ #undef HAVE_LIBXFT -/* Define to 1 if you have the `lseek64' function. */ +/* Define to 1 if you have the 'lseek64' function. */ #undef HAVE_LSEEK64 -/* Define to 1 if you have the `open64' function. */ +/* Define to 1 if you have the 'open64' function. */ #undef HAVE_OPEN64 -/* Define to 1 if you have the `posix_spawnattr_setflags' function. */ +/* Define to 1 if you have the 'posix_spawnattr_setflags' function. */ #undef HAVE_POSIX_SPAWNATTR_SETFLAGS -/* Define to 1 if you have the `posix_spawnp' function. */ +/* Define to 1 if you have the 'posix_spawnp' function. */ #undef HAVE_POSIX_SPAWNP -/* Define to 1 if you have the `posix_spawn_file_actions_adddup2' function. */ +/* Define to 1 if you have the 'posix_spawn_file_actions_adddup2' function. */ #undef HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDDUP2 /* Does struct password have a pw_gecos field? */ @@ -82,13 +82,13 @@ /* Is off64_t in <sys/types.h>? */ #undef HAVE_TYPE_OFF64_T -/* Define to 1 if the system has the type `uintptr_t'. */ +/* Define to 1 if the system has the type 'uintptr_t'. */ #undef HAVE_UINTPTR_T /* Define to 1 if you have the <unistd.h> header file. */ #undef HAVE_UNISTD_H -/* Define to 1 if you have the `vfork' function. */ +/* Define to 1 if you have the 'vfork' function. */ #undef HAVE_VFORK /* Is weak import available? */ @@ -139,7 +139,7 @@ /* Is this a static build? */ #undef STATIC_BUILD -/* Define to 1 if all of the C90 standard headers exist (not just the ones +/* Define to 1 if all of the C89 standard headers exist (not just the ones required in a freestanding environment). This macro is provided for backward compatibility; new code need not use it. */ #undef STDC_HEADERS @@ -219,25 +219,25 @@ /* Do we want to use the XOPEN network library? */ #undef _XOPEN_SOURCE_EXTENDED -/* Define to 1 if type `char' is unsigned and your compiler does not +/* Define to 1 if type 'char' is unsigned and your compiler does not predefine this macro. */ #ifndef __CHAR_UNSIGNED__ # undef __CHAR_UNSIGNED__ #endif -/* Define to `__inline__' or `__inline' if that's what the C compiler +/* Define to '__inline__' or '__inline' if that's what the C compiler calls it, or to nothing if 'inline' is not supported under any name. */ #ifndef __cplusplus #undef inline #endif -/* Define to `int' if <sys/types.h> does not define. */ +/* Define to 'int' if <sys/types.h> does not define. */ #undef mode_t /* Define as a signed integer type capable of holding a process identifier. */ #undef pid_t -/* Define to `unsigned int' if <sys/types.h> does not define. */ +/* Define as 'unsigned int' if <stddef.h> doesn't define. */ #undef size_t diff --git a/unix/tkUnixFont.c b/unix/tkUnixFont.c index da75d0f..6ff53cf 100644 --- a/unix/tkUnixFont.c +++ b/unix/tkUnixFont.c @@ -242,6 +242,33 @@ static int SeenName(const char *name, Tcl_DString *dsPtr); /* *------------------------------------------------------------------------- * + * XLoadQueryFontNoXError -- + * + * This function is XLoadQueryFont wrapped in a NULL error handler. + * It is a temporary workaround for ticket [36e379c01b], + * "macOS Ventura, X11 build with XQuartz: crash in XLoadQueryFont", + * which actually is issue #216 in XQuartz: + * https://github.com/XQuartz/XQuartz/issues/216 + * + *------------------------------------------------------------------------- + */ + +static XFontStruct * +XLoadQueryFontNoXError(Display *display, char *name) +{ + XFontStruct *fontStructPtr = NULL; + Tk_ErrorHandler handler; + + /* 45 is the major opcode of X_OpenFont */ + handler = Tk_CreateErrorHandler(display, BadValue, 45, -1, NULL, NULL); + fontStructPtr = XLoadQueryFont(display, name); + Tk_DeleteErrorHandler(handler); + return fontStructPtr; +} + +/* + *------------------------------------------------------------------------- + * * FontPkgCleanup -- * * This function is called when an application is created. It initializes @@ -490,7 +517,7 @@ TkpGetNativeFont( return NULL; } - fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), name); + fontStructPtr = XLoadQueryFontNoXError(Tk_Display(tkwin), (char *)name); if (fontStructPtr == NULL) { /* * Handle all names that look like XLFDs here. Otherwise, when @@ -745,7 +772,7 @@ void TkpGetFontAttrsForChar( Tk_Window tkwin, /* Window on the font's display */ Tk_Font tkfont, /* Font to query */ - int c, /* Character of interest */ + int c, /* Character of interest */ TkFontAttributes *faPtr) /* Output: Font attributes */ { FontAttributes atts; @@ -2603,11 +2630,11 @@ GetScreenFont( snprintf(buf, sizeof(buf), "%.200s-%d-*-*-*-*-*%s", nameList[bestIdx[1]], (int)(-wantPtr->fa.size+0.5), rest); *str = '-'; - fontStructPtr = XLoadQueryFont(display, buf); + fontStructPtr = XLoadQueryFontNoXError(display, buf); bestScore[1] = INT_MAX; } if (fontStructPtr == NULL) { - fontStructPtr = XLoadQueryFont(display, nameList[bestIdx[0]]); + fontStructPtr = XLoadQueryFontNoXError(display, nameList[bestIdx[0]]); if (fontStructPtr == NULL) { /* * This shouldn't happen because the font name is one of the names @@ -2647,9 +2674,9 @@ GetSystemFont( { XFontStruct *fontStructPtr; - fontStructPtr = XLoadQueryFont(display, "fixed"); + fontStructPtr = XLoadQueryFontNoXError(display, "fixed"); if (fontStructPtr == NULL) { - fontStructPtr = XLoadQueryFont(display, "*"); + fontStructPtr = XLoadQueryFontNoXError(display, "*"); if (fontStructPtr == NULL) { Tcl_Panic("TkpGetFontFromAttributes: cannot get any font"); } diff --git a/unix/tkUnixMenubu.c b/unix/tkUnixMenubu.c index c9a33aa..a87bb5b 100644 --- a/unix/tkUnixMenubu.c +++ b/unix/tkUnixMenubu.c @@ -367,7 +367,7 @@ TkpComputeMenuButtonGeometry( if (haveImage == 0 || mbPtr->compound != COMPOUND_NONE) { Tk_FreeTextLayout(mbPtr->textLayout); - mbPtr->textLayout = Tk_ComputeTextLayout(mbPtr->tkfont, mbPtr->text, + mbPtr->textLayout = Tk_ComputeTextLayout(mbPtr->tkfont, mbPtr->textObj ? Tcl_GetString(mbPtr->textObj) : "", TCL_INDEX_NONE, mbPtr->wrapLength, mbPtr->justify, 0, &mbPtr->textWidth, &mbPtr->textHeight); txtWidth = mbPtr->textWidth; diff --git a/unix/tkUnixSysTray.c b/unix/tkUnixSysTray.c index ebcc89d..b6199ae 100644 --- a/unix/tkUnixSysTray.c +++ b/unix/tkUnixSysTray.c @@ -190,8 +190,8 @@ typedef struct { int requestedWidth, requestedHeight; int visible; /* whether XEMBED_MAPPED should be set */ int docked; /* whether an icon should be docked */ - Tcl_Obj *imageStringObj; /* option: -image */ - Tcl_Obj *classStringObj; /* option: -class */ + Tcl_Obj *imageObj; /* option: -image */ + Tcl_Obj *classObj; /* option: -class */ } DockIcon; /* @@ -604,7 +604,7 @@ CreateTrayIconWindow( tkwin = icon->drawingWin = Tk_CreateWindow(icon->interp, icon->tkwin, Tk_Name(icon->tkwin), ""); if (tkwin) { - Tk_SetClass(icon->drawingWin, Tcl_GetString(icon->classStringObj)); + Tk_SetClass(icon->drawingWin, Tcl_GetString(icon->classObj)); Tk_CreateEventHandler(icon->drawingWin,ExposureMask|StructureNotifyMask| ButtonPressMask|ButtonReleaseMask| EnterWindowMask|LeaveWindowMask|PointerMotionMask, @@ -667,11 +667,11 @@ DockToManager( static const Tk_OptionSpec IconOptionSpec[] = { {TK_OPTION_STRING,"-image","image","Image", - NULL, offsetof(DockIcon, imageStringObj), TCL_INDEX_NONE, + NULL, offsetof(DockIcon, imageObj), TCL_INDEX_NONE, TK_OPTION_NULL_OK, NULL, ICON_CONF_IMAGE | ICON_CONF_REDISPLAY}, {TK_OPTION_STRING,"-class","class","Class", - "TrayIcon", offsetof(DockIcon, classStringObj), TCL_INDEX_NONE, + "TrayIcon", offsetof(DockIcon, classObj), TCL_INDEX_NONE, 0, NULL, ICON_CONF_CLASS}, {TK_OPTION_BOOLEAN,"-docked","docked","Docked", "1", TCL_INDEX_NONE, offsetof(DockIcon, docked), 0, NULL, @@ -901,13 +901,13 @@ DisplayIcon( Tk_WindowId(icon->drawingWin), w, h, 32); } if (!icon->photo) { - icon->photo = Tk_FindPhoto(icon->interp, Tcl_GetString(icon->imageStringObj)); + icon->photo = Tk_FindPhoto(icon->interp, Tcl_GetString(icon->imageObj)); } if (!icon->photo && !icon->imageVisualInstance) { Tcl_InterpState saved = Tcl_SaveInterpState(icon->interp, TCL_OK); icon->imageVisualInstance = Tk_GetImage(icon->interp,icon->drawingWin, - Tcl_GetString(icon->imageStringObj), IgnoreImageChange, NULL); + Tcl_GetString(icon->imageObj), IgnoreImageChange, NULL); Tcl_RestoreInterpState(icon->interp,saved); } if (icon->photo && !icon->offscreenImage) { @@ -1418,7 +1418,7 @@ TrayIconUpdate( */ if (mask & ICON_CONF_CLASS) { if (icon->drawingWin) - Tk_SetClass(icon->drawingWin,Tk_GetUid(Tcl_GetString(icon->classStringObj))); + Tk_SetClass(icon->drawingWin,Tk_GetUid(Tcl_GetString(icon->classObj))); } /* * First, ensure right icon visibility. @@ -1517,8 +1517,8 @@ TrayIconConfigureMethod( mask |= addflags; /* now check option validity */ if (mask & ICON_CONF_IMAGE) { - if (icon->imageStringObj) { - newImage = Tk_GetImage(interp, icon->tkwin, Tcl_GetString(icon->imageStringObj), + if (icon->imageObj) { + newImage = Tk_GetImage(interp, icon->tkwin, Tcl_GetString(icon->imageObj), TrayIconImageChanged, icon); if (!newImage) { Tk_RestoreSavedOptions(&saved); diff --git a/win/configure b/win/configure index 85e7d1a..9cc4e72 100755 --- a/win/configure +++ b/win/configure @@ -2410,7 +2410,7 @@ SHELL=/bin/sh TK_VERSION=9.0 TK_MAJOR_VERSION=9 TK_MINOR_VERSION=0 -TK_PATCH_LEVEL="b4" +TK_PATCH_LEVEL=".1" VER=$TK_MAJOR_VERSION$TK_MINOR_VERSION #------------------------------------------------------------------------ @@ -5885,7 +5885,11 @@ else fi fi -eval "TK_STUB_LIB_FILE=${LIBPREFIX}tkstub${LIBSUFFIX}" ; +if test "${TCL_MAJOR_VERSION}" -gt 8 ; then + eval "TK_STUB_LIB_FILE=${LIBPREFIX}tkstub${LIBSUFFIX}" ; +else + eval "TK_STUB_LIB_FILE=${LIBPREFIX}tkstub${VER}${LIBSUFFIX}" ; +fi # FIXME: All of this var junk needs to be done in tcl.m4 !!!! # I left out the other vars that also need to get defined here. # we also need to double check about spaces in path names @@ -5893,7 +5897,7 @@ TK_LIB_FLAG="-l" if test "${TCL_MAJOR_VERSION}" -gt 8 ; then TK_LIB_FLAG="${TK_LIB_FLAG}tcl9" fi -eval "TK_LIB_FLAG=\"${TK_LIB_FLAG}${VER}${LIBFLAGSUFFIX}\"" +eval "TK_LIB_FLAG=\"${TK_LIB_FLAG}tk${VER}${LIBFLAGSUFFIX}\"" TK_LIB_SPEC="-L${libdir} ${TK_LIB_FLAG}" eval "TK_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TK_LIB_FLAG}\"" diff --git a/win/configure.ac b/win/configure.ac index a315389..d8e207a 100644 --- a/win/configure.ac +++ b/win/configure.ac @@ -15,7 +15,7 @@ SHELL=/bin/sh TK_VERSION=9.0 TK_MAJOR_VERSION=9 TK_MINOR_VERSION=0 -TK_PATCH_LEVEL="b4" +TK_PATCH_LEVEL=".1" VER=$TK_MAJOR_VERSION$TK_MINOR_VERSION #------------------------------------------------------------------------ @@ -242,7 +242,11 @@ else fi fi -eval "TK_STUB_LIB_FILE=${LIBPREFIX}tkstub${LIBSUFFIX}" ; +if test "${TCL_MAJOR_VERSION}" -gt 8 ; then + eval "TK_STUB_LIB_FILE=${LIBPREFIX}tkstub${LIBSUFFIX}" ; +else + eval "TK_STUB_LIB_FILE=${LIBPREFIX}tkstub${VER}${LIBSUFFIX}" ; +fi # FIXME: All of this var junk needs to be done in tcl.m4 !!!! # I left out the other vars that also need to get defined here. # we also need to double check about spaces in path names @@ -250,7 +254,7 @@ TK_LIB_FLAG="-l" if test "${TCL_MAJOR_VERSION}" -gt 8 ; then TK_LIB_FLAG="${TK_LIB_FLAG}tcl9" fi -eval "TK_LIB_FLAG=\"${TK_LIB_FLAG}${VER}${LIBFLAGSUFFIX}\"" +eval "TK_LIB_FLAG=\"${TK_LIB_FLAG}tk${VER}${LIBFLAGSUFFIX}\"" TK_LIB_SPEC="-L${libdir} ${TK_LIB_FLAG}" eval "TK_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TK_LIB_FLAG}\"" |