diff --git a/ChangeLog b/ChangeLog index 94cabc1c..2c1ca702 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,6 +1,6 @@ A NOTE ON THE CHANGELOG: Starting in early 2011, Tk source code has been under the management of -fossil, hosted at http://core.tcl.tk/tk/ . Fossil presents a "Timeline" +fossil, hosted at http://core.tcl-lang.org/tk/ . Fossil presents a "Timeline" view of changes made that is superior in every way to a hand edited log file. Because of this, many Tk developers are now out of the habit of maintaining this log file. You may still find useful things in it, but the Timeline is diff --git a/README b/README index a26667cd..0c41c9c9 100644 --- a/README +++ b/README @@ -1,5 +1,5 @@ README: Tk - This is the Tk 8.6.8 source distribution. + This is the Tk 8.6.9 source distribution. http://sourceforge.net/projects/tcl/files/Tcl/ You can get any source release of Tk from the URL above. @@ -12,7 +12,7 @@ toolkit implemented with the Tcl scripting language. For details on features, incompatibilities, and potential problems with this release, see the Tcl/Tk 8.6 Web page at - http://www.tcl.tk/software/tcltk/8.6.html + http://www.tcl-lang.org/software/tcltk/8.6.html or refer to the "changes" file in this directory, which contains a historical record of all changes to Tk. @@ -21,11 +21,11 @@ Tk is maintained, enhanced, and distributed freely by the Tcl community. Source code development and tracking of bug reports and feature requests takes place at: - http://core.tcl.tk/tk/ + http://core.tcl-lang.org/tk/ with the Tcl Developer Xchange at: - http://www.tcl.tk/ + http://www.tcl-lang.org/ Tk is a freely available open source package. You can do virtually anything you like with it, such as modifying it, redistributing it, diff --git a/changes b/changes index 2532748c..29e992a5 100644 --- a/changes +++ b/changes @@ -1315,7 +1315,7 @@ ISO Latin-1 character set. result across the execution of binding scripts. Otherwise if an event triggers in the middle of some other script (e.g. a destroy event during window creation, because there was an error in the creation command), -the intepreter's result gets lost. +the interpreter's result gets lost. 2/19/94 (bug fix) Fixed bug in dealing with results of sent command that could cause them to get lost in some situations. @@ -7370,7 +7370,7 @@ Tk Cocoa 2.0: More drawing internals refinements (culler,walzer) 2017-03-11 (bug)[775273] artifacts on Ubuntu 16.10+ (nemethi) -2n017-03-26 (TIP 464) Win multimedia keys support (fassel,vogel) +2017-03-26 (TIP 464) Win multimedia keys support (fassel,vogel) 2017-03-29 (bug)[28a3c3] test BTree memleaks plugged (anonymous) @@ -7495,3 +7495,77 @@ Tk Cocoa 2.0: More drawing internals refinements (culler,walzer) 2017-12-18 (bug)[b77626] Make [tk busy -cursor] silent no-op on macOS (vogel) --- Released 8.6.8, December 22, 2017 --- http://core.tcl.tk/tk/ for details + +2017-12-31 (bug)[aa7679] crash using window after master destroyed (vogel) + +2017-12-31 (bug)[6525e1] encoding leak in tkMacOSXProcessFiles (werner) + +2018-01-07 (bug)[925262] New option -state for ttk::scale (vogel) + +2018-01-07 (bug)[fa8de7] Crash [ttk::checkbutton .x -variable {}] (werner) + +2018-01-16 (bug)[382712] Crash in [event generate . ] (werner) + +2018-01-19 (bug)[657c38] Crash in menu destroy with checkbutton entry (werner) + +2018-01-25 (bug)[de156e] Deny PRIMARY selection access in safe interps (nash) + +2018-01-28 (bug)[b68710] Fixes in [text] bindings (nash) + +2018-01-28 (bug)[e20d5c] Stop failures of textTag-18.1 (vogel) + +2018-02-04 (bug)[5d991b] Fortify var traces against deleted vars (vogel) + +2018-02-10 (bug)[1821174] Stop RenderBadPicture X error (werner) + +2018-02-11 (bug)[502e74] Stop X errors on untrusted connections (werner) + +2018-03-07 (bug)[71b131] Regression in Tk_DrawChars() (werner,cramer) + +2018-04-03 (bug)[59fccb] menu flaws when empty menubar clicked (vogel,mcdonald) + +2018-04-28 (bug)[7423f9] improved legacy support for [tk_setPalette] (bll) + +2018-04-30 (bug)[6d5042] enable [tk inactive] on Mac OSX (culler) + +2018-05-03 (bug)[75d38f] fix touchpad scroll of listbox on win notebook (vogel) + +2018-06-16 (bug)[de01e2] Crash in [$text replace] (vogel) + +2018-07-04 (bug)[6ca257] Fix [wm resizable] on Mac OSX (culler) + +2018-07-04 (bug)[135696] Crash in [wm transient] (culler) + +2018-07-04 (bug)[309b42] Improve ttk high-contrast-mode support (lemburg,vogel) + +2018-07-17 (bug)[1088825] fix frame-2.17,3.9,3.10 on Mac (vogel) + +2018-07-27 (bug)[fabed1] GIF photo support for "deferred clear code" (vogel) + +2018-08-08 (feature) Modern full-screen support on Mac OSX (walzer) + +2018-08-12 (bug)[1875c1] scrollbar on Mac OSX (walzer) + +2018-08-14 (bug)[1ba71a] KeyRelease events on Mac OSX(walzer) + +2018-09-02 (bug)[3441086] error message in layout-2 (vogel) + +2018-09-07 (bug)[05bd7f] vista theme for combobox (vogel) + +2018-09-08 (bug)[382712] crash in KeyPress event handling (vogel,werner) + +2018-09-08 (bug)[6fcaaa] insertion cursor visibility in ttk::entry (nemethi) + +2018-09-30 (bug)[822923] cascade menu indicator color (mcdonald) + +2018-10-06 (bug)[9658bc] borderwidth calculations on menu items (vogel) + +2018-10-17 (bug)[ca403f] treeview border drawing (vogel) + +2018-10-17 (bug)[4b555a] hang in [$text search -all] (vogel,danckaert) + +2018-10-30 (new platform) port to system changes in Mac OSX 10.14 (culler) + +2018-11-04 (bug)[6b22d4] [treeview] binding fix (ohagan) + +- Released 8.6.9, November 16, 2018 - http://core.tcl-lang.org/tk/ for details - diff --git a/compat/stdlib.h b/compat/stdlib.h index 0ad4c1d1..6900be33 100644 --- a/compat/stdlib.h +++ b/compat/stdlib.h @@ -29,7 +29,6 @@ extern char * malloc(unsigned int numBytes); extern void qsort(void *base, int n, int size, int (*compar)( const void *element1, const void *element2)); extern char * realloc(char *ptr, unsigned int numBytes); -extern double strtod(const char *string, char **endPtr); extern long strtol(const char *string, char **endPtr, int base); extern unsigned long strtoul(const char *string, char **endPtr, int base); diff --git a/doc/Inactive.3 b/doc/Inactive.3 index 5528fa52..0d2a1b7a 100644 --- a/doc/Inactive.3 +++ b/doc/Inactive.3 @@ -14,7 +14,7 @@ Tk_GetUserInactiveTime, Tk_ResetUserInactiveTime \- discover user inactivity tim long \fBTk_GetUserInactiveTime(\fIdisplay\fB)\fR .sp -\fBTk_GetUserInactiveTime(\fIdisplay\fB)\fR +\fBTk_ResetUserInactiveTime(\fIdisplay\fB)\fR .SH ARGUMENTS .AS Display *display .AP Display *display in @@ -26,8 +26,8 @@ reset. \fBTk_GetUserInactiveTime\fR returns the number of milliseconds that have passed since the last user interaction (usually via keyboard or mouse) with the respective display. On systems and displays that do not -support querying the user inactiviy time, \fB\-1\fR is returned. -\fBTk_GetUserInactiveTime\fR resets the user inactivity timer of the +support querying the user inactivity time, \fB\-1\fR is returned. +\fBTk_ResetUserInactiveTime\fR resets the user inactivity timer of the given display to zero. On windowing systems that do not support multiple displays \fIdisplay\fR can be passed as \fBNULL\fR. .SH KEYWORDS diff --git a/doc/chooseDirectory.n b/doc/chooseDirectory.n index 8528ddbd..e441d78e 100644 --- a/doc/chooseDirectory.n +++ b/doc/chooseDirectory.n @@ -17,6 +17,13 @@ The procedure \fBtk_chooseDirectory\fR pops up a dialog box for the user to select a directory. The following \fIoption\-value\fR pairs are possible as command line arguments: .TP +\fB\-command\fR \fIstring\fR +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. +.TP \fB\-initialdir\fR \fIdirname\fR Specifies that the directories in \fIdirectory\fR should be displayed when the dialog pops up. If this parameter is not specified, @@ -27,6 +34,10 @@ user-selected directory for the application. If the parameter specifies a relative path, the return value will convert the relative path to an absolute path. .TP +\fB\-message\fR \fIstring\fR +Specifies a message to include in the client area of the dialog. +This is only available on Mac OS X. +.TP \fB\-mustexist\fR \fIboolean\fR Specifies whether the user may specify non-existent directories. If this parameter is true, then the user may only select directories that diff --git a/doc/event.n b/doc/event.n index 54ad42e7..51097949 100644 --- a/doc/event.n +++ b/doc/event.n @@ -338,7 +338,9 @@ This is sent to a text widget when the selection in the widget is changed. .TP \fB<>\fR -This is sent to a text widget when the ttk (Tile) theme changed. +This is sent to all widgets when the ttk theme changed. The ttk +widgets listen to this event and redisplay themselves when it fires. +The legacy widgets ignore this event. .TP \fB<>\fR This is sent to a widget when the focus enters the widget because of a diff --git a/doc/getOpenFile.n b/doc/getOpenFile.n index 39bce416..d2323de2 100644 --- a/doc/getOpenFile.n +++ b/doc/getOpenFile.n @@ -35,6 +35,13 @@ whether the existing file should be overwritten or not. The following \fIoption\-value\fR pairs are possible as command line arguments to these two commands: .TP +\fB\-command\fR \fIstring\fR +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. +.TP \fB\-confirmoverwrite\fR \fIboolean\fR Configures how the Save dialog reacts when the selected file already exists, and saving would overwrite it. A true value requests a diff --git a/doc/messageBox.n b/doc/messageBox.n index 5ce17451..6bcbc099 100644 --- a/doc/messageBox.n +++ b/doc/messageBox.n @@ -24,6 +24,12 @@ buttons. Then it returns the symbolic name of the selected button. .PP The following option-value pairs are supported: .TP +\fB\-command\fR \fIstring\fR +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. +.TP \fB\-default\fR \fIname\fR . \fIName\fR gives the symbolic name of the default button for diff --git a/doc/panedwindow.n b/doc/panedwindow.n index fcfebf41..40997a94 100644 --- a/doc/panedwindow.n +++ b/doc/panedwindow.n @@ -29,6 +29,17 @@ drawn as squares. May be any value accepted by \fBTk_GetPixels\fR. Specifies a desired height for the overall panedwindow widget. May be any value accepted by \fBTk_GetPixels\fR. If an empty string, the widget will be made high enough to allow all contained widgets to have their natural height. +.OP \-opaqueresize opaqueResize OpaqueResize +Specifies whether panes should be resized as a sash is moved (true), +or if resizing should be deferred until the sash is placed (false). +In the latter case, a +.QW ghost +version of the sash is displayed during the resizing to show where the +panes will be resized to when releasing the mouse button. This +.QW ghost +version of the sash is the proxy. It's rendering can be configured +using the \fB-proxybackground\fR, \fB-proxyborderwidth\fR and +\fB-proxyrelief\fR options. .OP \-proxybackground proxyBackground ProxyBackground Background color to use when drawing the proxy. If an empty string, the value of the \fB-background\fR option will be used. @@ -39,9 +50,6 @@ Specifies the borderwidth of the proxy. May be any value accepted by Relief to use when drawing the proxy. May be any of the standard Tk relief values. If an empty string, the value of the \fB-sashrelief\fR option will be used. -.OP \-opaqueresize opaqueResize OpaqueResize -Specifies whether panes should be resized as a sash is moved (true), -or if resizing should be deferred until the sash is placed (false). .OP \-sashcursor sashCursor SashCursor Mouse cursor to use when over a sash. If null, \fBsb_h_double_arrow\fR will be used for horizontal panedwindows, and @@ -133,56 +141,6 @@ index of the sash or handle, and a word indicating whether it is over a sash or a handle, such as {0 sash} or {2 handle}. If the point is over any other part of the panedwindow, the result is an empty list. .TP -\fIpathName \fBproxy \fR?\fIargs\fR? -. -This command is used to query and change the position of the sash -proxy, used for rubberband-style pane resizing. It can take any of -the following forms: -.RS -.TP -\fIpathName \fBproxy coord\fR -. -Return a list containing the x and y coordinates of the most recent -proxy location. -.TP -\fIpathName \fBproxy forget\fR -. -Remove the proxy from the display. -.TP -\fIpathName \fBproxy place \fIx y\fR -. -Place the proxy at the given \fIx\fR and \fIy\fR coordinates. -.RE -.TP -\fIpathName \fBsash \fR?\fIargs\fR? -This command is used to query and change the position of sashes in the -panedwindow. It can take any of the following forms: -.RS -.TP -\fIpathName \fBsash coord \fIindex\fR -. -Return the current x and y coordinate pair for the sash given by -\fIindex\fR. \fIIndex\fR must be an integer between 0 and 1 less than -the number of panes in the panedwindow. The coordinates given are -those of the top left corner of the region containing the sash. -.TP -\fIpathName \fBsash dragto \fIindex x y\fR -. -This command computes the difference between the given coordinates and the -coordinates given to the last \fBsash mark\fR command for the given -sash. It then moves that sash the computed difference. The return -value is the empty string. -.TP -\fIpathName \fBsash mark \fIindex x y\fR -. -Records \fIx\fR and \fIy\fR for the sash given by \fIindex\fR; used in -conjunction with later \fBsash dragto\fR commands to move the sash. -.TP -\fIpathName \fBsash place \fIindex x y\fR -. -Place the sash given by \fIindex\fR at the given coordinates. -.RE -.TP \fIpathName \fBpanecget \fIwindow option\fR . Query a management option for \fIwindow\fR. \fIOption\fR may be any @@ -310,6 +268,56 @@ panedwindow. \fISize\fR may be any value accepted by \fBTk_GetPixels\fR. \fIpathName \fBpanes\fR . Returns an ordered list of the widgets managed by \fIpathName\fR. +.TP +\fIpathName \fBproxy \fR?\fIargs\fR? +. +This command is used to query and change the position of the sash +proxy, used for rubberband-style pane resizing. It can take any of +the following forms: +.RS +.TP +\fIpathName \fBproxy coord\fR +. +Return a list containing the x and y coordinates of the most recent +proxy location. +.TP +\fIpathName \fBproxy forget\fR +. +Remove the proxy from the display. +.TP +\fIpathName \fBproxy place \fIx y\fR +. +Place the proxy at the given \fIx\fR and \fIy\fR coordinates. +.RE +.TP +\fIpathName \fBsash \fR?\fIargs\fR? +This command is used to query and change the position of sashes in the +panedwindow. It can take any of the following forms: +.RS +.TP +\fIpathName \fBsash coord \fIindex\fR +. +Return the current x and y coordinate pair for the sash given by +\fIindex\fR. \fIIndex\fR must be an integer between 0 and 1 less than +the number of panes in the panedwindow. The coordinates given are +those of the top left corner of the region containing the sash. +.TP +\fIpathName \fBsash dragto \fIindex x y\fR +. +This command computes the difference between the given coordinates and the +coordinates given to the last \fBsash mark\fR command for the given +sash. It then moves that sash the computed difference. The return +value is the empty string. +.TP +\fIpathName \fBsash mark \fIindex x y\fR +. +Records \fIx\fR and \fIy\fR for the sash given by \fIindex\fR; used in +conjunction with later \fBsash dragto\fR commands to move the sash. +.TP +\fIpathName \fBsash place \fIindex x y\fR +. +Place the sash given by \fIindex\fR at the given coordinates. +.RE .SH "RESIZING PANES" .PP A pane is resized by grabbing the sash (or sash handle if present) and diff --git a/doc/radiobutton.n b/doc/radiobutton.n index 086a4e20..fceb1ecf 100644 --- a/doc/radiobutton.n +++ b/doc/radiobutton.n @@ -63,9 +63,8 @@ alternative relief is used when the mouse cursor is over the radiobutton. The empty string is the default value. .OP \-selectcolor selectColor Background Specifies a background color to use when the button is selected. -If \fB\-indicatoron\fR is true then the color applies to the indicator. -Under Windows, this color is used as the background for the indicator -regardless of the select state. +If \fBindicatorOn\fR is true then the color is used as the background for +the indicator regardless of the select state. If \fB\-indicatoron\fR is false, this color is used as the background for the entire widget, in place of \fB\-background\fR or \fB\-activeBackground\fR, whenever the widget is selected. diff --git a/doc/selection.n b/doc/selection.n index f5bb660d..ec678fa4 100644 --- a/doc/selection.n +++ b/doc/selection.n @@ -140,6 +140,26 @@ If \fIcommand\fR is specified, it is a Tcl script to execute when some other window claims ownership of the selection away from \fIwindow\fR. \fISelection\fR defaults to PRIMARY. .RE +.SH WIDGET FACILITIES +.PP +The \fBtext\fR, \fBentry\fR, \fBttk::entry\fR, \fBlistbox\fR, \fBspinbox\fR and \fBttk::spinbox\fR widgets have the option \fB\-exportselection\fR. If a widget has this option set to boolean \fBtrue\fR, then (in an unsafe interpreter) a selection made in the widget is automatically written to the \fBPRIMARY\fR selection. +.PP +A GUI event, for example \fB<>\fR, can copy the \fBPRIMARY\fR selection to certain widgets. This copy is implemented by a widget binding to the event. The binding script makes appropriate calls to the \fBselection\fR command. +.PP +.SH PORTABILITY ISSUES +.PP +On X11, the \fBPRIMARY\fR selection is a system-wide feature of the X server, allowing communication between different processes that are X11 clients. +.PP +On Windows, the \fBPRIMARY\fR selection is not provided by the system, but only by Tk, and so it is shared only between windows of a master interpreter and its unsafe slave interpreters. It is not shared between interpreters in different processes or different threads. Each master interpreter has a separate \fBPRIMARY\fR selection that is shared only with its unsafe slaves. +.PP +.SH SECURITY +.PP +A safe interpreter cannot read from the \fBPRIMARY\fR selection because its \fBselection\fR command is hidden. For this reason the \fBPRIMARY\fR selection cannot be written to the Tk widgets of a safe interpreter. +.PP +A Tk widget can have its option \fB\-exportselection\fR set to boolean \fBtrue\fR, but in a safe interpreter this option has no effect: writing from the widget to the \fBPRIMARY\fR selection is disabled. +.PP +These are security features. A safe interpreter may run untrusted code, and it is a security risk if this untrusted code can read or write the \fBPRIMARY\fR selection used by other interpreters. +.PP .SH EXAMPLES .PP On X11 platforms, one of the standard selections available is the diff --git a/doc/ttk_button.n b/doc/ttk_button.n index b84ca483..cf47a1a7 100644 --- a/doc/ttk_button.n +++ b/doc/ttk_button.n @@ -39,13 +39,6 @@ The default is \fBnormal\fR. Depending on the theme, the default button may be displayed with an extra highlight ring, or with a different border color. .RE -.OP \-width width Width -If greater than zero, specifies how much space, in character widths, -to allocate for the text label. -If less than zero, specifies a minimum width. -If zero or unspecified, the natural width of the text label is used. -Note that some themes may specify a non-zero \fB\-width\fR -in the style. .\" Not documented -- may go away .\" .OP \-padding padding Padding .\" .OP \-foreground foreground Foreground @@ -64,13 +57,49 @@ Invokes the command associated with the button. .PP \fBTtk::button\fR widgets support the \fBToolbutton\fR style in all standard themes, which is useful for creating widgets for toolbars. -.SH "COMPATIBILITY OPTIONS" -.OP \-state state State -May be set to \fBnormal\fR or \fBdisabled\fR to control the -\fBdisabled\fR state bit. This is a -.QW write-only -option: setting it changes the widget state, but the \fBstate\fR -widget command does not affect the state option. +.SH "STYLING OPTIONS" +.PP +The class name for a \fBttk::button\fP is \fBTButton\fP. +.PP +Dynamic states: \fBactive\fP, \fBdisabled\fP, \fBpressed\fP, \fBreadonly\fP. +.PP +\fBTButton\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-anchor\fP \fIanchor\fP +.br +\fB\-background\fP \fIcolor\fP +.br +\fB\-bordercolor\fP \fIcolor\fP +.br +\fB\-darkcolor\fP \fIcolor\fP +.br +\fB\-foreground\fP \fIcolor\fP +.br +\fB\-font\fP \fIfont\fP +.br +\fB\-highlightcolor\fP \fIcolor\fP +.br +\fB\-highlightthickness\fP \fIamount\fP +.br +\fB\-lightcolor\fP \fIcolor\fP +.br +\fB\-padding\fP \fIpadding\fP +.br +\fB\-relief\fP \fIrelief\fP +.br +\fB\-shiftrelief\fP \fIamount\fP +.RS +\fB\-shiftrelief\fP specifies how far the button contents are +shifted down and right in the \fIpressed\fP state. +This action provides additional skeumorphic feedback. +.RE +\fB\-width\fP \fIamount\fP +.PP +Some options are only available for specific themes. +.PP +See the \fBttk::style\fP manual page for information on how to configure +ttk styles. .SH "SEE ALSO" ttk::widget(n), button(n) .SH "KEYWORDS" diff --git a/doc/ttk_checkbutton.n b/doc/ttk_checkbutton.n index ed79f5ad..a18a8866 100644 --- a/doc/ttk_checkbutton.n +++ b/doc/ttk_checkbutton.n @@ -68,6 +68,34 @@ selection.) .PP \fBTtk::checkbutton\fR widgets support the \fBToolbutton\fR style in all standard themes, which is useful for creating widgets for toolbars. +.SH "STYLING OPTIONS" +.PP +The class name for a \fBttk::checkbutton\fP is \fBTCheckbutton\fP. +.PP +Dynamic states: \fBactive\fP, \fBalternate\fP, \fBdisabled\fP, +\fBpressed\fP, \fBselected\fP, \fBreadonly\fP. +.PP +\fBTCheckbutton\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-background\fP \fIcolor\fP +.br +\fB\-foreground\fP \fIcolor\fP +.br +\fB\-indicatorbackground\fP \fIcolor\fP +.br +\fB\-indicatorcolor\fP \fIcolor\fP +.br +\fB\-indicatormargin\fP \fIpadding\fP +.br +\fB\-indicatorrelief\fP \fIrelief\fP +.br +\fB\-padding\fP \fIpadding\fP +.PP +Some options are only available for specific themes. +.PP +See the \fBttk::style\fP manual page for information on how to configure +ttk styles. .SH "SEE ALSO" ttk::widget(n), ttk::radiobutton(n), checkbutton(n) .SH "KEYWORDS" diff --git a/doc/ttk_combobox.n b/doc/ttk_combobox.n index 5e5b3fc3..9c014093 100644 --- a/doc/ttk_combobox.n +++ b/doc/ttk_combobox.n @@ -110,6 +110,83 @@ The combobox widget generates a \fB<>\fR virtual event when the user selects an element from the list of values. If the selection action unposts the listbox, this event is delivered after the listbox is unposted. +.SH "STYLING OPTIONS" +.PP +The class name for a \fBttk::combobox\fP is \fBTCombobox\fP. +The \fBttk::combobox\fP uses the \fBentry\fP and +\fBlistbox\fP widgets internally. +The listbox frame has a class name of \fBComboboxPopdownFrame\fP. +.PP +Dynamic states: \fBdisabled\fP, \fBfocus\fP, \fBpressed\fP, \fBreadonly\fP. +.PP +\fBTCombobox\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-arrowcolor\fP \fIcolor\fP +.br +\fB\-background\fP \fIcolor\fP +.br +\fB\-bordercolor\fP \fIcolor\fP +.br +\fB\-darkcolor\fP \fIcolor\fP +.br +\fB\-focusfill\fP \fIcolor\fP +.br +\fB\-foreground\fP \fIcolor\fP +.br +\fB\-fieldbackground\fP \fIcolor\fP +.RS +Can only be changed when using non-native and non-graphical themes. +.RE +\fB\-insertwidth\fP \fIamount\fP +.br +\fB\-lightcolor\fP \fIcolor\fP +.br +\fB\-padding\fP \fIpadding\fP +.br +\fB\-postoffset\fP \fIpadding\fP +.br +\fB\-selectbackground\fP \fIcolor\fP +.RS +Text entry select background. +.RE +\fB\-selectforeground\fP \fIcolor\fP +.RS +Text entry select foreground. +.RE +.PP +The \fBttk::combobox\fP popdown listbox cannot be configured using +\fBttk::style\fP nor via the widget \fBconfigure\fP command. The listbox +can be configured using the option database. +.PP +option add *TCombobox*Listbox.background \fIcolor\fP +.br +option add *TCombobox*Listbox.font \fIfont\fP +.br +option add *TCombobox*Listbox.foreground \fIcolor\fP +.br +option add *TCombobox*Listbox.selectBackground \fIcolor\fP +.br +option add *TCombobox*Listbox.selectForeground \fIcolor\fP +.PP +To configure a specific listbox (subject to future change): +.CS +set popdown [ttk::combobox::PopdownWindow .mycombobox] +$popdown.f.l configure \-font \fIfont\fP +.CE +.PP +\fBComboboxPopdownFrame\fP +styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-borderwidth\fP \fIamount\fP +.br +\fB\-relief\fP \fIrelief\fP +.PP +Some options are only available for specific themes. +.PP +See the \fBttk::style\fP manual page for information on how to configure +ttk styles. .SH "SEE ALSO" ttk::widget(n), ttk::entry(n) .SH KEYWORDS diff --git a/doc/ttk_entry.n b/doc/ttk_entry.n index 984e9571..d7526704 100644 --- a/doc/ttk_entry.n +++ b/doc/ttk_entry.n @@ -461,6 +461,47 @@ and a different background is used in the \fBreadonly\fR state. .PP The entry widget sets the \fBinvalid\fR state if revalidation fails, and clears it whenever validation succeeds. +.SH "STYLING OPTIONS" +.PP +The class name for a \fBttk::entry\fP is \fBTEntry\fP. +.PP +Dynamic states: \fBdisabled\fP, \fBfocus\fP, \fBreadonly\fP. +.PP +\fBTEntry\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-background\fP \fIcolor\fP +.RS +When using the aqua theme (Mac OS X), changes the \fB\-fieldbackground\fP. +.RE +\fB\-bordercolor\fP \fIcolor\fP +.br +\fB\-darkcolor\fP \fIcolor\fP +.br +\fB\-fieldbackground\fP \fIcolor\fP +.RS +Does not work with the aqua theme (Mac OS X). +.br +Some themes use a graphical background and their field background colors cannot be changed. +.RE +\fB\-foreground\fP \fIcolor\fP +.br +\fB\-insertwidth\fP \fIamount\fP +.br +\fB\-lightcolor\fP \fIcolor\fP +.br +\fB\-padding\fP \fIpadding\fP +.br +\fB\-relief\fP \fIrelief\fP +.br +\fB\-selectbackground\fP \fIcolor\fP +.br +\fB\-selectborderwidth\fP \fIamount\fP +.br +\fB\-selectforeground\fP \fIcolor\fP +.PP +See the \fBttk::style\fP manual page for information on how to configure +ttk styles. .SH "SEE ALSO" ttk::widget(n), entry(n) .SH KEYWORDS diff --git a/doc/ttk_frame.n b/doc/ttk_frame.n index d2bd7456..8702592a 100644 --- a/doc/ttk_frame.n +++ b/doc/ttk_frame.n @@ -45,6 +45,19 @@ by the GM's requested size will normally take precedence over the \fBframe\fR widget's \fB\-width\fR and \fB\-height\fR options. \fBpack propagate\fR and \fBgrid propagate\fR can be used to change this. +.SH "STYLING OPTIONS" +.PP +The class name for a \fBttk::frame\fP is \fBTFrame\fP. +.PP +\fBTFrame\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-background\fP \fIcolor\fP +.PP +Some options are only available for specific themes. +.PP +See the \fBttk::style\fP manual page for information on how to configure +ttk styles. .SH "SEE ALSO" ttk::widget(n), ttk::labelframe(n), frame(n) .SH "KEYWORDS" diff --git a/doc/ttk_label.n b/doc/ttk_label.n index 9c28d7c3..aae95e62 100644 --- a/doc/ttk_label.n +++ b/doc/ttk_label.n @@ -19,7 +19,7 @@ The label may be linked to a Tcl variable to automatically change the displayed text. .SO ttk_widget \-class \-compound \-cursor -\-image \-padding \-style \-takefocus +\-image \-padding \-state \-style \-takefocus \-text \-textvariable \-underline \-width .SE @@ -63,6 +63,25 @@ than the specified value. Supports the standard widget commands \fBconfigure\fR, \fBcget\fR, \fBidentify\fR, \fBinstate\fR, and \fBstate\fR; see \fIttk::widget(n)\fR. +.SH "STYLING OPTIONS" +.PP +The class name for a \fBttk::label\fP is \fBTLabel\fP. +.PP +Dynamic states: \fBdisabled\fP, \fBreadonly\fP. +.PP +\fBTLabel\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-background\fP \fIcolor\fP +.br +\fB\-foreground\fP \fIcolor\fP +.br +\fB\-font\fP \fIfont\fP +.PP +Some options are only available for specific themes. +.PP +See the \fBttk::style\fP manual page for information on how to configure +ttk styles. .SH "SEE ALSO" ttk::widget(n), label(n) '\" Local Variables: diff --git a/doc/ttk_labelframe.n b/doc/ttk_labelframe.n index 4c2c8d5e..12f0b895 100644 --- a/doc/ttk_labelframe.n +++ b/doc/ttk_labelframe.n @@ -65,6 +65,46 @@ If specified, the widget's requested height in pixels. Supports the standard widget commands \fBconfigure\fR, \fBcget\fR, \fBidentify\fR, \fBinstate\fR, and \fBstate\fR; see \fIttk::widget(n)\fR. +.SH "STYLING OPTIONS" +.PP +The class name for a \fBttk::labelframe\fP is \fBTLabelframe\fP. +The text label +has a class of \fBTLabelframe.Label\fP. +.PP +Dynamic states: \fBdisabled\fP, \fBreadonly\fP. +.PP +\fBTLabelframe\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-background\fP \fIcolor\fP +.br +\fB\-bordercolor\fP \fIcolor\fP +.br +\fB\-borderwidth\fP \fIamount\fP +.br +\fB\-darkcolor\fP \fIcolor\fP +.br +\fB\-labelmargins\fP \fIamount\fP +.br +\fB\-labeloutside\fP \fIboolean\fP +.br +\fB\-lightcolor\fP \fIcolor\fP +.br +\fB\-relief\fP \fIrelief\fP +.PP +\fBTLabelframe.Label\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-background\fP \fIcolor\fP +.br +\fB\-font\fP \fIfont\fP +.br +\fB\-foreground\fP \fIcolor\fP +.PP +Some options are only available for specific themes. +.PP +See the \fBttk::style\fP manual page for information on how to configure +ttk styles. .SH "SEE ALSO" ttk::widget(n), ttk::frame(n), labelframe(n) .SH "KEYWORDS" diff --git a/doc/ttk_menubutton.n b/doc/ttk_menubutton.n index 698bd0c2..76d3829e 100644 --- a/doc/ttk_menubutton.n +++ b/doc/ttk_menubutton.n @@ -45,6 +45,33 @@ methods. No other widget methods are used. .PP \fBTtk::menubutton\fR widgets support the \fBToolbutton\fR style in all standard themes, which is useful for creating widgets for toolbars. +.SH "STYLING OPTIONS" +.PP +The class name for a \fBttk::menubutton\fP is \fBTMenubutton\fP. +.PP +Dynamic states: \fBactive\fP, \fBdisabled\fP, \fBreadonly\fP. +.PP +\fBTMenubutton\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-arrowsize\fP \fIamount\fP +.br +\fB\-background\fP \fIcolor\fP +.br +\fB\-foreground\fP \fIcolor\fP +.br +\fB\-font\fP \fIfont\fP +.br +\fB\-padding\fP \fIpadding\fP +.br +\fB\-relief\fP \fIrelief\fP +.br +\fB\-width\fP \fIamount\fP +.PP +Some options are only available for specific themes. +.PP +See the \fBttk::style\fP manual page for information on how to configure +ttk styles. .SH "SEE ALSO" ttk::widget(n), menu(n), menubutton(n) .SH "KEYWORDS" diff --git a/doc/ttk_notebook.n b/doc/ttk_notebook.n index e2ae1371..19416b52 100644 --- a/doc/ttk_notebook.n +++ b/doc/ttk_notebook.n @@ -208,6 +208,56 @@ pack [\fBttk::notebook\fR .nb] \&.nb select .nb.f2 ttk::notebook::enableTraversal .nb .CE +.SH "STYLING OPTIONS" +.PP +The class name for a \fBttk::notebook\fP is \fBTNotebook\fP. The tab has +a class name of \fBTNotebook.Tab\fP +.PP +Dynamic states: \fBactive\fP, \fBdisabled\fP, \fBselected\fP. +.PP +\fBTNotebook\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-background\fP \fIcolor\fP +.br +\fB\-bordercolor\fP \fIcolor\fP +.br +\fB\-darkcolor\fP \fIcolor\fP +.br +\fB\-foreground\fP \fIcolor\fP +.br +\fB\-lightcolor\fP \fIcolor\fP +.br +\fB\-padding\fP \fIpadding\fP +.br +\fB\-tabmargins\fP \fIpadding\fP +.br +\fB\-tabposition\fP \fIside\fP +.br +.PP +\fBTNotebook.Tab\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-background\fP \fIcolor\fP +.br +\fB\-bordercolor\fP \fIcolor\fP +.br +\fB\-expand\fP \fIpadding\fP +.RS +Defines how much the tab grows in size. Usually used with the +\fBselected\fP dynamic state. \fB\-tabmargins\fP should be +set appropriately so that there is room for the tab growth. +.RE +\fB\-font\fP \fIfont\fP +.br +\fB\-foreground\fP \fIcolor\fP +.br +\fB\-padding\fP \fIpadding\fP +.PP +Some options are only available for specific themes. +.PP +See the \fBttk::style\fP manual page for information on how to configure +ttk styles. .SH "SEE ALSO" ttk::widget(n), grid(n) .SH "KEYWORDS" diff --git a/doc/ttk_panedwindow.n b/doc/ttk_panedwindow.n index 4ba42bcb..d6b3ea34 100644 --- a/doc/ttk_panedwindow.n +++ b/doc/ttk_panedwindow.n @@ -106,12 +106,55 @@ and the total size of the widget. .\" depending on which changed most recently. Returns the new position of sash number \fIindex\fR. .\" Full story: new position may be different than the requested position. +.PP +The panedwindow widget also supports the following generic \fBttk::widget\fR +widget subcommands (see \fIttk::widget(n)\fR for details): +.DS +.ta 5.5c 11c +\fBcget\fR \fBconfigure\fR +\fBinstate\fR \fBstate\fR +.DE .SH "VIRTUAL EVENTS" .PP The panedwindow widget generates an \fB<>\fR virtual event on LeaveNotify/NotifyInferior events, because Tk does not execute binding scripts for events when the pointer crosses from a parent to a child. The panedwindow widget needs to know when that happens. +.SH "STYLING OPTIONS" +.PP +The class name for a \fBttk::panedwindow\fP is \fBTPanedwindow\fP. The +sash has a class name of \fBSash\fP. +.PP +\fBTPanedwindow\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-background\fP \fIcolor\fP +.PP +\fBSash\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-background\fP \fIcolor\fP +.br +\fB\-bordercolor\fP \fIcolor\fP +.br +\fB\-gripcount\fP \fIcount\fP +.br +\fB\-handlepad\fP \fIamount\fP +.br +\fB\-handlesize\fP \fIamount\fP +.br +\fB\-lightcolor\fP \fIcolor\fP +.br +\fB\-sashpad\fP \fIamount\fP +.br +\fB\-sashrelief\fP \fIrelief\fP +.br +\fB\-sashthickness\fP \fIamount\fP +.PP +Some options are only available for specific themes. +.PP +See the \fBttk::style\fP manual page for information on how to configure +ttk styles. .SH "SEE ALSO" ttk::widget(n), ttk::notebook(n), panedwindow(n) '\" Local Variables: diff --git a/doc/ttk_progressbar.n b/doc/ttk_progressbar.n index 1945f704..16871234 100644 --- a/doc/ttk_progressbar.n +++ b/doc/ttk_progressbar.n @@ -24,17 +24,24 @@ that something is happening. \-style .SE .SH "WIDGET-SPECIFIC OPTIONS" -.OP \-orient orient Orient -One of \fBhorizontal\fR or \fBvertical\fR. -Specifies the orientation of the progress bar. .OP \-length length Length Specifies the length of the long axis of the progress bar (width if horizontal, height if vertical). -.OP \-mode mode Mode -One of \fBdeterminate\fR or \fBindeterminate\fR. .OP \-maximum maximum Maximum A floating point number specifying the maximum \fB\-value\fR. Defaults to 100. +.OP \-mode mode Mode +One of \fBdeterminate\fR or \fBindeterminate\fR. +.OP \-orient orient Orient +One of \fBhorizontal\fR or \fBvertical\fR. +Specifies the orientation of the progress bar. +.OP \-phase phase Phase +Read-only option. +The widget periodically increments the value of this option +whenever the \fB\-value\fR is greater than 0 and, +in \fIdeterminate\fR mode, less than \fB\-maximum\fR. +This option may be used by the current theme +to provide additional animation effects. .OP \-value value Value The current value of the progress bar. In \fIdeterminate\fR mode, this represents the amount of work completed. @@ -47,13 +54,6 @@ The name of a global Tcl variable which is linked to the \fB\-value\fR. If specified, the \fB\-value\fR of the progress bar is automatically set to the value of the variable whenever the latter is modified. -.OP \-phase phase Phase -Read-only option. -The widget periodically increments the value of this option -whenever the \fB\-value\fR is greater than 0 and, -in \fIdeterminate\fR mode, less than \fB\-maximum\fR. -This option may be used by the current theme -to provide additional animation effects. .SH "WIDGET COMMAND" .PP .TP @@ -86,6 +86,35 @@ Increments the \fB\-value\fR by \fIamount\fR. \fIpathName \fBstop\fR Stop autoincrement mode: cancels any recurring timer event initiated by \fIpathName \fBstart\fR. +.SH "STYLING OPTIONS" +.PP +The class name for a \fBttk::progressbar\fP is \fBTProgressbar\fP. +.PP +\fBTProgressbar\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-background\fP \fIcolor\fP +.br +\fB\-bordercolor\fP \fIcolor\fP +.br +\fB\-darkcolor\fP \fIcolor\fP +.br +\fB\-lightcolor\fP \fIcolor\fP +.br +\fB\-maxphase\fP +.RS +For the aqua theme. +.RE +\fB\-period\fP +.RS +For the aqua theme. +.RE +\fB\-troughcolor\fP \fIcolor\fP +.PP +Some options are only available for specific themes. +.PP +See the \fBttk::style\fP manual page for information on how to configure +ttk styles. .SH "SEE ALSO" ttk::widget(n) '\" Local Variables: diff --git a/doc/ttk_radiobutton.n b/doc/ttk_radiobutton.n index 5b4dcce3..1344ae22 100644 --- a/doc/ttk_radiobutton.n +++ b/doc/ttk_radiobutton.n @@ -65,6 +65,34 @@ selection.) .PP \fBTtk::radiobutton\fR widgets support the \fBToolbutton\fR style in all standard themes, which is useful for creating widgets for toolbars. +.SH "STYLING OPTIONS" +.PP +The class name for a \fBttk::radiobutton\fP is \fBTRadiobutton\fP. +.PP +Dynamic states: \fBactive\fP, \fBalternate\fP, \fBdisabled\fP, +\fBpressed\fP, \fBreadonly\fP, \fBselected\fP. +.PP +\fBTRadiobutton\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-background\fP \fIcolor\fP +.br +\fB\-foreground\fP \fIcolor\fP +.br +\fB\-indicatorbackground\fP \fIcolor\fP +.br +\fB\-indicatorcolor\fP \fIcolor\fP +.br +\fB\-indicatormargin\fP \fIpadding\fP +.br +\fB\-indicatorrelief\fP \fIrelief\fP +.br +\fB\-padding\fP \fIpadding\fP +.PP +Some options are only available for specific themes. +.PP +See the \fBttk::style\fP manual page for information on how to configure +ttk styles. .SH "SEE ALSO" ttk::widget(n), ttk::checkbutton(n), radiobutton(n) .SH "KEYWORDS" diff --git a/doc/ttk_scale.n b/doc/ttk_scale.n index b52f9ac3..4e16999c 100644 --- a/doc/ttk_scale.n +++ b/doc/ttk_scale.n @@ -91,6 +91,35 @@ Modify or query the widget state; see \fIttk::widget(n)\fR. Get the coordinates corresponding to \fIvalue\fR, or the coordinates corresponding to the current value of the \fB\-value\fR option if \fIvalue\fR is omitted. +.SH "STYLING OPTIONS" +.PP +The class name for a \fBttk::scale\fP is \fBTProgressbar\fP. +.PP +Dynamic states: \fBactive\fP. +.PP +\fBTProgressbar\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-background\fP \fIcolor\fP +.br +\fB\-borderwidth\fP \fIamount\fP +.br +\fB\-darkcolor\fP \fIcolor\fP +.br +\fB\-groovewidth\fP \fIamount\fP +.br +\fB\-lightcolor\fP \fIcolor\fP +.br +\fB\-sliderwidth\fP \fIamount\fP +.br +\fB\-troughcolor\fP \fIcolor\fP +.br +\fB\-troughrelief\fP \fIrelief\fP +.PP +Some options are only available for specific themes. +.PP +See the \fBttk::style\fP manual page for information on how to configure +ttk styles. .SH "SEE ALSO" ttk::widget(n), scale(n) .SH KEYWORDS diff --git a/doc/ttk_scrollbar.n b/doc/ttk_scrollbar.n index 03d09f2c..49681a18 100644 --- a/doc/ttk_scrollbar.n +++ b/doc/ttk_scrollbar.n @@ -154,6 +154,33 @@ grid $f.hsb \-row 1 \-column 0 \-sticky nsew grid columnconfigure $f 0 \-weight 1 grid rowconfigure $f 0 \-weight 1 .CE +.SH "STYLING OPTIONS" +.PP +The class name for a \fBttk::scrollbar\fP is \fBTScrollbar\fP. +.PP +Dynamic states: \fBactive\fP, \fBdisabled\fP. +.PP +\fBTScrollbar\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-arrowcolor\fP \fIcolor\fP +.br +\fB\-background\fP \fIcolor\fP +.br +\fB\-bordercolor\fP \fIcolor\fP +.br +\fB\-darkcolor\fP \fIcolor\fP +.br +\fB\-foreground\fP \fIcolor\fP +.br +\fB\-lightcolor\fP \fIcolor\fP +.br +\fB\-troughcolor\fP \fIcolor\fP +.PP +Some options are only available for specific themes. +.PP +See the \fBttk::style\fP manual page for information on how to configure +ttk styles. .SH "SEE ALSO" ttk::widget(n), scrollbar(n) .SH KEYWORDS diff --git a/doc/ttk_separator.n b/doc/ttk_separator.n index fea27012..4befb0ab 100644 --- a/doc/ttk_separator.n +++ b/doc/ttk_separator.n @@ -17,7 +17,7 @@ ttk::separator \- Separator bar A \fBttk::separator\fR widget displays a horizontal or vertical separator bar. .SO ttk_widget -\-class \-cursor \-state +\-class \-cursor \-style \-takefocus .SE .SH "WIDGET-SPECIFIC OPTIONS" @@ -29,6 +29,20 @@ Specifies the orientation of the separator. Separator widgets support the standard \fBcget\fR, \fBconfigure\fR, \fBidentify\fR, \fBinstate\fR, and \fBstate\fR methods. No other widget methods are used. +.PP +.SH "STYLING OPTIONS" +.PP +The class name for a \fBttk::separator\fP is \fBTSeparator\fP. +.PP +\fBTSeparator\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-background\fP \fIcolor\fP +.PP +Some options are only available for specific themes. +.PP +See the \fBttk::style\fP manual page for information on how to configure +ttk styles. .SH "SEE ALSO" ttk::widget(n) .SH "KEYWORDS" diff --git a/doc/ttk_sizegrip.n b/doc/ttk_sizegrip.n index 8b3429ec..707a17e6 100644 --- a/doc/ttk_sizegrip.n +++ b/doc/ttk_sizegrip.n @@ -3,7 +3,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH ttk::sizegrip n 8.5 Tk "Tk Themed Widget" .so man.macros .BS @@ -18,7 +18,7 @@ A \fBttk::sizegrip\fR widget (also known as a \fIgrow box\fR) allows the user to resize the containing toplevel window by pressing and dragging the grip. .SO ttk_widget -\-class \-cursor \-state +\-class \-cursor \-style \-takefocus .SE .SH "WIDGET COMMAND" @@ -60,6 +60,19 @@ the sizegrip widget will not resize the window. \fBttk::sizegrip\fR widgets only support .QW southeast resizing. +.SH "STYLING OPTIONS" +.PP +The class name for a \fBttk::sizegrip\fP is \fBTSizegrip\fP. +.PP +\fBTSizegrip\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-background\fP \fIcolor\fP +.PP +Some options are only available for specific themes. +.PP +See the \fBttk::style\fP manual page for information on how to configure +ttk styles. .SH "SEE ALSO" ttk::widget(n) .SH "KEYWORDS" diff --git a/doc/ttk_spinbox.n b/doc/ttk_spinbox.n index 7ae586f7..325d4d8d 100644 --- a/doc/ttk_spinbox.n +++ b/doc/ttk_spinbox.n @@ -21,25 +21,32 @@ of the \fBttk::entry\fR widget including support of the \fB\-textvariable\fR option to link the value displayed by the widget to a Tcl variable. .SO ttk_widget -\-class \-cursor \-style +\-class \-cursor \-state \-style \-takefocus \-xscrollcommand .SE .SO ttk_entry \-validate \-validatecommand .SE .SH "WIDGET-SPECIFIC OPTIONS" +.OP \-command command Command +Specifies a Tcl command to be invoked whenever a spinbutton is invoked. +.OP \-format format Format +Specifies an alternate format to use when setting the string value +when using the \fB\-from\fR and \fB\-to\fR range. +This must be a format specifier of the form \fB%.f\fR, +as it will format a floating-point number. .OP \-from from From A floating\-point value specifying the lowest value for the spinbox. This is used in conjunction with \fB\-to\fR and \fB\-increment\fR to set a numerical range. -.OP \-to to To -A floating\-point value specifying the highest permissible value for the -widget. See also \fB\-from\fR and \fB\-increment\fR. -range. .OP \-increment increment Increment A floating\-point value specifying the change in value to be applied each time one of the widget spin buttons is pressed. The up button applies a positive increment, the down button applies a negative increment. +.OP \-to to To +A floating\-point value specifying the highest permissible value for the +widget. See also \fB\-from\fR and \fB\-increment\fR. +range. .OP \-values values Values This must be a Tcl list of values. If this option is set then this will override any range set using the \fB\-from\fR, \fB\-to\fR and @@ -48,13 +55,6 @@ specified beginning with the first value. .OP \-wrap wrap Wrap Must be a proper boolean value. If on, the spinbox will wrap around the values of data in the widget. -.OP \-format format Format -Specifies an alternate format to use when setting the string value -when using the \fB\-from\fR and \fB\-to\fR range. -This must be a format specifier of the form \fB%.f\fR, -as it will format a floating-point number. -.OP \-command command Command -Specifies a Tcl command to be invoked whenever a spinbutton is invoked. .SH "INDICES" .PP See the \fBttk::entry\fR manual for information about indexing characters. @@ -67,8 +67,6 @@ See the \fBttk::entry\fR manual for information about using the The following subcommands are possible for spinbox widgets in addition to the commands described for the \fBttk::entry\fR widget: .TP -\fIpathName \fBcurrent \fIindex\fR -.TP \fIpathName \fBget\fR Returns the spinbox's current value. .TP @@ -82,6 +80,45 @@ is set directly. The spinbox widget generates a \fB<>\fR virtual event when the user presses , and a \fB<>\fR virtual event when the user presses . +.SH "STYLING OPTIONS" +.PP +The class name for a \fBttk::spinbox\fP is \fBTSpinbox\fP. +.PP +Dynamic states: \fBactive\fP, \fBdisabled\fP, \fBfocus\fP, \fBreadonly\fP. +.PP +\fBTSpinbox\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-arrowcolor\fP \fIcolor\fP +.br +\fB\-arrowsize\fP \fIamount\fP +.br +\fB\-background\fP \fIcolor\fP +.RS +When using the aqua theme (Mac OS X), changes the \fB\-fieldbackground\fP. +.RE +\fB\-bordercolor\fP \fIcolor\fP +.br +\fB\-darkcolor\fP \fIcolor\fP +.br +\fB\-fieldbackground\fP \fIcolor\fP +.RS +Does not work with the aqua theme (Mac OS X). +.RE +\fB\-foreground\fP \fIcolor\fP +.br +\fB\-lightcolor\fP \fIcolor\fP +.br +\fB\-padding\fP \fIpadding\fP +.br +\fB\-selectbackground\fP \fIcolor\fP +.br +\fB\-selectforeground\fP \fIcolor\fP +.PP +Some options are only available for specific themes. +.PP +See the \fBttk::style\fP manual page for information on how to configure +ttk styles. .SH "SEE ALSO" ttk::widget(n), ttk::entry(n), spinbox(n) .SH KEYWORDS diff --git a/doc/ttk_treeview.n b/doc/ttk_treeview.n index 8399a092..b81bc622 100644 --- a/doc/ttk_treeview.n +++ b/doc/ttk_treeview.n @@ -474,6 +474,72 @@ to determine the affected item or items. '\" Not yet: '\" In Tk 8.5, the affected item is also passed as the \fB\-detail\fR field '\" of the virtual event. +.SH "STYLING OPTIONS" +.PP +The class name for a \fBttk::treeview\fP is \fBTreeview\fP. +The treeview header class name is \fBHeading\fP. +The treeview item class name is \fBItem\fP. +The treeview cell class name is \fBCell\fP. +.PP +Dynamic states: \fBdisabled\fP, \fBselected\fP. +.PP +\fBTreeview\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-background\fP \fIcolor\fP +.br +\fB\-fieldbackground\fP \fIcolor\fP +.br +\fB\-font\fP \fIfont\fP +.br +\fB\-foreground\fP \fIcolor\fP +.br +\fB\-rowheight\fP \fIamount\fP +.RS +The \fB\-rowheight\fP value is not corrected by the \fBtk scaling\fP +value or by the configured font size and must always be set. Also make +sure that the \fB\-rowheight\fP is large enough to contain any images. +.PP +To adjust the \fB\-rowheight\fP for the Treeview style, use the following code +after \fBtk scaling\fP has been applied. +Note that even if you do not support or change \fBtk scaling\fP +in your program, your users may have it set in their .wishrc. +.RE +.PP +.CS +ttk::style configure Treeview \\ + \-rowheight [expr {[font metrics \fIfont\fP \-linespace] + 2}] +.CE +.PP +\fBHeading\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-background\fP \fIcolor\fP +.br +\fB\-font\fP \fIfont\fP +.br +\fB\-relief\fP \fIrelief\fP +.PP +\fBItem\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-foreground\fP \fIcolor\fP +.br +\fB\-indicatormargins\fP \fIpadding\fP +.br +\fB\-indicatorsize\fP \fIamount\fP +.br +\fB\-padding\fP \fIpadding\fP +.PP +\fBCell\fP styling options configurable with \fBttk::style\fP +are: +.PP +\fB\-padding\fP \fIpadding\fP +.PP +Some options are only available for specific themes. +.PP +See the \fBttk::style\fP manual page for information on how to configure +ttk styles. .SH "SEE ALSO" ttk::widget(n), listbox(n), image(n), bind(n) '\" Local Variables: diff --git a/doc/ttk_widget.n b/doc/ttk_widget.n index d362bba1..ad90e998 100644 --- a/doc/ttk_widget.n +++ b/doc/ttk_widget.n @@ -125,6 +125,9 @@ to allocate for the text label. If less than zero, specifies a minimum width. If zero or unspecified, the natural width of the text label is used. .SH "COMPATIBILITY OPTIONS" +This option is only available for themed widgets that have +.QW corresponding +traditional Tk widgets. .OP \-state state State May be set to \fBnormal\fR or \fBdisabled\fR to control the \fBdisabled\fR state bit. diff --git a/generic/tk.h b/generic/tk.h index 87150e96..c94882cf 100644 --- a/generic/tk.h +++ b/generic/tk.h @@ -75,10 +75,10 @@ extern "C" { #define TK_MAJOR_VERSION 8 #define TK_MINOR_VERSION 6 #define TK_RELEASE_LEVEL TCL_FINAL_RELEASE -#define TK_RELEASE_SERIAL 8 +#define TK_RELEASE_SERIAL 9 #define TK_VERSION "8.6" -#define TK_PATCH_LEVEL "8.6.8" +#define TK_PATCH_LEVEL "8.6.9" /* * A special definition used to allow this header file to be included from @@ -1174,7 +1174,7 @@ typedef struct Tk_TSOffset { } Tk_TSOffset; /* - * Bit fields in Tk_Offset->flags: + * Bit fields in Tk_TSOffset->flags: */ #define TK_OFFSET_INDEX 1 diff --git a/generic/tkBind.c b/generic/tkBind.c index 006d9a3b..af5306b7 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.c @@ -75,7 +75,20 @@ typedef union { * EVENT_BUFFER_SIZE too much, shift multi-clicks will be lost. */ -#define EVENT_BUFFER_SIZE 30 +/* + * NOTE: The changes which were needed to make Tk work on OSX 10.14 (Mojave) + * also demand that the event ring be a bit bigger. It might be wise to + * augment the current double-click pattern matching by adding a new + * DoubleClick modifier bit which could be set based on the clickCount of the + * Apple NSEvent object. + */ + +#ifndef TK_MAC_OSX + #define EVENT_BUFFER_SIZE 45 +#else + #define EVENT_BUFFER_SIZE 30 +#endif + typedef struct Tk_BindingTable_ { XEvent eventRing[EVENT_BUFFER_SIZE]; /* Circular queue of recent events (higher @@ -3467,7 +3480,7 @@ HandleEventGenerate( if ((warp != 0) && Tk_IsMapped(tkwin)) { TkDisplay *dispPtr = TkGetDisplay(event.general.xmotion.display); -Tk_Window warpWindow = Tk_IdToWindow(dispPtr->display, + Tk_Window warpWindow = Tk_IdToWindow(dispPtr->display, event.general.xmotion.window); if (!(dispPtr->flags & TK_DISPLAY_IN_WARP)) { diff --git a/generic/tkButton.c b/generic/tkButton.c index b7e314e7..77603599 100644 --- a/generic/tkButton.c +++ b/generic/tkButton.c @@ -879,7 +879,13 @@ ButtonWidgetObjCmd( Tcl_CancelIdleCall(TkpDisplayButton, butPtr); XFlush(butPtr->display); + #ifndef MAC_OSX_TK + /* + * On the mac you can not sleep in a display proc, and the + * flash command doesn't do anything anyway. + */ Tcl_Sleep(50); + #endif } } break; @@ -1610,6 +1616,19 @@ ButtonVarProc( const char *value; Tcl_Obj *valuePtr; + /* + * See ticket [5d991b82]. + */ + + if (butPtr->selVarNamePtr == NULL) { + if (!(flags & TCL_INTERP_DESTROYED)) { + Tcl_UntraceVar2(interp, name1, name2, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ButtonVarProc, clientData); + } + return NULL; + } + /* * If the variable is being unset, then just re-establish the trace unless * the whole interpreter is going away. @@ -1692,8 +1711,8 @@ static char * ButtonTextVarProc( ClientData clientData, /* Information about button. */ Tcl_Interp *interp, /* Interpreter containing variable. */ - const char *name1, /* Not used. */ - const char *name2, /* Not used. */ + const char *name1, /* Name of variable. */ + const char *name2, /* Second part of variable name. */ int flags) /* Information about what happened. */ { TkButton *butPtr = clientData; @@ -1703,6 +1722,19 @@ ButtonTextVarProc( return NULL; } + /* + * See ticket [5d991b82]. + */ + + if (butPtr->textVarNamePtr == NULL) { + if (!(flags & TCL_INTERP_DESTROYED)) { + Tcl_UntraceVar2(interp, name1, name2, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ButtonTextVarProc, clientData); + } + return NULL; + } + /* * If the variable is unset, then immediately recreate it unless the whole * interpreter is going away. diff --git a/generic/tkCmds.c b/generic/tkCmds.c index 6196b178..a64d2e1c 100644 --- a/generic/tkCmds.c +++ b/generic/tkCmds.c @@ -101,6 +101,7 @@ Tk_BellObjCmd( enum options { TK_BELL_DISPLAYOF, TK_BELL_NICE }; Tk_Window tkwin = clientData; int i, index, nice = 0; + Tk_ErrorHandler handler; if (objc > 4) { wrongArgs: @@ -128,11 +129,13 @@ Tk_BellObjCmd( break; } } + handler = Tk_CreateErrorHandler(Tk_Display(tkwin), -1, -1, -1, NULL, NULL); XBell(Tk_Display(tkwin), 0); if (!nice) { XForceScreenSaver(Tk_Display(tkwin), ScreenSaverReset); } XFlush(Tk_Display(tkwin)); + Tk_DeleteErrorHandler(handler); return TCL_OK; } diff --git a/generic/tkConfig.c b/generic/tkConfig.c index 9c159e61..795a8e87 100644 --- a/generic/tkConfig.c +++ b/generic/tkConfig.c @@ -937,16 +937,13 @@ static int ObjectIsEmpty( Tcl_Obj *objPtr) /* Object to test. May be NULL. */ { - int length; - if (objPtr == NULL) { return 1; } - if (objPtr->bytes != NULL) { - return (objPtr->length == 0); + if (objPtr->bytes == NULL) { + Tcl_GetString(objPtr); } - (void)Tcl_GetStringFromObj(objPtr, &length); - return (length == 0); + return (objPtr->length == 0); } /* diff --git a/generic/tkEntry.c b/generic/tkEntry.c index 9e25bed2..678691fc 100644 --- a/generic/tkEntry.c +++ b/generic/tkEntry.c @@ -887,7 +887,8 @@ EntryWidgetObjCmd( entryPtr->selectLast = index2; } if (!(entryPtr->flags & GOT_SELECTION) - && (entryPtr->exportSelection)) { + && (entryPtr->exportSelection) + && (!Tcl_IsSafe(entryPtr->interp))) { Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, EntryLostSelection, entryPtr); entryPtr->flags |= GOT_SELECTION; @@ -1122,7 +1123,7 @@ ConfigureEntry( * value. */ - oldExport = entryPtr->exportSelection; + oldExport = (entryPtr->exportSelection) && (!Tcl_IsSafe(entryPtr->interp)); if (entryPtr->type == TK_SPINBOX) { oldValues = sbPtr->valueStr; oldFormat = sbPtr->reqFormat; @@ -1276,6 +1277,7 @@ ConfigureEntry( */ if (entryPtr->exportSelection && (!oldExport) + && (!Tcl_IsSafe(entryPtr->interp)) && (entryPtr->selectFirst != -1) && !(entryPtr->flags & GOT_SELECTION)) { Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, EntryLostSelection, @@ -2745,7 +2747,8 @@ EntrySelectTo( * Grab the selection if we don't own it already. */ - if (!(entryPtr->flags & GOT_SELECTION) && (entryPtr->exportSelection)) { + if (!(entryPtr->flags & GOT_SELECTION) && (entryPtr->exportSelection) + && (!Tcl_IsSafe(entryPtr->interp))) { Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, EntryLostSelection, entryPtr); entryPtr->flags |= GOT_SELECTION; @@ -2812,7 +2815,8 @@ EntryFetchSelection( const char *string; const char *selStart, *selEnd; - if ((entryPtr->selectFirst < 0) || !(entryPtr->exportSelection)) { + if ((entryPtr->selectFirst < 0) || (!entryPtr->exportSelection) + || Tcl_IsSafe(entryPtr->interp)) { return -1; } string = entryPtr->displayString; @@ -2865,7 +2869,8 @@ EntryLostSelection( */ if (TkpAlwaysShowSelection(entryPtr->tkwin) - && (entryPtr->selectFirst >= 0) && entryPtr->exportSelection) { + && (entryPtr->selectFirst >= 0) && entryPtr->exportSelection + && (!Tcl_IsSafe(entryPtr->interp))) { entryPtr->selectFirst = -1; entryPtr->selectLast = -1; EventuallyRedraw(entryPtr); @@ -3130,8 +3135,8 @@ static char * EntryTextVarProc( ClientData clientData, /* Information about button. */ Tcl_Interp *interp, /* Interpreter containing variable. */ - const char *name1, /* Not used. */ - const char *name2, /* Not used. */ + const char *name1, /* Name of variable. */ + const char *name2, /* Second part of variable name. */ int flags) /* Information about what happened. */ { Entry *entryPtr = clientData; @@ -3144,6 +3149,19 @@ EntryTextVarProc( return NULL; } + /* + * See ticket [5d991b82]. + */ + + if (entryPtr->textVarName == NULL) { + if (!(flags & TCL_INTERP_DESTROYED)) { + Tcl_UntraceVar2(interp, name1, name2, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + EntryTextVarProc, clientData); + } + return NULL; + } + /* * If the variable is unset, then immediately recreate it unless the whole * interpreter is going away. @@ -4034,7 +4052,8 @@ SpinboxWidgetObjCmd( entryPtr->selectLast = index2; } if (!(entryPtr->flags & GOT_SELECTION) - && entryPtr->exportSelection) { + && entryPtr->exportSelection + && (!Tcl_IsSafe(entryPtr->interp))) { Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, EntryLostSelection, entryPtr); entryPtr->flags |= GOT_SELECTION; diff --git a/generic/tkEntry.h b/generic/tkEntry.h index 52535c87..12c03740 100644 --- a/generic/tkEntry.h +++ b/generic/tkEntry.h @@ -221,7 +221,7 @@ typedef struct { * value that the users requests. Malloc'ed */ char *valueFormat; /* Sprintf conversion specifier used for the * value. */ - char digitFormat[10]; /* Sprintf conversion specifier computed from + char digitFormat[16]; /* Sprintf conversion specifier computed from * digits and other information; used for the * value. */ diff --git a/generic/tkError.c b/generic/tkError.c index fc223e6b..277d7f0e 100644 --- a/generic/tkError.c +++ b/generic/tkError.c @@ -82,8 +82,8 @@ Tk_CreateErrorHandler( * errors. */ ClientData clientData) /* Arbitrary value to pass to errorProc. */ { - register TkErrorHandler *errorPtr; - register TkDisplay *dispPtr; + TkErrorHandler *errorPtr; + TkDisplay *dispPtr; /* * Find the display. If Tk doesn't know about this display then it's an @@ -147,8 +147,8 @@ Tk_DeleteErrorHandler( Tk_ErrorHandler handler) /* Token for handler to delete; was previous * return value from Tk_CreateErrorHandler. */ { - register TkErrorHandler *errorPtr = (TkErrorHandler *) handler; - register TkDisplay *dispPtr = errorPtr->dispPtr; + TkErrorHandler *errorPtr = (TkErrorHandler *) handler; + TkDisplay *dispPtr = errorPtr->dispPtr; errorPtr->lastRequest = NextRequest(dispPtr->display) - 1; @@ -166,12 +166,20 @@ Tk_DeleteErrorHandler( dispPtr->deleteCount += 1; if (dispPtr->deleteCount >= 10) { - register TkErrorHandler *prevPtr; + TkErrorHandler *prevPtr; TkErrorHandler *nextPtr; - int lastSerial; + int lastSerial = LastKnownRequestProcessed(dispPtr->display); + /* + * Last chance to catch errors for this handler: if no event/error + * processing took place to follow up the end of this error handler + * we need a round trip with the X server now. + */ + + if (errorPtr->lastRequest > (unsigned long) lastSerial) { + XSync(dispPtr->display, False); + } dispPtr->deleteCount = 0; - lastSerial = LastKnownRequestProcessed(dispPtr->display); errorPtr = dispPtr->errorPtr; for (prevPtr = NULL; errorPtr != NULL; errorPtr = nextPtr) { nextPtr = errorPtr->nextPtr; @@ -213,11 +221,11 @@ Tk_DeleteErrorHandler( static int ErrorProc( Display *display, /* Display for which error occurred. */ - register XErrorEvent *errEventPtr) + XErrorEvent *errEventPtr) /* Information about error. */ { - register TkDisplay *dispPtr; - register TkErrorHandler *errorPtr; + TkDisplay *dispPtr; + TkErrorHandler *errorPtr; /* * See if we know anything about the display. If not, then invoke the diff --git a/generic/tkGrid.c b/generic/tkGrid.c index 6b9f5434..20e66b66 100644 --- a/generic/tkGrid.c +++ b/generic/tkGrid.c @@ -2868,17 +2868,18 @@ GridStructureProc( } } } else if (eventPtr->type == DestroyNotify) { - register Gridder *gridPtr2, *nextPtr; + register Gridder *slavePtr, *nextPtr; if (gridPtr->masterPtr != NULL) { Unlink(gridPtr); } - for (gridPtr2 = gridPtr->slavePtr; gridPtr2 != NULL; - gridPtr2 = nextPtr) { - Tk_UnmapWindow(gridPtr2->tkwin); - gridPtr2->masterPtr = NULL; - nextPtr = gridPtr2->nextPtr; - gridPtr2->nextPtr = NULL; + for (slavePtr = gridPtr->slavePtr; slavePtr != NULL; + slavePtr = nextPtr) { + Tk_ManageGeometry(slavePtr->tkwin, NULL, NULL); + Tk_UnmapWindow(slavePtr->tkwin); + slavePtr->masterPtr = NULL; + nextPtr = slavePtr->nextPtr; + slavePtr->nextPtr = NULL; } Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->gridHashTable, (char *) gridPtr->tkwin)); @@ -2894,11 +2895,11 @@ GridStructureProc( Tcl_DoWhenIdle(ArrangeGrid, gridPtr); } } else if (eventPtr->type == UnmapNotify) { - register Gridder *gridPtr2; + register Gridder *slavePtr; - for (gridPtr2 = gridPtr->slavePtr; gridPtr2 != NULL; - gridPtr2 = gridPtr2->nextPtr) { - Tk_UnmapWindow(gridPtr2->tkwin); + for (slavePtr = gridPtr->slavePtr; slavePtr != NULL; + slavePtr = slavePtr->nextPtr) { + Tk_UnmapWindow(slavePtr->tkwin); } } } diff --git a/generic/tkImgGIF.c b/generic/tkImgGIF.c index be90f068..7c4872be 100644 --- a/generic/tkImgGIF.c +++ b/generic/tkImgGIF.c @@ -1141,9 +1141,9 @@ ReadImage( * Last pass reset the decoder, so the first code we see * must be a singleton. Seed the stack with it, and set up * the old/first code pointers for insertion into the - * string table. We can't just roll this into the - * clearCode test above, because at that point we have not - * yet read the next code. + * codes table. We can't just roll this into the clearCode + * test above, because at that point we have not yet read + * the next code. */ *top++ = append[code]; @@ -1154,11 +1154,11 @@ ReadImage( inCode = code; - if (code == maxCode) { + if ((code == maxCode) && (maxCode < (1 << MAX_LWZ_BITS))) { /* * maxCode is always one bigger than our highest assigned * code. If the code we see is equal to maxCode, then we - * are about to add a new string to the table. ??? + * are about to add a new entry to the codes table. */ *top++ = firstCode; @@ -1167,7 +1167,7 @@ ReadImage( while (code > clearCode) { /* - * Populate the stack by tracing the string in the string + * Populate the stack by tracing the code in the codes * table from its tail to its head */ @@ -1176,28 +1176,24 @@ ReadImage( } firstCode = append[code]; - /* - * If there's no more room in our string table, quit. - * Otherwise, add a new string to the table - */ + /* + * Push the head of the code onto the stack. + */ - if (maxCode >= (1 << MAX_LWZ_BITS)) { - return TCL_OK; - } + *top++ = firstCode; - /* - * Push the head of the string onto the stack. - */ + if (maxCode < (1 << MAX_LWZ_BITS)) { + /* + * If there's still room in our codes table, add a new entry. + * Otherwise don't, and keep using the current table. + * See DEFERRED CLEAR CODE IN LZW COMPRESSION in the GIF89a + * specification. + */ - *top++ = firstCode; - - /* - * Add a new string to the string table - */ - - prefix[maxCode] = oldCode; - append[maxCode] = firstCode; - maxCode++; + prefix[maxCode] = oldCode; + append[maxCode] = firstCode; + maxCode++; + } /* * maxCode tells us the maximum code value we can accept. If diff --git a/generic/tkImgPhInstance.c b/generic/tkImgPhInstance.c index ec9ee043..fb106b17 100644 --- a/generic/tkImgPhInstance.c +++ b/generic/tkImgPhInstance.c @@ -30,8 +30,10 @@ extern int _XInitImageFuncPtrs(XImage *image); * Forward declarations */ +#ifndef MAC_OSX_TK static void BlendComplexAlpha(XImage *bgImg, PhotoInstance *iPtr, int xOffset, int yOffset, int width, int height); +#endif static int IsValidPalette(PhotoInstance *instancePtr, const char *palette); static int CountBits(pixel mask); @@ -409,7 +411,7 @@ TkImgPhotoGet( * *---------------------------------------------------------------------- */ - +#ifndef MAC_OSX_TK #ifndef _WIN32 #define GetRValue(rgb) (UCHAR(((rgb) & red_mask) >> red_shift)) #define GetGValue(rgb) (UCHAR(((rgb) & green_mask) >> green_shift)) @@ -418,13 +420,6 @@ TkImgPhotoGet( (UCHAR(r) << red_shift) | \ (UCHAR(g) << green_shift) | \ (UCHAR(b) << blue_shift) )) -#ifdef MAC_OSX_TK -#define RGBA(r, g, b, a) ((unsigned)( \ - (UCHAR(r) << red_shift) | \ - (UCHAR(g) << green_shift) | \ - (UCHAR(b) << blue_shift) | \ - (UCHAR(a) << alpha_shift) )) -#endif #define RGB15(r, g, b) ((unsigned)( \ (((r) * red_mask / 255) & red_mask) | \ (((g) * green_mask / 255) & green_mask) | \ @@ -443,16 +438,7 @@ BlendComplexAlpha( unsigned long pixel; unsigned char r, g, b, alpha, unalpha, *masterPtr; unsigned char *alphaAr = iPtr->masterPtr->pix32; -#if defined(MAC_OSX_TK) - /* Background "pixels" are actually 2^pp x 2^pp blocks of subpixels. Each - * block gets blended with the color of one image pixel. Since we iterate - * over the background subpixels, we reset the width and height to the - * subpixel dimensions of the background image we are using. - */ - int pp = bgImg->pixelpower; - width = width << pp; - height = height << pp; -#endif + /* * This blending is an integer version of the Source-Over compositing rule * (see Porter&Duff, "Compositing Digital Images", proceedings of SIGGRAPH @@ -492,13 +478,6 @@ BlendComplexAlpha( while ((0x0001 & (blue_mask >> blue_shift)) == 0) { blue_shift++; } -#ifdef MAC_OSX_TK - unsigned long alpha_mask = visual->alpha_mask; - unsigned long alpha_shift = 0; - while ((0x0001 & (alpha_mask >> alpha_shift)) == 0) { - alpha_shift++; - } -#endif #endif /* !_WIN32 */ /* @@ -558,16 +537,9 @@ BlendComplexAlpha( #endif /* !_WIN32 && !MAC_OSX_TK */ for (y = 0; y < height; y++) { -# if !defined(MAC_OSX_TK) line = (y + yOffset) * iPtr->masterPtr->width; for (x = 0; x < width; x++) { masterPtr = alphaAr + ((line + x + xOffset) * 4); -#else - /* Repeat each image row and column 2^pp times. */ - line = ((y>>pp) + yOffset) * iPtr->masterPtr->width; - for (x = 0; x < width; x++) { - masterPtr = alphaAr + ((line + (x>>pp) + xOffset) * 4); -#endif alpha = masterPtr[3]; /* @@ -599,16 +571,13 @@ BlendComplexAlpha( g = ALPHA_BLEND(ga, g, alpha, unalpha); b = ALPHA_BLEND(ba, b, alpha, unalpha); } -#ifndef MAC_OSX_TK XPutPixel(bgImg, x, y, RGB(r, g, b)); -#else - XPutPixel(bgImg, x, y, RGBA(r, g, b, alpha)); -#endif } } } #undef ALPHA_BLEND } +#endif /* MAC_OSX_TK */ /* *---------------------------------------------------------------------- @@ -651,6 +620,24 @@ TkImgPhotoDisplay( return; } +#ifdef MAC_OSX_TK + /* + * The Mac version of TkPutImage handles RGBA images directly. There is + * no need to call XGetImage or to do the Porter-Duff compositing by hand. + * We just let the CG graphics library do it, using the graphics hardware. + */ + unsigned char *rgbaPixels = instancePtr->masterPtr->pix32; + + XImage *photo = XCreateImage(display, NULL, 32, ZPixmap, 0, (char*)rgbaPixels, + (unsigned int)instancePtr->width, + (unsigned int)instancePtr->height, + 0, (unsigned int)(4 * instancePtr->width)); + TkPutImage(NULL, 0, display, drawable, instancePtr->gc, + photo, imageX, imageY, drawableX, drawableY, + (unsigned int) width, (unsigned int) height); + photo->data = NULL; + XDestroyImage(photo); +#else if ((instancePtr->masterPtr->flags & COMPLEX_ALPHA) && visInfo.depth >= 15 && (visInfo.class == DirectColor || visInfo.class == TrueColor)) { @@ -709,6 +696,7 @@ TkImgPhotoDisplay( XSetClipOrigin(display, instancePtr->gc, 0, 0); } XFlush(display); +#endif } /* diff --git a/generic/tkInt.decls b/generic/tkInt.decls index a13d8d79..d0b76785 100644 --- a/generic/tkInt.decls +++ b/generic/tkInt.decls @@ -983,9 +983,9 @@ declare 38 aqua { declare 39 aqua { void TkSetWMName(TkWindow *winPtr, Tk_Uid titleUid) } -declare 40 aqua { - void TkSuspendClipboard(void) -} +# +# Slot 40 unused (WAS: TkSuspendClipboard) +# declare 41 aqua { int TkMacOSXZoomToplevel(void *whichWindow, short zoomPart) } diff --git a/generic/tkIntPlatDecls.h b/generic/tkIntPlatDecls.h index e48e803d..ded5ac52 100644 --- a/generic/tkIntPlatDecls.h +++ b/generic/tkIntPlatDecls.h @@ -224,8 +224,7 @@ EXTERN void TkMacOSXWindowOffset(void *wRef, int *xOffset, EXTERN int TkSetMacColor(unsigned long pixel, void *macColor); /* 39 */ EXTERN void TkSetWMName(TkWindow *winPtr, Tk_Uid titleUid); -/* 40 */ -EXTERN void TkSuspendClipboard(void); +/* Slot 40 is reserved */ /* 41 */ EXTERN int TkMacOSXZoomToplevel(void *whichWindow, short zoomPart); @@ -384,7 +383,7 @@ typedef struct TkIntPlatStubs { void (*tkMacOSXWindowOffset) (void *wRef, int *xOffset, int *yOffset); /* 37 */ int (*tkSetMacColor) (unsigned long pixel, void *macColor); /* 38 */ void (*tkSetWMName) (TkWindow *winPtr, Tk_Uid titleUid); /* 39 */ - void (*tkSuspendClipboard) (void); /* 40 */ + void (*reserved40)(void); int (*tkMacOSXZoomToplevel) (void *whichWindow, short zoomPart); /* 41 */ Tk_Window (*tk_TopCoordsToWindow) (Tk_Window tkwin, int rootX, int rootY, int *newX, int *newY); /* 42 */ MacDrawable * (*tkMacOSXContainerId) (TkWindow *winPtr); /* 43 */ @@ -599,8 +598,7 @@ extern const TkIntPlatStubs *tkIntPlatStubsPtr; (tkIntPlatStubsPtr->tkSetMacColor) /* 38 */ #define TkSetWMName \ (tkIntPlatStubsPtr->tkSetWMName) /* 39 */ -#define TkSuspendClipboard \ - (tkIntPlatStubsPtr->tkSuspendClipboard) /* 40 */ +/* Slot 40 is reserved */ #define TkMacOSXZoomToplevel \ (tkIntPlatStubsPtr->tkMacOSXZoomToplevel) /* 41 */ #define Tk_TopCoordsToWindow \ diff --git a/generic/tkListbox.c b/generic/tkListbox.c index b0597279..5f650fed 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -1565,7 +1565,7 @@ ConfigureListbox( Tcl_Obj *errorResult = NULL; int oldExport, error; - oldExport = listPtr->exportSelection; + oldExport = (listPtr->exportSelection) && (!Tcl_IsSafe(listPtr->interp)); if (listPtr->listVarName != NULL) { Tcl_UntraceVar2(interp, listPtr->listVarName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, @@ -1607,10 +1607,11 @@ ConfigureListbox( /* * Claim the selection if we've suddenly started exporting it and - * there is a selection to export. + * there is a selection to export and this interp is unsafe. */ - if (listPtr->exportSelection && !oldExport + if (listPtr->exportSelection && (!oldExport) + && (!Tcl_IsSafe(listPtr->interp)) && (listPtr->numSelected != 0)) { Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY, ListboxLostSelection, listPtr); @@ -3079,7 +3080,8 @@ ListboxSelect( EventuallyRedrawRange(listPtr, first, last); } if ((oldCount == 0) && (listPtr->numSelected > 0) - && listPtr->exportSelection) { + && (listPtr->exportSelection) + && (!Tcl_IsSafe(listPtr->interp))) { Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY, ListboxLostSelection, listPtr); } @@ -3125,7 +3127,7 @@ ListboxFetchSelection( const char *stringRep; Tcl_HashEntry *entry; - if (!listPtr->exportSelection) { + if ((!listPtr->exportSelection) || Tcl_IsSafe(listPtr->interp)) { return -1; } @@ -3196,7 +3198,8 @@ ListboxLostSelection( { register Listbox *listPtr = clientData; - if ((listPtr->exportSelection) && (listPtr->nElements > 0)) { + if ((listPtr->exportSelection) && (!Tcl_IsSafe(listPtr->interp)) + && (listPtr->nElements > 0)) { ListboxSelect(listPtr, 0, listPtr->nElements-1, 0); GenerateListboxSelectEvent(listPtr); } @@ -3428,8 +3431,8 @@ static char * ListboxListVarProc( ClientData clientData, /* Information about button. */ Tcl_Interp *interp, /* Interpreter containing variable. */ - const char *name1, /* Not used. */ - const char *name2, /* Not used. */ + const char *name1, /* Name of variable. */ + const char *name2, /* Second part of variable name. */ int flags) /* Information about what happened. */ { Listbox *listPtr = clientData; @@ -3437,6 +3440,19 @@ ListboxListVarProc( int oldLength, i; Tcl_HashEntry *entry; + /* + * See ticket [5d991b82]. + */ + + if (listPtr->listVarName == NULL) { + if (!(flags & TCL_INTERP_DESTROYED)) { + Tcl_UntraceVar2(interp, name1, name2, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ListboxListVarProc, clientData); + } + return NULL; + } + /* * Bwah hahahaha! Puny mortal, you can't unset a -listvar'd variable! */ diff --git a/generic/tkMain.c b/generic/tkMain.c index 1b212235..1086eb2d 100644 --- a/generic/tkMain.c +++ b/generic/tkMain.c @@ -236,6 +236,10 @@ Tk_MainEx( Tcl_Preserve(interp); #if defined(_WIN32) && !defined(__CYGWIN__) +#if !defined(STATIC_BUILD) + /* If compiled for Win32 but running on Cygwin, don't use console */ + if (!tclStubsPtr->reserved9) +#endif Tk_InitConsoleChannels(interp); #endif diff --git a/generic/tkMenu.c b/generic/tkMenu.c index d24516f6..26ffc88f 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.c @@ -1700,12 +1700,12 @@ PostProcessEntry( if (mePtr->labelPtr == NULL) { mePtr->labelLength = 0; } else { - (void)Tcl_GetStringFromObj(mePtr->labelPtr, &mePtr->labelLength); + Tcl_GetStringFromObj(mePtr->labelPtr, &mePtr->labelLength); } if (mePtr->accelPtr == NULL) { mePtr->accelLength = 0; } else { - (void)Tcl_GetStringFromObj(mePtr->accelPtr, &mePtr->accelLength); + Tcl_GetStringFromObj(mePtr->accelPtr, &mePtr->accelLength); } /* @@ -2495,6 +2495,22 @@ MenuVarProc( } menuPtr = mePtr->menuPtr; + + if (menuPtr->menuFlags & MENU_DELETION_PENDING) { + return NULL; + } + + /* + * See ticket [5d991b82]. + */ + + if (mePtr->namePtr == NULL) { + Tcl_UntraceVar2(interp, name1, name2, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + MenuVarProc, clientData); + return NULL; + } + name = Tcl_GetString(mePtr->namePtr); /* diff --git a/generic/tkMenuDraw.c b/generic/tkMenuDraw.c index 1abe1c46..3f492db3 100644 --- a/generic/tkMenuDraw.c +++ b/generic/tkMenuDraw.c @@ -624,7 +624,6 @@ DisplayMenu( int width; int borderWidth; Tk_3DBorder border; - int activeBorderWidth; int relief; @@ -636,8 +635,6 @@ DisplayMenu( Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr, &borderWidth); border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr); - Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, - menuPtr->activeBorderWidthPtr, &activeBorderWidth); if (menuPtr->menuType == MENUBAR) { Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), border, borderWidth, @@ -668,28 +665,16 @@ DisplayMenu( } mePtr->entryFlags &= ~ENTRY_NEEDS_REDISPLAY; - if (menuPtr->menuType == MENUBAR) { - width = mePtr->width; - } else { - if (mePtr->entryFlags & ENTRY_LAST_COLUMN) { - width = Tk_Width(menuPtr->tkwin) - mePtr->x - - activeBorderWidth; - } else { - width = mePtr->width + borderWidth; - } - } TkpDrawMenuEntry(mePtr, Tk_WindowId(menuPtr->tkwin), tkfont, - &menuMetrics, mePtr->x, mePtr->y, width, + &menuMetrics, mePtr->x, mePtr->y, mePtr->width, mePtr->height, strictMotif, 1); if ((index > 0) && (menuPtr->menuType != MENUBAR) && mePtr->columnBreak) { mePtr = menuPtr->entries[index - 1]; Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), border, - mePtr->x, mePtr->y + mePtr->height, - mePtr->width, - Tk_Height(tkwin) - mePtr->y - mePtr->height - - activeBorderWidth, 0, - TK_RELIEF_FLAT); + mePtr->x, mePtr->y + mePtr->height, mePtr->width, + Tk_Height(tkwin) - mePtr->y - mePtr->height - borderWidth, + 0, TK_RELIEF_FLAT); } } @@ -698,19 +683,18 @@ DisplayMenu( if (menuPtr->numEntries == 0) { x = y = borderWidth; - width = Tk_Width(tkwin) - 2 * activeBorderWidth; - height = Tk_Height(tkwin) - 2 * activeBorderWidth; + width = Tk_Width(tkwin) - 2 * borderWidth; + height = Tk_Height(tkwin) - 2 * borderWidth; } else { mePtr = menuPtr->entries[menuPtr->numEntries - 1]; Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), border, mePtr->x, mePtr->y + mePtr->height, mePtr->width, - Tk_Height(tkwin) - mePtr->y - mePtr->height - - activeBorderWidth, 0, - TK_RELIEF_FLAT); + Tk_Height(tkwin) - mePtr->y - mePtr->height - borderWidth, + 0, TK_RELIEF_FLAT); x = mePtr->x + mePtr->width; y = mePtr->y + mePtr->height; - width = Tk_Width(tkwin) - x - activeBorderWidth; - height = Tk_Height(tkwin) - y - activeBorderWidth; + width = Tk_Width(tkwin) - x - borderWidth; + height = Tk_Height(tkwin) - y - borderWidth; } Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), border, x, y, width, height, 0, TK_RELIEF_FLAT); diff --git a/generic/tkMenubutton.c b/generic/tkMenubutton.c index 1a4d5ae6..2c1676c6 100644 --- a/generic/tkMenubutton.c +++ b/generic/tkMenubutton.c @@ -881,6 +881,19 @@ MenuButtonTextVarProc( const char *value; unsigned len; + /* + * See ticket [5d991b82]. + */ + + if (mbPtr->textVarName == NULL) { + if (!(flags & TCL_INTERP_DESTROYED)) { + Tcl_UntraceVar2(interp, name1, name2, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + MenuButtonTextVarProc, clientData); + } + return NULL; + } + /* * If the variable is unset, then immediately recreate it unless the whole * interpreter is going away. diff --git a/generic/tkMessage.c b/generic/tkMessage.c index 2b719987..f65b0468 100644 --- a/generic/tkMessage.c +++ b/generic/tkMessage.c @@ -838,6 +838,19 @@ MessageTextVarProc( register Message *msgPtr = clientData; const char *value; + /* + * See ticket [5d991b82]. + */ + + if (msgPtr->textVarName == NULL) { + if (!(flags & TCL_INTERP_DESTROYED)) { + Tcl_UntraceVar2(interp, name1, name2, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + MessageTextVarProc, clientData); + } + return NULL; + } + /* * If the variable is unset, then immediately recreate it unless the whole * interpreter is going away. diff --git a/generic/tkObj.c b/generic/tkObj.c index 3c49f94a..46f2da5c 100644 --- a/generic/tkObj.c +++ b/generic/tkObj.c @@ -153,8 +153,19 @@ GetTypeCache(void) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (tsdPtr->doubleTypePtr == NULL) { - tsdPtr->doubleTypePtr = Tcl_GetObjType("double"); - tsdPtr->intTypePtr = Tcl_GetObjType("int"); + /* Smart initialization of doubleTypePtr/intTypePtr without + * hash-table lookup or creating complete Tcl_Obj's */ + Tcl_Obj obj; + obj.length = 3; + obj.bytes = (char *)"0.0"; + obj.typePtr = NULL; + Tcl_GetDoubleFromObj(NULL, &obj, &obj.internalRep.doubleValue); + tsdPtr->doubleTypePtr = obj.typePtr; + obj.bytes += 2; + obj.length = 1; + obj.typePtr = NULL; + Tcl_GetLongFromObj(NULL, &obj, &obj.internalRep.longValue); + tsdPtr->intTypePtr = obj.typePtr; } return tsdPtr; } @@ -657,7 +668,7 @@ UpdateStringOfMM( { MMRep *mmPtr; char buffer[TCL_DOUBLE_SPACE]; - register int len; + size_t len; mmPtr = objPtr->internalRep.twoPtrValue.ptr1; /* assert( mmPtr->units == -1 && objPtr->bytes == NULL ); */ @@ -666,7 +677,7 @@ UpdateStringOfMM( } Tcl_PrintDouble(NULL, mmPtr->value, buffer); - len = (int)strlen(buffer); + len = strlen(buffer); objPtr->bytes = ckalloc(len + 1); strcpy(objPtr->bytes, buffer); @@ -881,7 +892,7 @@ SetWindowFromAny( * Free the old internalRep before setting the new one. */ - (void)Tcl_GetString(objPtr); + Tcl_GetString(objPtr); typePtr = objPtr->typePtr; if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { typePtr->freeIntRepProc(objPtr); diff --git a/generic/tkOldTest.c b/generic/tkOldTest.c index df1bb6c2..f78ebbaa 100644 --- a/generic/tkOldTest.c +++ b/generic/tkOldTest.c @@ -172,9 +172,9 @@ ImageCreate( timPtr->interp = interp; timPtr->width = 30; timPtr->height = 15; - timPtr->imageName = ckalloc((unsigned) (strlen(name) + 1)); + timPtr->imageName = ckalloc(strlen(name) + 1); strcpy(timPtr->imageName, name); - timPtr->varName = ckalloc((unsigned) (strlen(varName) + 1)); + timPtr->varName = ckalloc(strlen(varName) + 1); strcpy(timPtr->varName, varName); Tcl_CreateObjCommand(interp, name, ImageObjCmd, timPtr, NULL); *clientDataPtr = timPtr; diff --git a/generic/tkOption.c b/generic/tkOption.c index 24e7fb33..545a9b9b 100644 --- a/generic/tkOption.c +++ b/generic/tkOption.c @@ -996,6 +996,9 @@ AddFromString( while ((*src == ' ') || (*src == '\t')) { src++; } + if (*src == '\\' && (src[1] == '\t' || src[1] == ' ')) { + src++; + } if (*src == '\0') { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "missing value on line %d", lineNum)); @@ -1025,7 +1028,7 @@ AddFromString( src += 2; *dst++ = '\n'; continue; - } else if (src[1] == '\t' || src[1] == ' ' || src[1] == '\\') { + } else if (src[1] == '\\') { ++src; } else if (src[1] >= '0' && src[1] <= '3' && src[2] >= '0' && src[2] <= '9' && src[3] >= '0' && src[3] <= '9') { diff --git a/generic/tkPack.c b/generic/tkPack.c index 88a4b2d7..071a5378 100644 --- a/generic/tkPack.c +++ b/generic/tkPack.c @@ -1362,7 +1362,7 @@ Unlink( * handling it and should mark it as free. */ - if (masterPtr->slavePtr == NULL && masterPtr->flags & ALLOCED_MASTER) { + if ((masterPtr->slavePtr == NULL) && (masterPtr->flags & ALLOCED_MASTER)) { TkFreeGeometryMaster(masterPtr->tkwin, "pack"); masterPtr->flags &= ~ALLOCED_MASTER; } diff --git a/generic/tkPanedWindow.c b/generic/tkPanedWindow.c index 17e2b4aa..45d784a0 100644 --- a/generic/tkPanedWindow.c +++ b/generic/tkPanedWindow.c @@ -2992,16 +2992,13 @@ static int ObjectIsEmpty( Tcl_Obj *objPtr) /* Object to test. May be NULL. */ { - int length; - if (objPtr == NULL) { return 1; } - if (objPtr->bytes != NULL) { - return (objPtr->length == 0); + if (objPtr->bytes == NULL) { + Tcl_GetString(objPtr); } - (void)Tcl_GetStringFromObj(objPtr, &length); - return (length == 0); + return (objPtr->length == 0); } /* diff --git a/generic/tkScale.c b/generic/tkScale.c index ef67630d..af45afa7 100644 --- a/generic/tkScale.c +++ b/generic/tkScale.c @@ -1192,6 +1192,19 @@ ScaleVarProc( Tcl_Obj *valuePtr; int result; + /* + * See ticket [5d991b82]. + */ + + if (scalePtr->varNamePtr == NULL) { + if (!(flags & TCL_INTERP_DESTROYED)) { + Tcl_UntraceVar2(interp, name1, name2, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ScaleVarProc, clientData); + } + return NULL; + } + /* * If the variable is unset, then immediately recreate it unless the whole * interpreter is going away. diff --git a/generic/tkScale.h b/generic/tkScale.h index 4fd99959..aa0feff1 100644 --- a/generic/tkScale.h +++ b/generic/tkScale.h @@ -73,7 +73,7 @@ typedef struct TkScale { * values. 0 means we get to choose the number * based on resolution and/or the range of the * scale. */ - char format[10]; /* Sprintf conversion specifier computed from + char format[16]; /* Sprintf conversion specifier computed from * digits and other information. */ double bigIncrement; /* Amount to use for large increments to scale * value. (0 means we pick a value). */ diff --git a/generic/tkStubInit.c b/generic/tkStubInit.c index 9411c26f..7e02302a 100644 --- a/generic/tkStubInit.c +++ b/generic/tkStubInit.c @@ -547,7 +547,7 @@ static const TkIntPlatStubs tkIntPlatStubs = { TkMacOSXWindowOffset, /* 37 */ TkSetMacColor, /* 38 */ TkSetWMName, /* 39 */ - TkSuspendClipboard, /* 40 */ + 0, /* 40 */ TkMacOSXZoomToplevel, /* 41 */ Tk_TopCoordsToWindow, /* 42 */ TkMacOSXContainerId, /* 43 */ diff --git a/generic/tkTest.c b/generic/tkTest.c index fa9e0736..56093913 100644 --- a/generic/tkTest.c +++ b/generic/tkTest.c @@ -31,6 +31,9 @@ #if defined(MAC_OSX_TK) #include "tkMacOSXInt.h" #include "tkScrollbar.h" +#define SIMULATE_DRAWING TkTestSimulateDrawing(true); +#else +#define SIMULATE_DRAWING #endif #ifdef __UNIX__ @@ -168,7 +171,7 @@ static int TestmenubarObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); #endif -#if defined(_WIN32) || defined(MAC_OSX_TK) +#if defined(_WIN32) static int TestmetricsObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj * const objv[]); @@ -266,17 +269,17 @@ Tktest_Init( Tcl_CreateObjCommand(interp, "testtext", TkpTesttextCmd, (ClientData) Tk_MainWindow(interp), NULL); -#if defined(_WIN32) || defined(MAC_OSX_TK) +#if defined(_WIN32) Tcl_CreateObjCommand(interp, "testmetrics", TestmetricsObjCmd, (ClientData) Tk_MainWindow(interp), NULL); -#elif !defined(__CYGWIN__) +#elif !defined(__CYGWIN__) && !defined(MAC_OSX_TK) Tcl_CreateObjCommand(interp, "testmenubar", TestmenubarObjCmd, (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateObjCommand(interp, "testsend", TkpTestsendCmd, (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateObjCommand(interp, "testwrapper", TestwrapperObjCmd, (ClientData) Tk_MainWindow(interp), NULL); -#endif /* _WIN32 || MAC_OSX_TK */ +#endif /* _WIN32 */ /* * Create test image type. @@ -1550,17 +1553,35 @@ ImageDisplay( TImageInstance *instPtr = (TImageInstance *) clientData; char buffer[200 + TCL_INTEGER_SPACE * 6]; - sprintf(buffer, "%s display %d %d %d %d %d %d", - instPtr->masterPtr->imageName, imageX, imageY, width, height, - drawableX, drawableY); + /* + * The purpose of the test image type is to track the calls to an image + * display proc and record the parameters passed in each call. On macOS + * these tests will fail because of the asynchronous drawing. The low + * level graphics calls below which are supposed to draw a rectangle will + * not draw anything to the screen because the idle task will not be + * processed inside of the drawRect method and hence will not be able to + * obtain a valid graphics context. Instead, the window will be marked as + * needing display, and will be redrawn during a future asynchronous call + * to drawRect. This will generate an other call to this display proc, + * and the recorded data will show extra calls, causing the test to fail. + * To avoid this, we can set the [NSApp simulateDrawing] flag, which will + * cause all low level drawing routines to return immediately and not + * schedule the window for drawing later. This flag is cleared by the + * next call to XSync, which is called by the update command. + */ + + sprintf(buffer, "%s display %d %d %d %d", + instPtr->masterPtr->imageName, imageX, imageY, width, height); Tcl_SetVar2(instPtr->masterPtr->interp, instPtr->masterPtr->varName, NULL, - buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); + buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); if (width > (instPtr->masterPtr->width - imageX)) { width = instPtr->masterPtr->width - imageX; } if (height > (instPtr->masterPtr->height - imageY)) { height = instPtr->masterPtr->height - imageY; } + + SIMULATE_DRAWING XDrawRectangle(display, drawable, instPtr->gc, drawableX, drawableY, (unsigned) (width-1), (unsigned) (height-1)); XDrawLine(display, drawable, instPtr->gc, drawableX, drawableY, @@ -1765,7 +1786,7 @@ TestmenubarObjCmd( *---------------------------------------------------------------------- */ -#if defined(_WIN32) || defined(MAC_OSX_TK) +#if defined(_WIN32) static int TestmetricsObjCmd( ClientData clientData, /* Main window for application. */ @@ -1776,38 +1797,15 @@ TestmetricsObjCmd( char buf[TCL_INTEGER_SPACE]; int val; -#ifdef _WIN32 if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } -#else - Tk_Window tkwin = (Tk_Window) clientData; - TkWindow *winPtr; - - if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "option window"); - return TCL_ERROR; - } - - winPtr = (TkWindow *) Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); - if (winPtr == NULL) { - return TCL_ERROR; - } -#endif if (strcmp(Tcl_GetString(objv[1]), "cyvscroll") == 0) { -#ifdef _WIN32 val = GetSystemMetrics(SM_CYVSCROLL); -#else - val = ((TkScrollbar *) winPtr->instanceData)->width; -#endif } else if (strcmp(Tcl_GetString(objv[1]), "cxhscroll") == 0) { -#ifdef _WIN32 val = GetSystemMetrics(SM_CXHSCROLL); -#else - val = ((TkScrollbar *) winPtr->instanceData)->width; -#endif } else { Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]), "\": must be cxhscroll or cyvscroll", NULL); diff --git a/generic/tkText.c b/generic/tkText.c index 28fca765..4c536a22 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -864,7 +864,8 @@ TextWidgetObjCmd( } for (i = 2; i < objc-2; i++) { - int value, length; + int value; + size_t length; const char *option = Tcl_GetString(objv[i]); char c; @@ -873,19 +874,19 @@ TextWidgetObjCmd( goto badOption; } c = option[1]; - if (c == 'c' && !strncmp("-chars", option, (unsigned) length)) { + if (c == 'c' && !strncmp("-chars", option, length)) { value = CountIndices(textPtr, indexFromPtr, indexToPtr, COUNT_CHARS); } else if (c == 'd' && (length > 8) - && !strncmp("-displaychars", option, (unsigned) length)) { + && !strncmp("-displaychars", option, length)) { value = CountIndices(textPtr, indexFromPtr, indexToPtr, COUNT_DISPLAY_CHARS); } else if (c == 'd' && (length > 8) - && !strncmp("-displayindices", option,(unsigned)length)) { + && !strncmp("-displayindices", option,length)) { value = CountIndices(textPtr, indexFromPtr, indexToPtr, COUNT_DISPLAY_INDICES); } else if (c == 'd' && (length > 8) - && !strncmp("-displaylines", option, (unsigned) length)) { + && !strncmp("-displaylines", option, length)) { TkTextLine *fromPtr, *lastPtr; TkTextIndex index, index2; @@ -983,19 +984,19 @@ TextWidgetObjCmd( value = -value; } } else if (c == 'i' - && !strncmp("-indices", option, (unsigned) length)) { + && !strncmp("-indices", option, length)) { value = CountIndices(textPtr, indexFromPtr, indexToPtr, COUNT_INDICES); } else if (c == 'l' - && !strncmp("-lines", option, (unsigned) length)) { + && !strncmp("-lines", option, length)) { value = TkBTreeLinesTo(textPtr, indexToPtr->linePtr) - TkBTreeLinesTo(textPtr, indexFromPtr->linePtr); } else if (c == 'u' - && !strncmp("-update", option, (unsigned) length)) { + && !strncmp("-update", option, length)) { update = 1; continue; } else if (c == 'x' - && !strncmp("-xpixels", option, (unsigned) length)) { + && !strncmp("-xpixels", option, length)) { int x1, x2; TkTextIndex index; @@ -1005,7 +1006,7 @@ TextWidgetObjCmd( TkTextFindDisplayLineEnd(textPtr, &index, 0, &x2); value = x2 - x1; } else if (c == 'y' - && !strncmp("-ypixels", option, (unsigned) length)) { + && !strncmp("-ypixels", option, length)) { if (update) { TkTextUpdateLineMetrics(textPtr, TkBTreeLinesTo(textPtr, indexFromPtr->linePtr), @@ -1155,14 +1156,14 @@ TextWidgetObjCmd( objc++; } useIdx = ckalloc(objc); - memset(useIdx, 0, (unsigned) objc); + memset(useIdx, 0, (size_t) objc); /* * Do a decreasing order sort so that we delete the end ranges * first to maintain index consistency. */ - qsort(indices, (unsigned) objc / 2, + qsort(indices, (size_t) objc / 2, 2 * sizeof(TkTextIndex), TextIndexSortProc); lastStart = NULL; @@ -1260,7 +1261,7 @@ TextWidgetObjCmd( Tcl_Obj *objPtr = NULL; int i, found = 0, visible = 0; const char *name; - int length; + size_t length; if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, @@ -1279,7 +1280,7 @@ TextWidgetObjCmd( name = Tcl_GetString(objv[i]); length = objv[i]->length; if (length > 1 && name[0] == '-') { - if (strncmp("-displaychars", name, (unsigned) length) == 0) { + if (strncmp("-displaychars", name, length) == 0) { i++; visible = 1; name = Tcl_GetString(objv[i]); @@ -1465,7 +1466,7 @@ TextWidgetObjCmd( * unnecessarily. */ - int deleteInsertOffset, insertLength, j; + int deleteInsertOffset, insertLength, j, indexFromLine, indexFromByteOffset; insertLength = 0; for (j = 4; j < objc; j += 2) { @@ -1483,6 +1484,9 @@ TextWidgetObjCmd( deleteInsertOffset = insertLength; } + indexFromLine = TkBTreeLinesTo(textPtr, indexFromPtr->linePtr); + indexFromByteOffset = indexFromPtr->byteIndex; + result = TextReplaceCmd(textPtr, interp, indexFromPtr, indexToPtr, objc, objv, 0); @@ -1491,8 +1495,11 @@ TextWidgetObjCmd( * Move the insertion position to the correct place. */ - indexFromPtr = TkTextGetIndexFromObj(interp, textPtr, objv[2]); - TkTextIndexForwChars(NULL, indexFromPtr, + TkTextIndex indexTmp; + + TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, indexFromLine, + indexFromByteOffset, &indexTmp); + TkTextIndexForwChars(NULL, &indexTmp, deleteInsertOffset, &index, COUNT_INDICES); TkBTreeUnlinkSegment(textPtr->insertMarkPtr, textPtr->insertMarkPtr->body.mark.linePtr); @@ -2078,7 +2085,7 @@ ConfigureText( Tcl_Obj *const objv[]) /* Argument objects. */ { Tk_SavedOptions savedOptions; - int oldExport = textPtr->exportSelection; + int oldExport = (textPtr->exportSelection) && (!Tcl_IsSafe(textPtr->interp)); int mask = 0; if (Tk_SetOptions(interp, (char *) textPtr, textPtr->optionTable, @@ -2307,7 +2314,7 @@ ConfigureText( * are tagged characters. */ - if (textPtr->exportSelection && (!oldExport)) { + if (textPtr->exportSelection && (!oldExport) && (!Tcl_IsSafe(textPtr->interp))) { TkTextSearch search; TkTextIndex first, last; @@ -2627,7 +2634,8 @@ InsertChars( * information to add to text. */ int viewUpdate) /* Update the view if set. */ { - int lineIndex, length; + int lineIndex; + size_t length; TkText *tPtr; int *lineAndByteIndex; int resetViewCount; @@ -2726,10 +2734,14 @@ InsertChars( } /* - * Invalidate any selection retrievals in progress. + * Invalidate any selection retrievals in progress, and send an event + * that the selection changed if that is the case. */ for (tPtr = sharedTextPtr->peers; tPtr != NULL ; tPtr = tPtr->next) { + if (TkBTreeCharTagged(indexPtr, tPtr->selTagPtr)) { + TkTextSelectionEvent(tPtr); + } tPtr->abortSelections = 1; } @@ -3069,6 +3081,9 @@ DeleteIndexRange( int *lineAndByteIndex; int resetViewCount; int pixels[2*PIXEL_CLIENTS]; + Tcl_HashSearch search; + Tcl_HashEntry *hPtr; + int i; if (sharedTextPtr == NULL) { sharedTextPtr = textPtr->sharedTextPtr; @@ -3133,42 +3148,36 @@ DeleteIndexRange( } } - if (line1 < line2) { - /* - * We are deleting more than one line. For speed, we remove all tags - * from the range first. If we don't do this, the code below can (when - * there are many tags) grow non-linearly in execution time. - */ + /* + * For speed, we remove all tags from the range first. If we don't + * do this, the code below can (when there are many tags) grow + * non-linearly in execution time. + */ - Tcl_HashSearch search; - Tcl_HashEntry *hPtr; - int i; + for (i=0, hPtr=Tcl_FirstHashEntry(&sharedTextPtr->tagTable, &search); + hPtr != NULL; i++, hPtr = Tcl_NextHashEntry(&search)) { + TkTextTag *tagPtr = Tcl_GetHashValue(hPtr); - for (i=0, hPtr=Tcl_FirstHashEntry(&sharedTextPtr->tagTable, &search); - hPtr != NULL; i++, hPtr = Tcl_NextHashEntry(&search)) { - TkTextTag *tagPtr = Tcl_GetHashValue(hPtr); + TkBTreeTag(&index1, &index2, tagPtr, 0); + } - TkBTreeTag(&index1, &index2, tagPtr, 0); - } + /* + * Special case for the sel tag which is not in the hash table. We + * need to do this once for each peer text widget. + */ - /* - * Special case for the sel tag which is not in the hash table. We - * need to do this once for each peer text widget. - */ + for (tPtr = sharedTextPtr->peers; tPtr != NULL ; + tPtr = tPtr->next) { + if (TkBTreeTag(&index1, &index2, tPtr->selTagPtr, 0)) { + /* + * Send an event that the selection changed. This is + * equivalent to: + * event generate $textWidget <> + */ - for (tPtr = sharedTextPtr->peers; tPtr != NULL ; - tPtr = tPtr->next) { - if (TkBTreeTag(&index1, &index2, tPtr->selTagPtr, 0)) { - /* - * Send an event that the selection changed. This is - * equivalent to: - * event generate $textWidget <> - */ - - TkTextSelectionEvent(textPtr); - tPtr->abortSelections = 1; - } - } + TkTextSelectionEvent(textPtr); + tPtr->abortSelections = 1; + } } /* @@ -3378,7 +3387,7 @@ TextFetchSelection( TkTextSearch search; TkTextSegment *segPtr; - if (!textPtr->exportSelection) { + if ((!textPtr->exportSelection) || Tcl_IsSafe(textPtr->interp)) { return -1; } @@ -3508,7 +3517,7 @@ TkTextLostSelection( if (TkpAlwaysShowSelection(textPtr->tkwin)) { TkTextIndex start, end; - if (!textPtr->exportSelection) { + if ((!textPtr->exportSelection) || Tcl_IsSafe(textPtr->interp)) { return; } @@ -4175,7 +4184,7 @@ TextSearchAddNextLine( if (lenPtr != NULL) { if (searchSpecPtr->exact) { - (void)Tcl_GetString(theLine); + Tcl_GetString(theLine); *lenPtr = theLine->length; } else { *lenPtr = Tcl_GetCharLength(theLine); @@ -4700,7 +4709,7 @@ TextDumpCmd( if (objc == arg) { TkTextIndexForwChars(NULL, &index1, 1, &index2, COUNT_INDICES); } else { - int length; + size_t length; const char *str; if (TkTextGetObjIndex(interp, textPtr, objv[arg], &index2) != TCL_OK) { @@ -4708,7 +4717,7 @@ TextDumpCmd( } str = Tcl_GetString(objv[arg]); length = objv[arg]->length; - if (strncmp(str, "end", (unsigned) length) == 0) { + if (strncmp(str, "end", length) == 0) { atEnd = 1; } } @@ -5814,7 +5823,7 @@ SearchCore( firstOffset = 0; } - if (alreadySearchOffset != -1) { + if (alreadySearchOffset >= 0) { if (searchSpecPtr->backwards) { if (alreadySearchOffset < lastOffset) { lastOffset = alreadySearchOffset; @@ -5903,17 +5912,17 @@ SearchCore( * match. */ - const char c = pattern[0]; + const char c = matchLength ? pattern[0] : '\0'; - if (alreadySearchOffset != -1) { + if (alreadySearchOffset >= 0) { p = startOfLine + alreadySearchOffset; alreadySearchOffset = -1; } else { p = startOfLine + lastOffset -1; } while (p >= startOfLine + firstOffset) { - if (p[0] == c && !strncmp(p, pattern, - (unsigned) matchLength)) { + if (matchLength == 0 || (p[0] == c && !strncmp( + p, pattern, (size_t) matchLength))) { goto backwardsMatch; } p--; @@ -6008,7 +6017,7 @@ SearchCore( * result. */ - if (strncmp(p,pattern,(unsigned)matchLength)) { + if (strncmp(p,pattern,(size_t)matchLength)) { p = NULL; } break; @@ -6076,10 +6085,14 @@ SearchCore( if (firstNewLine != -1) { break; } else { - alreadySearchOffset -= matchLength; + alreadySearchOffset -= (matchLength ? matchLength : 1); + if (alreadySearchOffset < 0) { + break; + } } } else { - firstOffset = p - startOfLine + matchLength; + firstOffset = matchLength ? p - startOfLine + matchLength + : p - startOfLine + 1; if (firstOffset >= lastOffset) { /* * Now, we have to be careful not to find @@ -6815,10 +6828,9 @@ ObjectIsEmpty( if (objPtr == NULL) { return 1; } - if (objPtr->bytes != NULL) { - return (objPtr->length == 0); + if (objPtr->bytes == NULL) { + Tcl_GetString(objPtr); } - (void)Tcl_GetString(objPtr); return (objPtr->length == 0); } diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index 126b631b..84be2323 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -24,6 +24,11 @@ #ifdef MAC_OSX_TK #include "tkMacOSXInt.h" +#define OK_TO_LOG (!TkpAppIsDrawing()) +#define FORCE_DISPLAY(winPtr) TkpDisplayWindow(winPtr) +#else +#define OK_TO_LOG 1 +#define FORCE_DISPLAY(winPtr) #endif /* @@ -203,12 +208,21 @@ typedef struct TextStyle { (fabs((double1)-(double2))*((scaleFactor)+1.0) < 0.3) /* - * Macro to make debugging/testing logging a little easier. + * Macros to make debugging/testing logging a little easier. + * + * On OSX 10.14 Drawing procedures are sometimes run because the system has + * decided to redraw the window. This can corrupt the data that a test is + * trying to collect. So we don't write to the logging variables when the + * drawing procedure is being run that way. Other systems can always log. */ -#define LOG(toVar,what) \ - Tcl_SetVar2(textPtr->interp, toVar, NULL, (what), \ - TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT) +#define LOG(toVar,what) \ + if (OK_TO_LOG) \ + Tcl_SetVar2(textPtr->interp, toVar, NULL, (what), \ + TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT) +#define CLEAR(var) \ + if (OK_TO_LOG) \ + Tcl_SetVar2(interp, var, NULL, "", TCL_GLOBAL_ONLY) /* * The following structure describes one line of the display, which may be @@ -3121,6 +3135,18 @@ GenerateWidgetViewSyncEvent( TkText *textPtr, /* Information about text widget. */ Bool InSync) /* true if in sync, false otherwise */ { + /* + * OSX 10.14 needs to be told to display the window when the Text Widget + * is in sync. (That is, to run DisplayText inside of the drawRect + * method.) Otherwise the screen might not get updated until an event + * like a mouse click is received. But that extra drawing corrupts the + * data that the test suite is trying to collect. + */ + + if (!tkTextDebug) { + FORCE_DISPLAY(textPtr->tkwin); + } + TkSendVirtualEvent(textPtr->tkwin, "WidgetViewSync", Tcl_NewBooleanObj(InSync)); } @@ -4136,7 +4162,7 @@ DisplayText( Tcl_Preserve(interp); if (tkTextDebug) { - Tcl_SetVar2(interp, "tk_textRelayout", NULL, "", TCL_GLOBAL_ONLY); + CLEAR("tk_textRelayout"); } if (!Tk_IsMapped(textPtr->tkwin) || (dInfoPtr->maxX <= dInfoPtr->x) @@ -4147,7 +4173,7 @@ DisplayText( } numRedisplays++; if (tkTextDebug) { - Tcl_SetVar2(interp, "tk_textRedraw", NULL, "", TCL_GLOBAL_ONLY); + CLEAR("tk_textRedraw"); } /* @@ -5134,6 +5160,7 @@ TkTextRelayoutWindow( TextDInfo *dInfoPtr = textPtr->dInfoPtr; GC newGC; XGCValues gcValues; + Bool inSync = 1; /* * Schedule the window redisplay. See TkTextChanged for the reason why @@ -5142,6 +5169,7 @@ TkTextRelayoutWindow( if (!(dInfoPtr->flags & REDRAW_PENDING)) { Tcl_DoWhenIdle(DisplayText, textPtr); + inSync = 0; } dInfoPtr->flags |= REDRAW_PENDING|REDRAW_BORDERS|DINFO_OUT_OF_DATE |REPICK_NEEDED; @@ -5213,6 +5241,7 @@ TkTextRelayoutWindow( dInfoPtr->yScrollFirst = dInfoPtr->yScrollLast = -1; if (mask & TK_TEXT_LINE_GEOMETRY) { + /* * Set up line metric recalculation. * @@ -5237,7 +5266,11 @@ TkTextRelayoutWindow( textPtr->refCount++; dInfoPtr->lineUpdateTimer = Tcl_CreateTimerHandler(1, AsyncUpdateLineMetrics, textPtr); - GenerateWidgetViewSyncEvent(textPtr, 0); + inSync = 0; + } + + if (!inSync) { + GenerateWidgetViewSyncEvent(textPtr, 0); } } } diff --git a/generic/tkTextIndex.c b/generic/tkTextIndex.c index faa1afdb..582e1a8a 100644 --- a/generic/tkTextIndex.c +++ b/generic/tkTextIndex.c @@ -134,7 +134,7 @@ UpdateStringOfTextIndex( Tcl_Obj *objPtr) { char buffer[TK_POS_CHARS]; - register int len; + size_t len; const TkTextIndex *indexPtr = GET_TEXTINDEX(objPtr); len = TkTextPrintIndex(indexPtr->textPtr, indexPtr, buffer); @@ -387,7 +387,7 @@ TkTextMakeByteIndex( TkTextSegment *segPtr; int index; const char *p, *start; - Tcl_UniChar ch; + int ch; indexPtr->tree = tree; if (lineIndex < 0) { @@ -437,7 +437,7 @@ TkTextMakeByteIndex( start = segPtr->body.chars + (byteIndex - index); p = Tcl_UtfPrev(start, segPtr->body.chars); - p += Tcl_UtfToUniChar(p, &ch); + p += TkUtfToUniChar(p, &ch); indexPtr->byteIndex += p - start; } break; @@ -480,7 +480,7 @@ TkTextMakeCharIndex( register TkTextSegment *segPtr; char *p, *start, *end; int index, offset; - Tcl_UniChar ch; + int ch; indexPtr->tree = tree; if (lineIndex < 0) { @@ -527,7 +527,7 @@ TkTextMakeCharIndex( return indexPtr; } charIndex--; - offset = Tcl_UtfToUniChar(p, &ch); + offset = TkUtfToUniChar(p, &ch); index += offset; } } else { @@ -1475,7 +1475,7 @@ TkTextIndexForwChars( TkTextElideInfo *infoPtr = NULL; int byteOffset; char *start, *end, *p; - Tcl_UniChar ch; + int ch; int elide = 0; int checkElided = (type & COUNT_DISPLAY); @@ -1574,7 +1574,7 @@ TkTextIndexForwChars( if (segPtr->typePtr == &tkTextCharType) { start = segPtr->body.chars + byteOffset; end = segPtr->body.chars + segPtr->size; - for (p = start; p < end; p += Tcl_UtfToUniChar(p, &ch)) { + for (p = start; p < end; p += TkUtfToUniChar(p, &ch)) { if (charCount == 0) { dstPtr->byteIndex += (p - start); goto forwardCharDone; diff --git a/generic/tkTextTag.c b/generic/tkTextTag.c index d9329f54..9ade3ad1 100644 --- a/generic/tkTextTag.c +++ b/generic/tkTextTag.c @@ -243,6 +243,7 @@ TkTextTagCmd( TkTextSelectionEvent(textPtr); if (addTag && textPtr->exportSelection + && (!Tcl_IsSafe(textPtr->interp)) && !(textPtr->flags & GOT_SELECTION)) { Tk_OwnSelection(textPtr->tkwin, XA_PRIMARY, TkTextLostSelection, textPtr); diff --git a/generic/tkUtil.c b/generic/tkUtil.c index e6868262..1942975e 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -733,7 +733,7 @@ Tk_GetScrollInfoObj( size_t length = objv[2]->length; #define ArgPfxEq(str) \ - ((arg[0] == str[0]) && !strncmp(arg, str, (unsigned)length)) + ((arg[0] == str[0]) && !strncmp(arg, str, length)) if (ArgPfxEq("moveto")) { if (objc != 4) { @@ -1260,7 +1260,7 @@ TkUtfToUniChar( int TkUniCharToUtf(int ch, char *buf) { int size = Tcl_UniCharToUtf(ch, buf); - if ((ch > 0xffff) && (ch <= 0x10ffff) && (size < 4)) { + if ((((unsigned)(ch - 0x10000) <= 0xFFFFF)) && (size < 4)) { /* Hey, this is wrong, we must be running TCL_UTF_MAX==3 * The best thing we can do is spit out 2 surrogates */ ch -= 0x10000; diff --git a/generic/tkWindow.c b/generic/tkWindow.c index 2848ff59..d175ef9b 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -2785,6 +2785,18 @@ DeleteWindowsExitProc( Tcl_Release(interp); } + /* + * Let error handlers catch up before actual close of displays. + * Must be done before tsdPtr->displayList is cleared, otherwise + * ErrorProc() in tkError.c cannot associate the pending X errors + * to the remaining error handlers. + */ + + for (dispPtr = tsdPtr->displayList; dispPtr != NULL; + dispPtr = dispPtr->nextPtr) { + XSync(dispPtr->display, False); + } + /* * Iterate destroying the displays until no more displays remain. It is * possible for displays to get recreated during exit by any code that diff --git a/generic/ttk/ttkButton.c b/generic/ttk/ttkButton.c index c00754b3..68a62933 100644 --- a/generic/ttk/ttkButton.c +++ b/generic/ttk/ttkButton.c @@ -489,12 +489,15 @@ static int CheckbuttonConfigure(Tcl_Interp *interp, void *recordPtr, int mask) { Checkbutton *checkPtr = recordPtr; - Ttk_TraceHandle *vt = Ttk_TraceVariable( - interp, checkPtr->checkbutton.variableObj, - CheckbuttonVariableChanged, checkPtr); - - if (!vt) { - return TCL_ERROR; + Tcl_Obj *varName = checkPtr->checkbutton.variableObj; + Ttk_TraceHandle *vt = NULL; + + if (varName != NULL && *Tcl_GetString(varName) != '\0') { + vt = Ttk_TraceVariable(interp, varName, + CheckbuttonVariableChanged, checkPtr); + if (!vt) { + return TCL_ERROR; + } } if (BaseConfigure(interp, recordPtr, mask) != TCL_OK){ @@ -502,7 +505,9 @@ CheckbuttonConfigure(Tcl_Interp *interp, void *recordPtr, int mask) return TCL_ERROR; } - Ttk_UntraceVariable(checkPtr->checkbutton.variableTrace); + if (checkPtr->checkbutton.variableTrace) { + Ttk_UntraceVariable(checkPtr->checkbutton.variableTrace); + } checkPtr->checkbutton.variableTrace = vt; return TCL_OK; @@ -548,10 +553,13 @@ CheckbuttonInvokeCommand( else newValue = checkPtr->checkbutton.onValueObj; - if (Tcl_ObjSetVar2(interp, - checkPtr->checkbutton.variableObj, NULL, newValue, - TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) - == NULL) + if (checkPtr->checkbutton.variableObj == NULL || + *Tcl_GetString(checkPtr->checkbutton.variableObj) == '\0') + CheckbuttonVariableChanged(checkPtr, Tcl_GetString(newValue)); + else if (Tcl_ObjSetVar2(interp, + checkPtr->checkbutton.variableObj, NULL, newValue, + TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) + == NULL) return TCL_ERROR; if (WidgetDestroyed(corePtr)) diff --git a/generic/ttk/ttkEntry.c b/generic/ttk/ttkEntry.c index a25574ab..f6a9c271 100644 --- a/generic/ttk/ttkEntry.c +++ b/generic/ttk/ttkEntry.c @@ -337,7 +337,8 @@ EntryFetchSelection( const char *string; const char *selStart, *selEnd; - if (entryPtr->entry.selectFirst < 0 || !entryPtr->entry.exportSelection) { + if (entryPtr->entry.selectFirst < 0 || (!entryPtr->entry.exportSelection) + || Tcl_IsSafe(entryPtr->core.interp)) { return -1; } string = entryPtr->entry.displayString; @@ -372,11 +373,12 @@ static void EntryLostSelection(ClientData clientData) /* EntryOwnSelection -- * Assert ownership of the PRIMARY selection, - * if -exportselection set and selection is present. + * if -exportselection set and selection is present and interp is unsafe. */ static void EntryOwnSelection(Entry *entryPtr) { if (entryPtr->entry.exportSelection + && (!Tcl_IsSafe(entryPtr->core.interp)) && !(entryPtr->core.flags & GOT_SELECTION)) { Tk_OwnSelection(entryPtr->core.tkwin, XA_PRIMARY, EntryLostSelection, (ClientData) entryPtr); @@ -999,7 +1001,8 @@ static int EntryConfigure(Tcl_Interp *interp, void *recordPtr, int mask) /* Claim the selection, in case we've suddenly started exporting it. */ - if (entryPtr->entry.exportSelection && entryPtr->entry.selectFirst != -1) { + if (entryPtr->entry.exportSelection && (entryPtr->entry.selectFirst != -1) + && (!Tcl_IsSafe(entryPtr->core.interp))) { EntryOwnSelection(entryPtr); } @@ -1241,6 +1244,7 @@ static void EntryDisplay(void *clientData, Drawable d) /* Draw cursor: */ if (showCursor) { + Ttk_Box field = Ttk_ClientRegion(entryPtr->core.layout, "field"); int cursorX = EntryCharPosition(entryPtr, entryPtr->entry.insertPos), cursorY = entryPtr->entry.layoutY, cursorHeight = entryPtr->entry.layoutHeight, @@ -1254,10 +1258,16 @@ static void EntryDisplay(void *clientData, Drawable d) /* @@@ should: maybe: SetCaretPos even when blinked off */ Tk_SetCaretPos(tkwin, cursorX, cursorY, cursorHeight); - gc = EntryGetGC(entryPtr, es.insertColorObj, clipRegion); + cursorX -= cursorWidth/2; + if (cursorX < field.x) { + cursorX = field.x; + } else if (cursorX + cursorWidth > field.x + field.width) { + cursorX = field.x + field.width - cursorWidth; + } + + gc = EntryGetGC(entryPtr, es.insertColorObj, None); XFillRectangle(Tk_Display(tkwin), d, gc, - cursorX-cursorWidth/2, cursorY, cursorWidth, cursorHeight); - XSetClipMask(Tk_Display(tkwin), gc, None); + cursorX, cursorY, cursorWidth, cursorHeight); Tk_FreeGC(Tk_Display(tkwin), gc); } diff --git a/generic/ttk/ttkLayout.c b/generic/ttk/ttkLayout.c index ba245898..2fd90b64 100644 --- a/generic/ttk/ttkLayout.c +++ b/generic/ttk/ttkLayout.c @@ -702,6 +702,8 @@ Ttk_LayoutTemplate Ttk_ParseLayoutTemplate(Tcl_Interp *interp, Tcl_Obj *objPtr) if (childSpec) { tail->child = Ttk_ParseLayoutTemplate(interp, childSpec); if (!tail->child) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf("Invalid -children value")); + Tcl_SetErrorCode(interp, "TTK", "VALUE", "CHILDREN", NULL); goto error; } } diff --git a/generic/ttk/ttkProgress.c b/generic/ttk/ttkProgress.c index 4dc50a22..6c139920 100644 --- a/generic/ttk/ttkProgress.c +++ b/generic/ttk/ttkProgress.c @@ -421,21 +421,23 @@ static int ProgressbarStepCommand( } newValueObj = Tcl_NewDoubleObj(value); + Tcl_IncrRefCount(newValueObj); TtkRedisplayWidget(&pb->core); /* Update value by setting the linked -variable, if there is one: */ if (pb->progress.variableTrace) { - return Tcl_ObjSetVar2( - interp, pb->progress.variableObj, 0, newValueObj, - TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG) - ? TCL_OK : TCL_ERROR; + int result = Tcl_ObjSetVar2( + interp, pb->progress.variableObj, 0, newValueObj, + TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG) + ? TCL_OK : TCL_ERROR; + Tcl_DecrRefCount(newValueObj); + return result; } /* Otherwise, change the -value directly: */ - Tcl_IncrRefCount(newValueObj); Tcl_DecrRefCount(pb->progress.valueObj); pb->progress.valueObj = newValueObj; CheckAnimation(pb); diff --git a/generic/ttk/ttkScale.c b/generic/ttk/ttkScale.c index 69753d14..279fc7a5 100644 --- a/generic/ttk/ttkScale.c +++ b/generic/ttk/ttkScale.c @@ -15,6 +15,10 @@ #define MAX(a,b) ((a) > (b) ? (a) : (b)) #define MIN(a,b) ((a) < (b) ? (a) : (b)) +/* Bit fields for OptionSpec mask field: + */ +#define STATE_CHANGED (0x100) /* -state option changed */ + /* * Scale widget record */ @@ -35,6 +39,11 @@ typedef struct /* internal state */ Ttk_TraceHandle *variableTrace; + /* + * Compatibility/legacy options: + */ + Tcl_Obj *stateObj; + } ScalePart; typedef struct @@ -66,6 +75,10 @@ static Tk_OptionSpec ScaleOptionSpecs[] = DEF_SCALE_LENGTH, Tk_Offset(Scale,scale.lengthObj), -1, 0, 0, GEOMETRY_CHANGED}, + {TK_OPTION_STRING, "-state", "state", "State", + "normal", Tk_Offset(Scale,scale.stateObj), -1, + 0,0,STATE_CHANGED}, + WIDGET_TAKEFOCUS_TRUE, WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs) }; @@ -139,6 +152,10 @@ static int ScaleConfigure(Tcl_Interp *interp, void *recordPtr, int mask) } scale->scale.variableTrace = vt; + if (mask & STATE_CHANGED) { + TtkCheckStateOption(&scale->core, scale->scale.stateObj); + } + return TCL_OK; } diff --git a/generic/ttk/ttkState.c b/generic/ttk/ttkState.c index c34b900d..2941ca84 100644 --- a/generic/ttk/ttkState.c +++ b/generic/ttk/ttkState.c @@ -130,7 +130,8 @@ static void StateSpecUpdateString(Tcl_Obj *objPtr) unsigned int offbits = objPtr->internalRep.longValue & 0x0000FFFF; unsigned int mask = onbits | offbits; Tcl_DString result; - int i, len; + int i; + size_t len; Tcl_DStringInit(&result); @@ -146,9 +147,9 @@ static void StateSpecUpdateString(Tcl_Obj *objPtr) len = Tcl_DStringLength(&result); if (len) { /* 'len' includes extra trailing ' ' */ - objPtr->bytes = Tcl_Alloc((unsigned)len); + objPtr->bytes = Tcl_Alloc(len); objPtr->length = len-1; - strncpy(objPtr->bytes, Tcl_DStringValue(&result), (size_t)len-1); + strncpy(objPtr->bytes, Tcl_DStringValue(&result), len-1); objPtr->bytes[len-1] = '\0'; } else { /* empty string */ diff --git a/generic/ttk/ttkTrace.c b/generic/ttk/ttkTrace.c index ba66db42..e6eead2b 100644 --- a/generic/ttk/ttkTrace.c +++ b/generic/ttk/ttkTrace.c @@ -26,8 +26,8 @@ static char * VarTraceProc( ClientData clientData, /* Widget record pointer */ Tcl_Interp *interp, /* Interpreter containing variable. */ - const char *name1, /* (unused) */ - const char *name2, /* (unused) */ + const char *name1, /* Name of variable. */ + const char *name2, /* Second part of variable name. */ int flags) /* Information about what happened. */ { Ttk_TraceHandle *tracePtr = clientData; @@ -38,6 +38,17 @@ VarTraceProc( return NULL; } + /* + * See ticket [5d991b82]. + */ + + if (tracePtr->varnameObj == NULL) { + Tcl_UntraceVar2(interp, name1, name2, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + VarTraceProc, clientData); + return NULL; + } + name = Tcl_GetString(tracePtr->varnameObj); /* diff --git a/generic/ttk/ttkTreeview.c b/generic/ttk/ttkTreeview.c index d957ad22..bef84f35 100644 --- a/generic/ttk/ttkTreeview.c +++ b/generic/ttk/ttkTreeview.c @@ -1825,7 +1825,7 @@ static int DrawSubtree( static int DrawForest( Treeview *tv, TreeItem *item, Drawable d, int depth, int row) { - while (item && row <= tv->tree.yscroll.last) { + while (item && row < tv->tree.yscroll.last) { row = DrawSubtree(tv, item, d, depth, row); item = item->next; } diff --git a/library/demos/images/earthmenu.png b/library/demos/images/earthmenu.png new file mode 100644 index 00000000..c25b667b Binary files /dev/null and b/library/demos/images/earthmenu.png differ diff --git a/library/listbox.tcl b/library/listbox.tcl index 1b35b3d8..16e51bda 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -14,7 +14,7 @@ # tk::Priv elements used in this file: # # afterId - Token returned by "after" for autoscanning. -# listboxPrev - The last element to be selected or deselected +# listboxPrev - The last element to be selected or deselected # during a selection operation. # listboxSelection - All of the items that were selected before the # current selection operation (such as a mouse diff --git a/library/menu.tcl b/library/menu.tcl index e1c94c91..ba66b92b 100644 --- a/library/menu.tcl +++ b/library/menu.tcl @@ -609,7 +609,9 @@ proc ::tk::MenuButtonDown menu { return } if {[$menu index active] eq "none"} { - set Priv(window) {} + if {[$menu cget -type] ne "menubar" } { + set Priv(window) {} + } return } $menu postcascade active diff --git a/library/msgbox.tcl b/library/msgbox.tcl index 6d329c26..98603afe 100644 --- a/library/msgbox.tcl +++ b/library/msgbox.tcl @@ -234,7 +234,8 @@ proc ::tk::MessageBox {args} { } if {!$valid} { return -code error -errorcode {TK MSGBOX DEFAULT} \ - "invalid default button \"$data(-default)\"" + "bad -default value \"$data(-default)\": must be\ + abort, retry, ignore, ok, cancel, no, or yes" } # 2. Set the dialog to be a child window of $parent diff --git a/library/palette.tcl b/library/palette.tcl index 9cecf5b6..42c6a907 100644 --- a/library/palette.tcl +++ b/library/palette.tcl @@ -205,27 +205,27 @@ proc ::tk::RecolorTree {w colors} { # # Arguments: # color - Name of starting color. -# perecent - Integer telling how much to brighten or darken as a +# percent - Integer telling how much to brighten or darken as a # percent: 50 means darken by 50%, 110 means brighten # by 10%. proc ::tk::Darken {color percent} { - foreach {red green blue} [winfo rgb . $color] { - set red [expr {($red/256)*$percent/100}] - set green [expr {($green/256)*$percent/100}] - set blue [expr {($blue/256)*$percent/100}] - break + if {$percent < 0} { + return #000000 + } elseif {$percent > 200} { + 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}] + } 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}] } - if {$red > 255} { - set red 255 - } - if {$green > 255} { - set green 255 - } - if {$blue > 255} { - set blue 255 - } - return [format "#%02x%02x%02x" $red $green $blue] + return [format #%02x%02x%02x $r $g $b] } # ::tk_bisque -- diff --git a/library/text.tcl b/library/text.tcl index 645776da..468696b2 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -1058,13 +1058,13 @@ proc ::tk_textCut w { # make <> an atomic operation on the Undo stack, # i.e. separate it from other delete operations on either side set oldSeparator [$w cget -autoseparators] - if {$oldSeparator} { + if {([$w cget -state] eq "normal") && $oldSeparator} { $w edit separator } clipboard clear -displayof $w clipboard append -displayof $w $data $w delete sel.first sel.last - if {$oldSeparator} { + if {([$w cget -state] eq "normal") && $oldSeparator} { $w edit separator } } diff --git a/library/tk.tcl b/library/tk.tcl index d2f7b65b..61d13540 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 8.6.8 +package require -exact Tk 8.6.9 # Create a ::tk namespace namespace eval ::tk { diff --git a/library/ttk/altTheme.tcl b/library/ttk/altTheme.tcl index 5630e6ca..6fc76f85 100644 --- a/library/ttk/altTheme.tcl +++ b/library/ttk/altTheme.tcl @@ -95,8 +95,12 @@ namespace eval ttk::theme::alt { ttk::style configure Heading -font TkHeadingFont -relief raised ttk::style configure Treeview -background $colors(-window) ttk::style map Treeview \ - -background [list selected $colors(-selectbg)] \ - -foreground [list selected $colors(-selectfg)] ; + -background [list disabled $colors(-frame)\ + {!disabled !selected} $colors(-window) \ + selected $colors(-selectbg)] \ + -foreground [list disabled $colors(-disabledfg) \ + {!disabled !selected} black \ + selected $colors(-selectfg)] ttk::style configure TScale \ -groovewidth 4 -troughrelief sunken \ diff --git a/library/ttk/aquaTheme.tcl b/library/ttk/aquaTheme.tcl index fa0fa12c..d6be5a3e 100644 --- a/library/ttk/aquaTheme.tcl +++ b/library/ttk/aquaTheme.tcl @@ -41,8 +41,13 @@ namespace eval ttk::theme::aqua { ttk::style configure Heading -font TkHeadingFont ttk::style configure Treeview -rowheight 18 -background White ttk::style map Treeview \ - -background {{selected background} systemHighlightSecondary - selected systemHighlight} + -background [list disabled systemDialogBackgroundInactive \ + {!disabled !selected} systemWindowBody \ + {selected background} systemHighlightSecondary \ + selected systemHighlight] \ + -foreground [list disabled systemModelessDialogInactiveText \ + {!disabled !selected} black \ + selected systemModelessDialogActiveText] # Enable animation for ttk::progressbar widget: ttk::style configure TProgressbar -period 100 -maxphase 255 diff --git a/library/ttk/clamTheme.tcl b/library/ttk/clamTheme.tcl index 808c365a..3c6f5c38 100644 --- a/library/ttk/clamTheme.tcl +++ b/library/ttk/clamTheme.tcl @@ -131,8 +131,12 @@ namespace eval ttk::theme::clam { -font TkHeadingFont -relief raised -padding {3} ttk::style configure Treeview -background $colors(-window) ttk::style map Treeview \ - -background [list selected $colors(-selectbg)] \ - -foreground [list selected $colors(-selectfg)] ; + -background [list disabled $colors(-frame)\ + {!disabled !selected} $colors(-window) \ + selected $colors(-selectbg)] \ + -foreground [list disabled $colors(-disabledfg) \ + {!disabled !selected} black \ + selected $colors(-selectfg)] ttk::style configure TLabelframe \ -labeloutside true -labelmargins {0 0 0 4} \ diff --git a/library/ttk/classicTheme.tcl b/library/ttk/classicTheme.tcl index 3cb2b182..fefdb991 100644 --- a/library/ttk/classicTheme.tcl +++ b/library/ttk/classicTheme.tcl @@ -98,8 +98,12 @@ namespace eval ttk::theme::classic { ttk::style configure Heading -font TkHeadingFont -relief raised ttk::style configure Treeview -background $colors(-window) ttk::style map Treeview \ - -background [list selected $colors(-selectbg)] \ - -foreground [list selected $colors(-selectfg)] ; + -background [list disabled $colors(-frame)\ + {!disabled !selected} $colors(-window) \ + selected $colors(-selectbg)] \ + -foreground [list disabled $colors(-disabledfg) \ + {!disabled !selected} black \ + selected $colors(-selectfg)] # # Toolbar buttons: diff --git a/library/ttk/combobox.tcl b/library/ttk/combobox.tcl index 6ceccef2..c1b6da65 100644 --- a/library/ttk/combobox.tcl +++ b/library/ttk/combobox.tcl @@ -88,18 +88,18 @@ bind ComboboxPopdown \ ### Option database settings. # -option add *TCombobox*Listbox.font TkTextFont -option add *TCombobox*Listbox.relief flat -option add *TCombobox*Listbox.highlightThickness 0 +option add *TCombobox*Listbox.font TkTextFont widgetDefault +option add *TCombobox*Listbox.relief flat widgetDefault +option add *TCombobox*Listbox.highlightThickness 0 widgetDefault ## Platform-specific settings. # switch -- [tk windowingsystem] { x11 { - option add *TCombobox*Listbox.background white + option add *TCombobox*Listbox.background white widgetDefault } aqua { - option add *TCombobox*Listbox.borderWidth 0 + option add *TCombobox*Listbox.borderWidth 0 widgetDefault } } diff --git a/library/ttk/defaults.tcl b/library/ttk/defaults.tcl index 56e21768..4c1753d4 100644 --- a/library/ttk/defaults.tcl +++ b/library/ttk/defaults.tcl @@ -110,8 +110,12 @@ namespace eval ttk::theme::default { -background $colors(-window) \ -foreground $colors(-text) ; ttk::style map Treeview \ - -background [list selected $colors(-selectbg)] \ - -foreground [list selected $colors(-selectfg)] ; + -background [list disabled $colors(-frame)\ + {!disabled !selected} $colors(-window) \ + selected $colors(-selectbg)] \ + -foreground [list disabled $colors(-disabledfg) \ + {!disabled !selected} black \ + selected $colors(-selectfg)] # Combobox popdown frame ttk::style layout ComboboxPopdownFrame { diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl index b3ebcbde..c123bc96 100644 --- a/library/ttk/entry.tcl +++ b/library/ttk/entry.tcl @@ -34,7 +34,7 @@ namespace eval ttk { ### Option database settings. # -option add *TEntry.cursor [ttk::cursor text] +option add *TEntry.cursor [ttk::cursor text] widgetDefault ### Bindings. # @@ -418,7 +418,7 @@ proc ttk::entry::DragOut {w mode} { # Suspend autoscroll. # proc ttk::entry::DragIn {w} { - ttk::CancelRepeat + ttk::CancelRepeat } ## binding @@ -432,7 +432,7 @@ proc ttk::entry::Release {w} { ## AutoScroll # Called repeatedly when the mouse is outside an entry window # with Button 1 down. Scroll the window left or right, -# depending on where the mouse left the window, and extend +# depending on where the mouse left the window, and extend # the selection according to the current selection mode. # # TODO: AutoScroll should repeat faster (50ms) than normal autorepeat. diff --git a/library/ttk/sizegrip.tcl b/library/ttk/sizegrip.tcl index 153e3102..24a67c62 100644 --- a/library/ttk/sizegrip.tcl +++ b/library/ttk/sizegrip.tcl @@ -9,7 +9,7 @@ switch -- [tk windowingsystem] { x11 - win32 { - option add *TSizegrip.cursor [ttk::cursor seresize] + option add *TSizegrip.cursor [ttk::cursor seresize] widgetDefault } aqua { # Aqua sizegrips use default Arrow cursor. diff --git a/library/ttk/treeview.tcl b/library/ttk/treeview.tcl index 87725875..1ed87dbc 100644 --- a/library/ttk/treeview.tcl +++ b/library/ttk/treeview.tcl @@ -120,7 +120,7 @@ proc ttk::treeview::ActivateHeading {w heading} { variable State if {$w != $State(activeWidget) || $heading != $State(activeHeading)} { - if {$State(activeHeading) != {}} { + if {[winfo exists $State(activeWidget)] && $State(activeHeading) != {}} { $State(activeWidget) heading $State(activeHeading) state !active } if {$heading != {}} { diff --git a/library/ttk/vistaTheme.tcl b/library/ttk/vistaTheme.tcl index 3f75f51a..ecb39c9b 100644 --- a/library/ttk/vistaTheme.tcl +++ b/library/ttk/vistaTheme.tcl @@ -21,6 +21,7 @@ namespace eval ttk::theme::vista { -foreground SystemWindowText \ -selectforeground SystemHighlightText \ -selectbackground SystemHighlight \ + -insertcolor SystemWindowText \ -font TkDefaultFont \ ; @@ -46,20 +47,24 @@ namespace eval ttk::theme::vista { ttk::style configure Heading -font TkHeadingFont ttk::style configure Treeview -background SystemWindow ttk::style map Treeview \ - -background [list selected SystemHighlight] \ - -foreground [list selected SystemHighlightText] ; + -background [list disabled SystemButtonFace \ + {!disabled !selected} SystemWindow \ + selected SystemHighlight] \ + -foreground [list disabled SystemGrayText \ + {!disabled !selected} SystemWindowText \ + selected SystemHighlightText] # Label and Toolbutton - ttk::style configure TLabelframe.Label -foreground "#0046d5" + ttk::style configure TLabelframe.Label -foreground SystemButtonText ttk::style configure Toolbutton -padding {4 4} # Combobox ttk::style configure TCombobox -padding 2 - ttk::style element create Combobox.field vsapi \ - COMBOBOX 2 {{} 1} 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} @@ -67,8 +72,10 @@ namespace eval ttk::theme::vista { Combobox.border -sticky nswe -border 0 -children { Combobox.rightdownarrow -side right -sticky ns Combobox.padding -expand 1 -sticky nswe -children { - Combobox.focus -expand 1 -sticky nswe -children { - Combobox.textarea -sticky nswe + Combobox.background -sticky nswe -children { + Combobox.focus -expand 1 -sticky nswe -children { + Combobox.textarea -sticky nswe + } } } } diff --git a/library/ttk/winTheme.tcl b/library/ttk/winTheme.tcl index 55367bcd..a7a2c79e 100644 --- a/library/ttk/winTheme.tcl +++ b/library/ttk/winTheme.tcl @@ -10,6 +10,8 @@ namespace eval ttk::theme::winnative { -foreground SystemWindowText \ -selectforeground SystemHighlightText \ -selectbackground SystemHighlight \ + -fieldbackground SystemWindow \ + -insertcolor SystemWindowText \ -troughcolor SystemScrollbar \ -font TkDefaultFont \ ; @@ -71,8 +73,12 @@ namespace eval ttk::theme::winnative { ttk::style configure Heading -font TkHeadingFont -relief raised ttk::style configure Treeview -background SystemWindow ttk::style map Treeview \ - -background [list selected SystemHighlight] \ - -foreground [list selected SystemHighlightText] ; + -background [list disabled SystemButtonFace \ + {!disabled !selected} SystemWindow \ + selected SystemHighlight] \ + -foreground [list disabled SystemGrayText \ + {!disabled !selected} SystemWindowText \ + selected SystemHighlightText] ttk::style configure TProgressbar \ -background SystemHighlight -borderwidth 0 ; diff --git a/library/ttk/xpTheme.tcl b/library/ttk/xpTheme.tcl index 187ce0bc..5d8d09ba 100644 --- a/library/ttk/xpTheme.tcl +++ b/library/ttk/xpTheme.tcl @@ -11,6 +11,7 @@ namespace eval ttk::theme::xpnative { -foreground SystemWindowText \ -selectforeground SystemHighlightText \ -selectbackground SystemHighlight \ + -insertcolor SystemWindowText \ -font TkDefaultFont \ ; @@ -61,5 +62,15 @@ namespace eval ttk::theme::xpnative { ttk::style configure Toolbutton -padding {4 4} + # Treeview: + ttk::style configure Heading -font TkHeadingFont -relief raised + ttk::style configure Treeview -background SystemWindow + ttk::style map Treeview \ + -background [list disabled SystemButtonFace \ + {!disabled !selected} SystemWindow \ + selected SystemHighlight] \ + -foreground [list disabled SystemGrayText \ + {!disabled !selected} SystemWindowText \ + selected SystemHighlightText]; } } diff --git a/macosx/README b/macosx/README index bcd5dce3..c63b8aed 100644 --- a/macosx/README +++ b/macosx/README @@ -561,3 +561,12 @@ source and destination rectangles for the scrolling. The embedded windows are redrawn within the DisplayText function by some conditional code which is only used for macOS. +5.0 Virtual events on 10.14 +~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +10.14 supports system appearance changes, and has added a "Dark Mode" +that casts all window frames and menus as black. Tk 8.6.9 has added two +virtual events, <> and <>, to allow you to update +your Tk app's appearance when the system appearance changes. Just bind +your appearance-updating code to these virtual events and you will see +it triggered when the system appearance toggles between dark and light. diff --git a/macosx/Tk-Common.xcconfig b/macosx/Tk-Common.xcconfig index 0d6e4741..4ec1a52c 100644 --- a/macosx/Tk-Common.xcconfig +++ b/macosx/Tk-Common.xcconfig @@ -42,5 +42,5 @@ TCL_LIBRARY = $(LIBDIR)/tcl$(VERSION) TCL_PACKAGE_PATH = "$(LIBDIR)" TCL_DEFS = HAVE_TCL_CONFIG_H TK_LIBRARY = $(LIBDIR)/tk$(VERSION) -TK_DEFS = HAVE_TK_CONFIG_H TCL_NO_DEPRECATED +TK_DEFS = HAVE_TK_CONFIG_H VERSION = 8.6 diff --git a/macosx/configure b/macosx/configure index 13305856..7b899377 100755 --- a/macosx/configure +++ b/macosx/configure @@ -2287,7 +2287,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TK_VERSION=8.6 TK_MAJOR_VERSION=8 TK_MINOR_VERSION=6 -TK_PATCH_LEVEL=".8" +TK_PATCH_LEVEL=".9" VERSION=${TK_VERSION} LOCALES="cs da de el en en_gb eo es fr hu it nl pl pt ru sv" @@ -2376,11 +2376,13 @@ $as_echo "$as_me: WARNING: --with-tcl argument should refer to directory contain for i in `ls -d ${libdir} 2>/dev/null` \ `ls -d ${exec_prefix}/lib 2>/dev/null` \ `ls -d ${prefix}/lib 2>/dev/null` \ - `ls -d /usr/contrib/lib 2>/dev/null` \ `ls -d /usr/local/lib 2>/dev/null` \ + `ls -d /usr/contrib/lib 2>/dev/null` \ `ls -d /usr/pkg/lib 2>/dev/null` \ `ls -d /usr/lib 2>/dev/null` \ `ls -d /usr/lib64 2>/dev/null` \ + `ls -d /usr/local/lib/tcl8.6 2>/dev/null` \ + `ls -d /usr/local/lib/tcl/tcl8.6 2>/dev/null` \ ; do if test -f "$i/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd $i; pwd)`" @@ -4944,7 +4946,7 @@ $as_echo "$ac_cv_cygwin" >&6; } LDFLAGS="$LDFLAGS -Wl,--export-dynamic" SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" - SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}' + SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared' DL_OBJS="tclLoadDl.o" DL_LIBS="-lroot" { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inet_ntoa in -lnetwork" >&5 @@ -5266,7 +5268,7 @@ fi # get rid of the warnings. #CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES" - SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}' + SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared' DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -Wl,--export-dynamic" @@ -5374,7 +5376,7 @@ fi SHLIB_CFLAGS="-fpic" ;; esac - SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}' + SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" @@ -5401,7 +5403,7 @@ fi NetBSD-*) # NetBSD has ELF and can use 'cc -shared' to build shared libs SHLIB_CFLAGS="-fPIC" - SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}' + SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" @@ -5420,7 +5422,7 @@ fi fi ;; - FreeBSD-*) + DragonFly-*|FreeBSD-*) # This configuration from FreeBSD Ports. SHLIB_CFLAGS="-fPIC" SHLIB_LD="${CC} -shared" @@ -6236,7 +6238,7 @@ fi BSD/OS*) ;; CYGWIN_*|MINGW32_*) ;; IRIX*) ;; - NetBSD-*|FreeBSD-*|OpenBSD-*) ;; + NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;; Darwin-*) ;; SCO_SV-3.2*) ;; *) SHLIB_CFLAGS="-fPIC" ;; @@ -6702,6 +6704,40 @@ $as_echo "#define HAVE_STRUCT_DIRENT64 1" >>confdefs.h fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for DIR64" >&5 +$as_echo_n "checking for DIR64... " >&6; } +if ${tcl_cv_DIR64+:} false; then : + $as_echo_n "(cached) " >&6 +else + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +int +main () +{ +struct dirent64 *p; DIR64 d = opendir64("."); + p = readdir64(d); rewinddir64(d); closedir64(d); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_DIR64=yes +else + tcl_cv_DIR64=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_DIR64" >&5 +$as_echo "$tcl_cv_DIR64" >&6; } + if test "x${tcl_cv_DIR64}" = "xyes" ; then + +$as_echo "#define HAVE_DIR64 1" >>confdefs.h + + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct stat64" >&5 $as_echo_n "checking for struct stat64... " >&6; } if ${tcl_cv_struct_stat64+:} false; then : @@ -7162,81 +7198,6 @@ $as_echo "#define TIME_WITH_SYS_TIME 1" >>confdefs.h fi -#-------------------------------------------------------------------- -# Under Solaris 2.4, strtod returns the wrong value for the -# terminating character under some conditions. Check for this -# and if the problem exists use a substitute procedure -# "fixstrtod" (provided by Tcl) that corrects the error. -#-------------------------------------------------------------------- - - - ac_fn_c_check_func "$LINENO" "strtod" "ac_cv_func_strtod" -if test "x$ac_cv_func_strtod" = xyes; then : - tcl_strtod=1 -else - tcl_strtod=0 -fi - - if test "$tcl_strtod" = 1; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Solaris2.4/Tru64 strtod bugs" >&5 -$as_echo_n "checking for Solaris2.4/Tru64 strtod bugs... " >&6; } -if ${tcl_cv_strtod_buggy+:} false; then : - $as_echo_n "(cached) " >&6 -else - - if test "$cross_compiling" = yes; then : - tcl_cv_strtod_buggy=buggy -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - extern double strtod(); - int main() { - char *infString="Inf", *nanString="NaN", *spaceString=" "; - char *term; - double value; - value = strtod(infString, &term); - if ((term != infString) && (term[-1] == 0)) { - exit(1); - } - value = strtod(nanString, &term); - if ((term != nanString) && (term[-1] == 0)) { - exit(1); - } - value = strtod(spaceString, &term); - if (term == (spaceString+1)) { - exit(1); - } - exit(0); - } -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - tcl_cv_strtod_buggy=ok -else - tcl_cv_strtod_buggy=buggy -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_strtod_buggy" >&5 -$as_echo "$tcl_cv_strtod_buggy" >&6; } - if test "$tcl_cv_strtod_buggy" = buggy; then - case " $LIBOBJS " in - *" fixstrtod.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS fixstrtod.$ac_objext" - ;; -esac - - USE_COMPAT=1 - -$as_echo "#define strtod fixstrtod" >>confdefs.h - - fi - fi - - #-------------------------------------------------------------------- # Check for various typedefs and provide substitutes if # they don't exist. diff --git a/macosx/tkMacOSXButton.c b/macosx/tkMacOSXButton.c index 0ed52db7..ea78d435 100644 --- a/macosx/tkMacOSXButton.c +++ b/macosx/tkMacOSXButton.c @@ -21,19 +21,16 @@ #include "tkMacOSXFont.h" #include "tkMacOSXDebug.h" - #define FIRST_DRAW 2 #define ACTIVE 4 - /* - * Default insets for controls + * Extra padding used for computing the content size that should + * be allowed when drawing the HITheme button. */ -#define DEF_INSET_LEFT 12 -#define DEF_INSET_RIGHT 12 -#define DEF_INSET_TOP 1 -#define DEF_INSET_BOTTOM 1 +#define HI_PADX 2 +#define HI_PADY 1 /* * Some defines used to control what type of control is drawn. @@ -318,9 +315,8 @@ TkpComputeButtonGeometry( Tcl_GetString(butPtr->textPtr), -1, butPtr->wrapLength, butPtr->justify, 0, &butPtr->textWidth, &butPtr->textHeight); - /*Remove extraneous padding around label widgets.*/ txtWidth = butPtr->textWidth; - txtHeight = butPtr->textHeight + DEF_INSET_BOTTOM + DEF_INSET_TOP; + txtHeight = butPtr->textHeight; charWidth = Tk_TextWidth(butPtr->tkfont, "0", 1); Tk_GetFontMetrics(butPtr->tkfont, &fm); haveText = (txtWidth != 0 && txtHeight != 0); @@ -364,8 +360,7 @@ TkpComputeButtonGeometry( height = butPtr->height > 0 ? butPtr->height : height; } else { /* Text only */ - /*Add four pixels of padding to width for text-only buttons to improve appearance.*/ - width = txtWidth + butPtr->indicatorSpace + 4; + width = txtWidth + butPtr->indicatorSpace; height = txtHeight; if (butPtr->width > 0) { width = butPtr->width * charWidth; @@ -396,7 +391,7 @@ TkpComputeButtonGeometry( int paddingx = 0; int paddingy = 0; - tmpRect = CGRectMake(0, 0, width, height); + tmpRect = CGRectMake(0, 0, width + 2*HI_PADX, height + 2*HI_PADY); HIThemeGetButtonContentBounds(&tmpRect, &mbPtr->drawinfo, &contBounds); /* If the content region has a minimum height, match it. */ @@ -425,6 +420,9 @@ TkpComputeButtonGeometry( width += butPtr->inset*2; height += butPtr->inset*2; + if ([NSApp macMinorVersion] == 6) { + width += 12; + } Tk_GeometryRequest(butPtr->tkwin, width, height); Tk_SetInternalBorder(butPtr->tkwin, butPtr->inset); @@ -649,7 +647,7 @@ DrawButtonImageAndText( butPtr->textHeight, &x, &y); x += butPtr->indicatorSpace; Tk_DrawTextLayout(butPtr->display, pixmap, dpPtr->gc, butPtr->textLayout, - x, y - DEF_INSET_BOTTOM, 0, -1); + x, y, 0, -1); } /* @@ -786,19 +784,6 @@ TkMacOSXDrawButton( return; } - - if (mbPtr->btnkind == kThemePushButton) { - /* - * For some reason, pushbuttons get drawn a bit - * too low, normally. Correct for this. - */ - if (cntrRect.size.height < 22) { - cntrRect.origin.y -= 1; - } else if (cntrRect.size.height < 23) { - cntrRect.origin.y -= 2; - } - } - hiinfo.version = 0; hiinfo.state = mbPtr->drawinfo.state; hiinfo.kind = mbPtr->btnkind; @@ -910,7 +895,10 @@ ButtonContentDrawCB ( return; } - /*Overlay Tk elements over button native region: drawing elements within button boundaries/native region causes unpredictable metrics.*/ + /* + * Overlay Tk elements over button native region: drawing elements + * within button boundaries/native region causes unpredictable metrics. + */ DrawButtonImageAndText( butPtr); } @@ -1213,3 +1201,11 @@ PulseDefaultButtonProc(ClientData clientData) PULSE_TIMER_MSECS, PulseDefaultButtonProc, clientData); } +/* + * Local Variables: + * mode: objc + * c-basic-offset: 4 + * fill-column: 79 + * coding: utf-8 + * End: + */ diff --git a/macosx/tkMacOSXClipboard.c b/macosx/tkMacOSXClipboard.c index 07a84197..efd3c690 100644 --- a/macosx/tkMacOSXClipboard.c +++ b/macosx/tkMacOSXClipboard.c @@ -12,6 +12,7 @@ */ #include "tkMacOSXPrivate.h" +#include "tkMacOSXConstants.h" #include "tkSelect.h" static NSInteger changeCount = -1; @@ -70,10 +71,8 @@ static Tk_Window clipboardOwner = NULL; if (clipboardOwner && [[NSPasteboard generalPasteboard] changeCount] != changeCount) { TkDisplay *dispPtr = TkGetDisplayList(); - if (dispPtr) { XEvent event; - event.xany.type = SelectionClear; event.xany.serial = NextRequest(Tk_Display(clipboardOwner)); event.xany.send_event = False; @@ -125,8 +124,10 @@ TkSelGetSelection( int result = TCL_ERROR; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - if (dispPtr && selection == dispPtr->clipboardAtom && (target == XA_STRING - || target == dispPtr->utf8Atom)) { + int haveExternalClip = ([[NSPasteboard generalPasteboard] changeCount] != changeCount); + if (dispPtr && (haveExternalClip || dispPtr->clipboardActive) + && selection == dispPtr->clipboardAtom + && (target == XA_STRING || target == dispPtr->utf8Atom)) { NSString *string = nil; NSPasteboard *pb = [NSPasteboard generalPasteboard]; NSString *type = [pb availableTypeFromArray:[NSArray arrayWithObject: @@ -176,7 +177,6 @@ XSetSelectionOwner( clipboardOwner = owner ? Tk_IdToWindow(display, owner) : NULL; if (!dispPtr->clipboardActive) { NSPasteboard *pb = [NSPasteboard generalPasteboard]; - changeCount = [pb declareTypes:[NSArray array] owner:NSApp]; } } @@ -289,28 +289,6 @@ TkSelPropProc( { } -/* - *---------------------------------------------------------------------- - * - * TkSuspendClipboard -- - * - * Handle clipboard conversion as required by the suppend event. - * - * Results: - * None. - * - * Side effects: - * The local scrap is moved to the global scrap. - * - *---------------------------------------------------------------------- - */ - -void -TkSuspendClipboard(void) -{ - changeCount = [[NSPasteboard generalPasteboard] changeCount]; -} - /* * Local Variables: * mode: objc diff --git a/macosx/tkMacOSXConfig.c b/macosx/tkMacOSXConfig.c index bdfcb6ec..841fc54e 100644 --- a/macosx/tkMacOSXConfig.c +++ b/macosx/tkMacOSXConfig.c @@ -41,3 +41,12 @@ TkpGetSystemDefault( { return NULL; } + +/* + * Local Variables: + * mode: objc + * c-basic-offset: 4 + * fill-column: 79 + * coding: utf-8 + * End: + */ diff --git a/macosx/tkMacOSXConstants.h b/macosx/tkMacOSXConstants.h new file mode 100644 index 00000000..0badf1a8 --- /dev/null +++ b/macosx/tkMacOSXConstants.h @@ -0,0 +1,121 @@ +/* + * tkMacOSXConstants.h -- + * + * Macros which map the names of NS constants used in the Tk code to + * the new name that Apple came up with for subsequent versions of the + * operating system. (Each new OS release seems to come with a new + * naming convention for the same old constants.) + * + * Copyright (c) 2017 Marc Culler + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#ifndef _TKMACCONSTANTS +#define _TKMACCONSTANTS + +#if MAC_OS_X_VERSION_MAX_ALLOWED < 1070 +#define NSFullScreenWindowMask (1 << 14) +#endif + +/* + * Let's raise a glass for the project manager who improves our lives by + * generating deprecation warnings about pointless changes of the names + * of constants. + */ + +#if MAC_OS_X_VERSION_MIN_REQUIRED >= 1090 +#define kCTFontDefaultOrientation kCTFontOrientationDefault +#define kCTFontVerticalOrientation kCTFontOrientationVertical +#endif + +#if MAC_OS_X_VERSION_MIN_REQUIRED >= 101000 +#define NSOKButton NSModalResponseOK +#endif + +#if MAC_OS_X_VERSION_MIN_REQUIRED >= 101100 +#define kCTFontUserFixedPitchFontType kCTFontUIFontUserFixedPitch +#endif + +#if MAC_OS_X_VERSION_MIN_REQUIRED >= 101200 +#define NSAppKitDefined NSEventTypeAppKitDefined +#define NSApplicationDefined NSEventTypeApplicationDefined +#define NSApplicationActivatedEventType NSEventSubtypeApplicationActivated +#define NSApplicationDeactivatedEventType NSEventSubtypeApplicationDeactivated +#define NSWindowExposedEventType NSEventSubtypeWindowExposed +#define NSScreenChangedEventType NSEventSubtypeScreenChanged +#define NSWindowMovedEventType NSEventSubtypeWindowMoved +#define NSKeyUp NSEventTypeKeyUp +#define NSKeyDown NSEventTypeKeyDown +#define NSFlagsChanged NSEventTypeFlagsChanged +#define NSLeftMouseDown NSEventTypeLeftMouseDown +#define NSLeftMouseUp NSEventTypeLeftMouseUp +#define NSRightMouseDown NSEventTypeRightMouseDown +#define NSRightMouseUp NSEventTypeRightMouseUp +#define NSLeftMouseDragged NSEventTypeLeftMouseDragged +#define NSRightMouseDragged NSEventTypeRightMouseDragged +#define NSMouseMoved NSEventTypeMouseMoved +#define NSMouseEntered NSEventTypeMouseEntered +#define NSMouseExited NSEventTypeMouseExited +#define NSScrollWheel NSEventTypeScrollWheel +#define NSOtherMouseDown NSEventTypeOtherMouseDown +#define NSOtherMouseUp NSEventTypeOtherMouseUp +#define NSOtherMouseDragged NSEventTypeOtherMouseDragged +#define NSTabletPoint NSEventTypeTabletPoint +#define NSTabletProximity NSEventTypeTabletProximity +#define NSDeviceIndependentModifierFlagsMask NSEventModifierFlagDeviceIndependentFlagsMask +#define NSCommandKeyMask NSEventModifierFlagCommand +#define NSShiftKeyMask NSEventModifierFlagShift +#define NSAlphaShiftKeyMask NSEventModifierFlagCapsLock +#define NSAlternateKeyMask NSEventModifierFlagOption +#define NSControlKeyMask NSEventModifierFlagControl +#define NSNumericPadKeyMask NSEventModifierFlagNumericPad +#define NSFunctionKeyMask NSEventModifierFlagFunction +#define NSCursorUpdate NSEventTypeCursorUpdate +#define NSTexturedBackgroundWindowMask NSWindowStyleMaskTexturedBackground +#define NSCompositeCopy NSCompositingOperationCopy +#define NSWarningAlertStyle NSAlertStyleWarning +#define NSInformationalAlertStyle NSAlertStyleInformational +#define NSCriticalAlertStyle NSAlertStyleCritical +#define NSCenterTextAlignment NSTextAlignmentCenter +#define NSDeviceIndependentModifierFlagsMask NSEventModifierFlagDeviceIndependentFlagsMask +#define NSCommandKeyMask NSEventModifierFlagCommand +#define NSShiftKeyMask NSEventModifierFlagShift +#define NSAlphaShiftKeyMask NSEventModifierFlagCapsLock +#define NSAlternateKeyMask NSEventModifierFlagOption +#define NSControlKeyMask NSEventModifierFlagControl +#define NSNumericPadKeyMask NSEventModifierFlagNumericPad +#define NSFunctionKeyMask NSEventModifierFlagFunction +#define NSKeyUp NSEventTypeKeyUp +#define NSKeyDown NSEventTypeKeyDown +#define NSFlagsChanged NSEventTypeFlagsChanged +#define NSAlphaShiftKeyMask NSEventModifierFlagCapsLock +#define NSShiftKeyMask NSEventModifierFlagShift +#define NSAnyEventMask NSEventMaskAny +#define NSApplicationDefinedMask NSEventMaskApplicationDefined +#define NSTexturedBackgroundWindowMask NSWindowStyleMaskTexturedBackground +#define NSUtilityWindowMask NSWindowStyleMaskUtilityWindow +#define NSNonactivatingPanelMask NSWindowStyleMaskNonactivatingPanel +#define NSDocModalWindowMask NSWindowStyleMaskDocModalWindow +#define NSHUDWindowMask NSWindowStyleMaskHUDWindow +#define NSTitledWindowMask NSWindowStyleMaskTitled +#define NSClosableWindowMask NSWindowStyleMaskClosable +#define NSResizableWindowMask NSWindowStyleMaskResizable +#define NSUnifiedTitleAndToolbarWindowMask NSWindowStyleMaskUnifiedTitleAndToolbar +#define NSMiniaturizableWindowMask NSWindowStyleMaskMiniaturizable +#define NSBorderlessWindowMask NSWindowStyleMaskBorderless +#define NSFullScreenWindowMask NSWindowStyleMaskFullScreen +#endif + +#if MAC_OS_X_VERSION_MIN_REQUIRED >= 101400 +#define NSStringPboardType NSPasteboardTypeString +#define NSOnState NSControlStateValueOn +#define NSOffState NSControlStateValueOff +// Now we are also changing names of methods! +#define graphicsContextWithGraphicsPort graphicsContextWithCGContext +#endif + + +#endif + diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c index b98d6d89..f8453c77 100644 --- a/macosx/tkMacOSXDialog.c +++ b/macosx/tkMacOSXDialog.c @@ -117,7 +117,7 @@ enum alertIconOptions { ICON_ERROR, ICON_INFO, ICON_QUESTION, ICON_WARNING }; static const char *const alertButtonStrings[] = { - "abort", "retry", "ignore", "ok", "cancel", "yes", "no", NULL + "abort", "retry", "ignore", "ok", "cancel", "no", "yes", NULL }; static const NSString *const alertButtonNames[][3] = { @@ -147,8 +147,8 @@ static const short alertButtonIndexAndTypeToNativeButtonIndex[][7] = { [TYPE_OK] = {0, 0, 0, 1, 0, 0, 0}, [TYPE_OKCANCEL] = {0, 0, 0, 1, 2, 0, 0}, [TYPE_RETRYCANCEL] = {0, 1, 0, 0, 2, 0, 0}, - [TYPE_YESNO] = {0, 0, 0, 0, 0, 1, 2}, - [TYPE_YESNOCANCEL] = {0, 0, 0, 0, 3, 1, 2}, + [TYPE_YESNO] = {0, 0, 0, 0, 0, 2, 1}, + [TYPE_YESNOCANCEL] = {0, 0, 0, 0, 3, 2, 1}, }; /* @@ -161,8 +161,8 @@ static const short alertNativeButtonIndexAndTypeToButtonIndex[][3] = { [TYPE_OK] = {3, 0, 0}, [TYPE_OKCANCEL] = {3, 4, 0}, [TYPE_RETRYCANCEL] = {1, 4, 0}, - [TYPE_YESNO] = {5, 6, 0}, - [TYPE_YESNOCANCEL] = {5, 6, 4}, + [TYPE_YESNO] = {6, 5, 0}, + [TYPE_YESNOCANCEL] = {6, 5, 4}, }; /* @@ -746,7 +746,7 @@ Tk_GetOpenFileObjCmd( /* * The -typevariable must be set to the selected file type, if the dialog was not cancelled */ - NSInteger selectedFilterIndex = filterInfo.fileTypeIndex; + NSUInteger selectedFilterIndex = filterInfo.fileTypeIndex; NSString *selectedFilter = NULL; if (filterInfo.userHasSelectedFilter) { selectedFilterIndex = filterInfo.fileTypeIndex; @@ -772,7 +772,7 @@ Tk_GetOpenFileObjCmd( selectedFilter = [filterInfo.fileTypeNames objectAtIndex:selectedFilterIndex]; } else { // scan the list - int i; + NSUInteger i; for (i = 0; i < [filterInfo.fileTypeNames count]; i++) { if (filterCompatible(extension, i)) { selectedFilterIndex = i; @@ -1198,36 +1198,42 @@ TkAboutDlg(void) NSString *year = [dateFormatter stringFromDate:[NSDate date]]; [dateFormatter release]; - - NSMutableParagraphStyle *style = - [[[NSParagraphStyle defaultParagraphStyle] mutableCopy] - autorelease]; - - [style setAlignment:NSCenterTextAlignment]; - - NSDictionary *options = [NSDictionary dictionaryWithObjectsAndKeys: - @"Tcl & Tk", @"ApplicationName", - @"Tcl " TCL_VERSION " & Tk " TK_VERSION, @"ApplicationVersion", - @TK_PATCH_LEVEL, @"Version", - image, @"ApplicationIcon", - [NSString stringWithFormat:@"Copyright %1$C 1987-%2$@.", 0xA9, - year], @"Copyright", - [[[NSAttributedString alloc] initWithString: - [NSString stringWithFormat: - @"%1$C 1987-%2$@ Tcl Core Team." "\n\n" - "%1$C 1989-%2$@ Contributors." "\n\n" - "%1$C 2011-%2$@ Kevin Walzer/WordTech Communications LLC." "\n\n" - "%1$C 2014-%2$@ Marc Culler." "\n\n" - "%1$C 2002-%2$@ Daniel A. Steffen." "\n\n" - "%1$C 2001-2009 Apple Inc." "\n\n" - "%1$C 2001-2002 Jim Ingham & Ian Reid" "\n\n" - "%1$C 1998-2000 Jim Ingham & Ray Johnson" "\n\n" - "%1$C 1998-2000 Scriptics Inc." "\n\n" - "%1$C 1996-1997 Sun Microsystems Inc.", 0xA9, year] attributes: - [NSDictionary dictionaryWithObject:style - forKey:NSParagraphStyleAttributeName]] autorelease], @"Credits", - nil]; - [NSApp orderFrontStandardAboutPanelWithOptions:options]; + + /* + * This replaces the old about dialog with a standard alert that displays + * correctly on 10.14. + */ + + NSString *version = @"Tcl " TCL_PATCH_LEVEL " & Tk " TCL_PATCH_LEVEL; + NSString *url = @"www.tcl-lang.org"; + NSTextView *credits = [[NSTextView alloc] initWithFrame:NSMakeRect(0,0,300,300)]; + NSFont *font = [NSFont systemFontOfSize:[NSFont systemFontSize]]; + NSDictionary *textAttributes = [NSDictionary dictionaryWithObject:font + forKey:NSFontAttributeName]; + [credits insertText: [[NSAttributedString alloc] + initWithString:[NSString stringWithFormat: @"\n" + "Tcl and Tk are distributed under a modified BSD license: " + "www.tcl.tk/software/tcltk/license.html\n\n" + "%1$C 1987-%2$@ Tcl Core Team and Contributers.\n\n" + "%1$C 2011-%2$@ Kevin Walzer/WordTech Communications LLC.\n\n" + "%1$C 2014-%2$@ Marc Culler.\n\n" + "%1$C 2002-2012 Daniel A. Steffen.\n\n" + "%1$C 2001-2009 Apple Inc.\n\n" + "%1$C 2001-2002 Jim Ingham & Ian Reid\n\n" + "%1$C 1998-2000 Jim Ingham & Ray Johnson\n\n" + "%1$C 1998-2000 Scriptics Inc.\n\n" + "%1$C 1996-1997 Sun Microsystems Inc.", 0xA9, year] + attributes:textAttributes] + replacementRange:NSMakeRange(0,0)]; + [credits setDrawsBackground:NO]; + [credits setEditable:NO]; + NSAlert *about = [[NSAlert alloc] init]; + [[about window] setTitle:@"About Tcl & Tk"]; + [about setMessageText: version]; + [about setInformativeText:url]; + about.accessoryView = credits; + [about runModal]; + [about release]; } /* @@ -1257,7 +1263,7 @@ TkMacOSXStandardAboutPanelObjCmd( Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } - [NSApp orderFrontStandardAboutPanelWithOptions:[NSDictionary dictionary]]; + TkAboutDlg(); return TCL_OK; } @@ -1330,7 +1336,7 @@ Tk_MessageBoxObjCmd( case ALERT_ICON: if (Tcl_GetIndexFromObjStruct(interp, objv[i + 1], alertIconStrings, - sizeof(char *), "value", TCL_EXACT, &iconIndex) != TCL_OK) { + sizeof(char *), "-icon value", TCL_EXACT, &iconIndex) != TCL_OK) { goto end; } break; @@ -1360,7 +1366,7 @@ Tk_MessageBoxObjCmd( case ALERT_TYPE: if (Tcl_GetIndexFromObjStruct(interp, objv[i + 1], alertTypeStrings, - sizeof(char *), "value", TCL_EXACT, &typeIndex) != TCL_OK) { + sizeof(char *), "-type value", TCL_EXACT, &typeIndex) != TCL_OK) { goto end; } break; @@ -1376,7 +1382,7 @@ Tk_MessageBoxObjCmd( */ if (Tcl_GetIndexFromObjStruct(interp, objv[indexDefaultOption + 1], - alertButtonStrings, sizeof(char *), "value", TCL_EXACT, &index) != TCL_OK) { + alertButtonStrings, sizeof(char *), "-default value", TCL_EXACT, &index) != TCL_OK) { goto end; } diff --git a/macosx/tkMacOSXDraw.c b/macosx/tkMacOSXDraw.c index f40e5e62..984e2e57 100644 --- a/macosx/tkMacOSXDraw.c +++ b/macosx/tkMacOSXDraw.c @@ -18,6 +18,12 @@ #include "tkMacOSXDebug.h" #include "tkButton.h" +#if MAC_OS_X_VERSION_MIN_REQUIRED >= 101400 +#define GET_CGCONTEXT [[NSGraphicsContext currentContext] CGContext] +#else +#define GET_CGCONTEXT [[NSGraphicsContext currentContext] graphicsPort] +#endif + /* #ifdef TK_MAC_DEBUG #define TK_MAC_DEBUG_DRAWING @@ -105,6 +111,25 @@ TkMacOSXInitCGDrawing( * * Extract bitmap data from a MacOSX drawable as an NSBitmapImageRep. * + * This is only used by XGetImage, which is never called. And this + * implementation does not work correctly. Originally it relied on + * [NSBitmapImageRep initWithFocusedViewRect:view_rect] which was + * deprecated by Apple in OSX 10.14 and also required the use of other + * deprecated functions such as [NSView lockFocus]. Apple's suggested + * replacement is [NSView cacheDisplayInRect: toBitmapImageRep:] and that + * is what is being used here. However, that method only works when the + * view has a valid CGContext, and a view is only guaranteed to have a + * valid context during a call to [NSView drawRect]. To further + * complicate matters, cacheDisplayInRect calls [NSView drawRect]. + * Essentially it is asking the view to draw a subrectangle of itself into + * a special graphics context which is linked to the BitmapImageRep. But + * our implementation of [NSView drawRect] does not allow recursive calls. + * If called recursively it returns immediately without doing any drawing. + * So the bottom line is that this function either returns a NULL pointer + * or a black image. To make it useful would require a significant amount + * of rewriting of the drawRect method. Perhaps the next release of OSX + * will include some more helpful ways of doing this. + * * Results: * Returns an NSBitmapRep representing the image of the given * rectangle of the given drawable. This object is retained. @@ -128,15 +153,16 @@ TkMacOSXBitmapRepFromDrawableRect( unsigned int height) { MacDrawable *mac_drawable = (MacDrawable *) drawable; - CGContextRef cg_context=NULL; - CGImageRef cg_image=NULL, sub_cg_image=NULL; - NSBitmapImageRep *bitmap_rep=NULL; + CGContextRef cg_context = NULL; + CGImageRef cg_image=NULL, sub_cg_image = NULL; + NSBitmapImageRep *bitmap_rep = NULL; NSView *view=NULL; if ( mac_drawable->flags & TK_IS_PIXMAP ) { + /* - * This means that the MacDrawable is functioning as a - * Tk Pixmap, so its view field is NULL. - */ + * This MacDrawable is a bitmap, so its view is NULL. + */ + cg_context = TkMacOSXGetCGContextForDrawable(drawable); CGRect image_rect = CGRectMake(x, y, width, height); cg_image = CGBitmapContextCreateImage( (CGContextRef) cg_context); @@ -149,22 +175,32 @@ TkMacOSXBitmapRepFromDrawableRect( CGImageRelease(cg_image); } } else if ( (view = TkMacOSXDrawableView(mac_drawable)) ) { + /* * Convert Tk top-left to NSView bottom-left coordinates. */ + int view_height = [view bounds].size.height; NSRect view_rect = NSMakeRect(x + mac_drawable->xOff, view_height - height - y - mac_drawable->yOff, width, height); - if ( [view lockFocusIfCanDraw] ) { - bitmap_rep = [NSBitmapImageRep alloc]; - bitmap_rep = [bitmap_rep initWithFocusedViewRect:view_rect]; - [view unlockFocus]; - } else { - TkMacOSXDbgMsg("Could not lock focus on view."); - } + /* + * Attempt to copy from the view to a bitmapImageRep. If the view does + * not have a valid CGContext, doing this will silently corrupt memory + * and make a big mess. So, in that case, we mark the view as needing + * display and return NULL. + */ + if (view == [NSView focusView]) { + bitmap_rep = [view bitmapImageRepForCachingDisplayInRect: view_rect]; + [bitmap_rep retain]; + [view cacheDisplayInRect:view_rect toBitmapImageRep:bitmap_rep]; + } else { + TkMacOSXDbgMsg("No CGContext - cannot copy from screen to bitmap."); + [view setNeedsDisplay:YES]; + return NULL; + } } else { TkMacOSXDbgMsg("Invalid source drawable"); } @@ -205,26 +241,24 @@ XCopyArea( MacDrawable *srcDraw = (MacDrawable *) src; NSBitmapImageRep *bitmap_rep = NULL; CGImageRef img = NULL; + CGRect bounds, srcRect, dstRect; display->request++; - if (!width || !height) { - /* This happens all the time. - TkMacOSXDbgMsg("Drawing of empty area requested"); - */ return; } if (!TkMacOSXSetupDrawingContext(dst, gc, 1, &dc)) { return; - /*TkMacOSXDbgMsg("Failed to setup drawing context.");*/ + TkMacOSXDbgMsg("Failed to setup drawing context."); } if ( dc.context ) { if (srcDraw->flags & TK_IS_PIXMAP) { img = TkMacOSXCreateCGImageWithDrawable(src); }else if (TkMacOSXDrawableWindow(src)) { - bitmap_rep = TkMacOSXBitmapRepFromDrawableRect(src, src_x, src_y, width, height); + bitmap_rep = TkMacOSXBitmapRepFromDrawableRect(src, + src_x, src_y, width, height); if ( bitmap_rep ) { img = [bitmap_rep CGImage]; } @@ -233,13 +267,12 @@ XCopyArea( } if (img) { - TkMacOSXDrawCGImage(dst, gc, dc.context, img, gc->foreground, gc->background, - CGRectMake(0, 0, srcDraw->size.width, srcDraw->size.height), - CGRectMake(src_x, src_y, width, height), - CGRectMake(dest_x, dest_y, width, height)); + bounds = CGRectMake(0, 0, srcDraw->size.width, srcDraw->size.height); + srcRect = CGRectMake(src_x, src_y, width, height); + dstRect = CGRectMake(dest_x, dest_y, width, height); + TkMacOSXDrawCGImage(dst, gc, dc.context, img, + gc->foreground, gc->background, bounds, srcRect, dstRect); CFRelease(img); - - } else { TkMacOSXDbgMsg("Failed to construct CGImage."); } @@ -288,7 +321,7 @@ XCopyPlane( TkMacOSXDrawingContext dc; MacDrawable *srcDraw = (MacDrawable *) src; MacDrawable *dstDraw = (MacDrawable *) dst; - + CGRect bounds, srcRect, dstRect; display->request++; if (!width || !height) { /* TkMacOSXDbgMsg("Drawing of empty area requested"); */ @@ -308,7 +341,7 @@ XCopyPlane( TkpClipMask *clipPtr = (TkpClipMask *) gc->clip_mask; unsigned long imageBackground = gc->background; if (clipPtr && clipPtr->type == TKP_CLIP_PIXMAP){ - CGRect srcRect = CGRectMake(src_x, src_y, width, height); + srcRect = CGRectMake(src_x, src_y, width, height); CGImageRef mask = TkMacOSXCreateCGImageWithDrawable(clipPtr->value.pixmap); CGImageRef submask = CGImageCreateWithImageInRect(img, srcRect); CGRect rect = CGRectMake(dest_x, dest_y, width, height); @@ -333,10 +366,11 @@ XCopyPlane( CGImageRelease(submask); CGImageRelease(subimage); } else { - TkMacOSXDrawCGImage(dst, gc, dc.context, img, gc->foreground, imageBackground, - CGRectMake(0, 0, srcDraw->size.width, srcDraw->size.height), - CGRectMake(src_x, src_y, width, height), - CGRectMake(dest_x, dest_y, width, height)); + bounds = CGRectMake(0, 0, srcDraw->size.width, srcDraw->size.height); + srcRect = CGRectMake(src_x, src_y, width, height); + dstRect = CGRectMake(dest_x, dest_y, width, height); + TkMacOSXDrawCGImage(dst, gc, dc.context, img, gc->foreground, + imageBackground, bounds, srcRect, dstRect); CGImageRelease(img); } } else { /* no image */ @@ -440,10 +474,8 @@ TkMacOSXGetNSImageWithTkImage( int height) { Pixmap pixmap = Tk_GetPixmap(display, None, width, height, 0); - MacDrawable *macDraw = (MacDrawable *) pixmap; NSImage *nsImage; - macDraw->flags |= TK_USE_XIMAGE_ALPHA; Tk_RedrawImage(image, 0, 0, width, height, pixmap, 0, 0); nsImage = CreateNSImageWithPixmap(pixmap, width, height); Tk_FreePixmap(display, pixmap); @@ -596,11 +628,13 @@ TkMacOSXDrawCGImage( } } dstBounds = CGRectOffset(dstBounds, macDraw->xOff, macDraw->yOff); - if (CGImageIsMask(image)) { - /*CGContextSaveGState(context);*/ if (macDraw->flags & TK_IS_BW_PIXMAP) { - /* Set fill color to black, background comes from the context, or is transparent. */ + + /* Set fill color to black; background comes from the context, + * or is transparent. + */ + if (imageBackground != TRANSPARENT_PIXEL << 24) { CGContextClearRect(context, dstBounds); } @@ -1448,7 +1482,7 @@ TkMacOSXSetUpGraphicsPort( *---------------------------------------------------------------------- */ -int +Bool TkMacOSXSetupDrawingContext( Drawable d, GC gc, @@ -1456,41 +1490,71 @@ TkMacOSXSetupDrawingContext( TkMacOSXDrawingContext *dcPtr) { MacDrawable *macDraw = ((MacDrawable*)d); - int dontDraw = 0, isWin = 0; + Bool canDraw = true; + NSWindow *win = NULL; TkMacOSXDrawingContext dc = {}; CGRect clipBounds; - dc.clipRgn = TkMacOSXGetClipRgn(d); - if (!dontDraw) { - ClipToGC(d, gc, &dc.clipRgn); - dontDraw = dc.clipRgn ? HIShapeIsEmpty(dc.clipRgn) : 0; + /* + * If we are simulating drawing for tests, just return false. + */ + + if ([NSApp simulateDrawing]) { + return false; } - if (dontDraw) { + + /* + * If the drawable is not a pixmap and it has an associated + * NSWindow then we know we are drawing to a window. + */ + + if (!(macDraw->flags & TK_IS_PIXMAP)) { + win = TkMacOSXDrawableWindow(d); + } + + /* + * Check that we have a non-empty clipping region. + */ + + dc.clipRgn = TkMacOSXGetClipRgn(d); + ClipToGC(d, gc, &dc.clipRgn); + if (dc.clipRgn && HIShapeIsEmpty(dc.clipRgn)) { + canDraw = false; goto end; } - if (useCG) { - dc.context = TkMacOSXGetCGContextForDrawable(d); - } - if (!dc.context || !(macDraw->flags & TK_IS_PIXMAP)) { - isWin = (TkMacOSXDrawableWindow(d) != nil); - } + + /* + * If we already have a CGContext, use it. Otherwise, if we + * are drawing to a window then we can get one from the + * window. + */ + + dc.context = TkMacOSXGetCGContextForDrawable(d); if (dc.context) { dc.portBounds = clipBounds = CGContextGetClipBoundingBox(dc.context); - } else if (isWin) { + } else if (win) { NSView *view = TkMacOSXDrawableView(macDraw); if (view) { - if (view != [NSView focusView]) { - dc.focusLocked = [view lockFocusIfCanDraw]; - dontDraw = !dc.focusLocked; - } else { - dontDraw = ![view canDraw]; - } - if (dontDraw) { - goto end; - } - [[view window] disableFlushWindow]; + + /* + * We can only draw into the view when the current CGContext is + * valid and belongs to the view. Validity can only be guaranteed + * inside of a view's drawRect or setFrame methods. The isDrawing + * attribute tells us whether we are being called from one of those + * methods. + * + * If the CGContext is not valid, or belongs to a different View, + * then we mark our view as needing display and return failure. + * It should get drawn in a later call to drawRect. + */ + + if (view != [NSView focusView]) { + [view setNeedsDisplay:YES]; + canDraw = false; + goto end; + } dc.view = view; - dc.context = [[NSGraphicsContext currentContext] graphicsPort]; + dc.context = GET_CGCONTEXT; dc.portBounds = NSRectToCGRect([view bounds]); if (dc.clipRgn) { clipBounds = CGContextGetClipBoundingBox(dc.context); @@ -1503,14 +1567,17 @@ TkMacOSXSetupDrawingContext( Tcl_Panic("TkMacOSXSetupDrawingContext(): " "no context to draw into !"); } + + /* + * Configure the drawing context. + */ + if (dc.context) { CGAffineTransform t = { .a = 1, .b = 0, .c = 0, .d = -1, .tx = 0, .ty = dc.portBounds.size.height}; dc.portBounds.origin.x += macDraw->xOff; dc.portBounds.origin.y += macDraw->yOff; - if (!dc.focusLocked) { - CGContextSaveGState(dc.context); - } + CGContextSaveGState(dc.context); CGContextSetTextDrawingMode(dc.context, kCGTextFill); CGContextConcatCTM(dc.context, t); if (dc.clipRgn) { @@ -1545,7 +1612,7 @@ TkMacOSXSetupDrawingContext( double w = gc->line_width; TkMacOSXSetColorInContext(gc, gc->foreground, dc.context); - if (isWin) { + if (win) { CGContextSetPatternPhase(dc.context, CGSizeMake( dc.portBounds.size.width, dc.portBounds.size.height)); } @@ -1583,13 +1650,21 @@ TkMacOSXSetupDrawingContext( } } } + end: - if (dontDraw && dc.clipRgn) { +#ifdef TK_MAC_DEBUG_DRAWING + if (!canDraw && win != NULL) { + TkWindow *winPtr = TkMacOSXGetTkWindow(win); + if (winPtr) fprintf(stderr, "Cannot draw in %s - postponing.\n", + Tk_PathName(winPtr)); + } +#endif + if (!canDraw && dc.clipRgn) { CFRelease(dc.clipRgn); dc.clipRgn = NULL; } *dcPtr = dc; - return !dontDraw; + return canDraw; } /* @@ -1614,13 +1689,7 @@ TkMacOSXRestoreDrawingContext( { if (dcPtr->context) { CGContextSynchronize(dcPtr->context); - [[dcPtr->view window] setViewsNeedDisplay:YES]; - [[dcPtr->view window] enableFlushWindow]; - if (dcPtr->focusLocked) { - [dcPtr->view unlockFocus]; - } else { - CGContextRestoreGState(dcPtr->context); - } + CGContextRestoreGState(dcPtr->context); } if (dcPtr->clipRgn) { CFRelease(dcPtr->clipRgn); @@ -1659,17 +1728,13 @@ TkMacOSXGetClipRgn( #ifdef TK_MAC_DEBUG_DRAWING TkMacOSXDbgMsg("%s", macDraw->winPtr->pathName); NSView *view = TkMacOSXDrawableView(macDraw); - if ([view lockFocusIfCanDraw]) { - CGContextRef context = [[NSGraphicsContext currentContext] graphicsPort]; - CGContextSaveGState(context); - CGContextConcatCTM(context, CGAffineTransformMake(1.0, 0.0, 0.0, - -1.0, 0.0, [view bounds].size.height)); - ChkErr(HIShapeReplacePathInCGContext, macDraw->visRgn, context); - CGContextSetRGBFillColor(context, 0.0, 1.0, 0.0, 0.1); - CGContextEOFillPath(context); - CGContextRestoreGState(context); - [view unlockFocus]; - } + CGContextSaveGState(context); + CGContextConcatCTM(context, CGAffineTransformMake(1.0, 0.0, 0.0, + -1.0, 0.0, [view bounds].size.height)); + ChkErr(HIShapeReplacePathInCGContext, macDraw->visRgn, context); + CGContextSetRGBFillColor(context, 0.0, 1.0, 0.0, 0.1); + CGContextEOFillPath(context); + CGContextRestoreGState(context); #endif /* TK_MAC_DEBUG_DRAWING */ } @@ -1729,13 +1794,11 @@ TkpClipDrawableToRect( int width, int height) { MacDrawable *macDraw = (MacDrawable *) d; - NSView *view = TkMacOSXDrawableView(macDraw); if (macDraw->drawRgn) { CFRelease(macDraw->drawRgn); macDraw->drawRgn = NULL; } - if (width >= 0 && height >= 0) { CGRect clipRect = CGRectMake(x + macDraw->xOff, y + macDraw->yOff, width, height); @@ -1751,17 +1814,6 @@ TkpClipDrawableToRect( } else { macDraw->drawRgn = drawRgn; } - if (view && view != [NSView focusView] && [view lockFocusIfCanDraw]) { - clipRect.origin.y = [view bounds].size.height - - (clipRect.origin.y + clipRect.size.height); - NSRectClip(NSRectFromCGRect(clipRect)); - macDraw->flags |= TK_FOCUSED_VIEW; - } - } else { - if (view && (macDraw->flags & TK_FOCUSED_VIEW)) { - [view unlockFocus]; - macDraw->flags &= ~TK_FOCUSED_VIEW; - } } } diff --git a/macosx/tkMacOSXEmbed.c b/macosx/tkMacOSXEmbed.c index 8348456f..f6c32b3a 100644 --- a/macosx/tkMacOSXEmbed.c +++ b/macosx/tkMacOSXEmbed.c @@ -805,7 +805,7 @@ ContainerEventProc( */ return; } - + /* * Ignore any X protocol errors that happen in this procedure (almost any * operation could fail, for example, if the embedded application has diff --git a/macosx/tkMacOSXEvent.c b/macosx/tkMacOSXEvent.c index 95e80a9e..798c73ca 100644 --- a/macosx/tkMacOSXEvent.c +++ b/macosx/tkMacOSXEvent.c @@ -112,14 +112,23 @@ enum { * * TkMacOSXFlushWindows -- * - * This routine flushes all the visible windows of the application. It is - * called by XSync(). + * This routine is a stub called by XSync, which is called during the Tk + * update command. The language specification does not require that the + * update command be synchronous but many of the tests assume that is the + * case. It is not naturally the case on macOS since many idle tasks are + * run inside of the drawRect method of a window's contentView, and that + * method will not be called until after this function returns. To make + * the tests work, we attempt to force this to be synchronous by waiting + * until drawRect has been called for each window. The mechanism we use + * for this is to have drawRect post an ApplicationDefined NSEvent on the + * AppKit event queue when it finishes drawing, and wait for it here. * * Results: * None. * * Side effects: - * Flushes all visible Cocoa windows + * Calls the drawRect method of the contentView of each visible + * window. * *---------------------------------------------------------------------- */ @@ -128,11 +137,14 @@ MODULE_SCOPE void TkMacOSXFlushWindows(void) { NSArray *macWindows = [NSApp orderedWindows]; - + if ([NSApp simulateDrawing]) { + [NSApp setSimulateDrawing:NO]; + return; + } for (NSWindow *w in macWindows) { - if (TkMacOSXGetXWindow(w)) { - [w flushWindow]; - } + if (TkMacOSXGetXWindow(w)) { + [w displayIfNeeded]; + } } } diff --git a/macosx/tkMacOSXFont.c b/macosx/tkMacOSXFont.c index fd4c19a3..30e318c2 100644 --- a/macosx/tkMacOSXFont.c +++ b/macosx/tkMacOSXFont.c @@ -14,19 +14,11 @@ #include "tkMacOSXPrivate.h" #include "tkMacOSXFont.h" +#include "tkMacOSXConstants.h" -#if MAC_OS_X_VERSION_MIN_REQUIRED < 1080 #define defaultOrientation kCTFontDefaultOrientation #define verticalOrientation kCTFontVerticalOrientation -#else -#define defaultOrientation kCTFontOrientationDefault -#define verticalOrientation kCTFontOrientationVertical -#endif -#if MAC_OS_X_VERSION_MIN_REQUIRED < 101100 #define fixedPitch kCTFontUserFixedPitchFontType -#else -#define fixedPitch kCTFontUIFontUserFixedPitch -#endif /* #ifdef TK_MAC_DEBUG @@ -259,7 +251,7 @@ InitFont( } fontPtr->nsFont = nsFont; // some don't like antialiasing on fixed-width even if bigger than limit -// dontAA = [nsFont isFixedPitch] && fontPtr->font.fa.size <= 10; + // dontAA = [nsFont isFixedPitch] && fontPtr->font.fa.size <= 10; if (antialiasedTextEnabled >= 0/* || dontAA*/) { renderingMode = (antialiasedTextEnabled == 0/* || dontAA*/) ? NSFontIntegerAdvancementsRenderingMode : @@ -819,15 +811,6 @@ TkpMeasureCharsInContext( *lengthPtr = 0; return 0; } -#if 0 - /* Back-compatibility with ATSUI renderer, appears not to be needed */ - if (rangeStart == 0 && maxLength == 1 && (flags & TK_ISOLATE_END) && - !(flags & TK_AT_LEAST_ONE)) { - length = 0; - fit = 0; - goto done; - } -#endif if (maxLength > 32767) { maxLength = 32767; } @@ -860,6 +843,10 @@ TkpMeasureCharsInContext( double maxWidth = maxLength + offset; NSCharacterSet *cs; + /* + * Get a line breakpoint in the source string. + */ + index = start; if (flags & TK_WHOLE_WORDS) { index = CTTypesetterSuggestLineBreak(typesetter, start, maxWidth); @@ -870,15 +857,43 @@ TkpMeasureCharsInContext( if (index <= start && !(flags & TK_WHOLE_WORDS)) { index = CTTypesetterSuggestClusterBreak(typesetter, start, maxWidth); } + + /* + * Trim right whitespace/lineending characters. + */ + cs = (index <= len && (flags & TK_WHOLE_WORDS)) ? whitespaceCharacterSet : lineendingCharacterSet; while (index > start && [cs characterIsMember:[string characterAtIndex:(index - 1)]]) { index--; } + + /* + * If there is no line breakpoint in the source string between + * its start and the index position that fits in maxWidth, then + * CTTypesetterSuggestLineBreak() returns that very last index. + * However if the TK_WHOLE_WORDS flag is set, we want to break + * at a word boundary. In this situation, unless TK_AT_LEAST_ONE + * is set, we must report that zero chars actually fit (in other + * words the smallest word of the source string is still larger + * than maxWidth). + */ + + if ((index >= start) && (index < len) && + (flags & TK_WHOLE_WORDS) && !(flags & TK_AT_LEAST_ONE) && + ![cs characterIsMember:[string characterAtIndex:index]]) { + index = start; + } + if (index <= start && (flags & TK_AT_LEAST_ONE)) { index = start + 1; } + + /* + * Now measure the string width in pixels. + */ + if (index > 0) { range.length = index; line = CTTypesetterCreateLine(typesetter, range); @@ -921,7 +936,6 @@ done: flags & TK_AT_LEAST_ONE ? "atLeastOne " : "", flags & TK_ISOLATE_END ? "isolateEnd " : "", length, fit); -//if (!(rangeLength==1 && rangeStart == 0)) fprintf(stderr, " measure len=%d (max=%d, w=%.0f) from %d (nb=%d): source=\"%s\": index=%d return %d\n",rangeLength,maxLength,width,rangeStart,numBytes, source+rangeStart, index, fit); #endif *lengthPtr = length; return fit; diff --git a/macosx/tkMacOSXHLEvents.c b/macosx/tkMacOSXHLEvents.c index 340c20c0..468e41c7 100644 --- a/macosx/tkMacOSXHLEvents.c +++ b/macosx/tkMacOSXHLEvents.c @@ -279,7 +279,7 @@ tkMacOSXProcessFiles( Tcl_Interp *interp, const char* procedure) { - Tcl_Encoding utf8 = Tcl_GetEncoding(NULL, "utf-8"); + Tcl_Encoding utf8; const AEDesc *fileSpecDesc = nil; AEDesc contents; char URLString[1 + URL_MAX_LENGTH]; @@ -331,6 +331,7 @@ tkMacOSXProcessFiles( Tcl_DStringInit(&command); Tcl_DStringAppend(&command, procedure, -1); + utf8 = Tcl_GetEncoding(NULL, "utf-8"); for (index = 1; index <= count; index++) { if (noErr != AEGetNthPtr(fileSpecDesc, index, typeFileURL, &keyword, @@ -349,6 +350,8 @@ tkMacOSXProcessFiles( Tcl_DStringAppendElement(&command, Tcl_DStringValue(&pathName)); Tcl_DStringFree(&pathName); } + + Tcl_FreeEncoding(utf8); AEDisposeDesc(&contents); /* @@ -361,7 +364,6 @@ tkMacOSXProcessFiles( Tcl_BackgroundException(interp, code); } Tcl_DStringFree(&command); - return; } /* diff --git a/macosx/tkMacOSXImage.c b/macosx/tkMacOSXImage.c new file mode 100644 index 00000000..a5c870ad --- /dev/null +++ b/macosx/tkMacOSXImage.c @@ -0,0 +1,584 @@ +/* + * tkMacOSXImage.c -- + * + * The code in this file provides an interface for XImages, + * + * Copyright (c) 1995-1997 Sun Microsystems, Inc. + * Copyright 2001-2009, Apple Inc. + * Copyright (c) 2005-2009 Daniel A. Steffen + * Copyright 2017-2018 Marc Culler. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "tkMacOSXPrivate.h" +#include "xbytes.h" + +#pragma mark XImage handling + +int +_XInitImageFuncPtrs( + XImage *image) +{ + return 0; +} + +/* + *---------------------------------------------------------------------- + * + * TkMacOSXCreateCGImageWithXImage -- + * + * Create CGImage from XImage, copying the image data. Called + * in Tk_PutImage and (currently) nowhere else. + * + * Results: + * CGImage, release after use. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void ReleaseData(void *info, const void *data, size_t size) { + ckfree(info); +} + +CGImageRef +TkMacOSXCreateCGImageWithXImage( + XImage *image) +{ + CGImageRef img = NULL; + size_t bitsPerComponent, bitsPerPixel; + size_t len = image->bytes_per_line * image->height; + const CGFloat *decode = NULL; + CGBitmapInfo bitmapInfo; + CGDataProviderRef provider = NULL; + char *data = NULL; + CGDataProviderReleaseDataCallback releaseData = ReleaseData; + + if (image->bits_per_pixel == 1) { + /* + * BW image + */ + + /* Reverses the sense of the bits */ + static const CGFloat decodeWB[2] = {1, 0}; + decode = decodeWB; + + bitsPerComponent = 1; + bitsPerPixel = 1; + if (image->bitmap_bit_order != MSBFirst) { + char *srcPtr = image->data + image->xoffset; + char *endPtr = srcPtr + len; + char *destPtr = (data = ckalloc(len)); + + while (srcPtr < endPtr) { + *destPtr++ = xBitReverseTable[(unsigned char)(*(srcPtr++))]; + } + } else { + data = memcpy(ckalloc(len), image->data + image->xoffset, len); + } + if (data) { + provider = CGDataProviderCreateWithData(data, data, len, releaseData); + } + if (provider) { + img = CGImageMaskCreate(image->width, image->height, bitsPerComponent, + bitsPerPixel, image->bytes_per_line, provider, decode, 0); + } + } else if (image->format == ZPixmap && image->bits_per_pixel == 32) { + + /* + * Color image + */ + + CGColorSpaceRef colorspace = CGColorSpaceCreateDeviceRGB(); + bitsPerComponent = 8; + bitsPerPixel = 32; + bitmapInfo = (image->byte_order == MSBFirst ? + kCGBitmapByteOrder32Little : kCGBitmapByteOrder32Big); + bitmapInfo |= kCGImageAlphaLast; + data = memcpy(ckalloc(len), image->data + image->xoffset, len); + if (data) { + provider = CGDataProviderCreateWithData(data, data, len, releaseData); + } + if (provider) { + img = CGImageCreate(image->width, image->height, bitsPerComponent, + bitsPerPixel, image->bytes_per_line, colorspace, bitmapInfo, + provider, decode, 0, kCGRenderingIntentDefault); + CFRelease(provider); + } + if (colorspace) { + CFRelease(colorspace); + } + } else { + TkMacOSXDbgMsg("Unsupported image type"); + } + return img; +} + + +/* + *---------------------------------------------------------------------- + * + * XGetImage -- + * + * This function copies data from a pixmap or window into an XImage. It + * is essentially never used. At one time it was called by + * pTkImgPhotoDisplay, but that is no longer the case. Currently it is + * called two places, one of which is requesting an XY image which we do + * not support. It probably does not work correctly -- see the comments + * for TkMacOSXBitmapRepFromDrawableRect. + * + * Results: + * Returns a newly allocated XImage containing the data from the given + * rectangle of the given drawable, or NULL if the XImage could not be + * constructed. NOTE: If we are copying from a window on a Retina + * display, the dimensions of the XImage will be 2*width x 2*height. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +struct pixel_fmt {int r; int g; int b; int a;}; +static struct pixel_fmt bgra = {2, 1, 0, 3}; +static struct pixel_fmt abgr = {3, 2, 1, 0}; + +XImage * +XGetImage( + Display *display, + Drawable drawable, + int x, + int y, + unsigned int width, + unsigned int height, + unsigned long plane_mask, + int format) +{ + NSBitmapImageRep* bitmap_rep = NULL; + NSUInteger bitmap_fmt = 0; + XImage* imagePtr = NULL; + char* bitmap = NULL; + char R, G, B, A; + int depth = 32, offset = 0, bitmap_pad = 0; + unsigned int bytes_per_row, size, row, n, m; + unsigned int scalefactor=1, scaled_height=height, scaled_width=width; + NSWindow *win = TkMacOSXDrawableWindow(drawable); + static enum {unknown, no, yes} has_retina = unknown; + + if (win && has_retina == unknown) { +#ifdef __clang__ + has_retina = [win respondsToSelector:@selector(backingScaleFactor)]? + yes : no; +#else + has_retina = no; +#endif + } + + if (has_retina == yes) { + + /* + * We only allow scale factors 1 or 2, as Apple currently does. + */ + +#ifdef __clang__ + scalefactor = [win backingScaleFactor] == 2.0 ? 2 : 1; +#endif + scaled_height *= scalefactor; + scaled_width *= scalefactor; + } + + if (format == ZPixmap) { + if (width == 0 || height == 0) { + return NULL; + } + + bitmap_rep = TkMacOSXBitmapRepFromDrawableRect(drawable, + x, y, width, height); + if (!bitmap_rep) { + TkMacOSXDbgMsg("XGetImage: Failed to construct NSBitmapRep"); + return NULL; + } + bitmap_fmt = [bitmap_rep bitmapFormat]; + size = [bitmap_rep bytesPerPlane]; + bytes_per_row = [bitmap_rep bytesPerRow]; + bitmap = ckalloc(size); + if (!bitmap || + (bitmap_fmt != 0 && bitmap_fmt != 1) || + [bitmap_rep samplesPerPixel] != 4 || + [bitmap_rep isPlanar] != 0 || + bytes_per_row < 4 * scaled_width || + size != bytes_per_row*scaled_height ) { + TkMacOSXDbgMsg("XGetImage: Unrecognized bitmap format"); + CFRelease(bitmap_rep); + return NULL; + } + memcpy(bitmap, (char *)[bitmap_rep bitmapData], size); + CFRelease(bitmap_rep); + + /* + * When Apple extracts a bitmap from an NSView, it may be in + * either BGRA or ABGR format. For an XImage we need RGBA. + */ + + struct pixel_fmt pixel = bitmap_fmt == 0 ? bgra : abgr; + + for (row = 0, n = 0; row < scaled_height; row++, n += bytes_per_row) { + for (m = n; m < n + 4*scaled_width; m += 4) { + R = *(bitmap + m + pixel.r); + G = *(bitmap + m + pixel.g); + B = *(bitmap + m + pixel.b); + A = *(bitmap + m + pixel.a); + + *(bitmap + m) = R; + *(bitmap + m + 1) = G; + *(bitmap + m + 2) = B; + *(bitmap + m + 3) = A; + } + } + imagePtr = XCreateImage(display, NULL, depth, format, offset, + (char*)bitmap, scaled_width, scaled_height, + bitmap_pad, bytes_per_row); + if (scalefactor == 2) { + imagePtr->pixelpower = 1; + } + } else { + /* + * There are some calls to XGetImage in the generic Tk + * code which pass an XYPixmap rather than a ZPixmap. + * XYPixmaps should be handled here. + */ + TkMacOSXDbgMsg("XGetImage does not handle XYPixmaps at the moment."); + } + return imagePtr; +} + +/* + *---------------------------------------------------------------------- + * + * DestroyImage -- + * + * Destroys storage associated with an image. + * + * Results: + * None. + * + * Side effects: + * Deallocates the image. + * + *---------------------------------------------------------------------- + */ + +static int +DestroyImage( + XImage *image) +{ + if (image) { + if (image->data) { + ckfree(image->data); + } + ckfree(image); + } + return 0; +} + +/* + *---------------------------------------------------------------------- + * + * ImageGetPixel -- + * + * Get a single pixel from an image. + * + * Results: + * Returns the 32 bit pixel value. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static unsigned long +ImageGetPixel( + XImage *image, + int x, + int y) +{ + unsigned char r = 0, g = 0, b = 0; + + if (image && image->data) { + unsigned char *srcPtr = ((unsigned char*) image->data) + + (y * image->bytes_per_line) + + (((image->xoffset + x) * image->bits_per_pixel) / NBBY); + + switch (image->bits_per_pixel) { + case 32: { + r = (*((unsigned int*) srcPtr) >> 16) & 0xff; + g = (*((unsigned int*) srcPtr) >> 8) & 0xff; + b = (*((unsigned int*) srcPtr) ) & 0xff; + /*if (image->byte_order == LSBFirst) { + r = srcPtr[2]; g = srcPtr[1]; b = srcPtr[0]; + } else { + r = srcPtr[1]; g = srcPtr[2]; b = srcPtr[3]; + }*/ + break; + } + case 16: + r = (*((unsigned short*) srcPtr) >> 7) & 0xf8; + g = (*((unsigned short*) srcPtr) >> 2) & 0xf8; + b = (*((unsigned short*) srcPtr) << 3) & 0xf8; + break; + case 8: + r = (*srcPtr << 2) & 0xc0; + g = (*srcPtr << 4) & 0xc0; + b = (*srcPtr << 6) & 0xc0; + r |= r >> 2 | r >> 4 | r >> 6; + g |= g >> 2 | g >> 4 | g >> 6; + b |= b >> 2 | b >> 4 | b >> 6; + break; + case 4: { + unsigned char c = (x % 2) ? *srcPtr : (*srcPtr >> 4); + r = (c & 0x04) ? 0xff : 0; + g = (c & 0x02) ? 0xff : 0; + b = (c & 0x01) ? 0xff : 0; + break; + } + case 1: + r = g = b = ((*srcPtr) & (0x80 >> (x % 8))) ? 0xff : 0; + break; + } + } + return (PIXEL_MAGIC << 24) | (r << 16) | (g << 8) | b; +} + +/* + *---------------------------------------------------------------------- + * + * ImagePutPixel -- + * + * Set a single pixel in an image. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ImagePutPixel( + XImage *image, + int x, + int y, + unsigned long pixel) +{ + if (image && image->data) { + unsigned char *dstPtr = ((unsigned char*) image->data) + + (y * image->bytes_per_line) + + (((image->xoffset + x) * image->bits_per_pixel) / NBBY); + if (image->bits_per_pixel == 32) { + *((unsigned int*) dstPtr) = pixel; + } else { + unsigned char r = ((pixel & image->red_mask) >> 16) & 0xff; + unsigned char g = ((pixel & image->green_mask) >> 8) & 0xff; + unsigned char b = ((pixel & image->blue_mask) ) & 0xff; + switch (image->bits_per_pixel) { + case 16: + *((unsigned short*) dstPtr) = ((r & 0xf8) << 7) | + ((g & 0xf8) << 2) | ((b & 0xf8) >> 3); + break; + case 8: + *dstPtr = ((r & 0xc0) >> 2) | ((g & 0xc0) >> 4) | + ((b & 0xc0) >> 6); + break; + case 4: { + unsigned char c = ((r & 0x80) >> 5) | ((g & 0x80) >> 6) | + ((b & 0x80) >> 7); + *dstPtr = (x % 2) ? ((*dstPtr & 0xf0) | (c & 0x0f)) : + ((*dstPtr & 0x0f) | ((c << 4) & 0xf0)); + break; + } + case 1: + *dstPtr = ((r|g|b) & 0x80) ? (*dstPtr | (0x80 >> (x % 8))) : + (*dstPtr & ~(0x80 >> (x % 8))); + break; + } + } + } + return 0; +} + +/* + *---------------------------------------------------------------------- + * + * XCreateImage -- + * + * Allocates storage for a new XImage. + * + * Results: + * Returns a newly allocated XImage. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +XImage * +XCreateImage( + Display* display, + Visual* visual, + unsigned int depth, + int format, + int offset, + char* data, + unsigned int width, + unsigned int height, + int bitmap_pad, + int bytes_per_line) +{ + XImage *ximage; + display->request++; + ximage = ckalloc(sizeof(XImage)); + + ximage->height = height; + ximage->width = width; + ximage->depth = depth; + ximage->xoffset = offset; + ximage->format = format; + ximage->data = data; + ximage->obdata = NULL; + /* The default pixelpower is 0. This must be explicitly set to 1 in the + * case of an XImage extracted from a Retina display. + */ + ximage->pixelpower = 0; + + if (format == ZPixmap) { + ximage->bits_per_pixel = 32; + ximage->bitmap_unit = 32; + } else { + ximage->bits_per_pixel = 1; + ximage->bitmap_unit = 8; + } + if (bitmap_pad) { + ximage->bitmap_pad = bitmap_pad; + } else { + /* Use 16 byte alignment for best Quartz perfomance */ + ximage->bitmap_pad = 128; + } + if (bytes_per_line) { + ximage->bytes_per_line = bytes_per_line; + } else { + ximage->bytes_per_line = ((width * ximage->bits_per_pixel + + (ximage->bitmap_pad - 1)) >> 3) & + ~((ximage->bitmap_pad >> 3) - 1); + } +#ifdef WORDS_BIGENDIAN + ximage->byte_order = MSBFirst; + ximage->bitmap_bit_order = MSBFirst; +#else + ximage->byte_order = LSBFirst; + ximage->bitmap_bit_order = LSBFirst; +#endif + ximage->red_mask = 0x00FF0000; + ximage->green_mask = 0x0000FF00; + ximage->blue_mask = 0x000000FF; + ximage->f.create_image = NULL; + ximage->f.destroy_image = DestroyImage; + ximage->f.get_pixel = ImageGetPixel; + ximage->f.put_pixel = ImagePutPixel; + ximage->f.sub_image = NULL; + ximage->f.add_pixel = NULL; + + return ximage; +} + +/* + *---------------------------------------------------------------------- + * + * TkPutImage -- + * + * Copies a rectangular subimage of an XImage into a drawable. + * Currently this is only called by TkImgPhotoDisplay, using + * a Window as the drawable. + * + * Results: + * None. + * + * Side effects: + * Draws the image on the specified drawable. + * + *---------------------------------------------------------------------- + */ + +int +TkPutImage( + unsigned long *colors, /* Unused on Macintosh. */ + int ncolors, /* Unused on Macintosh. */ + Display* display, /* Display. */ + Drawable drawable, /* Drawable to place image on. */ + GC gc, /* GC to use. */ + XImage* image, /* Image to place. */ + int src_x, /* Source X & Y. */ + int src_y, + int dest_x, /* Destination X & Y. */ + int dest_y, + unsigned int width, /* Same width & height for both */ + unsigned int height) /* distination and source. */ +{ + TkMacOSXDrawingContext dc; + MacDrawable *macDraw = (MacDrawable *) drawable; + + display->request++; + if (!TkMacOSXSetupDrawingContext(drawable, gc, 1, &dc)) { + return BadDrawable; + } + if (dc.context) { + CGRect bounds, srcRect, dstRect; + CGImageRef img = TkMacOSXCreateCGImageWithXImage(image); + + /* + * The CGContext for a pixmap is RGB only, with A = 0. + */ + + if (!(macDraw->flags & TK_IS_PIXMAP)) { + CGContextSetBlendMode(dc.context, kCGBlendModeSourceAtop); + } + if (img) { + + /* If the XImage has big pixels, the source is rescaled to reflect + * the actual pixel dimensions. This is not currently used, but + * could arise if the image were copied from a retina monitor and + * redrawn on an ordinary monitor. + */ + + int pp = image->pixelpower; + bounds = CGRectMake(0, 0, image->width, image->height); + srcRect = CGRectMake(src_x<foreground, gc->background, + bounds, srcRect, dstRect); + CFRelease(img); + } else { + TkMacOSXDbgMsg("Invalid source drawable"); + } + } else { + TkMacOSXDbgMsg("Invalid destination drawable"); + } + TkMacOSXRestoreDrawingContext(&dc); + return Success; +} + +/* + * Local Variables: + * mode: objc + * c-basic-offset: 4 + * fill-column: 79 + * coding: utf-8 + * End: + */ diff --git a/macosx/tkMacOSXInit.c b/macosx/tkMacOSXInit.c index e03b5aa3..8e9c6001 100644 --- a/macosx/tkMacOSXInit.c +++ b/macosx/tkMacOSXInit.c @@ -16,7 +16,6 @@ #include "tkMacOSXPrivate.h" #include -#include #include #include @@ -29,8 +28,6 @@ static char tkLibPath[PATH_MAX + 1] = ""; static char scriptPath[PATH_MAX + 1] = ""; -long tkMacOSXMacOSXVersion = 0; - #pragma mark TKApplication(TKInit) @interface TKApplication(TKKeyboard) @@ -48,6 +45,9 @@ long tkMacOSXMacOSXVersion = 0; @implementation TKApplication @synthesize poolLock = _poolLock; +@synthesize macMinorVersion = _macMinorVersion; +@synthesize isDrawing = _isDrawing; +@synthesize simulateDrawing = _simulateDrawing; @end /* @@ -152,6 +152,26 @@ long tkMacOSXMacOSXVersion = 0; _mainPool = [NSAutoreleasePool new]; [NSApp setPoolLock:0]; + /* + * Record the OS version we are running on. + */ + int minorVersion; +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101000 + Gestalt(gestaltSystemVersionMinor, (SInt32*)&minorVersion); +#else + NSOperatingSystemVersion systemVersion; + systemVersion = [[NSProcessInfo processInfo] operatingSystemVersion]; + minorVersion = systemVersion.minorVersion; +#endif + [NSApp setMacMinorVersion: minorVersion]; + + /* + * We are not drawing yet. + */ + + [NSApp setIsDrawing:NO]; + [NSApp setSimulateDrawing:NO]; + /* * Be our own delegate. */ @@ -160,6 +180,7 @@ long tkMacOSXMacOSXVersion = 0; /* * Make sure we are allowed to open windows. */ + [NSApp setActivationPolicy:NSApplicationActivationPolicyRegular]; /* @@ -255,7 +276,6 @@ TkpInit( */ if (!initialized) { - struct utsname name; struct stat st; initialized = 1; @@ -268,20 +288,6 @@ TkpInit( # error Mac OS X 10.6 required #endif - if (!uname(&name)) { - tkMacOSXMacOSXVersion = (strtod(name.release, NULL) + 96) * 10; - } - /*Check for new versioning scheme on Yosemite (10.10) and later.*/ - if (MAC_OS_X_VERSION_MIN_REQUIRED > 100000) { - tkMacOSXMacOSXVersion = MAC_OS_X_VERSION_MIN_REQUIRED/100; - } - if (tkMacOSXMacOSXVersion && MAC_OS_X_VERSION_MIN_REQUIRED < 100000 && - tkMacOSXMacOSXVersion/10 < MAC_OS_X_VERSION_MIN_REQUIRED/10) { - Tcl_Panic("Mac OS X 10.%d or later required !", - (MAC_OS_X_VERSION_MIN_REQUIRED/10)-100); - } - - #ifdef TK_FRAMEWORK /* * When Tk is in a framework, force tcl_findLibrary to look in the diff --git a/macosx/tkMacOSXInt.h b/macosx/tkMacOSXInt.h index 52be0e1d..4e1e689b 100644 --- a/macosx/tkMacOSXInt.h +++ b/macosx/tkMacOSXInt.h @@ -83,11 +83,10 @@ typedef struct TkWindowPrivate MacDrawable; #define TK_CLIP_INVALID 0x02 #define TK_HOST_EXISTS 0x04 #define TK_DRAWN_UNDER_MENU 0x08 -#define TK_FOCUSED_VIEW 0x10 -#define TK_IS_PIXMAP 0x20 -#define TK_IS_BW_PIXMAP 0x40 -#define TK_DO_NOT_DRAW 0x80 -#define TK_USE_XIMAGE_ALPHA 0x100 +#define TK_IS_PIXMAP 0x10 +#define TK_IS_BW_PIXMAP 0x20 +#define TK_DO_NOT_DRAW 0x40 + /* * I am reserving TK_EMBEDDED = 0x100 in the MacDrawable flags * This is defined in tk.h. We need to duplicate the TK_EMBEDDED flag in the @@ -199,6 +198,10 @@ MODULE_SCOPE void TkpClipDrawableToRect(Display *display, Drawable d, int x, MODULE_SCOPE void TkpRetainRegion(TkRegion r); MODULE_SCOPE void TkpReleaseRegion(TkRegion r); MODULE_SCOPE void TkpShiftButton(NSButton *button, NSPoint delta); +MODULE_SCOPE Bool TkpAppIsDrawing(void); +MODULE_SCOPE void TkpDisplayWindow(Tk_Window tkwin); +MODULE_SCOPE void TkTestSimulateDrawing(Bool); + /* * Include the stubbed internal platform-specific API. */ diff --git a/macosx/tkMacOSXKeyEvent.c b/macosx/tkMacOSXKeyEvent.c index 958f9608..31fffa15 100644 --- a/macosx/tkMacOSXKeyEvent.c +++ b/macosx/tkMacOSXKeyEvent.c @@ -41,6 +41,8 @@ static int caret_x = 0, caret_y = 0, caret_height = 0; static void setupXEvent(XEvent *xEvent, NSWindow *w, unsigned int state); static unsigned isFunctionKey(unsigned int code); +unsigned short releaseCode; + #pragma mark TKApplication(TKKeyEvent) @@ -66,14 +68,22 @@ static unsigned isFunctionKey(unsigned int code); processingCompose = NO; } + w = [theEvent window]; + TkWindow *winPtr = TkMacOSXGetTkWindow(w); + Tk_Window tkwin = (Tk_Window) winPtr; + XEvent xEvent; + + if (!winPtr) { + return theEvent; + } + switch (type) { case NSKeyUp: - if (finishedCompose) - { - // if we were composing, swallow the last release since we already sent - finishedCompose = NO; - return theEvent; - } + /*Fix for bug #1ba71a86bb: key release firing on key press.*/ + setupXEvent(&xEvent, w, 0); + xEvent.xany.type = KeyRelease; + xEvent.xkey.keycode = releaseCode; + xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); case NSKeyDown: repeat = [theEvent isARepeat]; characters = [theEvent characters]; @@ -82,10 +92,9 @@ static unsigned isFunctionKey(unsigned int code); case NSFlagsChanged: modifiers = [theEvent modifierFlags]; keyCode = [theEvent keyCode]; - // w = [self windowWithWindowNumber:[theEvent windowNumber]]; - w = [theEvent window]; + #if defined(TK_MAC_DEBUG_EVENTS) || NS_KEYLOG == 1 - NSLog(@"-[%@(%p) %s] r=%d mods=%u '%@' '%@' code=%u c=%d %@ %d", [self class], self, _cmd, repeat, modifiers, characters, charactersIgnoringModifiers, keyCode,([charactersIgnoringModifiers length] == 0) ? 0 : [charactersIgnoringModifiers characterAtIndex: 0], w, type); + TKLog(@"-[%@(%p) %s] r=%d mods=%u '%@' '%@' code=%u c=%d %@ %d", [self class], self, _cmd, repeat, modifiers, characters, charactersIgnoringModifiers, keyCode,([charactersIgnoringModifiers length] == 0) ? 0 : [charactersIgnoringModifiers characterAtIndex: 0], w, type); #endif break; @@ -171,7 +180,7 @@ static unsigned isFunctionKey(unsigned int code); xEvent.xkey.keycode = (modifiers ^ savedModifiers); } else { if (type == NSKeyUp || repeat) { - xEvent.xany.type = KeyRelease; + xEvent.xany.type = KeyRelease; } else { xEvent.xany.type = KeyPress; } @@ -238,11 +247,9 @@ static unsigned isFunctionKey(unsigned int code); { int i, len = [(NSString *)aString length]; XEvent xEvent; - TkWindow *winPtr = TkMacOSXGetTkWindow([self window]); - Tk_Window tkwin = (Tk_Window) winPtr; if (NS_KEYLOG) - NSLog (@"insertText '%@'\tlen = %d", aString, len); + TKLog (@"insertText '%@'\tlen = %d", aString, len); processingCompose = NO; finishedCompose = YES; @@ -255,20 +262,17 @@ static unsigned isFunctionKey(unsigned int code); xEvent.xany.type = KeyPress; for (i =0; i impl. */ @@ -410,7 +414,7 @@ static unsigned isFunctionKey(unsigned int code); if (privateWorkingText == nil) return; if (NS_KEYLOG) - NSLog(@"deleteWorkingText len = %lu\n", + TKLog(@"deleteWorkingText len = %lu\n", (unsigned long)[privateWorkingText length]); [privateWorkingText release]; privateWorkingText = nil; @@ -430,6 +434,9 @@ setupXEvent(XEvent *xEvent, NSWindow *w, unsigned int state) { TkWindow *winPtr = TkMacOSXGetTkWindow(w); Tk_Window tkwin = (Tk_Window) winPtr; + if (!winPtr) { + return; + } memset(xEvent, 0, sizeof(XEvent)); xEvent->xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); diff --git a/macosx/tkMacOSXKeyboard.c b/macosx/tkMacOSXKeyboard.c index 1abbbbaa..31f842a0 100644 --- a/macosx/tkMacOSXKeyboard.c +++ b/macosx/tkMacOSXKeyboard.c @@ -690,7 +690,7 @@ TkpSetKeycodeAndState( eventPtr->xkey.keycode = 0; } else if ( modKeyArray[0] <= keysym && keysym <= modKeyArray[NUM_MOD_KEYCODES - 1]) { - /* + /* * Keysyms for pure modifiers only arise in generated events. * We should just copy them to the keycode. */ diff --git a/macosx/tkMacOSXMenu.c b/macosx/tkMacOSXMenu.c index 1e0dc407..d5865f68 100644 --- a/macosx/tkMacOSXMenu.c +++ b/macosx/tkMacOSXMenu.c @@ -773,7 +773,7 @@ TkpPostMenu( int result; inPostMenu = 1; - + result = TkPreprocessMenu(menuPtr); if (result != TCL_OK) { inPostMenu = 0; @@ -785,7 +785,7 @@ TkpPostMenu( NSRect frame = NSMakeRect(x + 9, tkMacOSXZeroScreenHeight - y - 9, 1, 1); frame.origin = [view convertPoint: - [win convertPointFromScreen:frame.origin] fromView:nil]; + [win tkConvertPointFromScreen:frame.origin] fromView:nil]; NSMenu *menu = (NSMenu *) menuPtr->platformData; NSPopUpButtonCell *popUpButtonCell = [[NSPopUpButtonCell alloc] @@ -1139,7 +1139,7 @@ TkpComputeStandardMenuGeometry( columnEntryPtr->x = x; columnEntryPtr->entryFlags &= ~ENTRY_LAST_COLUMN; } - x += maxIndicatorSpace + maxWidth + 2 * borderWidth; + x += maxIndicatorSpace + maxWidth + 2 * activeBorderWidth; maxWidth = maxIndicatorSpace = 0; lastColumnBreak = i; y = borderWidth; @@ -1625,8 +1625,7 @@ TkpDrawMenuEntry( int height, /* Height of the current rectangle */ int strictMotif, /* Boolean flag */ int drawArrow) /* Whether or not to draw the cascade arrow - * for cascade items. Only applies to - * Windows. */ + * for cascade items. */ { } diff --git a/macosx/tkMacOSXMenubutton.c b/macosx/tkMacOSXMenubutton.c index a85e5727..1acefe51 100644 --- a/macosx/tkMacOSXMenubutton.c +++ b/macosx/tkMacOSXMenubutton.c @@ -843,3 +843,11 @@ TkMacOSXComputeMenuButtonDrawParams(TkMenuButton * butPtr, DrawParams * dpPtr) return 1; } +/* + * Local Variables: + * mode: objc + * c-basic-offset: 4 + * fill-column: 79 + * coding: utf-8 + * End: + */ diff --git a/macosx/tkMacOSXMenus.c b/macosx/tkMacOSXMenus.c index f8f00a62..15dbad4f 100644 --- a/macosx/tkMacOSXMenus.c +++ b/macosx/tkMacOSXMenus.c @@ -379,13 +379,13 @@ GenerateEditEvent( XVirtualEvent event; int x, y; TkWindow *winPtr = TkMacOSXGetTkWindow([NSApp keyWindow]); - Tk_Window tkwin = (Tk_Window) winPtr; + Tk_Window tkwin; - if (tkwin == NULL) { + if (!winPtr) { return; } tkwin = (Tk_Window) winPtr->dispPtr->focusPtr; - if (tkwin == NULL) { + if (!tkwin) { return; } bzero(&event, sizeof(XVirtualEvent)); diff --git a/macosx/tkMacOSXMouseEvent.c b/macosx/tkMacOSXMouseEvent.c index 010023fc..828d8747 100644 --- a/macosx/tkMacOSXMouseEvent.c +++ b/macosx/tkMacOSXMouseEvent.c @@ -90,14 +90,14 @@ enum { /* Create an Xevent to add to the Tk queue. */ NSPoint global, local = [theEvent locationInWindow]; if (eventWindow) { /* local will be in window coordinates. */ - global = [eventWindow convertPointToScreen: local]; + global = [eventWindow tkConvertPointToScreen: local]; local.y = [eventWindow frame].size.height - local.y; global.y = tkMacOSXZeroScreenHeight - global.y; } else { /* local will be in screen coordinates. */ if (_windowWithMouse ) { eventWindow = _windowWithMouse; global = local; - local = [eventWindow convertPointFromScreen: local]; + local = [eventWindow tkConvertPointFromScreen: local]; local.y = [eventWindow frame].size.height - local.y; global.y = tkMacOSXZeroScreenHeight - global.y; } else { /* We have no window. Use the screen???*/ @@ -373,7 +373,7 @@ XQueryPointer( if (win) { NSPoint local; - local = [win convertPointFromScreen:global]; + local = [win tkConvertPointFromScreen:global]; local.y = [win frame].size.height - local.y; if (macWin->winPtr && macWin->winPtr->wmInfoPtr) { local.x -= macWin->winPtr->wmInfoPtr->xInParent; @@ -471,7 +471,7 @@ TkGenerateButtonEvent( if (win) { NSPoint local = NSMakePoint(x, tkMacOSXZeroScreenHeight - y); - local = [win convertPointFromScreen:local]; + local = [win tkConvertPointFromScreen:local]; local.y = [win frame].size.height - local.y; if (macWin->winPtr && macWin->winPtr->wmInfoPtr) { local.x -= macWin->winPtr->wmInfoPtr->xInParent; diff --git a/macosx/tkMacOSXNotify.c b/macosx/tkMacOSXNotify.c index fad61b43..7cbd2483 100644 --- a/macosx/tkMacOSXNotify.c +++ b/macosx/tkMacOSXNotify.c @@ -32,6 +32,85 @@ static void TkMacOSXNotifyExitHandler(ClientData clientData); static void TkMacOSXEventsSetupProc(ClientData clientData, int flags); static void TkMacOSXEventsCheckProc(ClientData clientData, int flags); +#ifdef TK_MAC_DEBUG_EVENTS +static char* Tk_EventName[39] = { + "", + "", + "KeyPress", /*2*/ + "KeyRelease", /*3*/ + "ButtonPress", /*4*/ + "ButtonRelease", /*5*/ + "MotionNotify", /*6*/ + "EnterNotify", /*7*/ + "LeaveNotify", /*8*/ + "FocusIn", /*9*/ + "FocusOut", /*10*/ + "KeymapNotify", /*11*/ + "Expose", /*12*/ + "GraphicsExpose", /*13*/ + "NoExpose", /*14*/ + "VisibilityNotify", /*15*/ + "CreateNotify", /*16*/ + "DestroyNotify", /*17*/ + "UnmapNotify", /*18*/ + "MapNotify", /*19*/ + "MapRequest", /*20*/ + "ReparentNotify", /*21*/ + "ConfigureNotify", /*22*/ + "ConfigureRequest", /*23*/ + "GravityNotify", /*24*/ + "ResizeRequest", /*25*/ + "CirculateNotify", /*26*/ + "CirculateRequest", /*27*/ + "PropertyNotify", /*28*/ + "SelectionClear", /*29*/ + "SelectionRequest", /*30*/ + "SelectionNotify", /*31*/ + "ColormapNotify", /*32*/ + "ClientMessage", /*33*/ + "MappingNotify", /*34*/ + "VirtualEvent", /*35*/ + "ActivateNotify", /*36*/ + "DeactivateNotify", /*37*/ + "MouseWheelEvent" /*38*/ +}; + +static Tk_RestrictAction +InspectQueueRestrictProc( + ClientData arg, + XEvent *eventPtr) +{ + XVirtualEvent* ve = (XVirtualEvent*) eventPtr; + const char *name; + long serial = ve->serial; + long time = eventPtr->xkey.time; + + if (eventPtr->type == VirtualEvent) { + name = ve->name; + } else { + name = Tk_EventName[eventPtr->type]; + } + fprintf(stderr, " > %s;serial = %lu; time=%lu)\n", + name, serial, time); + return TK_DEFER_EVENT; +} + +/* + * Debugging tool which prints the current Tcl queue. + */ + +void DebugPrintQueue(void) +{ + ClientData oldArg; + Tk_RestrictProc *oldProc; + + oldProc = Tk_RestrictEvents(InspectQueueRestrictProc, NULL, &oldArg); + fprintf(stderr, "Current queue:\n"); + while (Tcl_DoOneEvent(TCL_ALL_EVENTS|TCL_DONT_WAIT)) {}; + Tk_RestrictEvents(oldProc, oldArg, &oldArg); +} +# endif + #pragma mark TKApplication(TKNotify) @interface NSApplication(TKNotify) @@ -39,31 +118,26 @@ static void TkMacOSXEventsCheckProc(ClientData clientData, int flags); - (void) _modalSession: (NSModalSession) session sendEvent: (NSEvent *) event; @end -@implementation NSWindow(TKNotify) -- (id) tkDisplayIfNeeded -{ - if (![self isAutodisplay]) { - [self displayIfNeeded]; - } - return nil; -} -@end - @implementation TKApplication(TKNotify) -/* Display all windows each time an event is removed from the queue.*/ -- (NSEvent *) nextEventMatchingMask: (NSUInteger) mask - untilDate: (NSDate *) expiration inMode: (NSString *) mode - dequeue: (BOOL) deqFlag -{ - NSEvent *event = [super nextEventMatchingMask:mask - untilDate:expiration - inMode:mode - dequeue:deqFlag]; - /* Retain this event for later use. Must be released.*/ - [event retain]; - [NSApp makeWindowsPerform:@selector(tkDisplayIfNeeded) inOrder:NO]; - return event; -} +/* + * Earlier versions of Tk would override nextEventMatchingMask here, adding a + * call to displayIfNeeded on all windows after calling super. This would cause + * windows to be redisplayed (if necessary) each time that an event was + * received. This was intended to replace Apple's default autoDisplay + * mechanism, which the earlier versions of Tk would disable. When autoDisplay + * is set to the default value of YES, the Apple event loop will call + * displayIfNeeded on all windows at the beginning of each iteration of their + * event loop. Since Tk does not call the Apple event loop, it was thought + * that the autoDisplay behavior needed to be replicated. + * + * However, as of OSX 10.14 (Mojave) the autoDisplay property became + * deprecated. Luckily it turns out that, even though we don't ever start the + * Apple event loop, the Apple window manager still calls displayIfNeeded on + * all windows on a regular basis, perhaps each time the queue is empty. So we + * no longer, and perhaps never did need to set autoDisplay to NO, nor call + * displayIfNeeded on our windows. We can just leave all of that to the window + * manager. + */ /* * Call super then check the pasteboard. @@ -72,6 +146,10 @@ static void TkMacOSXEventsCheckProc(ClientData clientData, int flags); { [super sendEvent:theEvent]; [NSApp tkCheckPasteboard]; +#ifdef TK_MAC_DEBUG_EVENTS + fprintf(stderr, "Sending event of type %d\n", (int)[theEvent type]); + DebugPrintQueue(); +#endif } @end @@ -91,7 +169,7 @@ static void TkMacOSXEventsCheckProc(ClientData clientData, int flags); *---------------------------------------------------------------------- */ -static NSString * +NSString * GetRunLoopMode(NSModalSession modalSession) { NSString *runLoopMode = nil; @@ -229,7 +307,6 @@ TkMacOSXEventsSetupProc( if (currentEvent.type > 0) { Tcl_SetMaxBlockTime(&zeroBlockTime); } - [currentEvent release]; } } } @@ -298,7 +375,6 @@ TkMacOSXEventsCheckProc( [NSApp sendEvent:currentEvent]; } } - [currentEvent release]; } else { break; } diff --git a/macosx/tkMacOSXPrivate.h b/macosx/tkMacOSXPrivate.h index 730ccaab..d804ca06 100644 --- a/macosx/tkMacOSXPrivate.h +++ b/macosx/tkMacOSXPrivate.h @@ -131,7 +131,6 @@ typedef struct TkMacOSXDrawingContext { NSView *view; HIShapeRef clipRgn; CGRect portBounds; - int focusLocked; } TkMacOSXDrawingContext; /* @@ -190,8 +189,7 @@ MODULE_SCOPE int TkGenerateButtonEventForXPointer(Window window); MODULE_SCOPE EventModifiers TkMacOSXModifierState(void); MODULE_SCOPE NSBitmapImageRep* TkMacOSXBitmapRepFromDrawableRect(Drawable drawable, int x, int y, unsigned int width, unsigned int height); -MODULE_SCOPE CGImageRef TkMacOSXCreateCGImageWithXImage(XImage *image, - int use_ximage_alpha); +MODULE_SCOPE CGImageRef TkMacOSXCreateCGImageWithXImage(XImage *image); MODULE_SCOPE void TkMacOSXDrawCGImage(Drawable d, GC gc, CGContextRef context, CGImageRef image, unsigned long imageForeground, unsigned long imageBackground, CGRect imageBounds, @@ -265,9 +263,15 @@ VISIBILITY_HIDDEN #ifdef __i386__ /* The Objective C runtime used on i386 requires this. */ int _poolLock; + int _macMinorVersion; + Bool _isDrawing; + Bool _simulateDrawing; #endif } @property int poolLock; +@property int macMinorVersion; +@property Bool isDrawing; +@property Bool simulateDrawing; @end @interface TKApplication(TKInit) @@ -329,8 +333,7 @@ VISIBILITY_HIDDEN @interface TKContentView(TKWindowEvent) - (void) drawRect: (NSRect) rect; -- (void) generateExposeEvents: (HIShapeRef) shape; -- (void) viewDidEndLiveResize; +- (void) generateExposeEvents: (HIShapeRef) shape; - (void) tkToolbarButton: (id) sender; - (BOOL) isOpaque; - (BOOL) wantsDefaultClipping; @@ -343,8 +346,8 @@ VISIBILITY_HIDDEN @end @interface NSWindow(TKWm) -- (NSPoint) convertPointToScreen:(NSPoint)point; -- (NSPoint) convertPointFromScreen:(NSPoint)point; +- (NSPoint) tkConvertPointToScreen:(NSPoint)point; +- (NSPoint) tkConvertPointFromScreen:(NSPoint)point; @end #pragma mark NSMenu & NSMenuItem Utilities diff --git a/macosx/tkMacOSXScrlbr.c b/macosx/tkMacOSXScrlbr.c index 49ba9998..d1287bb1 100644 --- a/macosx/tkMacOSXScrlbr.c +++ b/macosx/tkMacOSXScrlbr.c @@ -8,6 +8,7 @@ * Copyright 2001-2009, Apple Inc. * Copyright (c) 2006-2009 Daniel A. Steffen * Copyright (c) 2015 Kevin Walzer/WordTech Commununications LLC. + * Copyright (c) 2018 Marc Culler * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ @@ -26,25 +27,40 @@ #define MIN_SLIDER_LENGTH 5 -/*Borrowed from ttkMacOSXTheme.c to provide appropriate scaling of scrollbar values.*/ +/*Borrowed from ttkMacOSXTheme.c to provide appropriate scaling.*/ #ifdef __LP64__ #define RangeToFactor(maximum) (((double) (INT_MAX >> 1)) / (maximum)) #else #define RangeToFactor(maximum) (((double) (LONG_MAX >> 1)) / (maximum)) #endif /* __LP64__ */ -#define MOUNTAIN_LION_STYLE (NSAppKitVersionNumber < 1138) +/* + * Apple reversed the scroll direction with the release of OSX 10.7 Lion. + */ + +#define SNOW_LEOPARD_STYLE (NSAppKitVersionNumber < 1138) /* - * Declaration of Mac specific scrollbar structure. + * Declaration of an extended scrollbar structure with Mac specific additions. */ typedef struct MacScrollbar { - TkScrollbar information; /* Generic scrollbar info. */ + TkScrollbar information; /* Generic scrollbar info. */ GC troughGC; /* For drawing trough. */ GC copyGC; /* Used for copying from pixmap onto screen. */ + Bool buttonDown; /* Is the mouse button down? */ + Bool mouseOver; /* Is the pointer over the scrollbar. */ + HIThemeTrackDrawInfo info; /* Controls how the scrollbar is drawn. */ } MacScrollbar; +/* Used to initialize a MacScrollbar's info field. */ +HIThemeTrackDrawInfo defaultInfo = { + .version = 0, + .min = 0.0, + .max = 100.0, + .attributes = kThemeTrackShowThumb, +}; + /* * The class procedure table for the scrollbar widget. All fields except size * are left initialized to NULL, which should happen automatically since the @@ -59,31 +75,25 @@ const Tk_ClassProcs tkpScrollbarProcs = { }; -/*Information on scrollbar layout, metrics, and draw info.*/ +/* Information on scrollbar layout, metrics, and draw info.*/ typedef struct ScrollbarMetrics { SInt32 width, minThumbHeight; int minHeight, topArrowHeight, bottomArrowHeight; NSControlSize controlSize; } ScrollbarMetrics; -static ScrollbarMetrics metrics[2] = { - {15, 54, 26, 14, 14, kControlSizeNormal}, /* kThemeScrollBarMedium */ - {11, 40, 20, 10, 10, kControlSizeSmall}, /* kThemeScrollBarSmall */ -}; -HIThemeTrackDrawInfo info = { - .version = 0, - .min = 0.0, - .max = 100.0, - .attributes = kThemeTrackShowThumb, + +static ScrollbarMetrics metrics = { + 15, 54, 26, 14, 14, kControlSizeNormal /* kThemeScrollBarMedium */ }; /* - * Forward declarations for procedures defined later in this file: + * Declarations of static functions defined later in this file: */ static void ScrollbarEventProc(ClientData clientData, XEvent *eventPtr); -static int ScrollbarPress(TkScrollbar *scrollPtr, XEvent *eventPtr); +static int ScrollbarEvent(TkScrollbar *scrollPtr, XEvent *eventPtr); static void UpdateControlValues(TkScrollbar *scrollPtr); /* @@ -111,8 +121,19 @@ TkpCreateScrollbar( scrollPtr->troughGC = None; scrollPtr->copyGC = None; - - Tk_CreateEventHandler(tkwin,ExposureMask|StructureNotifyMask|FocusChangeMask|ButtonPressMask|ButtonReleaseMask|EnterWindowMask|LeaveWindowMask|VisibilityChangeMask, ScrollbarEventProc, scrollPtr); + scrollPtr->info = defaultInfo; + scrollPtr->buttonDown = false; + + Tk_CreateEventHandler(tkwin, + ExposureMask | + StructureNotifyMask | + FocusChangeMask | + ButtonPressMask | + ButtonReleaseMask | + EnterWindowMask | + LeaveWindowMask | + VisibilityChangeMask, + ScrollbarEventProc, scrollPtr); return (TkScrollbar *) scrollPtr; } @@ -130,7 +151,7 @@ TkpCreateScrollbar( * None. * * Side effects: - * Information appears on the screen. + * Draws a scrollbar on the screen. * *-------------------------------------------------------------- */ @@ -140,6 +161,7 @@ TkpDisplayScrollbar( ClientData clientData) /* Information about window. */ { register TkScrollbar *scrollPtr = (TkScrollbar *) clientData; + MacScrollbar *msPtr = (MacScrollbar *) scrollPtr; register Tk_Window tkwin = scrollPtr->tkwin; TkWindow *winPtr = (TkWindow *) tkwin; TkMacOSXDrawingContext dc; @@ -163,7 +185,7 @@ TkpDisplayScrollbar( .ty = viewHeight}; CGContextConcatCTM(dc.context, t); - /*Draw Unix-style scroll trough to provide rect for native scrollbar.*/ + /*Draw a 3D rectangle to provide a base for the native scrollbar.*/ if (scrollPtr->highlightWidth != 0) { GC fgGC, bgGC; @@ -187,12 +209,13 @@ TkpDisplayScrollbar( Tk_Width(tkwin) - 2*scrollPtr->inset, Tk_Height(tkwin) - 2*scrollPtr->inset, 0, TK_RELIEF_FLAT); - /*Update values and draw in native rect.*/ + /* Update values and then draw the native scrollbar over the rectangle.*/ UpdateControlValues(scrollPtr); - if (MOUNTAIN_LION_STYLE) { - HIThemeDrawTrack (&info, 0, dc.context, kHIThemeOrientationInverted); + + if (SNOW_LEOPARD_STYLE) { + HIThemeDrawTrack (&(msPtr->info), 0, dc.context, kHIThemeOrientationInverted); } else { - HIThemeDrawTrack (&info, 0, dc.context, kHIThemeOrientationNormal); + HIThemeDrawTrack (&(msPtr->info), 0, dc.context, kHIThemeOrientationNormal); } TkMacOSXRestoreDrawingContext(&dc); @@ -218,76 +241,89 @@ TkpDisplayScrollbar( */ - extern void + +extern void TkpComputeScrollbarGeometry( - register TkScrollbar *scrollPtr) -/* Scrollbar whose geometry may have - * changed. */ + register TkScrollbar *scrollPtr) + /* Scrollbar whose geometry may have + * changed. */ { - int variant, fieldLength; + /* + * The code below is borrowed from tkUnixScrlbr.c but has been adjusted to + * account for some differences between macOS and X11. The Unix scrollbar + * has an arrow button on each end. On macOS 10.6 (Snow Leopard) the + * scrollbars by default have both arrow buttons at the bottom or right. + * (There is a preferences setting to use the Unix layout, but we are not + * supporting that!) On more recent versions of macOS there are no arrow + * buttons at all. The case of no arrow buttons can be handled as a special + * case of having both buttons at the end, but where scrollPtr->arrowLength + * happens to be zero. To adjust for having both arrows at the same end we + * shift the scrollbar up by the arrowLength. + */ + + int fieldLength; if (scrollPtr->highlightWidth < 0) { - scrollPtr->highlightWidth = 0; + scrollPtr->highlightWidth = 0; } scrollPtr->inset = scrollPtr->highlightWidth + scrollPtr->borderWidth; - variant = ((scrollPtr->vertical ? Tk_Width(scrollPtr->tkwin) : - Tk_Height(scrollPtr->tkwin)) - 2 * scrollPtr->inset - < metrics[0].width) ? 1 : 0; - scrollPtr->arrowLength = (metrics[variant].topArrowHeight + - metrics[variant].bottomArrowHeight) / 2; - fieldLength = (scrollPtr->vertical ? Tk_Height(scrollPtr->tkwin) - : Tk_Width(scrollPtr->tkwin)) - - 2 * (scrollPtr->arrowLength + scrollPtr->inset); - if (fieldLength < 0) { - fieldLength = 0; + if ([NSApp macMinorVersion] == 6) { + scrollPtr->arrowLength = scrollPtr->width; + } else { + scrollPtr->arrowLength = 0; } - scrollPtr->sliderFirst = fieldLength * scrollPtr->firstFraction; - scrollPtr->sliderLast = fieldLength * scrollPtr->lastFraction; + fieldLength = (scrollPtr->vertical ? Tk_Height(scrollPtr->tkwin) + : Tk_Width(scrollPtr->tkwin)) + - 2*(scrollPtr->arrowLength + scrollPtr->inset); + if (fieldLength < 0) { + fieldLength = 0; + } + scrollPtr->sliderFirst = fieldLength*scrollPtr->firstFraction; + scrollPtr->sliderLast = fieldLength*scrollPtr->lastFraction; /* - * Adjust the slider so that some piece of it is always - * displayed in the scrollbar and so that it has at least - * a minimal width (so it can be grabbed with the mouse). + * Adjust the slider so that some piece of it is always displayed in the + * scrollbar and so that it has at least a minimal width (so it can be + * grabbed with the mouse). */ - if (scrollPtr->sliderFirst > (fieldLength - 2*scrollPtr->borderWidth)) { - scrollPtr->sliderFirst = fieldLength - 2*scrollPtr->borderWidth; + if (scrollPtr->sliderFirst > fieldLength - MIN_SLIDER_LENGTH) { + scrollPtr->sliderFirst = fieldLength - MIN_SLIDER_LENGTH; } if (scrollPtr->sliderFirst < 0) { - scrollPtr->sliderFirst = 0; + scrollPtr->sliderFirst = 0; } - if (scrollPtr->sliderLast < (scrollPtr->sliderFirst + - metrics[variant].minThumbHeight)) { - scrollPtr->sliderLast = scrollPtr->sliderFirst + - metrics[variant].minThumbHeight; + if (scrollPtr->sliderLast < scrollPtr->sliderFirst + MIN_SLIDER_LENGTH) { + scrollPtr->sliderLast = scrollPtr->sliderFirst + MIN_SLIDER_LENGTH; } if (scrollPtr->sliderLast > fieldLength) { - scrollPtr->sliderLast = fieldLength; + scrollPtr->sliderLast = fieldLength; } + scrollPtr->sliderFirst += -scrollPtr->arrowLength + scrollPtr->inset; + scrollPtr->sliderLast += scrollPtr->inset; - scrollPtr->sliderFirst += scrollPtr->arrowLength + scrollPtr->inset; - scrollPtr->sliderLast += scrollPtr->arrowLength + scrollPtr->inset; - - - /* Register the desired geometry for the window (leave enough space - * for the two arrows plus a minimum-size slider, plus border around - * the whole window, if any). Then arrange for the window to be - * redisplayed. + /* + * Register the desired geometry for the window. Leave enough space for the + * two arrows, if there are any arrows, plus a minimum-size slider, plus + * border around the whole window, if any. Then arrange for the window to + * be redisplayed. */ - if (scrollPtr->vertical) { - Tk_GeometryRequest(scrollPtr->tkwin, scrollPtr->width + 2 * scrollPtr->inset, 2 * (scrollPtr->arrowLength + scrollPtr->borderWidth + scrollPtr->inset) + metrics[variant].minThumbHeight); + if (scrollPtr->vertical) { + Tk_GeometryRequest(scrollPtr->tkwin, + scrollPtr->width + 2*scrollPtr->inset, + 2*(scrollPtr->arrowLength + scrollPtr->borderWidth + + scrollPtr->inset) + metrics.minThumbHeight); } else { - Tk_GeometryRequest(scrollPtr->tkwin, 2 * (scrollPtr->arrowLength + scrollPtr->borderWidth + scrollPtr->inset) + metrics[variant].minThumbHeight, scrollPtr->width + 2 * scrollPtr->inset); + Tk_GeometryRequest(scrollPtr->tkwin, + 2*(scrollPtr->arrowLength + scrollPtr->borderWidth + + scrollPtr->inset) + metrics.minThumbHeight, + scrollPtr->width + 2*scrollPtr->inset); } Tk_SetInternalBorder(scrollPtr->tkwin, scrollPtr->inset); - } - - - /* *---------------------------------------------------------------------- * @@ -316,8 +352,6 @@ TkpDestroyScrollbar( if (macScrollPtr->copyGC != None) { Tk_FreeGC(scrollPtr->display, macScrollPtr->copyGC); } - - macScrollPtr=NULL; } /* @@ -327,13 +361,13 @@ TkpDestroyScrollbar( * * This procedure is called after the generic code has finished * processing configuration options, in order to configure platform - * specific options. + * specific options. There are no such option on the Mac, however. * * Results: * None. * * Side effects: - * Configuration info may get changed. + * Currently, none. * *---------------------------------------------------------------------- */ @@ -341,8 +375,6 @@ TkpDestroyScrollbar( void TkpConfigureScrollbar( register TkScrollbar *scrollPtr) -/* Information about widget; may or may not - * already have values for some fields. */ { } @@ -372,54 +404,51 @@ TkpScrollbarPosition( int x, int y) /* Coordinates within scrollPtr's window. */ { - /* - * Using code from tkUnixScrlbr.c because Unix scroll bindings are - * driving the display at the script level. All the Mac scrollbar - * has to do is re-draw itself. + /* + * The code below is borrowed from tkUnixScrlbr.c and needs no adjustment + * since it does not involve the arrow buttons. */ - int length, fieldlength, width, tmp; + int length, width, tmp; register const int inset = scrollPtr->inset; - register const int arrowSize = scrollPtr->arrowLength + inset; if (scrollPtr->vertical) { length = Tk_Height(scrollPtr->tkwin); - fieldlength = length - 2 * arrowSize; width = Tk_Width(scrollPtr->tkwin); } else { tmp = x; x = y; y = tmp; length = Tk_Width(scrollPtr->tkwin); - fieldlength = length - 2 * arrowSize; width = Tk_Height(scrollPtr->tkwin); } - fieldlength = fieldlength < 0 ? 0 : fieldlength; - - if (x=width-inset || y=length-inset) { + if (x < inset || x >= width - inset || + y < inset || y >= length - inset) { return OUTSIDE; } /* - * All of the calculations in this procedure mirror those in - * TkpDisplayScrollbar. Be sure to keep the two consistent. + * Here we assume that the scrollbar is layed out with both arrow buttons + * at the bottom (or right). Except on 10.6, however, the arrows do not + * actually exist, i.e. the arrowLength is 0. These are the same + * assumptions which are being made in TkpComputeScrollbarGeometry. */ - if (y < scrollPtr->sliderFirst) { + if (y < scrollPtr->sliderFirst + scrollPtr->arrowLength) { return TOP_GAP; - } - if (y < scrollPtr->sliderLast) { + } + if (y < scrollPtr->sliderLast) { return SLIDER; - } - if (y < fieldlength){ + } + if (y < length - (2*scrollPtr->arrowLength + inset)) { return BOTTOM_GAP; - } - if (y < fieldlength + arrowSize) { + } + /* On systems newer than 10.6 we have already returned. */ + if (y < length - (scrollPtr->arrowLength + inset)) { return TOP_ARROW; - } - return BOTTOM_ARROW; - + } + return BOTTOM_ARROW; } /* @@ -429,7 +458,7 @@ TkpScrollbarPosition( * * This procedure updates the Macintosh scrollbar control to * display the values defined by the Tk scrollbar. This is the - * key interface to the Mac-native * scrollbar; the Unix bindings + * key interface to the Mac-native scrollbar; the Unix bindings * drive scrolling in the Tk window and all the Mac scrollbar has * to do is redraw itself. * @@ -446,11 +475,11 @@ static void UpdateControlValues( TkScrollbar *scrollPtr) /* Scrollbar data struct. */ { + MacScrollbar *msPtr = (MacScrollbar *)scrollPtr; Tk_Window tkwin = scrollPtr->tkwin; MacDrawable *macWin = (MacDrawable *) Tk_WindowId(scrollPtr->tkwin); double dViewSize; HIRect contrlRect; - int variant; short width, height; NSView *view = TkMacOSXDrawableView(macWin); @@ -462,23 +491,21 @@ UpdateControlValues( frame.origin.y = viewHeight - (frame.origin.y + frame.size.height); contrlRect = NSRectToCGRect(frame); - info.bounds = contrlRect; + msPtr->info.bounds = contrlRect; width = contrlRect.size.width; height = contrlRect.size.height; - variant = contrlRect.size.width < metrics[0].width ? 1 : 0; - /* * Ensure we set scrollbar control bounds only once all size adjustments * have been computed. */ - info.bounds = contrlRect; + msPtr->info.bounds = contrlRect; if (scrollPtr->vertical) { - info.attributes &= ~kThemeTrackHorizontal; + msPtr->info.attributes &= ~kThemeTrackHorizontal; } else { - info.attributes |= kThemeTrackHorizontal; + msPtr->info.attributes |= kThemeTrackHorizontal; } /* @@ -495,25 +522,25 @@ UpdateControlValues( factor = RangeToFactor(maximum); dViewSize = (scrollPtr->lastFraction - scrollPtr->firstFraction) * factor; - info.max = MIN_SCROLLBAR_VALUE + + msPtr->info.max = MIN_SCROLLBAR_VALUE + factor - dViewSize; - info.trackInfo.scrollbar.viewsize = dViewSize; + msPtr->info.trackInfo.scrollbar.viewsize = dViewSize; if (scrollPtr->vertical) { - if (MOUNTAIN_LION_STYLE) { - info.value = factor * scrollPtr->firstFraction; + if (SNOW_LEOPARD_STYLE) { + msPtr->info.value = factor * scrollPtr->firstFraction; } else { - info.value = info.max - factor * scrollPtr->firstFraction; + msPtr->info.value = msPtr->info.max - factor * scrollPtr->firstFraction; } } else { - info.value = MIN_SCROLLBAR_VALUE + factor * scrollPtr->firstFraction; + msPtr->info.value = MIN_SCROLLBAR_VALUE + factor * scrollPtr->firstFraction; } if((scrollPtr->firstFraction <= 0.0 && scrollPtr->lastFraction >= 1.0) - || height <= metrics[variant].minHeight) { - info.enableState = kThemeTrackHideTrack; + || height <= metrics.minHeight) { + msPtr->info.enableState = kThemeTrackHideTrack; } else { - info.enableState = kThemeTrackActive; - info.attributes = kThemeTrackShowThumb | kThemeTrackThumbRgnIsNotGhost; + msPtr->info.enableState = kThemeTrackActive; + msPtr->info.attributes = kThemeTrackShowThumb | kThemeTrackThumbRgnIsNotGhost; } } @@ -521,29 +548,79 @@ UpdateControlValues( /* *-------------------------------------------------------------- * - * ScrollbarPress -- + * ScrollbarEvent -- * * This procedure is invoked in response to , , - * , and events. Scrollbar appearance is modified. + * , and events. The Scrollbar appearance is + * modified for each event. * *-------------------------------------------------------------- */ static int -ScrollbarPress(TkScrollbar *scrollPtr, XEvent *eventPtr) +ScrollbarEvent(TkScrollbar *scrollPtr, XEvent *eventPtr) { + MacScrollbar *msPtr = (MacScrollbar *)scrollPtr; + + /* The pressState does not indicate whether the moused button was + * pressed at some location in the Scrollbar. Rather, it indicates + * that the scrollbar should appear as if it were pressed in that + * location. The standard Mac behavior is that once the button is + * pressed inside the Scrollbar the appearance should not change until + * the button is released, even if the mouse moves outside of the + * scrollbar. However, if the mouse lies over the scrollbar but the + * button is not pressed then the appearance should be the same as if + * the button had been pressed on the slider, i.e. kThemeThumbPressed. + * See the file Appearance.r, or HIToolbox.bridgesupport on 10.14. + */ - if (eventPtr->type == ButtonPress) { - UpdateControlValues(scrollPtr); - info.trackInfo.scrollbar.pressState = 1; - } - if (eventPtr->type == EnterNotify) { - info.trackInfo.scrollbar.pressState = 1; - } - if (eventPtr->type == ButtonRelease || eventPtr->type == LeaveNotify) { - info.trackInfo.scrollbar.pressState = 0; - } - return TCL_OK; + if (eventPtr->type == ButtonPress) { + msPtr->buttonDown = true; + UpdateControlValues(scrollPtr); + int where = TkpScrollbarPosition(scrollPtr, + eventPtr->xbutton.x, + eventPtr->xbutton.y); + switch(where) { + case OUTSIDE: + msPtr->info.trackInfo.scrollbar.pressState = 0; + break; + case TOP_GAP: + msPtr->info.trackInfo.scrollbar.pressState = kThemeTopTrackPressed; + break; + case SLIDER: + msPtr->info.trackInfo.scrollbar.pressState = kThemeThumbPressed; + break; + case BOTTOM_GAP: + msPtr->info.trackInfo.scrollbar.pressState = kThemeBottomTrackPressed; + break; + case TOP_ARROW: + /* This looks wrong and the docs say it is wrong but it works. */ + msPtr->info.trackInfo.scrollbar.pressState = kThemeTopInsideArrowPressed; + break; + case BOTTOM_ARROW: + msPtr->info.trackInfo.scrollbar.pressState = kThemeBottomOutsideArrowPressed; + break; + } + } + if (eventPtr->type == ButtonRelease) { + msPtr->buttonDown = false; + if (!msPtr->mouseOver) { + msPtr->info.trackInfo.scrollbar.pressState = 0; + } + } + if (eventPtr->type == EnterNotify) { + msPtr->mouseOver = true; + if (!msPtr->buttonDown) { + msPtr->info.trackInfo.scrollbar.pressState = kThemeThumbPressed; + } + } + if (eventPtr->type == LeaveNotify) { + msPtr->mouseOver = false; + if (!msPtr->buttonDown) { + msPtr->info.trackInfo.scrollbar.pressState = 0; + } + } + return TCL_OK; } @@ -585,9 +662,18 @@ ScrollbarEventProc( case ButtonRelease: case EnterNotify: case LeaveNotify: - ScrollbarPress(clientData, eventPtr); + ScrollbarEvent(clientData, eventPtr); break; default: TkScrollbarEventProc(clientData, eventPtr); } } + +/* + * Local Variables: + * mode: objc + * c-basic-offset: 4 + * fill-column: 79 + * coding: utf-8 + * End: + */ diff --git a/macosx/tkMacOSXSubwindows.c b/macosx/tkMacOSXSubwindows.c index 3d5e9865..0f9214f4 100644 --- a/macosx/tkMacOSXSubwindows.c +++ b/macosx/tkMacOSXSubwindows.c @@ -205,6 +205,13 @@ XMapWindow( event.xvisibility.type = VisibilityNotify; event.xvisibility.state = VisibilityUnobscured; NotifyVisibility(macWin->winPtr, &event); + + /* + * Make sure that subwindows get displayed. + */ + + GenerateConfigureNotify(macWin->winPtr, 1); + } /* @@ -295,10 +302,12 @@ XUnmapWindow( event.xunmap.from_configure = false; Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL); } else { + /* * Rebuild the visRgn clip region for the parent so it will be allowed * to draw in the space from which this subwindow was removed. */ + if (parentPtr && parentPtr->privatePtr->visRgn) { TkMacOSXInvalidateViewRegion(TkMacOSXDrawableView(parentPtr->privatePtr), parentPtr->privatePtr->visRgn); @@ -380,10 +389,12 @@ XMoveResizeWindow( if (Tk_IsTopLevel(macWin->winPtr) && !Tk_IsEmbedded(macWin->winPtr)) { NSWindow *w = macWin->winPtr->wmInfoPtr->window; if (w) { + /* We explicitly convert everything to doubles so we don't get * surprised (again) by what happens when you do arithmetic with * unsigned ints. */ + CGFloat X = (CGFloat)x; CGFloat Y = (CGFloat)y; CGFloat Width = (CGFloat)width; @@ -470,6 +481,7 @@ MoveResizeWindow( if (contWinPtr) { macParent = contWinPtr->privatePtr; } else { + /* * Here we should handle out of process embedding. At this point, * we are assuming that the changes.x,y is not maintained, if you @@ -478,6 +490,7 @@ MoveResizeWindow( */ } } else { + /* * TODO: update all xOff & yOffs */ @@ -569,6 +582,7 @@ XRaiseWindow( if (Tk_IsTopLevel(macWin->winPtr) && !Tk_IsEmbedded(macWin->winPtr)) { TkWmRestackToplevel(macWin->winPtr, Above, NULL); } else { + /* * TODO: this should generate damage */ @@ -603,7 +617,8 @@ XLowerWindow( if (Tk_IsTopLevel(macWin->winPtr) && !Tk_IsEmbedded(macWin->winPtr)) { TkWmRestackToplevel(macWin->winPtr, Below, NULL); } else { - /* + + /* * TODO: this should generate damage */ } @@ -874,6 +889,7 @@ TkMacOSXUpdateClipRgn( } CFRelease(rgn); } else { + /* * An unmapped window has empty clip regions to prevent any * (erroneous) drawing into it or its children from becoming @@ -1134,6 +1150,7 @@ void * TkMacOSXGetRootControl( Drawable drawable) { + /* * will probably need to fix this up for embedding */ @@ -1314,6 +1331,7 @@ UpdateOffsets( TkWindow *childPtr; if (winPtr->privatePtr == NULL) { + /* * We haven't called Tk_MakeWindowExist for this window yet. The offset * information will be postponed and calulated at that time. (This will diff --git a/macosx/tkMacOSXTest.c b/macosx/tkMacOSXTest.c index 1882ce62..5576c44a 100644 --- a/macosx/tkMacOSXTest.c +++ b/macosx/tkMacOSXTest.c @@ -79,6 +79,35 @@ DebuggerObjCmd( return TCL_OK; } +/* + *---------------------------------------------------------------------- + * + * TkTestSimulateDrawing -- + * + * A test widget display procedure which records calls can use this to + * avoid duplicate calls which would occur due to fact that no valid + * graphics context is available to the idle task which is running the + * display proc. Note that no actual drawing to the screen will take + * place when this flag is set. This is just a wrapper for the NSApp + * property. + * + * + * Results: + * Calls to low level drawing routines will return without actually + * drawing anything to the screen. + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ +MODULE_SCOPE void +TkTestSimulateDrawing(Bool yesno) { + [NSApp setSimulateDrawing:yesno]; +} + + + /* * Local Variables: * mode: objc diff --git a/macosx/tkMacOSXWindowEvent.c b/macosx/tkMacOSXWindowEvent.c index ccdb9378..5bb42ae5 100644 --- a/macosx/tkMacOSXWindowEvent.c +++ b/macosx/tkMacOSXWindowEvent.c @@ -68,11 +68,7 @@ extern NSString *NSWindowDidOrderOffScreenNotification; TKLog(@"-[%@(%p) %s] %@", [self class], self, _cmd, notification); #endif BOOL movedOnly = [[notification name] - isEqualToString:NSWindowDidMoveNotification]; - - if (movedOnly) { - /* constraining to screen after move not needed with AppKit */ - } + isEqualToString:NSWindowDidMoveNotification]; NSWindow *w = [notification object]; TkWindow *winPtr = TkMacOSXGetTkWindow(w); @@ -96,6 +92,7 @@ extern NSString *NSWindowDidOrderOffScreenNotification; flags |= TK_SIZE_CHANGED; } if (Tcl_GetServiceMode() != TCL_SERVICE_NONE) { + /* * Propagate geometry changes immediately. */ @@ -119,6 +116,7 @@ extern NSString *NSWindowDidOrderOffScreenNotification; TkMacOSXIsWindowZoomed(winPtr) ? ZoomState : NormalState; Tk_MapWindow((Tk_Window) winPtr); if (Tcl_GetServiceMode() != TCL_SERVICE_NONE) { + /* * Process all Tk events generated by Tk_MapWindow(). */ @@ -174,6 +172,7 @@ extern NSString *NSWindowDidOrderOffScreenNotification; return (winPtr ? NO : YES); } + #ifdef TK_MAC_DEBUG_NOTIFICATIONS - (void) windowDragStart: (NSNotification *) notification @@ -213,6 +212,8 @@ extern NSString *NSWindowDidOrderOffScreenNotification; //Tk_UnmapWindow((Tk_Window) winPtr); } } + + #endif /* TK_MAC_DEBUG_NOTIFICATIONS */ - (void) _setupWindowNotifications @@ -236,6 +237,7 @@ extern NSString *NSWindowDidOrderOffScreenNotification; observe(NSWindowDidOrderOffScreenNotification, windowUnmapped:); #endif #undef observe + } @end @@ -256,7 +258,6 @@ extern NSString *NSWindowDidOrderOffScreenNotification; #ifdef TK_MAC_DEBUG_NOTIFICATIONS TKLog(@"-[%@(%p) %s] %@", [self class], self, _cmd, notification); #endif - TkSuspendClipboard(); } - (void) applicationShowHide: (NSNotification *) notification @@ -292,6 +293,31 @@ extern NSString *NSWindowDidOrderOffScreenNotification; @end #pragma mark - + +/* + *---------------------------------------------------------------------- + * + * TkpAppIsDrawing -- + * + * A widget display procedure can call this to determine whether it + * is being run inside of the drawRect method. This is needed for + * some tests, especially of the Text widget, which record data in + * a global Tcl variable and assume that display procedures will be + * run in a predictable sequence as Tcl idle tasks. + * + * Results: + * True only while running the drawRect method of a TKContentView; + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ +MODULE_SCOPE Bool +TkpAppIsDrawing(void) { + return [NSApp isDrawing]; +} + /* *---------------------------------------------------------------------- @@ -299,7 +325,7 @@ extern NSString *NSWindowDidOrderOffScreenNotification; * GenerateUpdates -- * * Given a Macintosh update region and a Tk window this function geneates - * a X Expose event for the window if it is within the update region. The + * an X Expose event for the window if it meets the update region. The * function will then recursivly have each damaged window generate Expose * events for its child windows. * @@ -360,7 +386,7 @@ GenerateUpdates( Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL); #ifdef TK_MAC_DEBUG_DRAWING - NSLog(@"Expose %p {{%d, %d}, {%d, %d}}", event.xany.window, event.xexpose.x, + TKLog(@"Expose %p {{%d, %d}, {%d, %d}}", event.xany.window, event.xexpose.x, event.xexpose.y, event.xexpose.width, event.xexpose.height); #endif @@ -579,10 +605,12 @@ TkGenWMConfigureEvent( if ((flags & TK_SIZE_CHANGED) && !(wmPtr->flags & WM_SYNC_PENDING) && ((width != Tk_Width(tkwin)) || (height != Tk_Height(tkwin)))) { if ((wmPtr->width == -1) && (width == winPtr->reqWidth)) { + /* * Don't set external width, since the user didn't change it * from what the widgets asked for. */ + } else if (wmPtr->gridWin != NULL) { wmPtr->width = wmPtr->reqGridWidth + (width - winPtr->reqWidth)/wmPtr->widthInc; @@ -594,10 +622,12 @@ TkGenWMConfigureEvent( } if ((wmPtr->height == -1) && (height == winPtr->reqHeight)) { + /* * Don't set external height, since the user didn't change it * from what the widgets asked for. */ + } else if (wmPtr->gridWin != NULL) { wmPtr->height = wmPtr->reqGridHeight + (height - winPtr->reqHeight)/wmPtr->heightInc; @@ -796,131 +826,216 @@ ConfigureRestrictProc( const NSRect *rectsBeingDrawn; NSInteger rectsBeingDrawnCount; - [self getRectsBeingDrawn:&rectsBeingDrawn count:&rectsBeingDrawnCount]; - #ifdef TK_MAC_DEBUG_DRAWING - TKLog(@"-[%@(%p) %s%@]", [self class], self, _cmd, NSStringFromRect(rect)); - [[NSColor colorWithDeviceRed:0.0 green:1.0 blue:0.0 alpha:.1] setFill]; - NSRectFillListUsingOperation(rectsBeingDrawn, rectsBeingDrawnCount, - NSCompositeSourceOver); + TkWindow *winPtr = TkMacOSXGetTkWindow([self window]); + if (winPtr) fprintf(stderr, "drawRect: drawing %s\n", + Tk_PathName(winPtr)); #endif + if ([NSApp simulateDrawing]) { + return; + } + + /* + * We do not allow recursive calls to drawRect, but we only log + * them on OSX > 10.13, where they should never happen. + */ + + if ([NSApp isDrawing] && [NSApp macMinorVersion] > 13) { + TKLog(@"WARNING: a recursive call to drawRect was aborted."); + return; + } + + [NSApp setIsDrawing: YES]; + + [self getRectsBeingDrawn:&rectsBeingDrawn count:&rectsBeingDrawnCount]; CGFloat height = [self bounds].size.height; HIMutableShapeRef drawShape = HIShapeCreateMutable(); while (rectsBeingDrawnCount--) { CGRect r = NSRectToCGRect(*rectsBeingDrawn++); + +#ifdef TK_MAC_DEBUG_DRAWING + fprintf(stderr, "drawRect: %dx%d@(%d,%d)\n", (int)r.size.width, + (int)r.size.height, (int)r.origin.x, (int)r.origin.y); +#endif + r.origin.y = height - (r.origin.y + r.size.height); HIShapeUnionWithRect(drawShape, &r); } - if (CFRunLoopGetMain() == CFRunLoopGetCurrent()) { - [self generateExposeEvents:(HIShapeRef)drawShape]; - } else { - [self performSelectorOnMainThread:@selector(generateExposeEvents:) - withObject:(id)drawShape waitUntilDone:NO - modes:[NSArray arrayWithObjects:NSRunLoopCommonModes, - - NSEventTrackingRunLoopMode, NSModalPanelRunLoopMode, - nil]]; - } - + [self generateExposeEvents:(HIShapeRef)drawShape]; CFRelease(drawShape); + [NSApp setIsDrawing: NO]; + +#ifdef TK_MAC_DEBUG_DRAWING + fprintf(stderr, "drawRect: done.\n"); +#endif } -(void) setFrameSize: (NSSize)newsize { [super setFrameSize: newsize]; - if ([self inLiveResize]) { - NSWindow *w = [self window]; - TkWindow *winPtr = TkMacOSXGetTkWindow(w); - Tk_Window tkwin = (Tk_Window) winPtr; + NSWindow *w = [self window]; + TkWindow *winPtr = TkMacOSXGetTkWindow(w); + Tk_Window tkwin = (Tk_Window) winPtr; + if (winPtr) { + /* On OSX versions below 10.14 setFrame calls drawRect. + * On 10.14 it does its own drawing. + */ + if ([NSApp macMinorVersion] > 13) { + [NSApp setIsDrawing:YES]; + } unsigned int width = (unsigned int)newsize.width; unsigned int height=(unsigned int)newsize.height; ClientData oldArg; Tk_RestrictProc *oldProc; - /* This can be called from outside the Tk event loop. + /* + * This can be called from outside the Tk event loop. * Since it calls Tcl_DoOneEvent, we need to make sure we * don't clobber the AutoreleasePool set up by the caller. */ + [NSApp _lockAutoreleasePool]; /* - * Try to prevent flickers and flashes. + * Disable Tk drawing until the window has been completely configured. */ - [w disableFlushWindow]; - NSDisableScreenUpdates(); - /* Disable Tk drawing until the window has been completely configured.*/ TkMacOSXSetDrawingEnabled(winPtr, 0); - /* Generate and handle a ConfigureNotify event for the new size.*/ + /* + * Generate and handle a ConfigureNotify event for the new size. + */ + TkGenWMConfigureEvent(tkwin, Tk_X(tkwin), Tk_Y(tkwin), width, height, TK_SIZE_CHANGED | TK_MACOSX_HANDLE_EVENT_IMMEDIATELY); oldProc = Tk_RestrictEvents(ConfigureRestrictProc, NULL, &oldArg); - while (Tk_DoOneEvent(TK_X_EVENTS|TK_DONT_WAIT)) {} Tk_RestrictEvents(oldProc, oldArg, &oldArg); - /* Now that Tk has configured all subwindows we can create the clip regions. */ + /* + * Now that Tk has configured all subwindows, create the clip regions. + */ + TkMacOSXSetDrawingEnabled(winPtr, 1); TkMacOSXInvalClipRgns(tkwin); TkMacOSXUpdateClipRgn(winPtr); - /* Finally, generate and process expose events to redraw the window. */ + /* + * Generate and process expose events to redraw the window. + */ + HIRect bounds = NSRectToCGRect([self bounds]); HIShapeRef shape = HIShapeCreateWithRect(&bounds); [self generateExposeEvents: shape]; - while (Tk_DoOneEvent(TK_ALL_EVENTS|TK_DONT_WAIT)) {} - [w enableFlushWindow]; - [w flushWindowIfNeeded]; - NSEnableScreenUpdates(); + [w displayIfNeeded]; + + /* + * Finally, unlock the main autoreleasePool. + */ + [NSApp _unlockAutoreleasePool]; } } /* - * As insurance against bugs that might cause layout glitches during a live - * resize, we redraw the window one more time at the end of the resize - * operation. + * Core method of this class: generates expose events for redrawing. The + * expose events are immediately removed from the Tcl event loop and processed. + * This causes drawing procedures to be scheduled as idle events. Then all + * pending idle events are processed so the drawing will actually take place. */ -- (void)viewDidEndLiveResize -{ - HIRect bounds = NSRectToCGRect([self bounds]); - HIShapeRef shape = HIShapeCreateWithRect(&bounds); - [super viewDidEndLiveResize]; - [self generateExposeEvents: shape]; -} - -/* Core method of this class: generates expose events for redrawing. If the - * Tcl_ServiceMode is set to TCL_SERVICE_ALL then the expose events will be - * immediately removed from the Tcl event loop and processed. Typically, they - * should be queued, however. - */ - (void) generateExposeEvents: (HIShapeRef) shape { unsigned long serial; CGRect updateBounds; int updatesNeeded; TkWindow *winPtr = TkMacOSXGetTkWindow([self window]); - + ClientData oldArg; + Tk_RestrictProc *oldProc; if (!winPtr) { - return; + return; } - /* Generate Tk Expose events. */ + /* + * Generate Tk Expose events. + */ + HIShapeGetBounds(shape, &updateBounds); - /* All of these events will share the same serial number. */ + + /* + * All of these events will share the same serial number. + */ + serial = LastKnownRequestProcessed(Tk_Display(winPtr)); updatesNeeded = GenerateUpdates(shape, &updateBounds, winPtr); - /* Process the Expose events if the service mode is TCL_SERVICE_ALL */ - if (updatesNeeded && Tcl_GetServiceMode() == TCL_SERVICE_ALL) { - ClientData oldArg; - Tk_RestrictProc *oldProc = Tk_RestrictEvents(ExposeRestrictProc, - UINT2PTR(serial), &oldArg); - while (Tcl_ServiceEvent(TCL_WINDOW_EVENTS)) {} + if (updatesNeeded) { + + /* + * First process all of the Expose events. + */ + + oldProc = Tk_RestrictEvents(ExposeRestrictProc, UINT2PTR(serial), &oldArg); + while (Tcl_ServiceEvent(TCL_WINDOW_EVENTS)) {}; Tk_RestrictEvents(oldProc, oldArg, &oldArg); + + /* + * Starting with OSX 10.14, which uses Core Animation to draw windows, + * all drawing must be done within the drawRect method. (The CGContext + * which draws to the backing CALayer is created by the NSView before + * calling drawRect, and destroyed when drawRect returns. Drawing done + * with the current CGContext outside of the drawRect method has no + * effect.) + * + * Fortunately, Tk schedules all drawing to be done while Tcl is idle. + * So we can do the drawing by processing all of the idle events that + * were created when the expose events were processed. + */ + while (Tcl_DoOneEvent(TCL_IDLE_EVENTS)) {} + } +} + +/* + * This method is called when a user changes between light and dark mode. + * The implementation here generates a Tk virtual event which can be bound + * to a function that redraws the window in an appropriate style. + */ + +- (void) viewDidChangeEffectiveAppearance +{ + XVirtualEvent event; + int x, y; + NSString *osxMode = [[NSUserDefaults standardUserDefaults] stringForKey:@"AppleInterfaceStyle"]; + NSWindow *w = [self window]; + TkWindow *winPtr = TkMacOSXGetTkWindow(w); + Tk_Window tkwin = (Tk_Window) winPtr; + + if (!winPtr) { + return; + } + bzero(&event, sizeof(XVirtualEvent)); + event.type = VirtualEvent; + event.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); + event.send_event = false; + event.display = Tk_Display(tkwin); + event.event = Tk_WindowId(tkwin); + event.root = XRootWindow(Tk_Display(tkwin), 0); + event.subwindow = None; + event.time = TkpGetMS(); + XQueryPointer(NULL, winPtr->window, NULL, NULL, + &event.x_root, &event.y_root, &x, &y, &event.state); + Tk_TopCoordsToWindow(tkwin, x, y, &event.x, &event.y); + event.same_screen = true; + if (osxMode == nil) { + event.name = Tk_GetUid("LightAqua"); + Tk_QueueWindowEvent((XEvent *) &event, TCL_QUEUE_TAIL); + return; + } + if ([osxMode isEqual:@"Dark"]) { + event.name = Tk_GetUid("DarkAqua"); + Tk_QueueWindowEvent((XEvent *) &event, TCL_QUEUE_TAIL); + return; } } @@ -928,6 +1043,7 @@ ConfigureRestrictProc( * This is no-op on 10.7 and up because Apple has removed this widget, * but we are leaving it here for backwards compatibility. */ + - (void) tkToolbarButton: (id) sender { #ifdef TK_MAC_DEBUG_EVENTS @@ -937,6 +1053,9 @@ ConfigureRestrictProc( int x, y; TkWindow *winPtr = TkMacOSXGetTkWindow([self window]); Tk_Window tkwin = (Tk_Window) winPtr; + if (!winPtr){ + return; + } bzero(&event, sizeof(XVirtualEvent)); event.type = VirtualEvent; event.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); @@ -957,7 +1076,6 @@ ConfigureRestrictProc( - (BOOL) isOpaque { NSWindow *w = [self window]; - return (w && (([w styleMask] & NSTexturedBackgroundWindowMask) || ![w isOpaque]) ? NO : YES); } diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index a68a87f5..9e45996c 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -204,16 +204,16 @@ static int windowHashInit = false; @implementation NSWindow(TKWm) #if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 -- (NSPoint) convertPointToScreen: (NSPoint) point +- (NSPoint) tkConvertPointToScreen: (NSPoint) point { return [self convertBaseToScreen:point]; } -- (NSPoint) convertPointFromScreen: (NSPoint)point +- (NSPoint) tkConvertPointFromScreen: (NSPoint)point { return [self convertScreenToBase:point]; } #else -- (NSPoint) convertPointToScreen: (NSPoint) point +- (NSPoint) tkConvertPointToScreen: (NSPoint) point { NSRect pointrect; pointrect.origin = point; @@ -221,7 +221,7 @@ static int windowHashInit = false; pointrect.size.height = 0; return [self convertRectToScreen:pointrect].origin; } -- (NSPoint) convertPointFromScreen: (NSPoint)point +- (NSPoint) tkConvertPointFromScreen: (NSPoint)point { NSRect pointrect; pointrect.origin = point; @@ -231,6 +231,21 @@ static int windowHashInit = false; } #endif +- (NSSize)windowWillResize:(NSWindow *)sender + toSize:(NSSize)frameSize +{ + NSRect currentFrame = [sender frame]; + TkWindow *winPtr = TkMacOSXGetTkWindow(sender); + if (winPtr) { + if (winPtr->wmInfoPtr->flags & WM_WIDTH_NOT_RESIZABLE) { + frameSize.width = currentFrame.size.width; + } + if (winPtr->wmInfoPtr->flags & WM_HEIGHT_NOT_RESIZABLE) { + frameSize.height = currentFrame.size.height; + } + } + return frameSize; +} @end #pragma mark - @@ -372,20 +387,48 @@ static void RemapWindows(TkWindow *winPtr, @implementation TKWindow: NSWindow -#if MAC_OS_X_VERSION_MIN_REQUIRED > MAC_OS_X_VERSION_10_12 -/* - * Override automatic fullscreen button on >10.12 because system fullscreen API - * confuses Tk window geometry. - */ + +/* Custom fullscreen implementation on 10.13 and above. On older versions of + * macOS dating back to 10.7, the NSWindow fullscreen API was opt-in, requiring + * explicit calls to toggleFullScreen. On 10.13, the API became implicit, + * applying to all NSWindows unless they were marked non-resizable; this caused + * issues with Tk, which was not aware of changes in screen geometry. Here we + * override the toggleFullScreen call to hook directly into Tk's own fullscreen + * API, allowing Tk to function smoothly with the Mac's fullscreen button. +*/ + +NSStatusItem *exitFullScreen; + + - (void)toggleFullScreen:(id)sender { - if ([self isZoomed]) { - TkMacOSXZoomToplevel(self, inZoomIn); - } else { - TkMacOSXZoomToplevel(self, inZoomOut); - } + TkWindow *winPtr = TkMacOSXGetTkWindow(self); + if (!winPtr) { + return; + } + Tcl_Interp *interp = Tk_Interp((Tk_Window)winPtr); + if ([NSApp macMinorVersion] > 12) { + if (([self styleMask] & NSFullScreenWindowMask) == NSFullScreenWindowMask) { + TkMacOSXMakeFullscreen(winPtr, self, 0, interp); + } else { + TkMacOSXMakeFullscreen(winPtr, self, 1, interp); + } + } else { + TKLog (@"toggleFullScreen is ignored by Tk on OSX versions < 10.13"); + } } -#endif + +-(void)restoreOldScreen:(id)sender +{ + TkWindow *winPtr = TkMacOSXGetTkWindow(self); + if (!winPtr) { + return; + } + Tcl_Interp *interp = Tk_Interp((Tk_Window)winPtr); + TkMacOSXMakeFullscreen(winPtr, self, 0, interp); + [[NSStatusBar systemStatusBar] removeStatusItem: exitFullScreen]; +} + @end @implementation TKWindow(TKWm) @@ -393,14 +436,15 @@ static void RemapWindows(TkWindow *winPtr, - (BOOL) canBecomeKeyWindow { TkWindow *winPtr = TkMacOSXGetTkWindow(self); - - return (winPtr && winPtr->wmInfoPtr && (winPtr->wmInfoPtr->macClass == - kHelpWindowClass || winPtr->wmInfoPtr->attributes & - kWindowNoActivatesAttribute)) ? NO : YES; + if (!winPtr) { + return NO; + } + return (winPtr->wmInfoPtr && + (winPtr->wmInfoPtr->macClass == kHelpWindowClass || + winPtr->wmInfoPtr->attributes & kWindowNoActivatesAttribute) + ) ? NO : YES; } - - #if DEBUG_ZOMBIES - (id) retain { @@ -410,7 +454,8 @@ static void RemapWindows(TkWindow *winPtr, title = "unnamed window"; } if (DEBUG_ZOMBIES > 1){ - printf("Retained <%s>. Count is: %lu\n", title, [self retainCount]); + fprintf(stderr, "Retained <%s>. Count is: %lu\n", + title, [self retainCount]); } return result; } @@ -423,7 +468,8 @@ static void RemapWindows(TkWindow *winPtr, title = "unnamed window"; } if (DEBUG_ZOMBIES > 1){ - printf("Autoreleased <%s>. Count is %lu\n", title, [self retainCount]); + fprintf(stderr, "Autoreleased <%s>. Count is %lu\n", + title, [self retainCount]); } return result; } @@ -434,7 +480,8 @@ static void RemapWindows(TkWindow *winPtr, title = "unnamed window"; } if (DEBUG_ZOMBIES > 1){ - printf("Releasing <%s>. Count is %lu\n", title, [self retainCount]); + fprintf(stderr, "Releasing <%s>. Count is %lu\n", + title, [self retainCount]); } [super release]; } @@ -445,7 +492,8 @@ static void RemapWindows(TkWindow *winPtr, title = "unnamed window"; } if (DEBUG_ZOMBIES > 0){ - printf(">>>> Freeing <%s>. Count is %lu\n", title, [self retainCount]); + fprintf(stderr, ">>>> Freeing <%s>. Count is %lu\n", + title, [self retainCount]); } [super dealloc]; } @@ -566,15 +614,15 @@ FrontWindowAtPoint( { NSPoint p = NSMakePoint(x, tkMacOSXZeroScreenHeight - y); NSArray *windows = [NSApp orderedWindows]; - TkWindow *front = NULL; + TkWindow *winPtr = NULL; for (NSWindow *w in windows) { - if (w && NSMouseInRect(p, [w frame], NO)) { - front = TkMacOSXGetTkWindow(w); - break; - } + winPtr = TkMacOSXGetTkWindow(w); + if (winPtr && NSMouseInRect(p, [w frame], NO)) { + break; } - return front; + } + return winPtr; } /* @@ -702,7 +750,6 @@ TkWmMapWindow( * mapped. */ { WmInfo *wmPtr = winPtr->wmInfoPtr; - if (wmPtr->flags & WM_NEVER_MAPPED) { /* * Create the underlying Mac window for this Tk window. @@ -774,7 +821,6 @@ TkWmMapWindow( /*Add window to Window menu.*/ NSWindow *win = TkMacOSXDrawableWindow(winPtr->window); [win setExcludedFromWindowsMenu:NO]; - } /* @@ -3430,7 +3476,15 @@ WmTransientCmd( if (TkGetWindowFromObj(interp, tkwin, objv[3], &master) != TCL_OK) { return TCL_ERROR; } - Tk_MakeWindowExist(master); + TkWindow* masterPtr = (TkWindow*) master; + while (!Tk_TopWinHierarchy(masterPtr)) { + /* + * Ensure that the master window is actually a Tk toplevel. + */ + + masterPtr = masterPtr->parentPtr; + } + Tk_MakeWindowExist((Tk_Window)masterPtr); if (wmPtr->iconFor != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -3440,8 +3494,7 @@ WmTransientCmd( return TCL_ERROR; } - wmPtr2 = ((TkWindow *) master)->wmInfoPtr; - + wmPtr2 = masterPtr->wmInfoPtr; /* Under some circumstances, wmPtr2 is NULL here */ if (wmPtr2 != NULL && wmPtr2->iconFor != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -3451,15 +3504,16 @@ WmTransientCmd( return TCL_ERROR; } - if ((TkWindow *) master == winPtr) { + if (masterPtr == winPtr) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't make \"%s\" its own master", Tk_PathName(winPtr))); Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "SELF", NULL); return TCL_ERROR; } - wmPtr->master = Tk_WindowId(master); - masterWindowName = Tcl_GetStringFromObj(objv[3], &length); + wmPtr->master = Tk_WindowId(masterPtr); + masterWindowName = masterPtr->pathName; + length = strlen(masterWindowName); if (wmPtr->masterWindowName != NULL) { ckfree(wmPtr->masterWindowName); } @@ -4251,15 +4305,7 @@ Tk_GetRootCoords( */ winPtr = otherPtr; - - /* - * Remember to offset by the container window here, since at the - * end of this if branch, we will pop out to the container's - * parent... - */ - - x += winPtr->changes.x + winPtr->changes.border_width; - y += winPtr->changes.y + winPtr->changes.border_width; + continue; } winPtr = winPtr->parentPtr; } @@ -5612,20 +5658,18 @@ TkMacOSXMakeRealWindowExist( } TKContentView *contentView = [[TKContentView alloc] initWithFrame:NSZeroRect]; - [window setColorSpace:[NSColorSpace deviceRGBColorSpace]]; [window setContentView:contentView]; [contentView release]; [window setDelegate:NSApp]; [window setAcceptsMouseMovedEvents:YES]; [window setReleasedWhenClosed:NO]; - [window setAutodisplay:NO]; if (styleMask & NSUtilityWindowMask) { [(NSPanel*)window setFloatingPanel:YES]; } if ((styleMask & (NSTexturedBackgroundWindowMask|NSHUDWindowMask)) && !(styleMask & NSDocModalWindowMask)) { /* - * Workaround for [Bug 2824538]: Texured windows are draggable + * Workaround for [Bug 2824538]: Textured windows are draggable * from opaque content. */ [window setMovableByWindowBackground:NO]; @@ -5641,11 +5685,38 @@ TkMacOSXMakeRealWindowExist( geometry.size.height += structureRect.size.height; geometry.origin.y = tkMacOSXZeroScreenHeight - (geometry.origin.y + geometry.size.height); - [window setFrame:geometry display:NO]; + [window setFrame:geometry display:YES]; TkMacOSXRegisterOffScreenWindow((Window) macWin, window); macWin->flags |= TK_HOST_EXISTS; } +/* + *---------------------------------------------------------------------- + * + * TkpDisplayWindow -- + * + * Mark the contentView of this window as needing display so the + * window will be drawn by the window manager. If this is called + * within the drawRect method, do nothing. + * + * Results: + * None. + * + * Side effects: + * The window's contentView is marked as needing display. + * + *---------------------------------------------------------------------- + */ + +MODULE_SCOPE void +TkpDisplayWindow(Tk_Window tkwin) { + if (![NSApp isDrawing]) { + TkWindow *winPtr = (TkWindow*)tkwin; + NSWindow *w = TkMacOSXDrawableWindow(winPtr->window); + [[w contentView] setNeedsDisplay: YES]; + } +} + /* *---------------------------------------------------------------------- * @@ -6268,12 +6339,15 @@ ApplyWindowAttributeFlagChanges( [[macWindow standardWindowButton:NSWindowZoomButton] setEnabled:(newAttributes & kWindowResizableAttribute) && (newAttributes & kWindowFullZoomAttribute)]; - if (newAttributes & kWindowResizableAttribute) { - wmPtr->flags &= ~(WM_WIDTH_NOT_RESIZABLE | - WM_HEIGHT_NOT_RESIZABLE); + if (newAttributes & kWindowHorizontalZoomAttribute) { + wmPtr->flags &= ~(WM_WIDTH_NOT_RESIZABLE); } else { - wmPtr->flags |= (WM_WIDTH_NOT_RESIZABLE | - WM_HEIGHT_NOT_RESIZABLE); + wmPtr->flags |= (WM_WIDTH_NOT_RESIZABLE); + } + if (newAttributes & kWindowVerticalZoomAttribute) { + wmPtr->flags &= ~(WM_HEIGHT_NOT_RESIZABLE); + } else { + wmPtr->flags |= (WM_HEIGHT_NOT_RESIZABLE); } WmUpdateGeom(wmPtr, winPtr); } @@ -6457,12 +6531,10 @@ TkMacOSXMakeFullscreen( Tcl_Interp *interp) { WmInfo *wmPtr = winPtr->wmInfoPtr; - int result = TCL_OK, wasFullscreen = (wmPtr->flags & WM_FULLSCREEN); - static unsigned long prevMask = 0, prevPres = 0; + int screenWidth = WidthOfScreen(Tk_Screen(winPtr)); + int screenHeight = HeightOfScreen(Tk_Screen(winPtr)); if (fullscreen) { - int screenWidth = WidthOfScreen(Tk_Screen(winPtr)); - int screenHeight = HeightOfScreen(Tk_Screen(winPtr)); /* * Check max width and height if set by the user. @@ -6477,58 +6549,73 @@ TkMacOSXMakeFullscreen( Tcl_SetErrorCode(interp, "TK", "FULLSCREEN", "CONSTRAINT_FAILURE", NULL); } - result = TCL_ERROR; wmPtr->flags &= ~WM_FULLSCREEN; - } else { - Tk_UnmapWindow((Tk_Window) winPtr); - NSRect bounds = [window contentRectForFrameRect:[window frame]]; - NSRect screenBounds = NSMakeRect(0, 0, screenWidth, screenHeight); - - if (!NSEqualRects(bounds, screenBounds) && !wasFullscreen) { - wmPtr->configX = wmPtr->x; - wmPtr->configY = wmPtr->y; - wmPtr->configAttributes = wmPtr->attributes; - wmPtr->attributes &= ~kWindowResizableAttribute; - ApplyWindowAttributeFlagChanges(winPtr, window, - wmPtr->configAttributes, wmPtr->flags, 1, 0); - wmPtr->flags |= WM_SYNC_PENDING; - [window setFrame:[window frameRectForContentRect: - screenBounds] display:YES]; - wmPtr->flags &= ~WM_SYNC_PENDING; - } - wmPtr->flags |= WM_FULLSCREEN; + return TCL_ERROR; } - prevMask = [window styleMask]; - prevPres = [NSApp presentationOptions]; - [window setStyleMask: NSBorderlessWindowMask]; - [NSApp setPresentationOptions: NSApplicationPresentationAutoHideDock - | NSApplicationPresentationAutoHideMenuBar]; - Tk_MapWindow((Tk_Window) winPtr); + /* + * Save the current window state. + */ + + wmPtr->cachedBounds = [window frame]; + wmPtr->cachedStyle = [window styleMask]; + wmPtr->cachedPresentation = [NSApp presentationOptions]; + + /* + * Adjust the window style so it looks like a Fullscreen window. + */ + + [window setStyleMask: NSFullScreenWindowMask]; + [NSApp setPresentationOptions: (NSApplicationPresentationAutoHideDock | + NSApplicationPresentationAutoHideMenuBar)]; + + /*For 10.13 and later add a button for exiting Fullscreen.*/ + if ([NSApp macMinorVersion] > 12) { +#if MAC_OS_X_VERSION_MAX_ALLOWED > 101200 + exitFullScreen = [[[NSStatusBar systemStatusBar] + statusItemWithLength:NSVariableStatusItemLength] retain]; + NSImage *exitIcon = [NSImage imageNamed:@"NSExitFullScreenTemplate"]; + exitFullScreen.button.image = exitIcon; + exitFullScreen.button.cell.highlighted = NO; + exitFullScreen.button.toolTip = @"Exit Full Screen"; + exitFullScreen.button.target = window; + exitFullScreen.button.action = @selector(restoreOldScreen:); +#endif + } + + /* + * Resize the window to fill the screen. (After setting the style!) + */ + + wmPtr->flags |= WM_SYNC_PENDING; + NSRect screenBounds = NSMakeRect(0, 0, screenWidth, screenHeight); + [window setFrame:screenBounds display:YES]; + wmPtr->flags &= ~WM_SYNC_PENDING; + wmPtr->flags |= WM_FULLSCREEN; } else { - wmPtr->flags &= ~WM_FULLSCREEN; - [NSApp setPresentationOptions: prevPres]; - [window setStyleMask: prevMask]; - } - if (wasFullscreen && !(wmPtr->flags & WM_FULLSCREEN)) { - Tk_UnmapWindow((Tk_Window) winPtr); + /* + * Restore the previous styles and attributes. + */ + + [NSApp setPresentationOptions: wmPtr->cachedPresentation]; + [window setStyleMask: wmPtr->cachedStyle]; UInt64 oldAttributes = wmPtr->attributes; - NSRect bounds = NSMakeRect(wmPtr->configX, tkMacOSXZeroScreenHeight - - (wmPtr->configY + wmPtr->yInParent + wmPtr->configHeight), - wmPtr->xInParent + wmPtr->configWidth, - wmPtr->yInParent + wmPtr->configHeight); - + wmPtr->flags &= ~WM_FULLSCREEN; wmPtr->attributes |= wmPtr->configAttributes & kWindowResizableAttribute; ApplyWindowAttributeFlagChanges(winPtr, window, oldAttributes, wmPtr->flags, 1, 0); + + /* + * Resize the window to its previous size. + */ + wmPtr->flags |= WM_SYNC_PENDING; - [window setFrame:[window frameRectForContentRect:bounds] display:YES]; + [window setFrame:wmPtr->cachedBounds display:YES]; wmPtr->flags &= ~WM_SYNC_PENDING; - Tk_MapWindow((Tk_Window) winPtr); } - return result; + return TCL_OK; } /* diff --git a/macosx/tkMacOSXWm.h b/macosx/tkMacOSXWm.h index e904f505..43f1a7a3 100644 --- a/macosx/tkMacOSXWm.h +++ b/macosx/tkMacOSXWm.h @@ -185,6 +185,15 @@ typedef struct TkWmInfo { TkWindow *scrollWinPtr; /* Ptr to scrollbar handling grow widget. */ TkMenu *menuPtr; NSWindow *window; + + /* + * Space to cache current window state when window becomes Fullscreen. + */ + + unsigned long cachedStyle; + unsigned long cachedPresentation; + NSRect cachedBounds; + } WmInfo; /* diff --git a/macosx/tkMacOSXXStubs.c b/macosx/tkMacOSXXStubs.c index 1b0a2464..cc98e84a 100644 --- a/macosx/tkMacOSXXStubs.c +++ b/macosx/tkMacOSXXStubs.c @@ -3,7 +3,7 @@ * * This file contains most of the X calls called by Tk. Many of these * calls are just stubs and either don't make sense on the Macintosh or - * their implamentation just doesn't do anything. Other calls will + * their implementation just doesn't do anything. Other calls will * eventually be moved into other files. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. @@ -40,10 +40,13 @@ CGFloat tkMacOSXZeroScreenTop = 0; * Declarations of static variables used in this file. */ +/* The unique Macintosh display. */ static TkDisplay *gMacDisplay = NULL; - /* Macintosh display. */ +/* The default name of the Macintosh display. */ static const char *macScreenName = ":0"; - /* Default name of macintosh display. */ +/* Timestamp showing the last reset of the inactivity timer. */ +static Time lastInactivityReset = 0; + /* * Forward declarations of procedures used in this file. @@ -175,7 +178,7 @@ TkpOpenDisplay( { int major, minor, patch; -#if MAC_OS_X_VERSION_MIN_REQUIRED < 1080 +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101000 Gestalt(gestaltSystemVersionMajor, (SInt32*)&major); Gestalt(gestaltSystemVersionMinor, (SInt32*)&minor); Gestalt(gestaltSystemVersionBugFix, (SInt32*)&patch); @@ -200,7 +203,6 @@ TkpOpenDisplay( screen->root_visual = ckalloc(sizeof(Visual)); screen->root_visual->visualid = 0; screen->root_visual->class = TrueColor; - screen->root_visual->alpha_mask = 0xFF000000; screen->root_visual->red_mask = 0x00FF0000; screen->root_visual->green_mask = 0x0000FF00; screen->root_visual->blue_mask = 0x000000FF; @@ -874,13 +876,10 @@ TkGetDefaultScreenName( Tcl_Interp *interp, /* Not used. */ const char *screenName) /* If NULL, use default string. */ { -#if 0 if ((screenName == NULL) || (screenName[0] == '\0')) { screenName = macScreenName; } return screenName; -#endif - return macScreenName; } /* @@ -928,27 +927,23 @@ Tk_GetUserInactiveTime( timeObj = CFDictionaryGetValue(props, CFSTR("HIDIdleTime")); if (timeObj) { - CFTypeID type = CFGetTypeID(timeObj); - - if (type == CFDataGetTypeID()) { /* Jaguar */ - CFDataGetBytes((CFDataRef) timeObj, - CFRangeMake(0, sizeof(time)), (UInt8 *) &time); - /* Convert nanoseconds to milliseconds. */ - /* ret /= kMillisecondScale; */ - ret = (long) (time/kMillisecondScale); - } else if (type == CFNumberGetTypeID()) { /* Panther+ */ CFNumberGetValue((CFNumberRef)timeObj, kCFNumberSInt64Type, &time); /* Convert nanoseconds to milliseconds. */ - /* ret /= kMillisecondScale; */ ret = (long) (time/kMillisecondScale); - } else { - ret = -1l; - } } /* Cleanup */ CFRelease(props); + /* + * If the idle time reported by the system is larger than the elapsed + * time since the last reset, return the elapsed time. + */ + long elapsed = (long)(TkpGetMS() - lastInactivityReset); + if (ret > elapsed) { + ret = elapsed; + } + return ret; } @@ -973,28 +968,7 @@ void Tk_ResetUserInactiveTime( Display *dpy) { - IOGPoint loc = {0, 0}; - kern_return_t kr; - NXEvent nullEvent = {NX_NULLEVENT, {0, 0}, 0, -1, 0}; - enum { kNULLEventPostThrottle = 10 }; - static io_connect_t io_connection = MACH_PORT_NULL; - - if (io_connection == MACH_PORT_NULL) { - io_service_t service = IOServiceGetMatchingService( - kIOMasterPortDefault, IOServiceMatching(kIOHIDSystemClass)); - - if (service == MACH_PORT_NULL) { - return; - } - kr = IOServiceOpen(service, mach_task_self(), kIOHIDParamConnectType, - &io_connection); - IOObjectRelease(service); - if (kr != KERN_SUCCESS) { - return; - } - } - kr = IOHIDPostEvent(io_connection, NX_NULLEVENT, loc, &nullEvent.data, - FALSE, 0, FALSE); + lastInactivityReset = TkpGetMS(); } /* diff --git a/tests/bind.test b/tests/bind.test index 9e30d783..7c5ccf10 100644 --- a/tests/bind.test +++ b/tests/bind.test @@ -39,10 +39,10 @@ proc unsetBindings {} { # events to make sure that there are no stray events in the ring # buffer which might cause the pattern matcher to find unintended # matches. The size of the ring buffer is EVENT_BUFFER_SIZE, which is -# currently set to 30. If this changes, the code below will need to -# change. +# currently set to 30 (or 45 on macOS). If this changes, the code +# below will need to change. proc clearRingBuffer {{event}} { - for {set i 0} {$i < 30} {incr i} { + for {set i 0} {$i < 45} {incr i} { event generate . $event } } diff --git a/tests/bitmap.test b/tests/bitmap.test index 6e2573f4..fea675d8 100644 --- a/tests/bitmap.test +++ b/tests/bitmap.test @@ -84,12 +84,14 @@ test bitmap-3.1 {Tk_FreeBitmapFromObj - reference counts} -constraints { test bitmap-4.1 {FreeBitmapObjProc} -constraints { testbitmap +} -setup { + proc copy {s} {return [string index $s 0][string range $s 1 end]} } -body { - set x [join questhead] + set x [copy questhead] button .b -bitmap $x - set y [join questhead] + set y [copy questhead] .b configure -bitmap $y - set z [join questhead] + set z [copy questhead] .b configure -bitmap $z set result {} lappend result [testbitmap questhead] @@ -102,6 +104,7 @@ test bitmap-4.1 {FreeBitmapObjProc} -constraints { set y bogus return $result } -cleanup { + rename copy {} destroy .b } -result {{{1 3}} {{1 2}} {{1 1}} {}} diff --git a/tests/border.test b/tests/border.test index 981e6401..f610ad8e 100644 --- a/tests/border.test +++ b/tests/border.test @@ -131,12 +131,13 @@ test border-3.1 {FreeBorderObjProc} -constraints { testborder } -setup { set result {} + proc copy {s} {return [string index $s 0][string range $s 1 end]} } -body { - set x [join purple] + set x [copy purple] button .b -bg $x -text .b1 - set y [join purple] + set y [copy purple] .b configure -bg $y - set z [join purple] + set z [copy purple] .b configure -bg $z lappend result [testborder purple] set x red @@ -148,6 +149,7 @@ test border-3.1 {FreeBorderObjProc} -constraints { set y bogus return $result } -cleanup { + rename copy {} destroy .b } -result {{{1 3}} {{1 2}} {{1 1}} {}} diff --git a/tests/canvImg.test b/tests/canvImg.test index 776d268f..a609337c 100644 --- a/tests/canvImg.test +++ b/tests/canvImg.test @@ -173,7 +173,7 @@ test canvImg-4.2 {ConfiugreImage procedure} -constraints testImageType -setup { .c delete all image delete foo image delete foo2 -} -result {{{foo free}} {{foo2 get} {foo2 display 0 0 80 60 30 30}} {50 100 130 160}} +} -result {{{foo free}} {{foo2 get} {foo2 display 0 0 80 60}} {50 100 130 160}} test canvImg-4.3 {ConfiugreImage procedure} -constraints testImageType -setup { .c delete all } -body { @@ -733,7 +733,7 @@ test canvImg-10.1 {TranslateImage procedure} -constraints testImageType -setup { } -cleanup { .c delete all image delete foo -} -result {{foo display 2 4 6 8 30 30}} +} -result {{foo display 2 4 6 8}} test canvImg-11.1 {TranslateImage procedure} -constraints testImageType -setup { .c delete all @@ -748,7 +748,7 @@ test canvImg-11.1 {TranslateImage procedure} -constraints testImageType -setup { } -cleanup { .c delete all image delete foo -} -result {{foo display 0 0 40 50 30 30}} +} -result {{foo display 0 0 40 50}} test canvImg-11.2 {ImageChangedProc procedure} -constraints { testImageType } -setup { @@ -784,7 +784,7 @@ test canvImg-11.3 {ImageChangedProc procedure} -constraints { } -cleanup { .c delete all image delete foo foo2 -} -result {{foo2 display 0 0 20 40 50 40}} +} -result {{foo2 display 0 0 20 40}} # cleanup imageFinish diff --git a/tests/canvText.test b/tests/canvText.test index ff5e4b90..c04cb637 100644 --- a/tests/canvText.test +++ b/tests/canvText.test @@ -55,8 +55,8 @@ test canvText-1.10 {configuration options: good value for "stipple"} -body { list [lindex [.c itemconfigure test -stipple] 4] [.c itemcget test -stipple] } -result {gray50 gray50} test canvasText-1.11 {configuration options: bad value for "stipple"} -body { - .c itemconfigure test -stipple xyz -} -returnCodes error -result {bitmap "xyz" not defined} + .c itemconfigure test -stipple abcxyz +} -returnCodes error -result {bitmap "abcxyz" not defined} test canvText-1.12 {configuration options: good value for "underline"} -body { .c itemconfigure test -underline 0 list [lindex [.c itemconfigure test -underline] 4] [.c itemcget test -underline] diff --git a/tests/choosedir.test b/tests/choosedir.test index fb6e62d4..f67a7216 100644 --- a/tests/choosedir.test +++ b/tests/choosedir.test @@ -85,23 +85,25 @@ set fake [file join $dir non-existant] set parent . -test choosedir-1.1 {tk_chooseDirectory command} -constraints unix -body { +test choosedir-1.1 {tk_chooseDirectory command} -body { tk_chooseDirectory -initialdir } -returnCodes error -result {value for "-initialdir" missing} -test choosedir-1.2 {tk_chooseDirectory command} -constraints unix -body { +test choosedir-1.2 {tk_chooseDirectory command} -body { tk_chooseDirectory -mustexist } -returnCodes error -result {value for "-mustexist" missing} -test choosedir-1.3 {tk_chooseDirectory command} -constraints unix -body { +test choosedir-1.3 {tk_chooseDirectory command} -body { tk_chooseDirectory -parent } -returnCodes error -result {value for "-parent" missing} -test choosedir-1.4 {tk_chooseDirectory command} -constraints unix -body { +test choosedir-1.4 {tk_chooseDirectory command} -body { tk_chooseDirectory -title } -returnCodes error -result {value for "-title" missing} - -test choosedir-1.5 {tk_chooseDirectory command} -constraints unix -body { +test choosedir-1.5.1 {tk_chooseDirectory command} -constraints notAqua -body { tk_chooseDirectory -foo bar } -returnCodes error -result {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title} -test choosedir-1.6 {tk_chooseDirectory command} -constraints unix -body { +test choosedir-1.5.2 {tk_chooseDirectory command} -constraints aqua -body { + tk_chooseDirectory -foo bar +} -returnCodes error -result {bad option "-foo": must be -initialdir, -message, -mustexist, -parent, -title, or -command} +test choosedir-1.6 {tk_chooseDirectory command} -body { tk_chooseDirectory -parent foo.bar } -returnCodes error -result {bad window path name "foo.bar"} diff --git a/tests/clipboard.test b/tests/clipboard.test index 6077940f..7f72f178 100644 --- a/tests/clipboard.test +++ b/tests/clipboard.test @@ -161,8 +161,7 @@ test clipboard-4.3 {ClipboardLostSel procedure} -setup { clipboard append "Test" clipboard append -t TEST "Test2" selection clear -s CLIPBOARD - catch {clipboard get} - clipboard get -t TEST + clipboard get -t TEST } -cleanup { clipboard clear } -returnCodes error -result {CLIPBOARD selection doesn't exist or form "TEST" not defined} @@ -184,8 +183,7 @@ test clipboard-4.5 {ClipboardLostSel procedure} -setup { clipboard append -t TEST "Test2" clipboard append "Test3" selection clear -s CLIPBOARD - catch {clipboard get} - clipboard get -t TEST + clipboard get -t TEST } -cleanup { clipboard clear } -returnCodes error -result {CLIPBOARD selection doesn't exist or form "TEST" not defined} @@ -230,7 +228,7 @@ test clipboard-6.1 {Tk_ClipboardAppend procedure} -setup { } -cleanup { clipboard clear } -returnCodes ok -result {first chunk second chunk} -test clipboard-6.2 {Tk_ClipboardAppend procedure} -constraints unix -setup { +test clipboard-6.2 {Tk_ClipboardAppend procedure} -constraints x11 -setup { clipboard clear } -body { setupbg diff --git a/tests/color.test b/tests/color.test index aa200993..6fefd902 100644 --- a/tests/color.test +++ b/tests/color.test @@ -277,13 +277,17 @@ test color-3.4 {Tk_FreeColorFromObj - unlinking from list} colorsFree { lappend result [testcolor purple] } {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}} -test color-4.1 {FreeColorObjProc} colorsFree { +test color-4.1 {FreeColorObjProc} -constraints { + colorsFree +} -setup { + proc copy {s} {return [string index $s 0][string range $s 1 end]} +} -body { destroy .b - set x [format purple] + set x [copy purple] button .b -foreground $x -text .b1 - set y [format purple] + set y [copy purple] .b configure -foreground $y - set z [format purple] + set z [copy purple] .b configure -foreground $z set result {} lappend result [testcolor purple] @@ -295,7 +299,9 @@ test color-4.1 {FreeColorObjProc} colorsFree { lappend result [testcolor purple] set y bogus set result -} {{{1 3}} {{1 2}} {{1 1}} {}} +} -cleanup { + rename copy {} +} -result {{{1 3}} {{1 2}} {{1 1}} {}} destroy .t diff --git a/tests/config.test b/tests/config.test index a0c19216..833e2882 100644 --- a/tests/config.test +++ b/tests/config.test @@ -679,10 +679,10 @@ test config-4.56 {DoObjConfig - new bitmap} -constraints testobjconfig -body { test config-4.57 {DoObjConfig - invalid bitmap} -constraints { testobjconfig } -body { - testobjconfig alltypes .foo -bitmap foo + testobjconfig alltypes .foo -bitmap foobar } -cleanup { killTables -} -returnCodes error -result {bitmap "foo" not defined} +} -returnCodes error -result {bitmap "foobar" not defined} test config-4.58 {DoObjConfig - null bitmap} -constraints testobjconfig -body { testobjconfig alltypes .foo -bitmap {} } -cleanup { diff --git a/tests/corruptMangled.gif b/tests/corruptMangled.gif new file mode 100644 index 00000000..9c1637c5 Binary files /dev/null and b/tests/corruptMangled.gif differ diff --git a/tests/corruptMangled4G.gif b/tests/corruptMangled4G.gif new file mode 100644 index 00000000..7dfde0eb --- /dev/null +++ b/tests/corruptMangled4G.gif @@ -0,0 +1,2 @@ +GIF89aÂf3ÿÿ33ÿ3ÿ3ÿ33ÿÿÿÿ3ÿÿÿ!ù +,!xºÜ-0Bw¤ïÚ¥µê×Jâ8Uæªkir/3Re7 ; \ No newline at end of file diff --git a/tests/corruptTruncated.gif b/tests/corruptTruncated.gif new file mode 100644 index 00000000..948305a4 Binary files /dev/null and b/tests/corruptTruncated.gif differ diff --git a/tests/cursor.test b/tests/cursor.test index ab7949e1..172c982f 100644 --- a/tests/cursor.test +++ b/tests/cursor.test @@ -144,12 +144,14 @@ test cursor-3.1 {Tk_FreeCursorFromObj - reference counts} -constraints { test cursor-4.1 {FreeCursorObjProc} -constraints { testcursor +} -setup { + proc copy {s} {return [string index $s 0][string range $s 1 end]} } -body { - set x [join heart] + set x [copy heart] button .b -cursor $x - set y [join heart] + set y [copy heart] .b configure -cursor $y - set z [join heart] + set z [copy heart] .b configure -cursor $z set result {} lappend result [testcursor heart] @@ -162,6 +164,7 @@ test cursor-4.1 {FreeCursorObjProc} -constraints { set y bogus set result } -cleanup { + rename copy {} destroy .b } -result {{{1 3}} {{1 2}} {{1 1}} {}} diff --git a/tests/deferredClearCode.gif b/tests/deferredClearCode.gif new file mode 100644 index 00000000..d5306180 Binary files /dev/null and b/tests/deferredClearCode.gif differ diff --git a/tests/filebox.test b/tests/filebox.test index 2f87c3e7..0114a074 100644 --- a/tests/filebox.test +++ b/tests/filebox.test @@ -110,8 +110,10 @@ if {$tcl_platform(platform) == "unix"} { set modes 1 } -set unknownOptionsMsg(tk_getOpenFile) {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable} -set unknownOptionsMsg(tk_getSaveFile) {bad option "-foo": must be -confirmoverwrite, -defaultextension, -filetypes, -initialdir, -initialfile, -parent, -title, or -typevariable} +set unknownOptionsMsg(tk_getOpenFile,notAqua) {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable} +set unknownOptionsMsg(tk_getOpenFile,aqua) {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -message, -multiple, -parent, -title, -typevariable, or -command} +set unknownOptionsMsg(tk_getSaveFile,notAqua) {bad option "-foo": must be -confirmoverwrite, -defaultextension, -filetypes, -initialdir, -initialfile, -parent, -title, or -typevariable} +set unknownOptionsMsg(tk_getSaveFile,aqua) {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -message, -parent, -title, -typevariable, -command, or -confirmoverwrite} set tmpFile "filebox.tmp" makeFile { @@ -155,9 +157,12 @@ foreach mode $modes { } } - test filebox-1.1-$mode "tk_getOpenFile command" -body { + test filebox-1.1.1-$mode "tk_getOpenFile command" -constraints notAqua -body { tk_getOpenFile -foo - } -returnCodes error -result $unknownOptionsMsg(tk_getOpenFile) + } -returnCodes error -result $unknownOptionsMsg(tk_getOpenFile,notAqua) + test filebox-1.1.2-$mode "tk_getOpenFile command" -constraints aqua -body { + tk_getOpenFile -foo + } -returnCodes error -result $unknownOptionsMsg(tk_getOpenFile,aqua) catch {tk_getOpenFile -foo 1} msg regsub -all , $msg "" options @@ -171,9 +176,12 @@ foreach mode $modes { } } - test filebox-1.3-$mode "tk_getOpenFile command" -body { + test filebox-1.3.1-$mode "tk_getOpenFile command" -constraints notAqua -body { tk_getOpenFile -foo bar - } -returnCodes error -result $unknownOptionsMsg(tk_getOpenFile) + } -returnCodes error -result $unknownOptionsMsg(tk_getOpenFile,notAqua) + test filebox-1.3.2-$mode "tk_getOpenFile command" -constraints aqua -body { + tk_getOpenFile -foo bar + } -returnCodes error -result $unknownOptionsMsg(tk_getOpenFile,aqua) test filebox-1.4-$mode "tk_getOpenFile command" -body { tk_getOpenFile -initialdir } -returnCodes error -result {value for "-initialdir" missing} @@ -289,9 +297,12 @@ foreach mode $modes { } $res } - test filebox-4.1-$mode "tk_getSaveFile command" -body { + test filebox-4.1.1-$mode "tk_getSaveFile command" -constraints notAqua -body { tk_getSaveFile -foo - } -returnCodes error -result $unknownOptionsMsg(tk_getSaveFile) + } -returnCodes error -result $unknownOptionsMsg(tk_getSaveFile,notAqua) + test filebox-4.1.2-$mode "tk_getSaveFile command" -constraints aqua -body { + tk_getSaveFile -foo + } -returnCodes error -result $unknownOptionsMsg(tk_getSaveFile,aqua) catch {tk_getSaveFile -foo 1} msg regsub -all , $msg "" options @@ -305,9 +316,12 @@ foreach mode $modes { } } - test filebox-4.3-$mode "tk_getSaveFile command" -body { + test filebox-4.3.1-$mode "tk_getSaveFile command" -constraints notAqua -body { tk_getSaveFile -foo bar - } -returnCodes error -result $unknownOptionsMsg(tk_getSaveFile) + } -returnCodes error -result $unknownOptionsMsg(tk_getSaveFile,notAqua) + test filebox-4.3.2-$mode "tk_getSaveFile command" -constraints aqua -body { + tk_getSaveFile -foo bar + } -returnCodes error -result $unknownOptionsMsg(tk_getSaveFile,aqua) test filebox-4.4-$mode "tk_getSaveFile command" -body { tk_getSaveFile -initialdir } -returnCodes error -result {value for "-initialdir" missing} diff --git a/tests/font.test b/tests/font.test index 62afa5a3..f7fb3251 100644 --- a/tests/font.test +++ b/tests/font.test @@ -38,7 +38,7 @@ wm geom .t +0+0 update idletasks switch [tk windowingsystem] { - x11 {set fixed "fixed"} + x11 {set fixed "TkFixedFont"} win32 {set fixed "courier 12"} aqua {set fixed "monaco 9"} } @@ -921,7 +921,7 @@ test font-21.5 {Tk_PostscriptFontName procedure: spaces} -constraints { } } -result {LucidaBright} test font-21.6 {Tk_PostscriptFontName procedure: spaces} -constraints { - unix + x11 } -body { psfontname "{new century schoolbook} 10" } -result {NewCenturySchlbk-Roman} @@ -2356,10 +2356,15 @@ test font-45.1 {TkFontGetAliasList: no match} -body { test font-45.2 {TkFontGetAliasList: match} -constraints win -body { font actual {times 10} -family } -result {Times New Roman} -test font-45.3 {TkFontGetAliasList: match} -constraints {unix noExceed} -body { - # can fail on Unix systems that have a real "times new roman" font - font actual {{times new roman} 10} -family -} -result [font actual {times 10} -family] +test font-45.3 {TkFontGetAliasList: match} -constraints {noExceed} -body { + if {[font actual {{times new roman} 10} -family] eq "Times New Roman"} { + # avoid test failure on systems that have a real "times new roman" font + set res 1 + } else { + set res [expr {[font actual {{times new roman} 10} -family] eq \ + [font actual {times 10} -family]} ] + } +} -result {1} test font-46.1 {font actual, with character, no option, no --} -body { diff --git a/tests/iDOT.png b/tests/iDOT.png new file mode 100644 index 00000000..e8cd024b Binary files /dev/null and b/tests/iDOT.png differ diff --git a/tests/image.test b/tests/image.test index 3134ee86..e2e602ef 100644 --- a/tests/image.test +++ b/tests/image.test @@ -67,7 +67,7 @@ test image-1.7 {Tk_ImageCmd procedure, "create" option} -constraints { return $x } -cleanup { imageCleanup -} -result {{myimage free} {myimage free} {myimage delete} {myimage get} {myimage get} {myimage display 0 0 30 15 30 30} {myimage display 0 0 30 15 30 130}} +} -result {{myimage free} {myimage free} {myimage delete} {myimage get} {myimage get} {myimage display 0 0 30 15} {myimage display 0 0 30 15}} test image-1.8 {Tk_ImageCmd procedure, "create" option} -constraints { testImageType } -setup { @@ -86,7 +86,7 @@ test image-1.8 {Tk_ImageCmd procedure, "create" option} -constraints { } -cleanup { .c delete all imageCleanup -} -result {{myimage get} {myimage get} {myimage display 0 0 30 15 30 30} {myimage display 0 0 30 15 30 130}} +} -result {{myimage get} {myimage get} {myimage display 0 0 30 15} {myimage display 0 0 30 15}} test image-1.9 {Tk_ImageCmd procedure, "create" option} -constraints { testImageType } -body { @@ -360,7 +360,7 @@ test image-9.1 {Tk_ImageChanged procedure} -constraints testImageType -setup { } -cleanup { .c delete all imageCleanup -} -result {{foo display 5 6 7 8 30 30}} +} -result {{foo display 5 6 7 8}} test image-9.2 {Tk_ImageChanged procedure} -constraints testImageType -setup { .c delete all imageCleanup @@ -376,7 +376,7 @@ test image-9.2 {Tk_ImageChanged procedure} -constraints testImageType -setup { } -cleanup { .c delete all imageCleanup -} -result {{foo display 5 6 25 9 30 30} {foo display 0 0 12 14 65 74}} +} -result {{foo display 5 6 25 9} {foo display 0 0 12 14}} test image-10.1 {Tk_GetImage procedure} -setup { @@ -417,7 +417,7 @@ test image-11.1 {Tk_FreeImage procedure} -constraints testImageType -setup { } -cleanup { .c delete all imageCleanup -} -result {foo {{foo free} {foo display 0 0 30 15 103 121}}} +} -result {foo {{foo free} {foo display 0 0 30 15}}} test image-11.2 {Tk_FreeImage procedure} -constraints testImageType -setup { .c delete all imageCleanup diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test index 0126ad95..97fb7ae4 100644 --- a/tests/imgPhoto.test +++ b/tests/imgPhoto.test @@ -1201,6 +1201,16 @@ test imgPhoto-14.4 {GIF buffer overflow} -setup { } -cleanup { image delete $i } -returnCodes error -result {malformed image} +test imgPhoto-14.5 {Bug [fbaed1f66b] - GIF decoder with deferred clear code} -setup { + set fileName [file join [file dirname [info script]] deferredClearCode.gif] +} -body { + # This erroneously produced "malformed image" error. + # The animated GIF "deferredClearCode.gif" has two frames, and calling for -index 2 + # simply is an easy way to trigger the problem of improper management of a deferred + # clear code. The effect was that the GIF decoder bailed out before the end of the + # image reading, and produced the inappropriate "malformed image error". + image create photo -file $fileName -format "gif -index 2" +} -returnCodes error -result {no image data for this index} test imgPhoto-15.1 {photo images can fail to allocate memory gracefully} -constraints { nonPortable diff --git a/tests/msgbox.test b/tests/msgbox.test index 643ae2c2..1b844639 100644 --- a/tests/msgbox.test +++ b/tests/msgbox.test @@ -11,12 +11,18 @@ tcltest::loadTestedCommands namespace import -force tcltest::test -test msgbox-1.1 {tk_messageBox command} -body { +test msgbox-1.1.1 {tk_messageBox command} -constraints notAqua -body { tk_messageBox -foo } -returnCodes error -result {bad option "-foo": must be -default, -detail, -icon, -message, -parent, -title, or -type} -test msgbox-1.2 {tk_messageBox command} -body { +test msgbox-1.1.2 {tk_messageBox command} -constraints aqua -body { + tk_messageBox -foo +} -returnCodes error -result {bad option "-foo": must be -default, -detail, -icon, -message, -parent, -title, -type, or -command} +test msgbox-1.2.1 {tk_messageBox command} -constraints notAqua -body { tk_messageBox -foo bar } -returnCodes error -result {bad option "-foo": must be -default, -detail, -icon, -message, -parent, -title, or -type} +test msgbox-1.2.2 {tk_messageBox command} -constraints aqua -body { + tk_messageBox -foo bar +} -returnCodes error -result {bad option "-foo": must be -default, -detail, -icon, -message, -parent, -title, -type, or -command} test msgbox-1.3 {tk_messageBox command} -body { tk_messageBox -default @@ -48,30 +54,22 @@ test msgbox-1.11 {tk_messageBox command} -body { tk_messageBox -type foo } -returnCodes error -result {bad -type value "foo": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel} -test msgbox-1.12 {tk_messageBox command} -constraints unix -body { - tk_messageBox -default 1.1 -} -returnCodes error -result {invalid default button "1.1"} -test msgbox-1.13 {tk_messageBox command} -constraints macOrWin -body { +test msgbox-1.13 {tk_messageBox command} -body { tk_messageBox -default 1.1 } -returnCodes error -result {bad -default value "1.1": must be abort, retry, ignore, ok, cancel, no, or yes} -test msgbox-1.14 {tk_messageBox command} -constraints unix -body { - tk_messageBox -default foo -} -returnCodes error -result {invalid default button "foo"} -test msgbox-1.15 {tk_messageBox command} -constraints macOrWin -body { +test msgbox-1.14 {tk_messageBox command} -body { tk_messageBox -default foo } -returnCodes error -result {bad -default value "foo": must be abort, retry, ignore, ok, cancel, no, or yes} -test msgbox-1.16 {tk_messageBox command} -constraints unix -body { - tk_messageBox -type yesno -default 3 -} -returnCodes error -result {invalid default button "3"} -test msgbox-1.17 {tk_messageBox command} -constraints macOrWin -body { +test msgbox-1.16 {tk_messageBox command} -body { tk_messageBox -type yesno -default 3 } -returnCodes error -result {bad -default value "3": must be abort, retry, ignore, ok, cancel, no, or yes} test msgbox-1.18 {tk_messageBox command} -body { tk_messageBox -icon foo } -returnCodes error -result {bad -icon value "foo": must be error, info, question, or warning} + test msgbox-1.19 {tk_messageBox command} -body { tk_messageBox -parent foo.bar } -returnCodes error -result {bad window path name "foo.bar"} diff --git a/tests/option.test b/tests/option.test index ea5b5d11..c8e29da6 100644 --- a/tests/option.test +++ b/tests/option.test @@ -386,7 +386,7 @@ test option-15.6 {database files} -body { test option-15.7 {database files} -body { option read $option1 option get . x9 color -} -result " \t\\A\n" +} -result " \\\t\\A\n" test option-15.8 {database files} -body { option read $option1 widget foo } -returnCodes error -result {wrong # args: should be "option readfile fileName ?priority?"} @@ -415,6 +415,22 @@ test option-16.1 {ReadOptionFile} -body { removeFile $option4 } -result {true false} +set opt162val {label { + foo bar +} +} +set opt162list [split $opt162val \n] + +test option-16.2 {ticket 766ef52f3} { + set option5 [makeFile {} option.file4] + set file [open $option5 w] + fconfigure $file -translation crlf + puts $file "*notok: $opt162list" + close $file + option read $option5 userDefault + option get . notok notok +} $opt162list + deleteWindows # cleanup diff --git a/tests/packgrid.test b/tests/packgrid.test index 355b49d0..6074ce92 100644 --- a/tests/packgrid.test +++ b/tests/packgrid.test @@ -246,5 +246,35 @@ test packgrid-3.4 {stealing slave} -setup { destroy .g } -result {cannot use geometry manager grid inside . which already has slaves managed by pack} +test packgrid-4.1 {slave stolen after master destruction - bug [aa7679685e]} -setup { + frame .f + button .b -text hello +} -body { + pack .f + grid .b -in .f + destroy .f + set res [winfo manager .b] + # shall not crash + pack .b + set res +} -cleanup { + destroy .b +} -result {} + +test packgrid-4.2 {slave stolen after master destruction - bug [aa7679685e]} -setup { + frame .f + button .b -text hello +} -body { + pack .f + pack .b -in .f + destroy .f + set res [winfo manager .b] + # shall not crash + grid .b + set res +} -cleanup { + destroy .b +} -result {} + cleanupTests return diff --git a/tests/red.gif b/tests/red.gif new file mode 100644 index 00000000..1d12ebbe Binary files /dev/null and b/tests/red.gif differ diff --git a/tests/safePrimarySelection.test b/tests/safePrimarySelection.test new file mode 100644 index 00000000..7cc31f46 --- /dev/null +++ b/tests/safePrimarySelection.test @@ -0,0 +1,1220 @@ +# This file is a Tcl script to test entry widgets in Tk. It is +# organized in the standard fashion for Tcl tests. +# +# Copyright (c) 1994 The Regents of the University of California. +# Copyright (c) 1994-1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. + +package require tcltest 2.2 +namespace import ::tcltest::* +eval tcltest::configure $argv +tcltest::loadTestedCommands + +# ------------------------------------------------------------------------------ +# Tests that a Safe Base interpreter cannot write to the PRIMARY selection. +# ------------------------------------------------------------------------------ +# - Tests 3.*, 6.* test that the fix for ticket de156e9efe implemented in branch +# bug-de156e9efe has been applied and still works. They test that a Safe Base +# slave interpreter cannot write to the PRIMARY selection. +# - The other tests verify that the master interpreter and an unsafe slave CAN +# write to the PRIMARY selection, and therefore that the test scripts +# themselves are valid. +# - A text, entry, ttk::entry, listbox, spinbox or ttk::spinbox widget can have +# option -exportselection 1, meaning (in an unsafe interpreter) that a +# selection made in one of these widgets is automatically written to the +# PRIMARY selection. +# - A safe interpreter must not write to the PRIMARY selection. +# - The spinbox, ttk::spinbox are variants of entry, ttk::entry respectively. +# ------------------------------------------------------------------------------ + +namespace eval ::_test_tmp {} + +# ------------------------------------------------------------------------------ +# Proc ::_test_tmp::unsafeInterp +# ------------------------------------------------------------------------------ +# Command that creates an unsafe child interpreter and tries to load Tk. +# - This is necessary for loading Tk if the tests are done in the build +# directory without installing Tk. In that case the usual auto_path loading +# mechanism cannot work because the tk binary is not where pkgIndex.tcl says +# it is. +# - This command is not needed for Safe Base slaves because safe::loadTk does +# something similar and works correctly. +# - Based on scripts in winSend.test. +# ------------------------------------------------------------------------------ + +namespace eval ::_test_tmp { + variable TkLoadCmd +} + +foreach pkg [info loaded] { + if {[lindex $pkg 1] eq "Tk"} { + set ::_test_tmp::TkLoadCmd [list load {*}$pkg] + break + } +} + +proc ::_test_tmp::unsafeInterp {name} { + variable TkLoadCmd + interp create $name + $name eval [list set argv [list -name $name]] + catch {{*}$TkLoadCmd $name} +} + + +set ::_test_tmp::script { + package require Tk + namespace eval ::_test_tmp {} + + proc ::_test_tmp::getPrimarySelection {} { + if {[catch {::tk::GetSelection . PRIMARY} sel]} { + set sel {} + } + return $sel + } + + proc ::_test_tmp::setPrimarySelection {} { + destroy .preset + text .preset -exportselection 1 + .preset insert end OLD_VALUE + # pack .preset + .preset tag add sel 1.0 end-1c + update + return + } + + # Clearing the PRIMARY selection is troublesome. + # The window need not be mapped. + # However, the window must continue to exist, or some X11 servers + # will set the PRIMARY selection to something else. + proc ::_test_tmp::clearPrimarySelection {} { + destroy .clear + text .clear -exportselection 1 + .clear insert end TMP_VALUE + # pack .clear + .clear tag add sel 1.0 end-1c + update + .clear tag remove sel 1.0 end-1c + update + return + } + + # If this interpreter can write to the PRIMARY + # selection, the commands below will do so. + + proc ::_test_tmp::tryText {} { + text .t -exportselection 1 + .t insert end PAYLOAD + pack .t + .t tag add sel 1.0 end-1c + update + return + } + + proc ::_test_tmp::tryEntry {} { + entry .t -exportselection 1 + .t insert end PAYLOAD + pack .t + .t selection range 0 end + update + return + } + + proc ::_test_tmp::tryTtkEntry {} { + ::ttk::entry .t -exportselection 1 + .t insert end PAYLOAD + pack .t + .t selection range 0 end + update + return + } + + proc ::_test_tmp::tryListbox {} { + listbox .t -exportselection 1 + .t insert end list1 PAYLOAD list3 + pack .t + .t selection set 1 + update + return + } + + proc ::_test_tmp::trySpinbox {ver} { + if {$ver == 1} { + # spinbox as entry + spinbox .t -exportselection 1 -values {1 2 3 4 5} + .t delete 0 end + .t insert end PAYLOAD + pack .t + .t selection range 0 end + update + return + # selects PAYLOAD + } elseif {$ver == 2} { + # spinbox spun + spinbox .t -exportselection 1 -values {1 2 3 4 5} + .t invoke buttonup + pack .t + .t selection range 0 end + update + return + # selects 2 + } else { + # spinbox spun/selected/spun + spinbox .t -exportselection 1 -values {1 2 3 4 5} + .t invoke buttonup + pack .t + .t selection range 0 end + update + .t invoke buttonup + update + return + # selects 3 + } + } + + proc ::_test_tmp::tryTtkSpinbox {ver} { + if {$ver == 1} { + # ttk::spinbox as entry + ::ttk::spinbox .t -exportselection 1 -values {1 2 3 4 5} + .t delete 0 end + .t insert end PAYLOAD + pack .t + .t selection range 0 end + update + return + } elseif {$ver == 2} { + # ttk::spinbox spun + ::ttk::spinbox .t -exportselection 1 -values {1 2 3 4 5} + ::ttk::spinbox::Spin .t +1 + ::ttk::spinbox::Spin .t +1 + pack .t + # ttk::spinbox::Spin sets selection + update + return + # selects 2 + } else { + # ttk::spinbox spun/selected/spun + ::ttk::spinbox .t -exportselection 1 -values {1 2 3 4 5} + ::ttk::spinbox::Spin .t +1 + ::ttk::spinbox::Spin .t +1 + pack .t + # ttk::spinbox::Spin sets selection + update + ::ttk::spinbox::Spin .t +1 + update + return + # selects 3 + } + } +} + +# Do this once for the master interpreter. +eval $::_test_tmp::script + +test safePrimarySelection-1.1 {master interpreter, text, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + ::_test_tmp::tryText + ::_test_tmp::getPrimarySelection +} -cleanup { + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-1.2 {master interpreter, entry, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + ::_test_tmp::tryEntry + ::_test_tmp::getPrimarySelection +} -cleanup { + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-1.3 {master interpreter, ttk::entry, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + ::_test_tmp::tryTtkEntry + ::_test_tmp::getPrimarySelection +} -cleanup { + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-1.4 {master interpreter, listbox, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + ::_test_tmp::tryListbox + ::_test_tmp::getPrimarySelection +} -cleanup { + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-1.5 {master interpreter, spinbox as entry, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + ::_test_tmp::trySpinbox 1 + ::_test_tmp::getPrimarySelection +} -cleanup { + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-1.6 {master interpreter, spinbox spun, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + ::_test_tmp::trySpinbox 2 + ::_test_tmp::getPrimarySelection +} -cleanup { + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -result {2} + +test safePrimarySelection-1.7 {master interpreter, spinbox spun/selected/spun, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + ::_test_tmp::trySpinbox 3 + ::_test_tmp::getPrimarySelection +} -cleanup { + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -result {3} + +test safePrimarySelection-1.8 {master interpreter, ttk::spinbox as entry, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + ::_test_tmp::tryTtkSpinbox 1 + ::_test_tmp::getPrimarySelection +} -cleanup { + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-1.9 {master interpreter, ttk::spinbox spun, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + ::_test_tmp::tryTtkSpinbox 2 + ::_test_tmp::getPrimarySelection +} -cleanup { + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -result {2} + +test safePrimarySelection-1.10 {master interpreter, ttk::spinbox spun/selected/spun, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + ::_test_tmp::tryTtkSpinbox 3 + ::_test_tmp::getPrimarySelection +} -cleanup { + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -result {3} + +test safePrimarySelection-2.1 {unsafe slave interpreter, text, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + set int2 slave2 + ::_test_tmp::unsafeInterp $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryText + $int2 eval ::_test_tmp::getPrimarySelection +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-2.2 {unsafe slave interpreter, entry, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + set int2 slave2 + ::_test_tmp::unsafeInterp $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryEntry + $int2 eval ::_test_tmp::getPrimarySelection +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-2.3 {unsafe slave interpreter, ttk::entry, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + set int2 slave2 + ::_test_tmp::unsafeInterp $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryTtkEntry + $int2 eval ::_test_tmp::getPrimarySelection +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-2.4 {unsafe slave interpreter, listbox, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + set int2 slave2 + ::_test_tmp::unsafeInterp $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryListbox + $int2 eval ::_test_tmp::getPrimarySelection +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-2.5 {unsafe slave interpreter, spinbox as entry, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + set int2 slave2 + ::_test_tmp::unsafeInterp $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::trySpinbox 1 + $int2 eval ::_test_tmp::getPrimarySelection +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-2.6 {unsafe slave interpreter, spinbox spun, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + set int2 slave2 + ::_test_tmp::unsafeInterp $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::trySpinbox 2 + $int2 eval ::_test_tmp::getPrimarySelection +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 + ::_test_tmp::clearPrimarySelection +} -result {2} + +test safePrimarySelection-2.7 {unsafe slave interpreter, spinbox spun/selected/spun, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + set int2 slave2 + ::_test_tmp::unsafeInterp $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::trySpinbox 3 + $int2 eval ::_test_tmp::getPrimarySelection +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 + ::_test_tmp::clearPrimarySelection +} -result {3} + +test safePrimarySelection-2.8 {unsafe slave interpreter, ttk::spinbox as entry, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + set int2 slave2 + ::_test_tmp::unsafeInterp $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryTtkSpinbox 1 + $int2 eval ::_test_tmp::getPrimarySelection +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-2.9 {unsafe slave interpreter, ttk::spinbox spun, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + set int2 slave2 + ::_test_tmp::unsafeInterp $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryTtkSpinbox 2 + $int2 eval ::_test_tmp::getPrimarySelection +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 + ::_test_tmp::clearPrimarySelection +} -result {2} + +test safePrimarySelection-2.10 {unsafe slave interpreter, ttk::spinbox spun/selected/spun, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + set int2 slave2 + ::_test_tmp::unsafeInterp $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryTtkSpinbox 3 + $int2 eval ::_test_tmp::getPrimarySelection +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 + ::_test_tmp::clearPrimarySelection +} -result {3} + +test safePrimarySelection-3.1 {IMPORTANT, safe slave interpreter, text, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + set res0 [::_test_tmp::getPrimarySelection] + set int2 slave2 + ::safe::interpCreate $int2 + ::safe::loadTk $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryText + set res1 [$int2 eval ::_test_tmp::getPrimarySelection] + set res2 [::_test_tmp::getPrimarySelection] + set res3 $res0--$res1--$res2 +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 res0 res1 res2 res3 + ::_test_tmp::clearPrimarySelection +} -result {----} + +test safePrimarySelection-3.2 {IMPORTANT, safe slave interpreter, entry, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + set res0 [::_test_tmp::getPrimarySelection] + set int2 slave2 + ::safe::interpCreate $int2 + ::safe::loadTk $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryEntry + set res1 [$int2 eval ::_test_tmp::getPrimarySelection] + set res2 [::_test_tmp::getPrimarySelection] + set res3 $res0--$res1--$res2 +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 res0 res1 res2 res3 + ::_test_tmp::clearPrimarySelection +} -result {----} + +test safePrimarySelection-3.3 {IMPORTANT, safe slave interpreter, ttk::entry, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + set res0 [::_test_tmp::getPrimarySelection] + set int2 slave2 + ::safe::interpCreate $int2 + ::safe::loadTk $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryTtkEntry + set res1 [$int2 eval ::_test_tmp::getPrimarySelection] + set res2 [::_test_tmp::getPrimarySelection] + set res3 $res0--$res1--$res2 +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 res0 res1 res2 res3 + ::_test_tmp::clearPrimarySelection +} -result {----} + +test safePrimarySelection-3.4 {IMPORTANT, safe slave interpreter, listbox, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + set res0 [::_test_tmp::getPrimarySelection] + set int2 slave2 + ::safe::interpCreate $int2 + ::safe::loadTk $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryListbox + set res1 [$int2 eval ::_test_tmp::getPrimarySelection] + set res2 [::_test_tmp::getPrimarySelection] + set res3 $res0--$res1--$res2 +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 res0 res1 res2 res3 + ::_test_tmp::clearPrimarySelection +} -result {----} + +test safePrimarySelection-3.5 {IMPORTANT, safe slave interpreter, spinbox as entry, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + set res0 [::_test_tmp::getPrimarySelection] + set int2 slave2 + ::safe::interpCreate $int2 + ::safe::loadTk $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::trySpinbox 1 + set res1 [$int2 eval ::_test_tmp::getPrimarySelection] + set res2 [::_test_tmp::getPrimarySelection] + set res3 $res0--$res1--$res2 +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 res0 res1 res2 res3 + ::_test_tmp::clearPrimarySelection +} -result {----} + +test safePrimarySelection-3.6 {IMPORTANT, safe slave interpreter, spinbox spun, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + set res0 [::_test_tmp::getPrimarySelection] + set int2 slave2 + ::safe::interpCreate $int2 + ::safe::loadTk $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::trySpinbox 2 + set res1 [$int2 eval ::_test_tmp::getPrimarySelection] + set res2 [::_test_tmp::getPrimarySelection] + set res3 $res0--$res1--$res2 +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 res0 res1 res2 res3 + ::_test_tmp::clearPrimarySelection +} -result {----} + +test safePrimarySelection-3.7 {IMPORTANT, safe slave interpreter, spinbox spun/selected/spun, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + set res0 [::_test_tmp::getPrimarySelection] + set int2 slave2 + ::safe::interpCreate $int2 + ::safe::loadTk $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::trySpinbox 3 + set res1 [$int2 eval ::_test_tmp::getPrimarySelection] + set res2 [::_test_tmp::getPrimarySelection] + set res3 $res0--$res1--$res2 +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 res0 res1 res2 res3 + ::_test_tmp::clearPrimarySelection +} -result {----} + +test safePrimarySelection-3.8 {IMPORTANT, safe slave interpreter, ttk::spinbox as entry, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + set res0 [::_test_tmp::getPrimarySelection] + set int2 slave2 + ::safe::interpCreate $int2 + ::safe::loadTk $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryTtkSpinbox 1 + set res1 [$int2 eval ::_test_tmp::getPrimarySelection] + set res2 [::_test_tmp::getPrimarySelection] + set res3 $res0--$res1--$res2 +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 res0 res1 res2 res3 + ::_test_tmp::clearPrimarySelection +} -result {----} + +test safePrimarySelection-3.9 {IMPORTANT, safe slave interpreter, ttk::spinbox spun, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + set res0 [::_test_tmp::getPrimarySelection] + set int2 slave2 + ::safe::interpCreate $int2 + ::safe::loadTk $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryTtkSpinbox 2 + set res1 [$int2 eval ::_test_tmp::getPrimarySelection] + set res2 [::_test_tmp::getPrimarySelection] + set res3 $res0--$res1--$res2 +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 res0 res1 res2 res3 + ::_test_tmp::clearPrimarySelection +} -result {----} + +test safePrimarySelection-3.10 {IMPORTANT, safe slave interpreter, ttk::spinbox spun/selected/spun, no existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -body { + set res0 [::_test_tmp::getPrimarySelection] + set int2 slave2 + ::safe::interpCreate $int2 + ::safe::loadTk $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryTtkSpinbox 3 + set res1 [$int2 eval ::_test_tmp::getPrimarySelection] + set res2 [::_test_tmp::getPrimarySelection] + set res3 $res0--$res1--$res2 +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 res0 res1 res2 res3 + ::_test_tmp::clearPrimarySelection +} -result {----} + +test safePrimarySelection-4.1 {master interpreter, text, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + ::_test_tmp::tryText + ::_test_tmp::getPrimarySelection +} -cleanup { + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-4.2 {master interpreter, entry, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + ::_test_tmp::tryEntry + ::_test_tmp::getPrimarySelection +} -cleanup { + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-4.3 {master interpreter, ttk::entry, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + ::_test_tmp::tryTtkEntry + ::_test_tmp::getPrimarySelection +} -cleanup { + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-4.4 {master interpreter, listbox, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + ::_test_tmp::tryListbox + ::_test_tmp::getPrimarySelection +} -cleanup { + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-4.5 {master interpreter, spinbox as entry, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + ::_test_tmp::trySpinbox 1 + ::_test_tmp::getPrimarySelection +} -cleanup { + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-4.6 {master interpreter, spinbox spun, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + ::_test_tmp::trySpinbox 2 + ::_test_tmp::getPrimarySelection +} -cleanup { + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -result {2} + +test safePrimarySelection-4.7 {master interpreter, spinbox spun/selected/spun, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + ::_test_tmp::trySpinbox 3 + ::_test_tmp::getPrimarySelection +} -cleanup { + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -result {3} + +test safePrimarySelection-4.8 {master interpreter, ttk::spinbox as entry, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + ::_test_tmp::tryTtkSpinbox 1 + ::_test_tmp::getPrimarySelection +} -cleanup { + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-4.9 {master interpreter, ttk::spinbox spun, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + ::_test_tmp::tryTtkSpinbox 2 + ::_test_tmp::getPrimarySelection +} -cleanup { + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -result {2} + +test safePrimarySelection-4.10 {master interpreter, ttk::spinbox spun/selected/spun, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + ::_test_tmp::tryTtkSpinbox 3 + ::_test_tmp::getPrimarySelection +} -cleanup { + destroy {*}[winfo children .] + ::_test_tmp::clearPrimarySelection +} -result {3} + +test safePrimarySelection-5.1 {unsafe slave interpreter, text, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + set int2 slave2 + ::_test_tmp::unsafeInterp $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryText + $int2 eval ::_test_tmp::getPrimarySelection +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-5.2 {unsafe slave interpreter, entry, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + set int2 slave2 + ::_test_tmp::unsafeInterp $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryEntry + $int2 eval ::_test_tmp::getPrimarySelection +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-5.3 {unsafe slave interpreter, ttk::entry, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + set int2 slave2 + ::_test_tmp::unsafeInterp $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryTtkEntry + $int2 eval ::_test_tmp::getPrimarySelection +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-5.4 {unsafe slave interpreter, listbox, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + set int2 slave2 + ::_test_tmp::unsafeInterp $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryListbox + $int2 eval ::_test_tmp::getPrimarySelection +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-5.5 {unsafe slave interpreter, spinbox as entry, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + set int2 slave2 + ::_test_tmp::unsafeInterp $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::trySpinbox 1 + $int2 eval ::_test_tmp::getPrimarySelection +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-5.6 {unsafe slave interpreter, spinbox spun, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + set int2 slave2 + ::_test_tmp::unsafeInterp $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::trySpinbox 2 + $int2 eval ::_test_tmp::getPrimarySelection +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 + ::_test_tmp::clearPrimarySelection +} -result {2} + +test safePrimarySelection-5.7 {unsafe slave interpreter, spinbox spun/selected/spun, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + set int2 slave2 + ::_test_tmp::unsafeInterp $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::trySpinbox 3 + $int2 eval ::_test_tmp::getPrimarySelection +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 + ::_test_tmp::clearPrimarySelection +} -result {3} + +test safePrimarySelection-5.8 {unsafe slave interpreter, ttk::spinbox as entry, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + set int2 slave2 + ::_test_tmp::unsafeInterp $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryTtkSpinbox 1 + $int2 eval ::_test_tmp::getPrimarySelection +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 + ::_test_tmp::clearPrimarySelection +} -result {PAYLOAD} + +test safePrimarySelection-5.9 {unsafe slave interpreter, ttk::spinbox spun, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + set int2 slave2 + ::_test_tmp::unsafeInterp $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryTtkSpinbox 2 + $int2 eval ::_test_tmp::getPrimarySelection +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 + ::_test_tmp::clearPrimarySelection +} -result {2} + +test safePrimarySelection-5.10 {unsafe slave interpreter, ttk::spinbox spun/selected/spun, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + set int2 slave2 + ::_test_tmp::unsafeInterp $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryTtkSpinbox 3 + $int2 eval ::_test_tmp::getPrimarySelection +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 + ::_test_tmp::clearPrimarySelection +} -result {3} + +test safePrimarySelection-6.1 {IMPORTANT, safe slave interpreter, text, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + set res0 [::_test_tmp::getPrimarySelection] + set int2 slave2 + ::safe::interpCreate $int2 + ::safe::loadTk $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryText + set res1 [$int2 eval ::_test_tmp::getPrimarySelection] + set res2 [::_test_tmp::getPrimarySelection] + set res3 $res0--$res1--$res2 +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 res0 res1 res2 res3 + ::_test_tmp::clearPrimarySelection +} -result {OLD_VALUE----OLD_VALUE} + +test safePrimarySelection-6.2 {IMPORTANT, safe slave interpreter, entry, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + set res0 [::_test_tmp::getPrimarySelection] + set int2 slave2 + ::safe::interpCreate $int2 + ::safe::loadTk $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryEntry + set res1 [$int2 eval ::_test_tmp::getPrimarySelection] + set res2 [::_test_tmp::getPrimarySelection] + set res3 $res0--$res1--$res2 +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 res0 res1 res2 res3 + ::_test_tmp::clearPrimarySelection +} -result {OLD_VALUE----OLD_VALUE} + +test safePrimarySelection-6.3 {IMPORTANT, safe slave interpreter, ttk::entry, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + set res0 [::_test_tmp::getPrimarySelection] + set int2 slave2 + ::safe::interpCreate $int2 + ::safe::loadTk $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryTtkEntry + set res1 [$int2 eval ::_test_tmp::getPrimarySelection] + set res2 [::_test_tmp::getPrimarySelection] + set res3 $res0--$res1--$res2 +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 res0 res1 res2 res3 + ::_test_tmp::clearPrimarySelection +} -result {OLD_VALUE----OLD_VALUE} + +test safePrimarySelection-6.4 {IMPORTANT, safe slave interpreter, listbox, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + set res0 [::_test_tmp::getPrimarySelection] + set int2 slave2 + ::safe::interpCreate $int2 + ::safe::loadTk $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryListbox + set res1 [$int2 eval ::_test_tmp::getPrimarySelection] + set res2 [::_test_tmp::getPrimarySelection] + set res3 $res0--$res1--$res2 +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 res0 res1 res2 res3 + ::_test_tmp::clearPrimarySelection +} -result {OLD_VALUE----OLD_VALUE} + +test safePrimarySelection-6.5 {IMPORTANT, safe slave interpreter, spinbox as entry, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + set res0 [::_test_tmp::getPrimarySelection] + set int2 slave2 + ::safe::interpCreate $int2 + ::safe::loadTk $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::trySpinbox 1 + set res1 [$int2 eval ::_test_tmp::getPrimarySelection] + set res2 [::_test_tmp::getPrimarySelection] + set res3 $res0--$res1--$res2 +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 res0 res1 res2 res3 + ::_test_tmp::clearPrimarySelection +} -result {OLD_VALUE----OLD_VALUE} + +test safePrimarySelection-6.6 {IMPORTANT, safe slave interpreter, spinbox spun, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + set res0 [::_test_tmp::getPrimarySelection] + set int2 slave2 + ::safe::interpCreate $int2 + ::safe::loadTk $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::trySpinbox 2 + set res1 [$int2 eval ::_test_tmp::getPrimarySelection] + set res2 [::_test_tmp::getPrimarySelection] + set res3 $res0--$res1--$res2 +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 res0 res1 res2 res3 + ::_test_tmp::clearPrimarySelection +} -result {OLD_VALUE----OLD_VALUE} + +test safePrimarySelection-6.7 {IMPORTANT, safe slave interpreter, spinbox spun/selected/spun, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + set res0 [::_test_tmp::getPrimarySelection] + set int2 slave2 + ::safe::interpCreate $int2 + ::safe::loadTk $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::trySpinbox 3 + set res1 [$int2 eval ::_test_tmp::getPrimarySelection] + set res2 [::_test_tmp::getPrimarySelection] + set res3 $res0--$res1--$res2 +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 res0 res1 res2 res3 + ::_test_tmp::clearPrimarySelection +} -result {OLD_VALUE----OLD_VALUE} + +test safePrimarySelection-6.8 {IMPORTANT, safe slave interpreter, ttk::spinbox as entry, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + set res0 [::_test_tmp::getPrimarySelection] + set int2 slave2 + ::safe::interpCreate $int2 + ::safe::loadTk $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryTtkSpinbox 1 + set res1 [$int2 eval ::_test_tmp::getPrimarySelection] + set res2 [::_test_tmp::getPrimarySelection] + set res3 $res0--$res1--$res2 +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 res0 res1 res2 res3 + ::_test_tmp::clearPrimarySelection +} -result {OLD_VALUE----OLD_VALUE} + +test safePrimarySelection-6.9 {IMPORTANT, safe slave interpreter, ttk::spinbox spun, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + set res0 [::_test_tmp::getPrimarySelection] + set int2 slave2 + ::safe::interpCreate $int2 + ::safe::loadTk $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryTtkSpinbox 2 + set res1 [$int2 eval ::_test_tmp::getPrimarySelection] + set res2 [::_test_tmp::getPrimarySelection] + set res3 $res0--$res1--$res2 +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 res0 res1 res2 res3 + ::_test_tmp::clearPrimarySelection +} -result {OLD_VALUE----OLD_VALUE} + +test safePrimarySelection-6.10 {IMPORTANT, safe slave interpreter, ttk::spinbox spun/selected/spun, existing selection} -setup { + catch {interp delete slave2} + destroy {*}[winfo children .] + ::_test_tmp::setPrimarySelection +} -body { + set res0 [::_test_tmp::getPrimarySelection] + set int2 slave2 + ::safe::interpCreate $int2 + ::safe::loadTk $int2 + $int2 eval $::_test_tmp::script + $int2 eval ::_test_tmp::tryTtkSpinbox 3 + set res1 [$int2 eval ::_test_tmp::getPrimarySelection] + set res2 [::_test_tmp::getPrimarySelection] + set res3 $res0--$res1--$res2 +} -cleanup { + interp delete $int2 + destroy {*}[winfo children .] + unset int2 res0 res1 res2 res3 + ::_test_tmp::clearPrimarySelection +} -result {OLD_VALUE----OLD_VALUE} + + +namespace delete ::_test_tmp + +# option clear +# cleanup +cleanupTests +return diff --git a/tests/scrollbar.test b/tests/scrollbar.test index bd140678..9d6a83c4 100644 --- a/tests/scrollbar.test +++ b/tests/scrollbar.test @@ -18,23 +18,38 @@ proc scroll args { proc getTroughSize {w} { if {[testConstraint testmetrics]} { + # Only Windows has [testmetrics] if [string match v* [$w cget -orient]] { return [expr [winfo height $w] - 2*[testmetrics cyvscroll $w]] } else { return [expr [winfo width $w] - 2*[testmetrics cxhscroll $w]] } } else { - if [string match v* [$w cget -orient]] { - return [expr [winfo height $w] \ - - ([winfo width $w] \ - - [$w cget -highlightthickness] \ - - [$w cget -bd] + 1)*2] - } else { - return [expr [winfo width $w] \ - - ([winfo height $w] \ - - [$w cget -highlightthickness] \ - - [$w cget -bd] + 1)*2] - } + if {[tk windowingsystem] eq "x11"} { + # Calculations here assume that the arrow area is a square. + if [string match v* [$w cget -orient]] { + return [expr [winfo height $w] \ + - ([winfo width $w] \ + - [$w cget -highlightthickness] \ + - [$w cget -bd] + 1)*2] + } else { + return [expr [winfo width $w] \ + - ([winfo height $w] \ + - [$w cget -highlightthickness] \ + - [$w cget -bd] + 1)*2] + } + } else { + # macOS aqua + if [string match v* [$w cget -orient]] { + return [expr [winfo height $w] \ + - ([$w cget -highlightthickness] \ + +[$w cget -bd])*2] + } else { + return [expr [winfo width $w] \ + - ([$w cget -highlightthickness] \ + +[$w cget -bd])*2] + } + } } } @@ -255,13 +270,13 @@ test scrollbar-3.35 {ScrollbarWidgetCmd procedure, "fraction" option} { format {%.6g} [.s fraction 4 21] } [format %.6g [expr (21.0 - ([winfo height .s] - [getTroughSize .s])/2.0) \ /([getTroughSize .s] - 1)]] -test scrollbar-3.36 {ScrollbarWidgetCmd procedure, "fraction" option} unix { +test scrollbar-3.36 {ScrollbarWidgetCmd procedure, "fraction" option} x11 { format {%.6g} [.s fraction 4 179] } {1} test scrollbar-3.37 {ScrollbarWidgetCmd procedure, "fraction" option} {testmetrics} { format {%.6g} [.s fraction 4 [expr 200 - [testmetrics cyvscroll .s]]] } {1} -test scrollbar-3.38 {ScrollbarWidgetCmd procedure, "fraction" option} unix { +test scrollbar-3.38 {ScrollbarWidgetCmd procedure, "fraction" option} x11 { format {%.6g} [.s fraction 4 178] } {0.993711} test scrollbar-3.39 {ScrollbarWidgetCmd procedure, "fraction" option} {testmetrics win} { @@ -281,9 +296,15 @@ test scrollbar-3.41 {ScrollbarWidgetCmd procedure, "fraction" option} { format {%.6g} [.t.s fraction 100 0] } {0.5} if {[testConstraint testmetrics]} { + # Only Windows has [testmetrics] place configure .t.s -width [expr 2*[testmetrics cxhscroll .t.s]+1] } else { - place configure .t.s -width [expr [winfo reqwidth .t.s] - 4] + if {[tk windowingsystem] eq "x11"} { + place configure .t.s -width [expr [winfo height .t.s] - 2*([.t.s cget -highlightthickness] + [.t.s cget -bd] + 1)] + } else { + # macOS aqua + place configure .t.s -width [expr 2*([.t.s cget -highlightthickness] + [.t.s cget -bd])] + } } update test scrollbar-3.42 {ScrollbarWidgetCmd procedure, "fraction" option} { @@ -317,9 +338,13 @@ test scrollbar-3.48 {ScrollbarWidgetCmd procedure, "identify" option} { test scrollbar-3.49 {ScrollbarWidgetCmd procedure, "identify" option} { list [catch {.s identify -1 bogus} msg] $msg } {1 {expected integer but got "bogus"}} -test scrollbar-3.50 {ScrollbarWidgetCmd procedure, "identify" option} { +test scrollbar-3.50.1 {ScrollbarWidgetCmd procedure, "identify" option} notAqua { .s identify 5 5 } {arrow1} +test scrollbar-3.50.1 {ScrollbarWidgetCmd procedure, "identify" option} aqua { + # macOS scrollbars have no arrows nowadays + .s identify 5 5 +} {trough1} test scrollbar-3.51 {ScrollbarWidgetCmd procedure, "identify" option} { .s identify 5 35 } {trough1} @@ -330,9 +355,13 @@ test scrollbar-3.52 {ScrollbarWidgetCmd procedure, "identify" option} { test scrollbar-3.53 {ScrollbarWidgetCmd procedure, "identify" option} { .s identify 5 145 } {trough2} -test scrollbar-3.54 {ScrollbarWidgetCmd procedure, "identify" option} {unixOrPc} { +test scrollbar-3.54.1 {ScrollbarWidgetCmd procedure, "identify" option} notAqua { .s identify 5 195 } {arrow2} +test scrollbar-3.54.2 {ScrollbarWidgetCmd procedure, "identify" option} aqua { + # macOS scrollbars have no arrows nowadays + .s identify 5 195 +} {trough2} test scrollbar-3.56 {ScrollbarWidgetCmd procedure, "identify" option} unix { .s identify 0 0 } {} @@ -455,12 +484,20 @@ test scrollbar-6.9 {ScrollbarPosition procedure} { test scrollbar-6.10 {ScrollbarPosition procedure} { .s identify [winfo width .s] [expr [winfo height .s] / 2] } {} -test scrollbar-6.11 {ScrollbarPosition procedure} unix { +test scrollbar-6.11.1 {ScrollbarPosition procedure} x11 { .s identify 8 4 } {arrow1} -test scrollbar-6.12 {ScrollbarPosition procedure} unix { +test scrollbar-6.11.2 {ScrollbarPosition procedure} aqua { + # macOS scrollbars have no arrows nowadays + .s identify 8 4 +} {trough1} +test scrollbar-6.12.1 {ScrollbarPosition procedure} x11 { .s identify 8 19 } {arrow1} +test scrollbar-6.12.2 {ScrollbarPosition procedure} aqua { + # macOS scrollbars have no arrows nowadays + .s identify 8 19 +} {trough1} test scrollbar-6.14 {ScrollbarPosition procedure} win { .s identify [expr [winfo width .s] / 2] 0 } {arrow1} @@ -504,11 +541,7 @@ test scrollbar-6.24 {ScrollbarPosition procedure} unix { test scrollbar-6.25 {ScrollbarPosition procedure} unix { .s identify 8 179 } {trough2} -test scrollbar-6.27 {ScrollbarPosition procedure} {testmetrics win knownBug} { - # This asks for 8,21, which is actually the slider, but there is a - # bug in that GetSystemMetrics(SM_CYVTHUMB) actually returns a value - # that is larger than the thumb displayed, skewing the ability to - # calculate the trough2 area correctly (Win2k). -- hobbs +test scrollbar-6.27 {ScrollbarPosition procedure} {testmetrics win} { .s identify [expr [winfo width .s] / 2] [expr int(.4 / [.s delta 0 1]) \ + [testmetrics cyvscroll .s]] } {trough2} @@ -516,12 +549,20 @@ test scrollbar-6.28 {ScrollbarPosition procedure} {testmetrics win} { .s identify [expr [winfo width .s] / 2] [expr [winfo height .s] \ - [testmetrics cyvscroll .s] - 1] } {trough2} -test scrollbar-6.29 {ScrollbarPosition procedure} unix { +test scrollbar-6.29.1 {ScrollbarPosition procedure} x11 { .s identify 8 180 } {arrow2} -test scrollbar-6.30 {ScrollbarPosition procedure} unix { +test scrollbar-6.29.2 {ScrollbarPosition procedure} aqua { + # macOS scrollbars have no arrows nowadays + .s identify 8 180 +} {trough2} +test scrollbar-6.30.1 {ScrollbarPosition procedure} x11 { .s identify 8 195 } {arrow2} +test scrollbar-6.30.2 {ScrollbarPosition procedure} aqua { + # macOS scrollbars have no arrows nowadays + .s identify 8 195 +} {trough2} test scrollbar-6.32 {ScrollbarPosition procedure} {testmetrics win} { .s identify [expr [winfo width .s] / 2] [expr [winfo height .s] \ - [testmetrics cyvscroll .s]] @@ -550,15 +591,23 @@ place .t.s -width 200 .t.s set .2 .4 update -test scrollbar-6.39 {ScrollbarPosition procedure} unix { +test scrollbar-6.39.1 {ScrollbarPosition procedure} x11 { .t.s identify 4 8 } {arrow1} +test scrollbar-6.39.2 {ScrollbarPosition procedure} aqua { + # macOS scrollbars have no arrows nowadays + .t.s identify 4 8 +} {trough1} test scrollbar-6.40 {ScrollbarPosition procedure} win { .t.s identify 0 [expr [winfo height .t.s] / 2] } {arrow1} -test scrollbar-6.41 {ScrollbarPosition procedure} unix { +test scrollbar-6.41.1 {ScrollbarPosition procedure} x11 { .t.s identify 82 8 } {slider} +test scrollbar-6.41.2 {ScrollbarPosition procedure} aqua { + # macOS scrollbars have no arrows nowadays + .t.s identify 82 8 +} {trough2} test scrollbar-6.43 {ScrollbarPosition procedure} {testmetrics win} { .t.s identify [expr int(.4 / [.t.s delta 1 0]) + [testmetrics cxhscroll .t.s] \ - 1] [expr [winfo height .t.s] / 2] @@ -582,7 +631,9 @@ test scrollbar-7.1 {EventuallyRedraw} { catch {destroy .t} toplevel .t wm geometry .t +0+0 -test scrollbar-8.1 {TkScrollbarEventProc: recursive deletion} { +test scrollbar-8.1 {TkScrollbarEventProc: recursive deletion} notAqua { + # constrained by notAqua because this test clicks on an arrow of the + # scrollbar - but macOS has no such arrows in modern scrollbars proc doit {args} { destroy .t.f } proc bgerror {args} {} destroy .t.f @@ -601,7 +652,9 @@ test scrollbar-8.1 {TkScrollbarEventProc: recursive deletion} { rename bgerror {} set result } {1 0 0} -test scrollbar-8.2 {TkScrollbarEventProc: recursive deletion} { +test scrollbar-8.2 {TkScrollbarEventProc: recursive deletion} notAqua { + # constrained by notAqua because this test clicks on an arrow of the + # scrollbar - but macOS has no such arrows in modern scrollbars proc doit {args} { destroy .t.f.s } proc bgerror {args} {} destroy .t.f @@ -632,7 +685,7 @@ test scrollbar-9.1 {scrollbar widget vs hidden commands} { list [winfo children .] [interp hidden] } [list {} $l] -test scrollbar-10.1 { event on scrollbar} -constraints {win|unix} -setup { +test scrollbar-10.1.1 { event on scrollbar} -constraints {notAqua} -setup { destroy .t .s } -body { pack [text .t -yscrollcommand {.s set}] -side left @@ -646,8 +699,22 @@ test scrollbar-10.1 { event on scrollbar} -constraints {win|unix} -s } -cleanup { destroy .t .s } -result {5.0} +test scrollbar-10.1.2 { event on scrollbar} -constraints {aqua} -setup { + destroy .t .s +} -body { + pack [text .t -yscrollcommand {.s set}] -side left + for {set i 1} {$i < 100} {incr i} {.t insert end "Line $i\n"} + pack [scrollbar .s -command {.t yview}] -fill y -expand 1 -side left + update + focus -force .s + event generate .s -delta -4 + after 200 {set eventprocessed 1} ; vwait eventprocessed + .t index @0,0 +} -cleanup { + destroy .t .s +} -result {5.0} -test scrollbar-10.2 { event on scrollbar} -constraints {win|unix} -setup { +test scrollbar-10.2.1 { event on scrollbar} -constraints {notAqua} -setup { destroy .t .s } -body { pack [text .t -xscrollcommand {.s set} -wrap none] -side top @@ -661,6 +728,20 @@ test scrollbar-10.2 { event on scrollbar} -constraints {win|unix} -s } -cleanup { destroy .t .s } -result {1.4} +test scrollbar-10.2.2 { event on scrollbar} -constraints {aqua} -setup { + destroy .t .s +} -body { + pack [text .t -xscrollcommand {.s set} -wrap none] -side top + for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "} + pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top + update + focus -force .s + event generate .s -delta -4 + after 200 {set eventprocessed 1} ; vwait eventprocessed + .t index @0,0 +} -cleanup { + destroy .t .s +} -result {1.4} test scrollbar-11.1 {bug fix: [011706ec42] Scrollbar unsafe wrt widget destruction} -body { proc destroy_scrollbar {} { diff --git a/tests/select.test b/tests/select.test index a7cd7802..5949b9c0 100644 --- a/tests/select.test +++ b/tests/select.test @@ -333,7 +333,7 @@ test select-3.6 {Tk_OwnSelection procedure} -setup { selection clear .f1 lappend result $lostSel } -result {owned lost2} -test select-3.7 {Tk_OwnSelection procedure} -constraints unix -setup { +test select-3.7 {Tk_OwnSelection procedure} -constraints x11 -setup { global lostSel setup setupbg @@ -407,7 +407,7 @@ test select-4.3 {Tk_ClearSelection procedure} -setup { } -body { list [selection clear .f1] [selection clear .f1] } -result {{} {}} -test select-4.4 {Tk_ClearSelection procedure} -constraints unix -setup { +test select-4.4 {Tk_ClearSelection procedure} -constraints x11 -setup { global lostSel setup setupbg @@ -439,7 +439,7 @@ test select-4.5 {Tk_ClearSelection procedure} -constraints { list $lostSel $lostSel2 } -result {owned lost2} test select-4.6 {Tk_ClearSelection procedure} -constraints { - unix altDisplay + x11 altDisplay } -setup { setup .f1 setup .f2 $env(TK_ALT_DISPLAY) @@ -525,7 +525,7 @@ test select-5.8 {Tk_GetSelection procedure} -setup { }} STRING} list [selection get] $selInfo [catch {selection get} msg] $msg } -result "$longValue {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000} 1 {PRIMARY selection doesn't exist or form \"STRING\" not defined}" -test select-5.9 {Tk_GetSelection procedure} -constraints unix -setup { +test select-5.9 {Tk_GetSelection procedure} -constraints x11 -setup { setup setupbg } -body { @@ -538,7 +538,7 @@ test select-5.9 {Tk_GetSelection procedure} -constraints unix -setup { cleanupbg lappend result $selInfo } -result {{Test value} {TEST 0 4000}} -test select-5.10 {Tk_GetSelection procedure} -constraints unix -setup { +test select-5.10 {Tk_GetSelection procedure} -constraints x11 -setup { setup setupbg } -body { @@ -586,7 +586,7 @@ test select-5.12 {Tk_GetSelection procedure} -constraints { $selInfo } -result {0 {Test value} {TEST 0 4000} 1 {PRIMARY selection doesn't exist or form "TEST" not defined} {}} test select-5.13 {Tk_GetSelection procedure} -constraints { - unix altDisplay + x11 altDisplay } -setup { setup .f1 setup .f2 $env(TK_ALT_DISPLAY) @@ -607,7 +607,7 @@ test select-5.13 {Tk_GetSelection procedure} -constraints { lappend result $selInfo } -result {{Test value} {Test value2} {TEST2 0 4000 TEST 0 4000}} test select-5.14 {Tk_GetSelection procedure} -constraints { - unix altDisplay + x11 altDisplay } -setup { setup .f1 setup .f2 $env(TK_ALT_DISPLAY) @@ -864,13 +864,14 @@ test select-7.1 {TkSelDeadWindow procedure} -constraints nonPortable -setup { ############################################################################## # Check reentrancy on losing selection -test select-8.1 {TkSelEventProc procedure} -constraints unix -setup { +test select-8.1 {TkSelEventProc procedure} -constraints x11 -setup { setup setupbg } -body { selection own -selection CLIPBOARD -command {destroy .f1} .f1 update dobg {selection own -selection CLIPBOARD .} + winfo children . } -cleanup { cleanupbg } -result {} @@ -880,7 +881,7 @@ test select-8.1 {TkSelEventProc procedure} -constraints unix -setup { test select-9.1 {SelCvtToX and SelCvtFromX procedures} -setup { setup setupbg -} -constraints unix -body { +} -constraints x11 -body { set selValue "1024" set selInfo "" selection handle -selection PRIMARY -format INTEGER -type TEST \ @@ -894,7 +895,7 @@ test select-9.1 {SelCvtToX and SelCvtFromX procedures} -setup { test select-9.2 {SelCvtToX and SelCvtFromX procedures} -setup { setup setupbg -} -constraints unix -body { +} -constraints x11 -body { set selValue "1024 0xffff 2048 -2 " set selInfo "" selection handle -selection PRIMARY -format INTEGER -type TEST \ @@ -907,7 +908,7 @@ test select-9.2 {SelCvtToX and SelCvtFromX procedures} -setup { test select-9.3 {SelCvtToX and SelCvtFromX procedures} -setup { setup setupbg -} -constraints unix -body { +} -constraints x11 -body { set selValue " " set selInfo "" selection handle -selection PRIMARY -format INTEGER -type TEST \ @@ -920,7 +921,7 @@ test select-9.3 {SelCvtToX and SelCvtFromX procedures} -setup { test select-9.4 {SelCvtToX and SelCvtFromX procedures} -setup { setup setupbg -} -constraints unix -body { +} -constraints x11 -body { set selValue "16 foobar 32" set selInfo "" selection handle -selection PRIMARY -format INTEGER -type TEST \ @@ -933,7 +934,7 @@ test select-9.4 {SelCvtToX and SelCvtFromX procedures} -setup { test select-9.5 {SelCvtToX and SelCvtFromX procedures} -setup { setup setupbg -} -constraints unix -body { +} -constraints x11 -body { # Ensure that lists of atoms are constructed correctly, even when the # atom names have spaces in. [Bug 1353414] set selValue "foo bar" @@ -951,7 +952,7 @@ test select-9.5 {SelCvtToX and SelCvtFromX procedures} -setup { # most control paths have been exercised above test select-10.1 {ConvertSelection procedure, race with selection clear} -constraints { - unix + x11 } -setup { setup } -body { @@ -981,7 +982,7 @@ test select-10.1 {ConvertSelection procedure, race with selection clear} -constr catch {close $fd} lappend x $selInfo } -result {{1:PRIMARY selection doesn't exist or form "STRING" not defined} {}} -test select-10.2 {ConvertSelection procedure} -constraints unix -setup { +test select-10.2 {ConvertSelection procedure} -constraints x11 -setup { setup setupbg } -body { @@ -993,7 +994,7 @@ test select-10.2 {ConvertSelection procedure} -constraints unix -setup { cleanupbg lappend result $selInfo } -result [list [string range $longValue 0 3999] {STRING 0 4000 STRING 4000 4000 STRING 0 4000 STRING 4000 4000}] -test select-10.3 {ConvertSelection procedure} -constraints unix -setup { +test select-10.3 {ConvertSelection procedure} -constraints x11 -setup { setup setupbg } -body { @@ -1005,7 +1006,7 @@ test select-10.3 {ConvertSelection procedure} -constraints unix -setup { # testing timers # This one hangs in Exceed test select-10.4 {ConvertSelection procedure} -constraints { - unix noExceed + x11 noExceed } -setup { setup setupbg @@ -1020,7 +1021,7 @@ test select-10.4 {ConvertSelection procedure} -constraints { lappend result $selInfo } -result {{selection owner didn't respond} {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000 STRING 0 4000 STRING 4000 4000}} test select-10.5 {ConvertSelection procedure, reentrancy issues} -constraints { - unix + x11 } -setup { setup setupbg @@ -1035,7 +1036,7 @@ test select-10.5 {ConvertSelection procedure, reentrancy issues} -constraints { lappend result $selInfo } -result {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000}} test select-10.6 {ConvertSelection procedure, reentrancy issues} -constraints { - unix + x11 } -setup { setup setupbg @@ -1058,7 +1059,7 @@ test select-10.6 {ConvertSelection procedure, reentrancy issues} -constraints { ############################################################################## # testing reentrancy -test select-11.1 {TkSelPropProc procedure} -constraints unix -setup { +test select-11.1 {TkSelPropProc procedure} -constraints x11 -setup { setup setupbg } -body { @@ -1076,7 +1077,7 @@ test select-11.1 {TkSelPropProc procedure} -constraints unix -setup { ############################################################################## # Note, this assumes we are using CurrentTtime -test select-12.1 {DefaultSelection procedure} -constraints unix -body { +test select-12.1 {DefaultSelection procedure} -constraints x11 -body { setup set result [selection get -type TIMESTAMP] setupbg @@ -1084,7 +1085,7 @@ test select-12.1 {DefaultSelection procedure} -constraints unix -body { cleanupbg set result } -result {0x0 {0x0 }} -test select-12.2 {DefaultSelection procedure} -constraints unix -body { +test select-12.2 {DefaultSelection procedure} -constraints x11 -body { setup set result [lsort [list [selection get -type TARGETS]]] setupbg @@ -1092,7 +1093,7 @@ test select-12.2 {DefaultSelection procedure} -constraints unix -body { cleanupbg set result } -result {{MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-12.3 {DefaultSelection procedure} -constraints unix -body { +test select-12.3 {DefaultSelection procedure} -constraints x11 -body { setup selection handle .f1 {handler TEST} TEST set result [list [lsort [selection get -type TARGETS]]] @@ -1101,7 +1102,7 @@ test select-12.3 {DefaultSelection procedure} -constraints unix -body { cleanupbg set result } -result {{MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-12.4 {DefaultSelection procedure} -constraints unix -setup { +test select-12.4 {DefaultSelection procedure} -constraints x11 -setup { setup set result "" } -body { @@ -1111,7 +1112,7 @@ test select-12.4 {DefaultSelection procedure} -constraints unix -setup { cleanupbg set result } -result [list [winfo name .] [winfo name .]] -test select-12.5 {DefaultSelection procedure} -constraints unix -body { +test select-12.5 {DefaultSelection procedure} -constraints x11 -body { setup set result [selection get -type TK_WINDOW] setupbg @@ -1130,7 +1131,7 @@ test select-12.6 {DefaultSelection procedure} -body { } -result {{Targets value} {TARGETS.f1 0 4000} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} test select-13.1 {SelectionSize procedure, handler deleted} -constraints { - unix + x11 } -setup { setup setupbg diff --git a/tests/text.test b/tests/text.test index 07192e88..5eadeac2 100644 --- a/tests/text.test +++ b/tests/text.test @@ -1587,6 +1587,15 @@ test text-8.27 {TextWidgetCmd procedure, "replace" option crash} -setup { } -cleanup { destroy .tt } -result {} +test text-8.28 {TextWidgetCmd procedure, "replace" option crash} -setup { + text .tt +} -body { + .tt insert end "foo\n" + .tt tag add sel 1.0 end + .tt replace sel.first sel.last "bar" +} -cleanup { + destroy .tt +} -result {} test text-9.1 {TextWidgetCmd procedure, "get" option} -setup { @@ -5548,9 +5557,7 @@ test text-22.198 {TextSearchCmd, regexp search multi-line} -body { } -cleanup { destroy .t } -result {2.0 19} -test text-22.199 {TextSearchCmd, regexp search multi-line} -constraints { - knownBug -} -body { +test text-22.199 {TextSearchCmd, regexp search multi-line} -body { pack [text .t] .t insert 1.0 "aaaa\nbbbb\ncccc\nbbbb\naaaa\n" set foo {} @@ -5559,9 +5566,7 @@ test text-22.199 {TextSearchCmd, regexp search multi-line} -constraints { } -cleanup { destroy .t } -result {2.0 19} -test text-22.200 {TextSearchCmd, regexp search multi-line} -constraints { - knownBug -} -body { +test text-22.200 {TextSearchCmd, regexp search multi-line} -body { pack [text .t] .t insert 1.0 "aaaa\nbbbb\ncccc\nbbbb\naaaa\n" set foo {} @@ -5579,23 +5584,18 @@ test text-22.201 {TextSearchCmd, regexp search multi-line} -body { } -cleanup { destroy .t } -result {1.0 24} -test text-22.202 {TextSearchCmd, regexp search multi-line} -constraints { - knownBug -} -body { +test text-22.202 {TextSearchCmd, regexp search multi-line} -body { pack [text .t] .t insert 1.0 "aaaa\nbbbb\nbbbb\nbbbb\nbbbb\n" list [.t search -regexp -backward -all -count foo \ - -- {b+\n|a+\n(b+\n)+} end] $foo + -- {(b+\n|a+\n)(b+\n)+} end] $foo } -cleanup { destroy .t } -result {1.0 25} -test text-22.203 {TextSearchCmd, regexp search multi-line} -constraints { - knownBug -} -body { +test text-22.203 {TextSearchCmd, regexp search multi-line} -body { pack [text .t] .t insert 1.0 "aaaa\nbbbb\nbbbb\nbbbb\nbbbb\n" - .t search -regexp -backward -- {b+\n|a+\n(b+\n)+} end -# Should match at 1.0 for a true greedy match + .t search -regexp -backward -- {(b+\n|a+\n)(b+\n)+} end } -cleanup { destroy .t } -result {1.0} @@ -5864,7 +5864,219 @@ test text-22.225 {TextSearchCmd, strict limits} -body { } -cleanup { destroy .t } -result {} - +test text-22.226 {TextSearchCmd, exact search for the empty string} -body { + text .t + set res [.t search -count C "" 1.0] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {1.0 0} +test text-22.227 {TextSearchCmd, exact search for the empty string} -body { + text .t + .t insert end "Searching for the\nempty string!" + set res [.t search -count C "" 2.5] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {2.5 0} +test text-22.228 {TextSearchCmd, exact search all empty strings} -body { + text .t + set res [.t search -count C -all "" 1.0] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {1.0 0} +test text-22.229 {TextSearchCmd, exact search all empty strings} -body { + text .t + .t insert end "Searching for the\nempty string!" + set res [.t search -count C -all "" 2.5 2.8] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {2.5 2.6 2.7 {0 0 0}} +test text-22.230 {TextSearchCmd, exact search all empty strings, with overlap} -body { + text .t + set res [.t search -count C -all -overlap "" 1.0] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {1.0 0} +test text-22.231 {TextSearchCmd, exact search all empty strings, with overlap} -body { + text .t + .t insert end "Searching for the\nempty string!" + set res [.t search -count C -all -overlap "" 2.5 2.8] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {2.5 2.6 2.7 {0 0 0}} +test text-22.232 {TextSearchCmd, regexp search for the empty string} -body { + text .t + set res [.t search -count C -regexp "" 1.0] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {1.0 0} +test text-22.233 {TextSearchCmd, regexp search for the empty string} -body { + text .t + .t insert end "Searching for the\nempty string!" + set res [.t search -count C -regexp "" 2.5] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {2.5 0} +test text-22.234 {TextSearchCmd, regexp search all empty strings} -body { + text .t + set res [.t search -count C -all -regexp "" 1.0] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {1.0 0} +test text-22.235 {TextSearchCmd, regexp search all empty strings} -body { + text .t + .t insert end "Searching for the\nempty string!" + set res [.t search -count C -all -regexp "" 2.5 2.8] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {2.5 2.6 2.7 {0 0 0}} +test text-22.236 {TextSearchCmd, regexp search all empty strings, with overlap} -body { + text .t + set res [.t search -count C -all -regexp -overlap "" 1.0] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {1.0 0} +test text-22.237 {TextSearchCmd, regexp search all empty strings, with overlap} -body { + text .t + .t insert end "Searching for the\nempty string!" + set res [.t search -count C -all -regexp -overlap "" 2.5 2.8] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {2.5 2.6 2.7 {0 0 0}} +test text-22.238 {TextSearchCmd, exact backwards search for the empty string} -body { + text .t + set res [.t search -count C -backwards "" 1.0] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {1.0 0} +test text-22.239 {TextSearchCmd, exact backwards search for the empty string} -body { + text .t + .t insert end "Searching for the\nempty string!" + set res [.t search -count C -backwards "" 2.5] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {2.4 0} +test text-22.240 {TextSearchCmd, exact backwards search all empty strings} -body { + text .t + set res [.t search -count C -backwards -all "" 1.0] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {1.0 0} +test text-22.241 {TextSearchCmd, exact backwards search all empty strings} -body { + text .t + .t insert end "Searching for the\nempty string!" + set res [.t search -count C -backwards -all "" 2.5 2.0] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {2.4 2.3 2.2 2.1 2.0 {0 0 0 0 0}} +test text-22.242 {TextSearchCmd, exact backwards search all empty strings, with overlap} -body { + text .t + set res [.t search -count C -backwards -all -overlap "" 1.0] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {1.0 0} +test text-22.243 {TextSearchCmd, exact backwards search all empty strings, with overlap} -body { + text .t + .t insert end "Searching for the\nempty string!" + set res [.t search -count C -backwards -all -overlap "" 2.5 2.0] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {2.4 2.3 2.2 2.1 2.0 {0 0 0 0 0}} +test text-22.244 {TextSearchCmd, regexp backwards search for the empty string} -body { + text .t + set res [.t search -count C -backwards -regexp "" 1.0] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {1.0 0} +test text-22.245 {TextSearchCmd, regexpbackwards search for the empty string} -body { + text .t + .t insert end "Searching for the\nempty string!" + set res [.t search -count C -backwards -regexp "" 2.5] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {2.4 0} +test text-22.246 {TextSearchCmd, regexp backwards search all empty strings} -body { + text .t + set res [.t search -count C -backwards -all -regexp "" 1.0] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {1.0 0} +test text-22.247 {TextSearchCmd, regexp backwards search all empty strings} -body { + text .t + .t insert end "Searching for the\nempty string!" + set res [.t search -count C -backwards -all -regexp "" 2.5 2.0] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {2.4 2.3 2.2 2.1 2.0 {0 0 0 0 0}} +test text-22.248 {TextSearchCmd, regexp backwards search all empty strings, with overlap} -body { + text .t + set res [.t search -count C -backwards -all -regexp -overlap "" 1.0] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {1.0 0} +test text-22.249 {TextSearchCmd, regexp backwards search all empty strings, with overlap} -body { + text .t + .t insert end "Searching for the\nempty string!" + set res [.t search -count C -backwards -all -regexp -overlap "" 2.5 2.0] + lappend res $C +} -cleanup { + destroy .t + unset -nocomplain res C +} -result {2.4 2.3 2.2 2.1 2.0 {0 0 0 0 0}} +test text-22.250 {TextSearchCmd, backwards search all matching at start of line} -body { + text .t + .t insert end "abc" + set res [.t search -backwards -all b end] ; # works + lappend res [.t search -backwards a end] ; # works + lappend res [.t search -backwards -all a end] ; # used to hang +} -cleanup { + destroy .t +} -result {1.1 1.0 1.0} test text-23.1 {TkTextGetTabs procedure} -setup { text .t -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 @@ -6395,9 +6607,9 @@ test text-27.14a {<> virtual event - propagation to peers} -body { } -cleanup { destroy .t .tt } -result {4} -test text-27.15 {<> virtual event} -body { +test text-27.15 {<> virtual event on sel tagging} -body { set ::retval no_selection - pack [text .t -undo 1] + pack [text .t] bind .t <> "set ::retval selection_changed" update idletasks .t insert end "nothing special\n" @@ -6407,6 +6619,110 @@ test text-27.15 {<> virtual event} -body { } -cleanup { destroy .t } -result {selection_changed} +test text-27.15a {<> virtual event on sel removal} -body { + set ::retval no_selection + pack [text .t] + .t insert end "nothing special\n" + .t tag add sel 1.0 1.1 + bind .t <> "set ::retval selection_changed" + update idletasks + .t tag remove 1.0 end + update + set ::retval +} -cleanup { + destroy .t +} -result {selection_changed} +test text-27.15b {<> virtual event on <> inside widget selection} -body { + pack [text .t] + .t insert end "There is a selection in this text widget,\n" + .t insert end "and it will be impacted by the <> event received.\n" + .t insert end "Therefore a <> event must fire back." + .t tag add sel 1.0 1.28 + bind .t <> "set ::retval <>_fired" + update + set ::retval no_<>_event_fired + event generate .t <> -x 15 -y 3 + update + set ::retval +} -cleanup { + destroy .t +} -result {<>_fired} +test text-27.15c {No <> virtual event on <> outside widget selection} -body { + pack [text .t] + .t insert end "There is a selection in this text widget,\n" + .t insert end "but it will not be impacted by the <> event received." + .t tag add sel 1.0 1.28 + bind .t <> "set ::retval <>_fired" + update + set ::retval no_<>_event_fired + event generate .t <> -x 15 -y 80 + update + set ::retval +} -cleanup { + destroy .t +} -result {no_<>_event_fired} +test text-27.15d {<> virtual event on with cursor inside selection} -body { + pack [text .t] + .t insert end "There is a selection in this text widget,\n" + .t insert end "and it will be impacted by the event received.\n" + .t insert end "Therefore a <> event must fire back." + .t tag add sel 1.0 1.28 + bind .t <> "set ::retval <>_fired" + update + set ::retval no_<>_event_fired + .t mark set insert 1.15 + focus .t + event generate .t + update + set ::retval +} -cleanup { + destroy .t +} -result {<>_fired} +test text-27.15e {No <> virtual event on with cursor outside selection} -body { + pack [text .t] + .t insert end "There is a selection in this text widget,\n" + .t insert end "but it will not be impacted by the event received." + .t tag add sel 1.0 1.28 + bind .t <> "set ::retval <>_fired" + update + set ::retval no_<>_event_fired + .t mark set insert 2.15 + focus .t + event generate .t + update + set ::retval +} -cleanup { + destroy .t +} -result {no_<>_event_fired} +test text-27.15f {<> virtual event on <> with a widget selection} -body { + pack [text .t] + .t insert end "There is a selection in this text widget,\n" + .t insert end "and it will be impacted by the <> event received.\n" + .t insert end "Therefore a <> event must fire back." + .t tag add sel 1.0 1.28 + bind .t <> "set ::retval <>_fired" + update + set ::retval no_<>_event_fired + event generate .t <> + update + set ::retval +} -cleanup { + destroy .t +} -result {<>_fired} +test text-27.15g {No <> virtual event on <> without widget selection} -body { + pack [text .t] + .t insert end "There is a selection in this text widget,\n" + .t insert end "and it will be impacted by the <> event received.\n" + .t insert end "Therefore a <> event must fire back." + bind .t <> "set ::retval <>_fired" + update + set ::retval no_<>_event_fired + event generate .t <> + update + set ::retval +} -cleanup { + destroy .t +} -result {no_<>_event_fired} test text-27.16 {-maxundo configuration option} -body { text .t -undo 1 -autoseparators 1 -maxundo 2 pack .t diff --git a/tests/textDisp.test b/tests/textDisp.test index 115b8cff..208f6640 100644 --- a/tests/textDisp.test +++ b/tests/textDisp.test @@ -3374,6 +3374,16 @@ test textDisp-24.24 {TkTextCharLayoutProc, justification and tabs} {textfonts} { .t tag add x 1.0 end list [.t bbox 1.0] [.t bbox 1.10] } [list [list 45 3 7 $fixedHeight] [list 94 3 7 $fixedHeight]] +test textDisp-24.25 {TkTextCharLayoutProc, justification and tabs} -constraints {textfonts} -setup { + text .tt -tabs {40 right} -wrap none -font $fixedFont + pack .tt +} -body { + .tt insert end \t9\n\t99\n\t999 + update + list [.tt bbox 1.1] [.tt bbox 2.2] [.tt bbox 3.3] +} -cleanup { + destroy .tt +} -result [list [list 38 5 7 $fixedHeight] [list 38 20 7 $fixedHeight] [list 38 35 7 $fixedHeight]] .t configure -width 40 -bd 0 -relief flat -highlightthickness 0 -padx 0 \ -tabs 100 diff --git a/tests/textTag.test b/tests/textTag.test index ddbaa3be..9bab5fb9 100644 --- a/tests/textTag.test +++ b/tests/textTag.test @@ -1746,6 +1746,7 @@ test textTag-18.1 {TkTextPickCurrent tag bindings} -setup { text .t -width 30 -height 4 -relief sunken -borderwidth 10 \ -highlightthickness 10 -pady 2 pack .t + update ; # map the window, otherwise -warp can't be done .t insert end " Tag here " TAG " no tag here" .t tag configure TAG -borderwidth 4 -relief raised diff --git a/tests/textWind.test b/tests/textWind.test index fd29e198..5f0c9b0c 100644 --- a/tests/textWind.test +++ b/tests/textWind.test @@ -11,28 +11,26 @@ namespace import ::tcltest::* tcltest::configure {*}$argv tcltest::loadTestedCommands -# Create entries in the option database to be sure that geometry options -# like border width have predictable values. - -option add *Text.borderWidth 2 -option add *Text.highlightThickness 2 -option add *Text.font {Courier -12} - - deleteWindows -# Widget used in tests 1.* - 16.* -text .t -width 30 -height 6 -bd 2 -highlightthickness 2 + +set fixedFont {"Courier New" -12} +set fixedHeight [font metrics $fixedFont -linespace] +set fixedWidth [font measure $fixedFont m] +set fixedAscent [font metrics $fixedFont -ascent] + +# Widget used in almost all tests +set tWidth 30 +set tHeight 6 +text .t -width $tWidth -height $tHeight -bd 2 -highlightthickness 2 \ + -font $fixedFont pack .t -expand 1 -fill both update .t debug on -# 15 on XP, 13 on Solaris 8 -set fixedHeight [font metrics {Courier -12} -linespace] -set fixedDiff [expr {$fixedHeight - 13}] ;# 2 on XP set color [expr {[winfo depth .t] > 1 ? "green" : "black"}] wm geometry . {} - + # The statements below reset the main window; it's needed if the window # manager is mwm to make mwm forget about a previous minimum size setting. @@ -41,9 +39,16 @@ wm minsize . 1 1 wm positionfrom . user wm deiconify . +set bw [.t cget -borderwidth] +set px [.t cget -padx] +set py [.t cget -pady] +set hlth [.t cget -highlightthickness] +set padx [expr {$bw+$px+$hlth}] +set pady [expr {$bw+$py+$hlth}] + # ---------------------------------------------------------------------- -test textWind-1.1 {basic tests of options} -constraints fonts -setup { +test textWind-1.1 {basic tests of options} -setup { .t delete 1.0 end } -body { .t insert end "This is the first line" @@ -53,8 +58,13 @@ test textWind-1.1 {basic tests of options} -constraints fonts -setup { update list [winfo ismapped .f] [winfo geom .f] [.t bbox .f] \ [.t window configure .f -window] -} -result {1 3x3+19+23 {19 23 3 3} {-window {} {} {} .f}} -test textWind-1.2 {basic tests of options} -constraints fonts -setup { +} -result [list \ + 1 \ + 3x3+[expr {$padx+2*$fixedWidth}]+[expr {$pady+$fixedHeight+(($fixedHeight-3)/2)}] \ + [list [expr {$padx+2*$fixedWidth}] [expr {$pady+$fixedHeight+(($fixedHeight-3)/2)}] 3 3] \ + {-window {} {} {} .f}] + +test textWind-1.2 {basic tests of options} -setup { .t delete 1.0 end } -body { .t insert end "This is the first line" @@ -64,7 +74,12 @@ test textWind-1.2 {basic tests of options} -constraints fonts -setup { update list [winfo ismapped .f] [winfo geom .f] [.t bbox .f] \ [.t window configure .f -align] -} -result {1 3x3+19+18 {19 18 3 3} {-align {} {} center top}} +} -result [list \ + 1 \ + 3x3+[expr {$padx+2*$fixedWidth}]+[expr {$pady+$fixedHeight}] \ + [list [expr {$padx+2*$fixedWidth}] [expr {$pady+$fixedHeight}] 3 3] \ + {-align {} {} center top}] + test textWind-1.3 {basic tests of options} -setup { .t delete 1.0 end } -body { @@ -73,17 +88,23 @@ test textWind-1.3 {basic tests of options} -setup { .t window create 2.2 -create "Test script" .t window configure 2.2 -create } -result {-create {} {} {} {Test script}} -test textWind-1.4 {basic tests of options} -constraints fonts -setup { + +test textWind-1.4 {basic tests of options} -setup { .t delete 1.0 end } -body { .t insert end "This is the first line" .t insert end "\nAnd this is a second line, which wraps around" + # the window .f should be wider than the fixed width frame .f -width 10 -height 20 -bg $color .t window create 2.2 -window .f -padx 5 update list [winfo geom .f] [.t window configure .f -padx] [.t bbox 2.3] -} -result {10x20+24+18 {-padx {} {} 0 5} {39 21 7 13}} -test textWind-1.5 {basic tests of options} -constraints fonts -setup { +} -result [list \ + 10x20+[expr {$padx+2*$fixedWidth+5}]+[expr {$pady+$fixedHeight}] \ + {-padx {} {} 0 5} \ + [list [expr {$padx+2*$fixedWidth+10+2*5}] [expr {$pady+$fixedHeight+((20-$fixedHeight)/2)}] $fixedWidth $fixedHeight]] + +test textWind-1.5 {basic tests of options} -setup { .t delete 1.0 end } -body { .t insert end "This is the first line" @@ -92,8 +113,12 @@ test textWind-1.5 {basic tests of options} -constraints fonts -setup { .t window create 2.2 -window .f -pady 4 update list [winfo geom .f] [.t window configure .f -pady] [.t bbox 2.31] -} -result {10x20+19+22 {-pady {} {} 0 4} {19 46 7 13}} -test textWind-1.6 {basic tests of options} -constraints fonts -setup { +} -result [list \ + 10x20+[expr {$padx+2*$fixedWidth}]+[expr {$pady+$fixedHeight+4}] \ + {-pady {} {} 0 4} \ + [list [expr {$padx+2*$fixedWidth}] [expr {$pady+$fixedHeight+20+2*4}] $fixedWidth $fixedHeight]] + +test textWind-1.6 {basic tests of options} -setup { .t delete 1.0 end } -body { .t insert end "This is the first line" @@ -102,7 +127,9 @@ test textWind-1.6 {basic tests of options} -constraints fonts -setup { .t window create 2.2 -window .f -stretch 1 update list [winfo geom .f] [.t window configure .f -stretch] -} -result {5x13+19+18 {-stretch {} {} 0 1}} +} -result [list \ + 5x$fixedHeight+[expr {$padx+2*$fixedWidth}]+[expr {$pady+$fixedHeight}] \ + {-stretch {} {} 0 1}] .t delete 1.0 end @@ -301,7 +328,8 @@ test textWind-3.1 {EmbWinConfigure procedure} -setup { } -cleanup { destroy .f } -returnCodes error -result {unknown option "-foo"} -test textWind-3.2 {EmbWinConfigure procedure} -constraints fonts -setup { + +test textWind-3.2 {EmbWinConfigure procedure} -setup { destroy .f } -body { .t insert 1.0 "Some sample text" @@ -314,7 +342,8 @@ test textWind-3.2 {EmbWinConfigure procedure} -constraints fonts -setup { } -cleanup { destroy .f } -returnCodes error -result {bad text index ".f"} -test textWind-3.3 {EmbWinConfigure procedure} -constraints fonts -setup { + +test textWind-3.3 {EmbWinConfigure procedure} -setup { destroy .f } -body { .t insert 1.0 "Some sample text" @@ -327,8 +356,10 @@ test textWind-3.3 {EmbWinConfigure procedure} -constraints fonts -setup { list [winfo ismapped .f] [.t bbox 1.4] } -cleanup { destroy .f -} -result {0 {26 5 7 13}} -test textWind-3.4 {EmbWinConfigure procedure} -constraints fonts -setup { +} -result [list 0 \ + [list [expr {$padx+3*$fixedWidth}] $pady $fixedWidth $fixedHeight]] + +test textWind-3.4 {EmbWinConfigure procedure} -setup { destroy .t.f } -body { .t insert 1.0 "Some sample text" @@ -341,7 +372,8 @@ test textWind-3.4 {EmbWinConfigure procedure} -constraints fonts -setup { } -cleanup { destroy .t.f } -returnCodes error -result {bad text index ".t.f"} -test textWind-3.5 {EmbWinConfigure procedure} -constraints fonts -setup { + +test textWind-3.5 {EmbWinConfigure procedure} -setup { destroy .t.f } -body { .t insert 1.0 "Some sample text" @@ -354,8 +386,10 @@ test textWind-3.5 {EmbWinConfigure procedure} -constraints fonts -setup { list [winfo ismapped .t.f] [.t bbox 1.4] } -cleanup { destroy .t.f -} -result {0 {26 5 7 13}} -test textWind-3.6 {EmbWinConfigure procedure} -constraints fonts -setup { +} -result [list 0 \ + [list [expr {$padx+3*$fixedWidth}] $pady $fixedWidth $fixedHeight]] + +test textWind-3.6 {EmbWinConfigure procedure} -setup { destroy .f } -body { .t insert 1.0 "Some sample text" @@ -367,7 +401,9 @@ test textWind-3.6 {EmbWinConfigure procedure} -constraints fonts -setup { list [catch {.t index .f} msg] $msg [winfo ismapped .f] [.t bbox 1.4] } -cleanup { destroy .f -} -result {0 1.3 1 {36 8 7 13}} +} -result [list 0 1.3 1 \ + [list [expr {$padx+3*$fixedWidth+10}] [expr {$pady+((20-$fixedHeight)/2)}] $fixedWidth $fixedHeight]] + test textWind-3.7 {EmbWinConfigure procedure} -setup { destroy .f } -body { @@ -450,19 +486,19 @@ test textWind-4.6 {AlignParseProc and AlignPrintProc procedures} -body { .t window configure 1.0 -align } -result {-align {} {} center top} +test textWind-5.1 {EmbWinStructureProc procedure} -setup { + .t delete 1.0 end + destroy .f +} -body { + .t insert 1.0 "Some sample text" + frame .f -width 10 -height 20 -bg $color + .t window create 1.2 -window .f + update + destroy .f + .t index .f +} -returnCodes error -result {bad text index ".f"} -test textWind-5.1 {EmbWinStructureProc procedure} -constraints fonts -setup { - .t delete 1.0 end - destroy .f -} -body { - .t insert 1.0 "Some sample text" - frame .f -width 10 -height 20 -bg $color - .t window create 1.2 -window .f - update - destroy .f - .t index .f -} -returnCodes error -result {bad text index ".f"} -test textWind-5.2 {EmbWinStructureProc procedure} -constraints fonts -setup { +test textWind-5.2 {EmbWinStructureProc procedure} -setup { .t delete 1.0 end destroy .f } -body { @@ -473,8 +509,11 @@ test textWind-5.2 {EmbWinStructureProc procedure} -constraints fonts -setup { destroy .f catch {.t index .f} list [.t bbox 1.2] [.t bbox 1.3] -} -result {{19 11 0 0} {19 5 7 13}} -test textWind-5.3 {EmbWinStructureProc procedure} -constraints fonts -setup { +} -result [list \ + [list [expr {$padx+2*$fixedWidth}] [expr {$pady+($fixedHeight/2)}] 0 0] \ + [list [expr {$padx+2*$fixedWidth}] $pady $fixedWidth $fixedHeight]] + +test textWind-5.3 {EmbWinStructureProc procedure} -setup { .t delete 1.0 end destroy .f } -body { @@ -486,7 +525,8 @@ test textWind-5.3 {EmbWinStructureProc procedure} -constraints fonts -setup { destroy .f .t index .f } -returnCodes error -result {bad text index ".f"} -test textWind-5.4 {EmbWinStructureProc procedure} -constraints fonts -setup { + +test textWind-5.4 {EmbWinStructureProc procedure} -setup { .t delete 1.0 end } -body { .t insert 1.0 "Some sample text" @@ -497,8 +537,11 @@ test textWind-5.4 {EmbWinStructureProc procedure} -constraints fonts -setup { destroy .f catch {.t index .f} list [.t bbox 1.2] [.t bbox 1.3] -} -result {{19 18 0 0} {19 5 7 13}} -test textWind-5.5 {EmbWinStructureProc procedure} -constraints fonts -setup { +} -result [list \ + [list [expr {$padx+2*$fixedWidth}] [expr {$pady+$fixedHeight}] 0 0] \ + [list [expr {$padx+2*$fixedWidth}] $pady $fixedWidth $fixedHeight]] + +test textWind-5.5 {EmbWinStructureProc procedure} -setup { .t delete 1.0 end destroy .f } -body { @@ -509,10 +552,12 @@ test textWind-5.5 {EmbWinStructureProc procedure} -constraints fonts -setup { destroy .f update list [catch {.t index .f} msg] $msg [.t bbox 1.2] [.t bbox 1.3] -} -result {0 1.2 {19 6 20 10} {39 5 7 13}} +} -result [list 0 1.2 \ + [list [expr {$padx+2*$fixedWidth}] [expr {$pady+(($fixedHeight-10)/2)}] 20 10] \ + [list [expr {$padx+2*$fixedWidth+20}] $pady $fixedWidth $fixedHeight]] -test textWind-6.1 {EmbWinRequestProc procedure} -constraints fonts -setup { +test textWind-6.1 {EmbWinRequestProc procedure} -setup { .t delete 1.0 end destroy .f set result {} @@ -525,12 +570,14 @@ test textWind-6.1 {EmbWinRequestProc procedure} -constraints fonts -setup { lappend result [.t bbox 1.2] [.t bbox 1.3] } -cleanup { destroy .f -} -result {{19 5 10 20} {29 8 7 13} {19 5 25 30} {44 13 7 13}} +} -result [list \ + [list [expr {$padx+2*$fixedWidth}] $pady 10 20] \ + [list [expr {$padx+2*$fixedWidth+10}] [expr {$pady+((20-$fixedHeight)/2)}] $fixedWidth $fixedHeight] \ + [list [expr {$padx+2*$fixedWidth}] $pady 25 30] \ + [list [expr {$padx+2*$fixedWidth+25}] [expr {$pady+((30-$fixedHeight)/2)}] $fixedWidth $fixedHeight]] -test textWind-7.1 {EmbWinLostSlaveProc procedure} -constraints { - textfonts -} -setup { +test textWind-7.1 {EmbWinLostSlaveProc procedure} -setup { .t delete 1.0 end destroy .f } -body { @@ -543,10 +590,11 @@ test textWind-7.1 {EmbWinLostSlaveProc procedure} -constraints { list [winfo geom .f] [.t bbox 1.2] } -cleanup { destroy .f -} -result [list 10x20+105+55 [list 19 [expr {11+$fixedDiff/2}] 0 0]] -test textWind-7.2 {EmbWinLostSlaveProc procedure} -constraints { - textfonts -} -setup { +} -result [list \ + 10x20+[expr {$padx+100}]+[expr {$pady+50}] \ + [list [expr {$padx+2*$fixedWidth}] [expr {$pady+($fixedHeight/2)}] 0 0]] + +test textWind-7.2 {EmbWinLostSlaveProc procedure} -setup { .t delete 1.0 end destroy .t.f } -body { @@ -559,10 +607,11 @@ test textWind-7.2 {EmbWinLostSlaveProc procedure} -constraints { list [winfo geom .t.f] [.t bbox 1.2] } -cleanup { destroy .t.f -} -result [list 10x20+105+55 [list 19 [expr {11+$fixedDiff/2}] 0 0]] +} -result [list \ + 10x20+[expr {$padx+100}]+[expr {$pady+50}] \ + [list [expr {$padx+2*$fixedWidth}] [expr {$pady+($fixedHeight/2)}] 0 0]] - -test textWind-8.1 {EmbWinDeleteProc procedure} -constraints fonts -setup { +test textWind-8.1 {EmbWinDeleteProc procedure} -setup { .t delete 1.0 end destroy .f } -body { @@ -573,8 +622,12 @@ test textWind-8.1 {EmbWinDeleteProc procedure} -constraints fonts -setup { set x XXX .t delete 1.2 list $x [.t bbox 1.2] [.t bbox 1.3] [winfo exists .f] -} -result {destroyed {19 5 7 13} {26 5 7 13} 0} -test textWind-8.2 {EmbWinDeleteProc procedure} -constraints fonts -setup { +} -result [list destroyed \ + [list [expr {$padx+2*$fixedWidth}] $pady $fixedWidth $fixedHeight] \ + [list [expr {$padx+3*$fixedWidth}] $pady $fixedWidth $fixedHeight] \ + 0] + +test textWind-8.2 {EmbWinDeleteProc procedure} -setup { .t delete 1.0 end destroy .f } -body { @@ -615,9 +668,8 @@ test textWind-10.1 {EmbWinLayoutProc procedure} -setup { } -cleanup { destroy .f } -result {1 10 20 1.5} -test textWind-10.2 {EmbWinLayoutProc procedure, error in creating window} -constraints { - fonts -} -setup { + +test textWind-10.2 {EmbWinLayoutProc procedure, error in creating window} -setup { .t delete 1.0 end proc bgerror args { global msg @@ -625,7 +677,7 @@ test textWind-10.2 {EmbWinLayoutProc procedure, error in creating window} -const } } -body { .t insert 1.0 "Some sample text" - .t window create 1.5 -create { + .t window create 1.5 -create { error "couldn't create window" } set msg xyzzy @@ -633,10 +685,11 @@ test textWind-10.2 {EmbWinLayoutProc procedure, error in creating window} -const list $msg [.t bbox 1.5] } -cleanup { rename bgerror {} -} -result {{{couldn't create window}} {40 11 0 0}} -test textWind-10.3 {EmbWinLayoutProc procedure, error in creating window} -constraints { - fonts -} -setup { +} -result [list \ + {{couldn't create window}} \ + [list [expr {$padx+5*$fixedWidth}] [expr {$pady+($fixedHeight/2)}] 0 0]] + +test textWind-10.3 {EmbWinLayoutProc procedure, error in creating window} -setup { .t delete 1.0 end proc bgerror args { global msg @@ -652,26 +705,16 @@ test textWind-10.3 {EmbWinLayoutProc procedure, error in creating window} -const list $msg [.t bbox 1.5] } -cleanup { rename bgerror {} -} -result {{{bad window path name "gorp"}} {40 11 0 0}} - .t delete 1.0 end - destroy .t.f - proc bgerror args { - global msg - if {[lsearch -exact $msg $args] == -1} { - lappend msg $args - } - } +} -result [list \ + {{bad window path name "gorp"}} \ + [list [expr {$padx+5*$fixedWidth}] [expr {$pady+($fixedHeight/2)}] 0 0]] -test textWind-10.4 {EmbWinLayoutProc procedure, error in creating window} -constraints { - textfonts -} -setup { +test textWind-10.4 {EmbWinLayoutProc procedure, error in creating window} -setup { .t delete 1.0 end destroy .t.f proc bgerror args { global msg - if {[lsearch -exact $msg $args] == -1} { - lappend msg $args - } + lappend msg $args } } -body { .t insert 1.0 "Some sample text" @@ -693,17 +736,17 @@ test textWind-10.4 {EmbWinLayoutProc procedure, error in creating window} -const } -cleanup { destroy .t.f rename bgerror {} -} -result [list {{can't embed .t.f.f relative to .t}} {{window name "f" already exists in parent}} [list 40 [expr {11+$fixedDiff/2}] 0 0] 1] -test textWind-10.5 {EmbWinLayoutProc procedure, error in creating window} -constraints { - textfonts -} -setup { +} -result [list \ + {{can't embed .t.f.f relative to .t}} {{window name "f" already exists in parent}} \ + [list [expr {$padx+5*$fixedWidth}] [expr {$pady+($fixedHeight/2)}] 0 0] \ + 1] + +test textWind-10.5 {EmbWinLayoutProc procedure, error in creating window} -setup { .t delete 1.0 end destroy .t.f proc bgerror args { global msg - if {[lsearch -exact $msg $args] == -1} { - lappend msg $args - } + lappend msg $args } } -body { .t insert 1.0 "Some sample text" @@ -718,10 +761,8 @@ test textWind-10.5 {EmbWinLayoutProc procedure, error in creating window} -const destroy .t.f rename bgerror {} } -result {{{can't embed .t.f.f relative to .t}} 1} -catch {destroy .t.f} -test textWind-10.6 {EmbWinLayoutProc procedure, error in creating window} -constraints { - textfonts -} -setup { + +test textWind-10.6 {EmbWinLayoutProc procedure, error in creating window} -setup { .t delete 1.0 end proc bgerror args { global msg @@ -731,6 +772,7 @@ test textWind-10.6 {EmbWinLayoutProc procedure, error in creating window} -const } } -body { .t insert 1.0 "Some sample text" + update .t window create 1.5 -create { concat .t } @@ -739,17 +781,16 @@ test textWind-10.6 {EmbWinLayoutProc procedure, error in creating window} -const lappend msg [.t bbox 1.5] } -cleanup { rename bgerror {} -} -result [list {{can't embed .t relative to .t}} [list 40 [expr {11+$fixedDiff/2}] 0 0]] -test textWind-10.7 {EmbWinLayoutProc procedure, error in creating window} -constraints { - textfonts -} -setup { +} -result [list \ + {{can't embed .t relative to .t}} \ + [list [expr {$padx+5*$fixedWidth}] [expr {$pady+($fixedHeight/2)}] 0 0]] + +test textWind-10.7 {EmbWinLayoutProc procedure, error in creating window} -setup { .t delete 1.0 end destroy .t2 proc bgerror args { global msg - if {[lsearch -exact $msg $args] == -1} { - lappend msg $args - } + lappend msg $args } } -body { .t insert 1.0 "Some sample text" @@ -763,15 +804,16 @@ test textWind-10.7 {EmbWinLayoutProc procedure, error in creating window} -const lappend msg [.t bbox 1.5] } -cleanup { rename bgerror {} -} -result [list {{can't embed .t2 relative to .t}} {{window name "t2" already exists in parent}} [list 40 [expr {11+$fixedDiff/2}] 0 0]] +} -result [list \ + {{can't embed .t2 relative to .t}} {{window name "t2" already exists in parent}} \ + [list [expr {$padx+5*$fixedWidth}] [expr {$pady+($fixedHeight/2)}] 0 0]] + test textWind-10.8 {EmbWinLayoutProc procedure, error in creating window} -setup { .t delete 1.0 end destroy .t2 proc bgerror args { global msg - if {[lsearch -exact $msg $args] == -1} { - lappend msg $args - } + lappend msg $args } } -body { .t insert 1.0 "Some sample text" @@ -804,9 +846,8 @@ test textWind-10.9 {EmbWinLayoutProc procedure, steal window from self} -setup { } -cleanup { destroy .t.b } -result {1.3} -test textWind-10.10 {EmbWinLayoutProc procedure, doesn't fit on line} -constraints { - fonts -} -setup { + +test textWind-10.10 {EmbWinLayoutProc procedure, doesn't fit on line} -setup { .t delete 1.0 end destroy .f } -body { @@ -817,10 +858,11 @@ test textWind-10.10 {EmbWinLayoutProc procedure, doesn't fit on line} -constrain list [.t bbox .f] [.t bbox 1.13] } -cleanup { destroy .f -} -result {{89 5 126 20} {5 25 7 13}} -test textWind-10.11 {EmbWinLayoutProc procedure, doesn't fit on line} -constraints { - fonts -} -setup { +} -result [list \ + [list [expr {$padx+12*$fixedWidth}] $pady [expr {$tWidth*$fixedWidth-12*$fixedWidth}] 20] \ + [list $padx [expr {$pady+20}] $fixedWidth $fixedHeight]] + +test textWind-10.11 {EmbWinLayoutProc procedure, doesn't fit on line} -setup { .t delete 1.0 end destroy .f } -body { @@ -832,10 +874,11 @@ test textWind-10.11 {EmbWinLayoutProc procedure, doesn't fit on line} -constrain list [.t bbox .f] [.t bbox 1.13] } -cleanup { destroy .f -} -result {{89 5 126 20} {5 25 7 13}} -test textWind-10.12 {EmbWinLayoutProc procedure, doesn't fit on line} -constraints { - fonts -} -setup { +} -result [list \ + [list [expr {$padx+12*$fixedWidth}] $pady [expr {$tWidth*$fixedWidth-12*$fixedWidth}] 20] \ + [list $padx [expr {$pady+20}] $fixedWidth $fixedHeight]] + +test textWind-10.12 {EmbWinLayoutProc procedure, doesn't fit on line} -setup { .t delete 1.0 end destroy .f } -body { @@ -847,7 +890,10 @@ test textWind-10.12 {EmbWinLayoutProc procedure, doesn't fit on line} -constrain list [.t bbox .f] [.t bbox 1.13] } -cleanup { destroy .f -} -result {{5 18 127 20} {132 21 7 13}} +} -result [list \ + [list $padx [expr {$pady+$fixedHeight}] 127 20] \ + [list [expr {$padx+127}] [expr {$pady+$fixedHeight+((20-$fixedHeight)/2)}] $fixedWidth $fixedHeight]] + test textWind-10.13 {EmbWinLayoutProc procedure, doesn't fit on line} -setup { .t delete 1.0 end destroy .f @@ -860,10 +906,11 @@ test textWind-10.13 {EmbWinLayoutProc procedure, doesn't fit on line} -setup { list [.t bbox .f] [.t bbox 1.13] } -cleanup { destroy .f -} -result {{89 5 126 20} {}} -test textWind-10.14 {EmbWinLayoutProc procedure, doesn't fit on line} -constraints { - fonts -} -setup { +} -result [list \ + [list [expr {$padx+12*$fixedWidth}] $pady [expr {$tWidth*$fixedWidth-12*$fixedWidth}] 20] \ + {}] + +test textWind-10.14 {EmbWinLayoutProc procedure, doesn't fit on line} -setup { .t delete 1.0 end destroy .f } -body { @@ -875,10 +922,11 @@ test textWind-10.14 {EmbWinLayoutProc procedure, doesn't fit on line} -constrain list [.t bbox .f] [.t bbox 1.13] } -cleanup { destroy .f -} -result {{89 5 126 78} {}} -test textWind-10.15 {EmbWinLayoutProc procedure, doesn't fit on line} -constraints { - fonts -} -setup { +} -result [list \ + [list [expr {$padx+12*$fixedWidth}] $pady [expr {$tWidth*$fixedWidth-12*$fixedWidth}] [expr {$tHeight*$fixedHeight}]] \ + {}] + +test textWind-10.15 {EmbWinLayoutProc procedure, doesn't fit on line} -setup { .t delete 1.0 end destroy .f } -body { @@ -890,8 +938,9 @@ test textWind-10.15 {EmbWinLayoutProc procedure, doesn't fit on line} -constrain list [.t bbox .f] [.t bbox 1.13] } -cleanup { destroy .f -} -result {{5 18 210 65} {}} - +} -result [list \ + [list $padx [expr {$pady+$fixedHeight}] [expr {$tWidth*$fixedWidth}] [expr {($tHeight-1)*$fixedHeight}]] \ + {}] test textWind-11.1 {EmbWinDisplayProc procedure, geometry transforms} -setup { .t delete 1.0 end @@ -909,7 +958,8 @@ test textWind-11.1 {EmbWinDisplayProc procedure, geometry transforms} -setup { } -cleanup { destroy .f place forget .t -} -result {30x20+119+55} +} -result [list 30x20+[expr {$padx+30+12*$fixedWidth}]+[expr {$pady+50}]] + test textWind-11.2 {EmbWinDisplayProc procedure, geometry transforms} -setup { .t delete 1.0 end destroy .t.f @@ -927,7 +977,8 @@ test textWind-11.2 {EmbWinDisplayProc procedure, geometry transforms} -setup { destroy .t.f place forget .t pack .t -} -result {30x20+89+5} +} -result [list 30x20+[expr {$padx+12*$fixedWidth}]+$pady] + test textWind-11.3 {EmbWinDisplayProc procedure, configuration optimization} -setup { .t delete 1.0 end destroy .f @@ -949,9 +1000,8 @@ test textWind-11.3 {EmbWinDisplayProc procedure, configuration optimization} -se place forget .t pack .t } -result {no configures} -test textWind-11.4 {EmbWinDisplayProc procedure, horizontal scrolling} -constraints { - fonts -} -setup { + +test textWind-11.4 {EmbWinDisplayProc procedure, horizontal scrolling} -setup { .t delete 1.0 end destroy .f .f2 } -body { @@ -969,10 +1019,12 @@ test textWind-11.4 {EmbWinDisplayProc procedure, horizontal scrolling} -constrai list [winfo ismapped .f] [winfo geom .f] [.t bbox .f] [winfo ismapped .f2] } -cleanup { destroy .f .f2 -} -result {1 30x20+103+18 {103 18 30 20} 0} -test textWind-11.5 {EmbWinDisplayProc procedure, horizontal scrolling} -constraints { - fonts -} -setup { +} -result [list 1 \ + 30x20+[expr {$padx+14*$fixedWidth}]+[expr {$pady+$fixedHeight}] \ + [list [expr {$padx+14*$fixedWidth}] [expr {$pady+$fixedHeight}] 30 20] \ + 0] + +test textWind-11.5 {EmbWinDisplayProc procedure, horizontal scrolling} -setup { .t delete 1.0 end destroy .f .f2 } -body { @@ -990,10 +1042,11 @@ test textWind-11.5 {EmbWinDisplayProc procedure, horizontal scrolling} -constrai update list [winfo ismapped .f] [winfo ismapped .f2] [winfo geom .f2] [.t bbox .f2] } -cleanup { - destroy .f .f2 -} -result {0 1 40x10+119+23 {119 23 40 10}} -.t configure -wrap char - + destroy .f .f2 + .t configure -wrap char +} -result [list 0 1 \ + 40x10+[expr {$padx+37*$fixedWidth+30-25*$fixedWidth}]+[expr {$pady+$fixedHeight+((20-10)/2)}] \ + [list [expr {$padx+37*$fixedWidth+30-25*$fixedWidth}] [expr {$pady+$fixedHeight+((20-10)/2)}] 40 10]] test textWind-12.1 {EmbWinUndisplayProc procedure, mapping/unmapping} -setup { .t delete 1.0 end @@ -1035,8 +1088,11 @@ test textWind-13.1 {EmbWinBboxProc procedure} -setup { list [winfo geom .f] [.t bbox .f] } -cleanup { destroy .f -} -result {5x5+21+6 {21 6 5 5}} -test textWind-13.2 {EmbWinBboxProc procedure} -constraints fonts -setup { +} -result [list \ + 5x5+[expr {$padx+2*$fixedWidth+2}]+[expr {$pady+1}] \ + [list [expr {$padx+2*$fixedWidth+2}] [expr {$pady+1}] 5 5]] + +test textWind-13.2 {EmbWinBboxProc procedure} -setup { .t delete 1.0 end destroy .f } -body { @@ -1047,8 +1103,11 @@ test textWind-13.2 {EmbWinBboxProc procedure} -constraints fonts -setup { list [winfo geom .f] [.t bbox .f] } -cleanup { destroy .f -} -result {5x5+21+9 {21 9 5 5}} -test textWind-13.3 {EmbWinBboxProc procedure} -constraints fonts -setup { +} -result [list \ + 5x5+[expr {$padx+2*$fixedWidth+2}]+[expr {$pady+1+(($fixedHeight-7)/2)}] \ + [list [expr {$padx+2*$fixedWidth+2}] [expr {$pady+1+(($fixedHeight-7)/2)}] 5 5]] + +test textWind-13.3 {EmbWinBboxProc procedure} -setup { .t delete 1.0 end destroy .f } -body { @@ -1059,8 +1118,11 @@ test textWind-13.3 {EmbWinBboxProc procedure} -constraints fonts -setup { list [winfo geom .f] [.t bbox .f] } -cleanup { destroy .f -} -result {5x5+21+10 {21 10 5 5}} -test textWind-13.4 {EmbWinBboxProc procedure} -constraints fonts -setup { +} -result [list \ + 5x5+[expr {$padx+2*$fixedWidth+2}]+[expr {$pady+1+($fixedAscent-6)}] \ + [list [expr {$padx+2*$fixedWidth+2}] [expr {$pady+1+($fixedAscent-6)}] 5 5]] + +test textWind-13.4 {EmbWinBboxProc procedure} -setup { .t delete 1.0 end destroy .f } -body { @@ -1071,8 +1133,11 @@ test textWind-13.4 {EmbWinBboxProc procedure} -constraints fonts -setup { list [winfo geom .f] [.t bbox .f] } -cleanup { destroy .f -} -result {5x5+21+12 {21 12 5 5}} -test textWind-13.5 {EmbWinBboxProc procedure} -constraints fonts -setup { +} -result [list \ + 5x5+[expr {$padx+2*$fixedWidth+2}]+[expr {$pady+1+($fixedHeight-7)}] \ + [list [expr {$padx+2*$fixedWidth+2}] [expr {$pady+1+($fixedHeight-7)}] 5 5]] + +test textWind-13.5 {EmbWinBboxProc procedure} -setup { .t delete 1.0 end destroy .f } -body { @@ -1083,8 +1148,11 @@ test textWind-13.5 {EmbWinBboxProc procedure} -constraints fonts -setup { list [winfo geom .f] [.t bbox .f] } -cleanup { destroy .f -} -result {5x11+21+6 {21 6 5 11}} -test textWind-13.6 {EmbWinBboxProc procedure} -constraints fonts -setup { +} -result [list \ + 5x[expr {$fixedHeight-2}]+[expr {$padx+2*$fixedWidth+2}]+[expr {$pady+1}] \ + [list [expr {$padx+2*$fixedWidth+2}] [expr {$pady+1}] 5 [expr {$fixedHeight-2}]]] + +test textWind-13.6 {EmbWinBboxProc procedure} -setup { .t delete 1.0 end destroy .f } -body { @@ -1095,8 +1163,11 @@ test textWind-13.6 {EmbWinBboxProc procedure} -constraints fonts -setup { list [winfo geom .f] [.t bbox .f] } -cleanup { destroy .f -} -result {5x11+21+6 {21 6 5 11}} -test textWind-13.7 {EmbWinBboxProc procedure} -constraints fonts -setup { +} -result [list \ + 5x[expr {$fixedHeight-2}]+[expr {$padx+2*$fixedWidth+2}]+[expr {$pady+1}] \ + [list [expr {$padx+2*$fixedWidth+2}] [expr {$pady+1}] 5 [expr {$fixedHeight-2}]]] + +test textWind-13.7 {EmbWinBboxProc procedure} -setup { .t delete 1.0 end destroy .f } -body { @@ -1107,8 +1178,11 @@ test textWind-13.7 {EmbWinBboxProc procedure} -constraints fonts -setup { list [winfo geom .f] [.t bbox .f] } -cleanup { destroy .f -} -result {5x9+21+6 {21 6 5 9}} -test textWind-13.8 {EmbWinBboxProc procedure} -constraints fonts -setup { +} -result [list \ + 5x[expr {$fixedAscent-1}]+[expr {$padx+2*$fixedWidth+2}]+[expr {$pady+1}] \ + [list [expr {$padx+2*$fixedWidth+2}] [expr {$pady+1}] 5 [expr {$fixedAscent-1}]]] + +test textWind-13.8 {EmbWinBboxProc procedure} -setup { .t delete 1.0 end destroy .f } -body { @@ -1119,10 +1193,11 @@ test textWind-13.8 {EmbWinBboxProc procedure} -constraints fonts -setup { list [winfo geom .f] [.t bbox .f] } -cleanup { destroy .f -} -result {5x11+21+6 {21 6 5 11}} -test textWind-13.9 {EmbWinBboxProc procedure, spacing options} -constraints { - fonts -} -setup { +} -result [list \ + 5x[expr {$fixedHeight-2}]+[expr {$padx+2*$fixedWidth+2}]+[expr {$pady+1}] \ + [list [expr {$padx+2*$fixedWidth+2}] [expr {$pady+1}] 5 [expr {$fixedHeight-2}]]] + +test textWind-13.9 {EmbWinBboxProc procedure, spacing options} -setup { .t delete 1.0 end destroy .f } -body { @@ -1134,8 +1209,11 @@ test textWind-13.9 {EmbWinBboxProc procedure, spacing options} -constraints { update list [winfo geom .f] [.t bbox .f] } -cleanup { + .t configure -spacing1 0 -spacing3 0 destroy .f -} -result {5x5+21+14 {21 14 5 5}} +} -result [list \ + 5x5+[expr {$padx+2*$fixedWidth+2}]+[expr {$pady+5+(($fixedHeight-5)/2)}] \ + [list [expr {$padx+2*$fixedWidth+2}] [expr {$pady+5+(($fixedHeight-5)/2)}] 5 5]] test textWind-14.1 {EmbWinDelayedUnmap procedure} -setup { @@ -1157,6 +1235,7 @@ test textWind-14.1 {EmbWinDelayedUnmap procedure} -setup { } -cleanup { destroy .f } -result {modified removed unmapped updated} + test textWind-14.2 {EmbWinDelayedUnmap procedure} -setup { .t delete 1.0 end destroy .f @@ -1176,6 +1255,7 @@ test textWind-14.2 {EmbWinDelayedUnmap procedure} -setup { } -cleanup { destroy .f } -result {modified deleted updated} + test textWind-14.3 {EmbWinDelayedUnmap procedure} -setup { .t delete 1.0 end destroy .f @@ -1191,6 +1271,7 @@ test textWind-14.3 {EmbWinDelayedUnmap procedure} -setup { } -cleanup { destroy .f } -result {1 0} + test textWind-14.4 {EmbWinDelayedUnmap procedure} -setup { .t delete 1.0 end destroy .t.f @@ -1207,13 +1288,13 @@ test textWind-14.4 {EmbWinDelayedUnmap procedure} -setup { destroy .t.f } -result {1 0} - test textWind-15.1 {TkTextWindowIndex procedure} -setup { .t delete 1.0 end } -body { .t index .foo } -returnCodes error -result {bad text index ".foo"} -test textWind-15.2 {TkTextWindowIndex procedure} -constraints fonts -setup { + +test textWind-15.2 {TkTextWindowIndex procedure} -setup { .t delete 1.0 end destroy .f } -body { @@ -1227,7 +1308,8 @@ test textWind-15.2 {TkTextWindowIndex procedure} -constraints fonts -setup { list [.t index .f] [.t bbox 1.7] } -cleanup { destroy .f -} -result {1.6 {77 8 7 13}} +} -result [list 1.6 \ + [list [expr {$padx+6*$fixedWidth+30}] [expr {$pady+((20-$fixedHeight)/2)}] $fixedWidth $fixedHeight]] test textWind-16.1 {EmbWinTextStructureProc procedure} -setup { @@ -1245,6 +1327,7 @@ test textWind-16.1 {EmbWinTextStructureProc procedure} -setup { } -cleanup { pack .t } -result 0 + test textWind-16.2 {EmbWinTextStructureProc procedure} -setup { .t delete 1.0 end destroy .f .f2 @@ -1263,7 +1346,12 @@ test textWind-16.2 {EmbWinTextStructureProc procedure} -setup { lappend result [winfo geom .f] [.t bbox .f] } -cleanup { destroy .f .f2 -} -result {30x20+47+5 {47 5 30 20} 30x20+47+35 {47 5 30 20}} +} -result [list \ + 30x20+[expr {$padx+6*$fixedWidth}]+$pady \ + [list [expr {$padx+6*$fixedWidth}] $pady 30 20] \ + 30x20+[expr {$padx+6*$fixedWidth}]+[expr {$pady+30}] \ + [list [expr {$padx+6*$fixedWidth}] $pady 30 20]] + test textWind-16.3 {EmbWinTextStructureProc procedure} -setup { .t delete 1.0 end } -body { @@ -1276,6 +1364,7 @@ test textWind-16.3 {EmbWinTextStructureProc procedure} -setup { } -cleanup { pack .t } -result {} + test textWind-16.4 {EmbWinTextStructureProc procedure} -setup { .t delete 1.0 end } -body { @@ -1290,7 +1379,7 @@ test textWind-16.4 {EmbWinTextStructureProc procedure} -setup { list [winfo ismapped .t.f] [.t bbox .t.f] } -cleanup { pack .t -} -result {1 {47 5 30 20}} +} -result [list 1 [list [expr {$padx+6*$fixedWidth}] $pady 30 20]] test textWind-17.1 {peer widgets and embedded windows} -setup { diff --git a/tests/ttk/checkbutton.test b/tests/ttk/checkbutton.test index 6b792872..15d365ff 100644 --- a/tests/ttk/checkbutton.test +++ b/tests/ttk/checkbutton.test @@ -61,4 +61,13 @@ test checkbutton-1.7 "Button destroyed by click" -body { update ; # shall not trigger error invalid command name ".top.b" } -result {} +# Bug [fa8de77936] +test checkbutton-1.8 "Empty -variable" -body { + # shall simply not crash + ttk::checkbutton .cbev -variable {} + .cbev invoke +} -cleanup { + destroy .cbev +} -result {} + tcltest::cleanupTests diff --git a/tests/ttk/layout.test b/tests/ttk/layout.test index 814e1d96..52f44b4e 100644 --- a/tests/ttk/layout.test +++ b/tests/ttk/layout.test @@ -21,5 +21,8 @@ test layout-1.1 "Size computations for mixed-orientation layouts" -body { } -cleanup { destroy .b } -result [list 24 24] +test layout-2 "Empty -children not allowed" -body { + ttk::style layout Test.Tentry {Entry.field -children {}} +} -returnCodes error -result {Invalid -children value} tcltest::cleanupTests diff --git a/tests/ttk/scrollbar.test b/tests/ttk/scrollbar.test index 04642738..341b5c18 100644 --- a/tests/ttk/scrollbar.test +++ b/tests/ttk/scrollbar.test @@ -65,5 +65,28 @@ test scale-1.0 "Self-destruction" -body { .s set 1 ; update } -returnCodes 1 -match glob -result "*" +test scale-2.1 "-state option" -setup { + ttk::scale .s + set res "" +} -body { + # defaults + lappend res [.s instate disabled] [.s cget -state] + # set -state: instate returns accordingly + .s configure -state disabled + lappend res [.s instate disabled] [.s cget -state] + # back to normal + .s configure -state normal + lappend res [.s instate disabled] [.s cget -state] + # use state command: -state does NOT reflect it + .s state disabled + lappend res [.s instate disabled] [.s cget -state] + # further use state command + .s state readonly + lappend res [.s state] [.s cget -state] +} -cleanup { + destroy .s + unset -nocomplain res +} -result {0 normal 1 disabled 0 normal 1 normal {disabled readonly} normal} + tcltest::cleanupTests diff --git a/tests/unixSelect.test b/tests/unixSelect.test index 53ae0065..a7025876 100644 --- a/tests/unixSelect.test +++ b/tests/unixSelect.test @@ -108,7 +108,7 @@ foreach i {a b c d e f g j h i j k l m o p q r s t u v w x y z} { # ---------------------------------------------------------------------- test unixSelect-1.1 {TkSelGetSelection procedure: simple i18n text} -constraints { - unix + x11 } -setup { destroy .e setupbg @@ -124,7 +124,7 @@ test unixSelect-1.1 {TkSelGetSelection procedure: simple i18n text} -constraints } -result {4} test unixSelect-1.2 {TkSelGetSelection procedure: simple i18n text, iso8859-1} -constraints { - unix + x11 } -setup { setupbg } -body { @@ -140,7 +140,7 @@ test unixSelect-1.2 {TkSelGetSelection procedure: simple i18n text, iso8859-1} - } -result \u00fc? test unixSelect-1.3 {TkSelGetSelection procedure: simple i18n text, iso2022} -constraints { - unix + x11 } -setup { setupbg setup @@ -160,7 +160,7 @@ test unixSelect-1.3 {TkSelGetSelection procedure: simple i18n text, iso2022} -co } -result {1 2 {COMPOUND_TEXT 0 4000}} test unixSelect-1.4 {TkSelGetSelection procedure: INCR i18n text, iso2022} -constraints { - unix + x11 } -setup { setupbg setup @@ -186,7 +186,7 @@ test unixSelect-1.4 {TkSelGetSelection procedure: INCR i18n text, iso2022} -cons } -result {1 8000 {COMPOUND_TEXT 0 4000 COMPOUND_TEXT 4000 3999 COMPOUND_TEXT 7998 4000 COMPOUND_TEXT 0 4000 COMPOUND_TEXT 4000 3998 COMPOUND_TEXT 7997 4000}} test unixSelect-1.5 {TkSelGetSelection procedure: simple i18n text, iso2022} -constraints { - unix + x11 } -setup { setupbg setup @@ -206,7 +206,7 @@ test unixSelect-1.5 {TkSelGetSelection procedure: simple i18n text, iso2022} -co } -result {1 2 {COMPOUND_TEXT 0 4000}} test unixSelect-1.6 {TkSelGetSelection procedure: INCR i18n text} -constraints { - unix + x11 } -setup { setupbg } -body { @@ -219,7 +219,7 @@ test unixSelect-1.6 {TkSelGetSelection procedure: INCR i18n text} -constraints { } -result [expr {4 + [string length $longValue]}] test unixSelect-1.7 {TkSelGetSelection procedure: INCR i18n text} -constraints { - unix + x11 } -setup { setupbg } -body { @@ -235,7 +235,7 @@ test unixSelect-1.7 {TkSelGetSelection procedure: INCR i18n text} -constraints { } -result [string repeat x 3999]\u00fc test unixSelect-1.8 {TkSelGetSelection procedure: INCR i18n text} -constraints { - unix + x11 } -setup { setupbg } -body { @@ -251,7 +251,7 @@ test unixSelect-1.8 {TkSelGetSelection procedure: INCR i18n text} -constraints { } -result \u00fc[string repeat x 3999] test unixSelect-1.9 {TkSelGetSelection procedure: INCR i18n text} -constraints { - unix + x11 } -setup { setupbg } -body { @@ -270,7 +270,7 @@ test unixSelect-1.9 {TkSelGetSelection procedure: INCR i18n text} -constraints { # from rearing its ugly head again. test unixSelect-1.10 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints { - unix + x11 } -setup { setupbg } -body { @@ -286,7 +286,7 @@ test unixSelect-1.10 {TkSelGetSelection procedure: INCR i18n text, utf-8} -const } -result [string repeat x 3999]\u00fc test unixSelect-1.11 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints { - unix + x11 } -setup { setupbg } -body { @@ -302,7 +302,7 @@ test unixSelect-1.11 {TkSelGetSelection procedure: INCR i18n text, utf-8} -const } -result \u00fc[string repeat x 3999] test unixSelect-1.12 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints { - unix + x11 } -setup { setupbg } -body { @@ -318,7 +318,7 @@ test unixSelect-1.12 {TkSelGetSelection procedure: INCR i18n text, utf-8} -const } -result [string repeat x 3999]\u00fc[string repeat x 4000] test unixSelect-1.13 {TkSelGetSelection procedure: simple i18n text, utf-8} -constraints { - unix + x11 } -setup { destroy .e setupbg @@ -334,7 +334,7 @@ test unixSelect-1.13 {TkSelGetSelection procedure: simple i18n text, utf-8} -con } -result {5} test unixSelect-1.14 {TkSelGetSelection procedure: simple i18n text, utf-8} -constraints { - unix + x11 } -setup { setupbg } -body { @@ -350,7 +350,7 @@ test unixSelect-1.14 {TkSelGetSelection procedure: simple i18n text, utf-8} -con } -result \u00fc\u0444 test unixSelect-1.15 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints { - unix + x11 } -setup { setupbg } -body { @@ -366,7 +366,7 @@ test unixSelect-1.15 {TkSelGetSelection procedure: INCR i18n text, utf-8} -const } -result [string repeat [string repeat \u00c4\u00e4 50]\n 21] test unixSelect-1.16 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints { - unix + x11 } -setup { setupbg } -body { @@ -382,7 +382,7 @@ test unixSelect-1.16 {TkSelGetSelection procedure: INCR i18n text, utf-8} -const } -result i[string repeat [string repeat \u00c4\u00e4 50]\n 21] test unixSelect-1.17 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints { - unix + x11 } -setup { setupbg } -body { @@ -400,7 +400,7 @@ test unixSelect-1.17 {TkSelGetSelection procedure: INCR i18n text, utf-8} -const } -result [string repeat [string repeat \u00c4\u00e4 50]\n 21] test unixSelect-1.18 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints { - unix + x11 } -setup { setupbg } -body { diff --git a/tests/wm.test b/tests/wm.test index afcc2cd9..9cbe49a4 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -140,7 +140,7 @@ test wm-attributes-1.2.4 {usage} -constraints {unix notAqua} -returnCodes error } -result {bad attribute "_": must be -alpha, -topmost, -zoomed, -fullscreen, or -type} test wm-attributes-1.2.5 {usage} -constraints aqua -returnCodes error -body { wm attributes . _ -} -result {bad attribute "_": must be -alpha, -modified, -notify, or -titlepath} +} -result {bad attribute "_": must be -alpha, -fullscreen, -modified, -notify, -titlepath, -topmost, or -transparent} ### wm client ### @@ -737,11 +737,11 @@ test wm-iconbitmap-1.2.2 {usage} -constraints win -returnCodes error -body { test wm-iconbitmap-1.3 {usage} -constraints win -returnCodes error -body { wm iconbitmap .t 12 13 } -result {illegal option "12" must be "-default"} -test wm-iconbitmap-1.4 {usage} -returnCodes error -body { +test wm-iconbitmap-1.4 {usage} -constraints notAqua -returnCodes error -body { wm iconbitmap .t bad-bitmap } -result {bitmap "bad-bitmap" not defined} -test wm-iconbitmap-2.1 {setting and reading values} -setup { +test wm-iconbitmap-2.1 {setting and reading values} -constraints notAqua -setup { set result {} } -body { lappend result [wm iconbitmap .t] @@ -1242,13 +1242,15 @@ test wm-resizable-1.5 {usage} -returnCodes error -body { } -result {expected boolean value but got "bad"} test wm-resizable-2.1 {setting and reading values} { - wm resizable .t 0 1 + wm resizable .t 0 0 set result [wm resizable .t] + wm resizable .t 0 1 + lappend result [wm resizable .t] wm resizable .t 1 0 lappend result [wm resizable .t] wm resizable .t 1 1 lappend result [wm resizable .t] -} {0 1 {1 0} {1 1}} +} {0 0 {0 1} {1 0} {1 1}} ### wm sizefrom ### diff --git a/unix/Makefile.in b/unix/Makefile.in index edb00b0c..46520527 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -187,8 +187,8 @@ KEYSYM_FLAGS = # Tk does not used deprecated Tcl constructs so it should # compile fine with -DTCL_NO_DEPRECATED. To remove its own # set of deprecated code uncomment the second line. -NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED -#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED -DTK_NO_DEPRECATED +NO_DEPRECATED_FLAGS = +#NO_DEPRECATED_FLAGS = -DTK_NO_DEPRECATED # Some versions of make, like SGI's, use the following variable to # determine which shell to use for executing commands: diff --git a/unix/configure b/unix/configure index 0150353f..56e9df49 100755 --- a/unix/configure +++ b/unix/configure @@ -1338,7 +1338,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TK_VERSION=8.6 TK_MAJOR_VERSION=8 TK_MINOR_VERSION=6 -TK_PATCH_LEVEL=".8" +TK_PATCH_LEVEL=".9" VERSION=${TK_VERSION} LOCALES="cs da de el en en_gb eo es fr hu it nl pl pt ru sv" @@ -1429,11 +1429,13 @@ echo "$as_me: error: ${with_tclconfig} directory doesn't contain tclConfig.sh" > for i in `ls -d ${libdir} 2>/dev/null` \ `ls -d ${exec_prefix}/lib 2>/dev/null` \ `ls -d ${prefix}/lib 2>/dev/null` \ - `ls -d /usr/contrib/lib 2>/dev/null` \ `ls -d /usr/local/lib 2>/dev/null` \ + `ls -d /usr/contrib/lib 2>/dev/null` \ `ls -d /usr/pkg/lib 2>/dev/null` \ `ls -d /usr/lib 2>/dev/null` \ `ls -d /usr/lib64 2>/dev/null` \ + `ls -d /usr/local/lib/tcl8.6 2>/dev/null` \ + `ls -d /usr/local/lib/tcl/tcl8.6 2>/dev/null` \ ; do if test -f "$i/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd $i; pwd)`" @@ -4794,7 +4796,7 @@ echo "$as_me: error: CYGWIN compile is only supported with --enable-threads" >&2 LDFLAGS="$LDFLAGS -Wl,--export-dynamic" SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" - SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}' + SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared' DL_OBJS="tclLoadDl.o" DL_LIBS="-lroot" echo "$as_me:$LINENO: checking for inet_ntoa in -lnetwork" >&5 @@ -5223,7 +5225,7 @@ fi # get rid of the warnings. #CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES" - SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}' + SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared' DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -Wl,--export-dynamic" @@ -5365,7 +5367,7 @@ fi SHLIB_CFLAGS="-fpic" ;; esac - SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}' + SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" @@ -5394,7 +5396,7 @@ fi NetBSD-*) # NetBSD has ELF and can use 'cc -shared' to build shared libs SHLIB_CFLAGS="-fPIC" - SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}' + SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" @@ -5415,7 +5417,7 @@ fi fi ;; - FreeBSD-*) + DragonFly-*|FreeBSD-*) # This configuration from FreeBSD Ports. SHLIB_CFLAGS="-fPIC" SHLIB_LD="${CC} -shared" @@ -6623,7 +6625,7 @@ fi BSD/OS*) ;; CYGWIN_*|MINGW32_*) ;; IRIX*) ;; - NetBSD-*|FreeBSD-*|OpenBSD-*) ;; + NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;; Darwin-*) ;; SCO_SV-3.2*) ;; *) SHLIB_CFLAGS="-fPIC" ;; @@ -7399,6 +7401,70 @@ _ACEOF fi + echo "$as_me:$LINENO: checking for DIR64" >&5 +echo $ECHO_N "checking for DIR64... $ECHO_C" >&6 +if test "${tcl_cv_DIR64+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +#include +int +main () +{ +struct dirent64 *p; DIR64 d = opendir64("."); + p = readdir64(d); rewinddir64(d); closedir64(d); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + tcl_cv_DIR64=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_DIR64=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $tcl_cv_DIR64" >&5 +echo "${ECHO_T}$tcl_cv_DIR64" >&6 + if test "x${tcl_cv_DIR64}" = "xyes" ; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_DIR64 1 +_ACEOF + + fi + echo "$as_me:$LINENO: checking for struct stat64" >&5 echo $ECHO_N "checking for struct stat64... $ECHO_C" >&6 if test "${tcl_cv_struct_stat64+set}" = set; then @@ -8220,191 +8286,6 @@ _ACEOF fi -#-------------------------------------------------------------------- -# Under Solaris 2.4, strtod returns the wrong value for the -# terminating character under some conditions. Check for this -# and if the problem exists use a substitute procedure -# "fixstrtod" (provided by Tcl) that corrects the error. -#-------------------------------------------------------------------- - - - echo "$as_me:$LINENO: checking for strtod" >&5 -echo $ECHO_N "checking for strtod... $ECHO_C" >&6 -if test "${ac_cv_func_strtod+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -/* Define strtod to an innocuous variant, in case declares strtod. - For example, HP-UX 11i declares gettimeofday. */ -#define strtod innocuous_strtod - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char strtod (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef strtod - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char strtod (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_strtod) || defined (__stub___strtod) -choke me -#else -char (*f) () = strtod; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != strtod; - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>conftest.er1 - ac_status=$? - grep -v '^ *+' conftest.er1 >conftest.err - rm -f conftest.er1 - cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" - || test ! -s conftest.err' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 - (eval $ac_try) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; } && - { ac_try='test -s conftest$ac_exeext' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 - (eval $ac_try) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; }; then - ac_cv_func_strtod=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_strtod=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_func_strtod" >&5 -echo "${ECHO_T}$ac_cv_func_strtod" >&6 -if test $ac_cv_func_strtod = yes; then - tcl_strtod=1 -else - tcl_strtod=0 -fi - - if test "$tcl_strtod" = 1; then - echo "$as_me:$LINENO: checking for Solaris2.4/Tru64 strtod bugs" >&5 -echo $ECHO_N "checking for Solaris2.4/Tru64 strtod bugs... $ECHO_C" >&6 -if test "${tcl_cv_strtod_buggy+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - - if test "$cross_compiling" = yes; then - tcl_cv_strtod_buggy=buggy -else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ - - extern double strtod(); - int main() { - char *infString="Inf", *nanString="NaN", *spaceString=" "; - char *term; - double value; - value = strtod(infString, &term); - if ((term != infString) && (term[-1] == 0)) { - exit(1); - } - value = strtod(nanString, &term); - if ((term != nanString) && (term[-1] == 0)) { - exit(1); - } - value = strtod(spaceString, &term); - if (term == (spaceString+1)) { - exit(1); - } - exit(0); - } -_ACEOF -rm -f conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && { ac_try='./conftest$ac_exeext' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 - (eval $ac_try) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; }; then - tcl_cv_strtod_buggy=ok -else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -( exit $ac_status ) -tcl_cv_strtod_buggy=buggy -fi -rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext -fi -fi -echo "$as_me:$LINENO: result: $tcl_cv_strtod_buggy" >&5 -echo "${ECHO_T}$tcl_cv_strtod_buggy" >&6 - if test "$tcl_cv_strtod_buggy" = buggy; then - case $LIBOBJS in - "fixstrtod.$ac_objext" | \ - *" fixstrtod.$ac_objext" | \ - "fixstrtod.$ac_objext "* | \ - *" fixstrtod.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS fixstrtod.$ac_objext" ;; -esac - - USE_COMPAT=1 - -cat >>confdefs.h <<\_ACEOF -#define strtod fixstrtod -_ACEOF - - fi - fi - - #-------------------------------------------------------------------- # Check for various typedefs and provide substitutes if # they don't exist. @@ -9580,7 +9461,7 @@ ac_x_header_dirs=' /usr/openwin/share/include' if test "$ac_x_includes" = no; then - # Guess where to find include files, by looking for Xlib.h. + # Guess where to find include files, by looking for Intrinsic.h. # First, try using that file with no special directory specified. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -9588,7 +9469,7 @@ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -#include +#include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 @@ -9615,7 +9496,7 @@ else sed 's/^/| /' conftest.$ac_ext >&5 for ac_dir in $ac_x_header_dirs; do - if test -r "$ac_dir/X11/Xlib.h"; then + if test -r "$ac_dir/X11/Intrinsic.h"; then ac_x_includes=$ac_dir break fi @@ -9629,18 +9510,18 @@ if test "$ac_x_libraries" = no; then # See if we find them without any special options. # Don't add to $LIBS permanently. ac_save_LIBS=$LIBS - LIBS="-lX11 $LIBS" + LIBS="-lXt $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -#include +#include int main () { -XrmInitialize () +XtMalloc (0) ; return 0; } diff --git a/unix/configure.in b/unix/configure.in index a2ed5669..0d7b0b2e 100755 --- a/unix/configure.in +++ b/unix/configure.in @@ -25,7 +25,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ TK_VERSION=8.6 TK_MAJOR_VERSION=8 TK_MINOR_VERSION=6 -TK_PATCH_LEVEL=".8" +TK_PATCH_LEVEL=".9" VERSION=${TK_VERSION} LOCALES="cs da de el en en_gb eo es fr hu it nl pl pt ru sv" @@ -196,15 +196,6 @@ fi AC_CHECK_HEADERS(sys/time.h) AC_HEADER_TIME -#-------------------------------------------------------------------- -# Under Solaris 2.4, strtod returns the wrong value for the -# terminating character under some conditions. Check for this -# and if the problem exists use a substitute procedure -# "fixstrtod" (provided by Tcl) that corrects the error. -#-------------------------------------------------------------------- - -SC_BUGGY_STRTOD - #-------------------------------------------------------------------- # Check for various typedefs and provide substitutes if # they don't exist. diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 8a802fb7..19537983 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -91,11 +91,13 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [ for i in `ls -d ${libdir} 2>/dev/null` \ `ls -d ${exec_prefix}/lib 2>/dev/null` \ `ls -d ${prefix}/lib 2>/dev/null` \ - `ls -d /usr/contrib/lib 2>/dev/null` \ `ls -d /usr/local/lib 2>/dev/null` \ + `ls -d /usr/contrib/lib 2>/dev/null` \ `ls -d /usr/pkg/lib 2>/dev/null` \ `ls -d /usr/lib 2>/dev/null` \ `ls -d /usr/lib64 2>/dev/null` \ + `ls -d /usr/local/lib/tcl8.6 2>/dev/null` \ + `ls -d /usr/local/lib/tcl/tcl8.6 2>/dev/null` \ ; do if test -f "$i/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd $i; pwd)`" @@ -224,8 +226,11 @@ AC_DEFUN([SC_PATH_TKCONFIG], [ `ls -d ${prefix}/lib 2>/dev/null` \ `ls -d /usr/local/lib 2>/dev/null` \ `ls -d /usr/contrib/lib 2>/dev/null` \ + `ls -d /usr/pkg/lib 2>/dev/null` \ `ls -d /usr/lib 2>/dev/null` \ `ls -d /usr/lib64 2>/dev/null` \ + `ls -d /usr/local/lib/tk8.6 2>/dev/null` \ + `ls -d /usr/local/lib/tcl/tk8.6 2>/dev/null` \ ; do if test -f "$i/tkConfig.sh" ; then ac_cv_c_tkconfig="`(cd $i; pwd)`" @@ -1258,7 +1263,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ LDFLAGS="$LDFLAGS -Wl,--export-dynamic" SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" - SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}' + SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared' DL_OBJS="tclLoadDl.o" DL_LIBS="-lroot" AC_CHECK_LIB(network, inet_ntoa, [LIBS="$LIBS -lnetwork"]) @@ -1402,7 +1407,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ # get rid of the warnings. #CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES" - SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}' + SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared' DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -Wl,--export-dynamic" @@ -1473,7 +1478,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ SHLIB_CFLAGS="-fpic" ;; esac - SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}' + SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" @@ -1496,7 +1501,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ NetBSD-*) # NetBSD has ELF and can use 'cc -shared' to build shared libs SHLIB_CFLAGS="-fPIC" - SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}' + SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" @@ -1511,7 +1516,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ LDFLAGS="$LDFLAGS -pthread" ]) ;; - FreeBSD-*) + DragonFly-*|FreeBSD-*) # This configuration from FreeBSD Ports. SHLIB_CFLAGS="-fPIC" SHLIB_LD="${CC} -shared" @@ -2007,7 +2012,7 @@ dnl # preprocessing tests use only CPPFLAGS. BSD/OS*) ;; CYGWIN_*|MINGW32_*) ;; IRIX*) ;; - NetBSD-*|FreeBSD-*|OpenBSD-*) ;; + NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;; Darwin-*) ;; SCO_SV-3.2*) ;; *) SHLIB_CFLAGS="-fPIC" ;; @@ -2392,59 +2397,6 @@ AC_DEFUN([SC_TIME_HANDLER], [ fi ]) -#-------------------------------------------------------------------- -# SC_BUGGY_STRTOD -# -# Under Solaris 2.4, strtod returns the wrong value for the -# terminating character under some conditions. Check for this -# and if the problem exists use a substitute procedure -# "fixstrtod" (provided by Tcl) that corrects the error. -# Also, on Compaq's Tru64 Unix 5.0, -# strtod(" ") returns 0.0 instead of a failure to convert. -# -# Arguments: -# none -# -# Results: -# -# Might defines some of the following vars: -# strtod (=fixstrtod) -# -#-------------------------------------------------------------------- - -AC_DEFUN([SC_BUGGY_STRTOD], [ - AC_CHECK_FUNC(strtod, tcl_strtod=1, tcl_strtod=0) - if test "$tcl_strtod" = 1; then - AC_CACHE_CHECK([for Solaris2.4/Tru64 strtod bugs], tcl_cv_strtod_buggy,[ - AC_TRY_RUN([ - extern double strtod(); - int main() { - char *infString="Inf", *nanString="NaN", *spaceString=" "; - char *term; - double value; - value = strtod(infString, &term); - if ((term != infString) && (term[-1] == 0)) { - exit(1); - } - value = strtod(nanString, &term); - if ((term != nanString) && (term[-1] == 0)) { - exit(1); - } - value = strtod(spaceString, &term); - if (term == (spaceString+1)) { - exit(1); - } - exit(0); - }], tcl_cv_strtod_buggy=ok, tcl_cv_strtod_buggy=buggy, - tcl_cv_strtod_buggy=buggy)]) - if test "$tcl_cv_strtod_buggy" = buggy; then - AC_LIBOBJ([fixstrtod]) - USE_COMPAT=1 - AC_DEFINE(strtod, fixstrtod, [Do we want to use the strtod() in compat?]) - fi - fi -]) - #-------------------------------------------------------------------- # SC_TCL_LINK_LIBS # @@ -2470,12 +2422,9 @@ AC_DEFUN([SC_TCL_LINK_LIBS], [ #-------------------------------------------------------------------- # On a few very rare systems, all of the libm.a stuff is # already in libc.a. Set compiler flags accordingly. - # Also, Linux requires the "ieee" library for math to work - # right (and it must appear before "-lm"). #-------------------------------------------------------------------- AC_CHECK_FUNC(sin, MATH_LIBS="", MATH_LIBS="-lm") - AC_CHECK_LIB(ieee, main, [MATH_LIBS="-lieee $MATH_LIBS"]) #-------------------------------------------------------------------- # Interactive UNIX requires -linet instead of -lsocket, plus it @@ -2579,7 +2528,7 @@ AC_DEFUN([SC_TCL_EARLY_FLAGS],[ # Might define the following vars: # TCL_WIDE_INT_IS_LONG # TCL_WIDE_INT_TYPE -# HAVE_STRUCT_DIRENT64 +# HAVE_STRUCT_DIRENT64, HAVE_DIR64 # HAVE_STRUCT_STAT64 # HAVE_TYPE_OFF64_T # @@ -2615,6 +2564,15 @@ AC_DEFUN([SC_TCL_64BIT_FLAGS], [ AC_DEFINE(HAVE_STRUCT_DIRENT64, 1, [Is 'struct dirent64' in ?]) fi + AC_CACHE_CHECK([for DIR64], tcl_cv_DIR64,[ + AC_TRY_COMPILE([#include +#include ],[struct dirent64 *p; DIR64 d = opendir64("."); + p = readdir64(d); rewinddir64(d); closedir64(d);], + tcl_cv_DIR64=yes,tcl_cv_DIR64=no)]) + if test "x${tcl_cv_DIR64}" = "xyes" ; then + AC_DEFINE(HAVE_DIR64, 1, [Is 'DIR64' in ?]) + fi + AC_CACHE_CHECK([for struct stat64], tcl_cv_struct_stat64,[ AC_TRY_COMPILE([#include ],[struct stat64 p; ], diff --git a/unix/tk.spec b/unix/tk.spec index 24019d4e..159c5335 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: 8.6.8 +Version: 8.6.9 Release: 2 License: BSD Group: Development/Languages diff --git a/unix/tkConfig.h.in b/unix/tkConfig.h.in index 4fd7726f..72d97c83 100644 --- a/unix/tkConfig.h.in +++ b/unix/tkConfig.h.in @@ -13,6 +13,9 @@ /* Do we have access to Darwin CoreFoundation.framework? */ #undef HAVE_COREFOUNDATION +/* Is 'DIR64' in ? */ +#undef HAVE_DIR64 + /* Compiler support for module scope symbols */ #undef HAVE_HIDDEN @@ -238,9 +241,6 @@ /* Define to `unsigned' if does not define. */ #undef size_t -/* Do we want to use the strtod() in compat? */ -#undef strtod - /* Define to `int' if doesn't define. */ #undef uid_t diff --git a/unix/tkUnixFont.c b/unix/tkUnixFont.c index b361e83e..96635b4b 100644 --- a/unix/tkUnixFont.c +++ b/unix/tkUnixFont.c @@ -406,8 +406,7 @@ ControlUtfProc( { const char *srcStart, *srcEnd; char *dstStart, *dstEnd; - int ch; - int result; + int ch, result; static char hexChars[] = "0123456789abcdef"; static char mapChars[] = { 0, 0, 0, 0, 0, 0, 0, @@ -954,7 +953,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; @@ -1018,7 +1017,7 @@ Tk_MeasureChars( { UnixFont *fontPtr; SubFont *lastSubFontPtr; - int curX, curByte; + int curX, curByte, ch; /* * Unix does not use kerning or fractional character widths when @@ -1036,7 +1035,6 @@ Tk_MeasureChars( curByte = 0; } else if (maxLength < 0) { const char *p, *end, *next; - int ch; SubFont *thisSubFontPtr; FontFamily *familyPtr; Tcl_DString runString; @@ -1090,7 +1088,6 @@ Tk_MeasureChars( } else { const char *p, *end, *next, *term; int newX, termX, sawNonSpace, dstWrote; - Tcl_UniChar ch; FontFamily *familyPtr; XChar2b buf[8]; @@ -1100,7 +1097,7 @@ Tk_MeasureChars( * individually. */ - next = source + Tcl_UtfToUniChar(source, &ch); + next = source + TkUtfToUniChar(source, &ch); newX = curX = termX = 0; term = source; @@ -1135,7 +1132,7 @@ Tk_MeasureChars( break; } - next += Tcl_UtfToUniChar(next, &ch); + next += TkUtfToUniChar(next, &ch); if ((ch < 256) && isspace(ch)) { if (sawNonSpace) { term = p; @@ -1160,13 +1157,13 @@ Tk_MeasureChars( */ curX = newX; - p += Tcl_UtfToUniChar(p, &ch); + p += TkUtfToUniChar(p, &ch); } if ((flags & TK_AT_LEAST_ONE) && (term == source) && (p < end)) { term = p; termX = curX; if (term == source) { - term += Tcl_UtfToUniChar(term, &ch); + term += TkUtfToUniChar(term, &ch); termX = newX; } } else if ((p >= end) || !(flags & TK_WHOLE_WORDS)) { @@ -1278,8 +1275,7 @@ Tk_DrawChars( SubFont *thisSubFontPtr, *lastSubFontPtr; Tcl_DString runString; const char *p, *end, *next; - int xStart, needWidth, window_width, do_width; - Tcl_UniChar ch; + int xStart, needWidth, window_width, do_width, ch; FontFamily *familyPtr; #ifdef TK_DRAW_CHAR_XWINDOW_CHECK int rx, ry; @@ -1314,7 +1310,7 @@ Tk_DrawChars( needWidth = fontPtr->font.fa.underline + fontPtr->font.fa.overstrike; for (p = source; p <= end; ) { if (p < end) { - next = p + Tcl_UtfToUniChar(p, &ch); + next = p + TkUtfToUniChar(p, &ch); thisSubFontPtr = FindSubFontForChar(fontPtr, ch, &lastSubFontPtr); } else { next = p + 1; @@ -1849,7 +1845,9 @@ AllocFontFamily( if ((familyPtr->faceName == fa.fa.family) && (familyPtr->foundry == fa.xa.foundry) && (familyPtr->encoding == encoding)) { - Tcl_FreeEncoding(encoding); + if (encoding) { + Tcl_FreeEncoding(encoding); + } familyPtr->refCount++; return familyPtr; } @@ -1923,7 +1921,9 @@ FreeFontFamily( if (familyPtr->refCount > 0) { return; } - Tcl_FreeEncoding(familyPtr->encoding); + if (familyPtr->encoding) { + Tcl_FreeEncoding(familyPtr->encoding); + } for (i = 0; i < FONTMAP_PAGES; i++) { if (familyPtr->fontMap[i] != NULL) { ckfree(familyPtr->fontMap[i]); @@ -2213,7 +2213,7 @@ FontMapLoadPage( int row) /* Index of the page to be loaded into the * cache. */ { - char buf[16], src[TCL_UTF_MAX]; + char buf[16], src[6]; int minHi, maxHi, minLo, maxLo, scale, checkLo; int i, end, bitOffset, isTwoByteFont, n; Tcl_Encoding encoding; @@ -2251,7 +2251,7 @@ FontMapLoadPage( for (i = row << FONTMAP_SHIFT; i < end; i++) { int hi, lo; - if (Tcl_UtfToExternal(NULL, encoding, src, Tcl_UniCharToUtf(i, src), + if (Tcl_UtfToExternal(NULL, encoding, src, TkUniCharToUtf(i, src), TCL_ENCODING_STOPONERROR, NULL, buf, sizeof(buf), NULL, NULL, NULL) != TCL_OK) { continue; @@ -2417,7 +2417,7 @@ CanUseFallback( unsigned bestScore[2]; char **nameList; char **nameListOrig; - char src[TCL_UTF_MAX]; + char src[6]; FontAttributes want, got; Display *display; SubFont subFont; @@ -2447,7 +2447,7 @@ CanUseFallback( } nameListOrig = nameList; - srcLen = Tcl_UniCharToUtf(ch, src); + srcLen = TkUniCharToUtf(ch, src); want.fa = fontPtr->font.fa; want.xa = fontPtr->xa; diff --git a/unix/tkUnixKey.c b/unix/tkUnixKey.c index 23c4aa48..6d4d0cfe 100644 --- a/unix/tkUnixKey.c +++ b/unix/tkUnixKey.c @@ -125,6 +125,17 @@ TkpGetString( return Tcl_DStringValue(dsPtr); } + /* + * Only do this for KeyPress events, otherwise + * further Xlib function behavior might be undefined. + */ + + if (eventPtr->type != KeyPress) { + len = 0; + Tcl_DStringSetLength(dsPtr, len); + goto done; + } + #ifdef TK_USE_INPUT_METHODS if ((winPtr->dispPtr->flags & TK_DISPLAY_USE_IM) && (winPtr->inputContext != NULL) @@ -217,6 +228,7 @@ TkpGetString( * from having to reenter the XIM engine. [Bug 1373712] */ +done: kePtr->charValuePtr = ckalloc(len + 1); kePtr->charValueLen = len; memcpy(kePtr->charValuePtr, Tcl_DStringValue(dsPtr), (unsigned) len + 1); @@ -236,7 +248,7 @@ TkpSetKeycodeAndState( XEvent *eventPtr) { TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - int state; + int state, mincode, maxcode; KeyCode keycode; if (keySym == NoSymbol) { @@ -258,6 +270,21 @@ TkpSetKeycodeAndState( } } } + + /* + * Filter keycodes out of range, otherwise further Xlib function + * behavior might be undefined, in particular XIM could cause crashes. + */ + + mincode = 0; + maxcode = -1; + XDisplayKeycodes(dispPtr->display, &mincode, &maxcode); + if (keycode < mincode) { + keycode = mincode; + } else if (keycode > maxcode) { + keycode = maxcode; + } + eventPtr->xkey.keycode = keycode; } diff --git a/unix/tkUnixMenu.c b/unix/tkUnixMenu.c index bc1bd2e5..38b6c585 100644 --- a/unix/tkUnixMenu.c +++ b/unix/tkUnixMenu.c @@ -52,8 +52,8 @@ static void SetHelpMenu(TkMenu *menuPtr); static void DrawMenuEntryAccelerator(TkMenu *menuPtr, TkMenuEntry *mePtr, Drawable d, GC gc, Tk_Font tkfont, const Tk_FontMetrics *fmPtr, - Tk_3DBorder activeBorder, int x, int y, - int width, int height, int drawArrow); + Tk_3DBorder activeBorder, Tk_3DBorder bgBorder, + int x, int y, int width, int height, int drawArrow); static void DrawMenuEntryBackground(TkMenu *menuPtr, TkMenuEntry *mePtr, Drawable d, Tk_3DBorder activeBorder, Tk_3DBorder bgBorder, @@ -481,6 +481,7 @@ DrawMenuEntryAccelerator( Tk_Font tkfont, /* The precalculated font */ const Tk_FontMetrics *fmPtr,/* The precalculated metrics */ Tk_3DBorder activeBorder, /* The border for an active item */ + Tk_3DBorder bgBorder, /* The background border */ int x, /* Left coordinate of entry rect */ int y, /* Top coordinate of entry rect */ int width, /* Width of entry */ @@ -510,8 +511,9 @@ DrawMenuEntryAccelerator( points[1].y = points[0].y + CASCADE_ARROW_HEIGHT; points[2].x = points[0].x + CASCADE_ARROW_WIDTH; points[2].y = points[0].y + CASCADE_ARROW_HEIGHT/2; - Tk_Fill3DPolygon(menuPtr->tkwin, d, activeBorder, points, 3, - DECORATION_BORDER_WIDTH, + Tk_Fill3DPolygon(menuPtr->tkwin, d, + (mePtr->state == ENTRY_ACTIVE) ? activeBorder : bgBorder, + points, 3, DECORATION_BORDER_WIDTH, (menuPtr->postedCascade == mePtr) ? TK_RELIEF_SUNKEN : TK_RELIEF_RAISED); } else if (mePtr->accelPtr != NULL) { @@ -638,7 +640,7 @@ DrawMenuSeparator( points[0].x = x; points[0].y = y + height/2; - points[1].x = width - 1; + points[1].x = x + width - 1; points[1].y = points[0].y; border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr); Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1, @@ -1193,7 +1195,7 @@ DrawTearoffEntry( points[0].y = y + height/2; points[1].y = points[0].y; segmentWidth = 6; - maxX = width - 1; + maxX = x + width - 1; border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr); while (points[0].x < maxX) { @@ -1326,8 +1328,7 @@ TkpDrawMenuEntry( int height, /* Height of the current rectangle */ int strictMotif, /* Boolean flag */ int drawArrow) /* Whether or not to draw the cascade arrow - * for cascade items. Only applies to - * Windows. */ + * for cascade items. */ { GC gc, indicatorGC; XColor *indicatorColor, *disableColor = NULL; @@ -1435,7 +1436,8 @@ TkpDrawMenuEntry( DrawMenuEntryLabel(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, adjustedY, width, adjustedHeight); DrawMenuEntryAccelerator(menuPtr, mePtr, d, gc, tkfont, fmPtr, - activeBorder, x, adjustedY, width, adjustedHeight, drawArrow); + activeBorder, bgBorder, x, adjustedY, width, adjustedHeight, + drawArrow); if (!mePtr->hideMargin) { if (mePtr->state == ENTRY_ACTIVE) { bgBorder = activeBorder; @@ -1718,7 +1720,7 @@ TkpComputeStandardMenuGeometry( menuPtr->entries[j]->entryFlags |= ENTRY_LAST_COLUMN; } windowWidth = x + indicatorSpace + labelWidth + accelWidth - + 2 * activeBorderWidth + 2 * borderWidth; + + 2 * activeBorderWidth + borderWidth; windowHeight += borderWidth; diff --git a/unix/tkUnixRFont.c b/unix/tkUnixRFont.c index d43ed246..70aebfa7 100644 --- a/unix/tkUnixRFont.c +++ b/unix/tkUnixRFont.c @@ -711,9 +711,19 @@ Tk_MeasureChars( (flags & TK_AT_LEAST_ONE && curByte == 0)) { curX = newX; curByte = newByte; - } else if (flags & TK_WHOLE_WORDS && termX != 0) { - curX = termX; - curByte = termByte; + } else if (flags & TK_WHOLE_WORDS) { + if ((flags & TK_AT_LEAST_ONE) && (termX == 0)) { + /* + * No space was seen before reaching the right + * of the allotted maxLength space, i.e. no word + * boundary. Return the string that fills the + * allotted space, without overfill. + * curX and curByte are already the right ones: + */ + } else { + curX = termX; + curByte = termByte; + } } break; } @@ -850,6 +860,7 @@ Tk_DrawChars( * string when drawing. */ { const int maxCoord = 0x7FFF;/* Xft coordinates are 16 bit values */ + const int minCoord = -maxCoord-1; UnixFtFont *fontPtr = (UnixFtFont *) tkfont; XGCValues values; XftColor *xftcolor; @@ -859,10 +870,6 @@ Tk_DrawChars( ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - if (maxCoord <= y) { - return; /* nothing to draw */ - } - if (fontPtr->ftDraw == 0) { #if DEBUG_FONTSEL printf("Switch to drawable 0x%x\n", drawable); @@ -900,26 +907,28 @@ Tk_DrawChars( ftFont = GetFont(fontPtr, c, 0.0); if (ftFont) { - int cx = x; - int cy = y; - specs[nspec].glyph = XftCharIndex(fontPtr->display, ftFont, c); XftGlyphExtents(fontPtr->display, ftFont, &specs[nspec].glyph, 1, &metrics); - if ((x += metrics.xOff) >= maxCoord - || (y += metrics.yOff) >= maxCoord) { - break; - } - if (metrics.xOff > 0 && cx >= 0 && cy >= 0) { - specs[nspec].font = ftFont; - specs[nspec].x = cx; - specs[nspec].y = cy; - if (++nspec == NUM_SPEC) { - XftDrawGlyphFontSpec(fontPtr->ftDraw, xftcolor, - specs, nspec); - nspec = 0; - } + + /* + * Draw glyph only when it fits entirely into 16 bit coords. + */ + + if (x >= minCoord && y >= minCoord && + x <= maxCoord - metrics.width && + y <= maxCoord - metrics.height) { + specs[nspec].font = ftFont; + specs[nspec].x = x; + specs[nspec].y = y; + if (++nspec == NUM_SPEC) { + XftDrawGlyphFontSpec(fontPtr->ftDraw, xftcolor, + specs, nspec); + nspec = 0; + } } + x += metrics.xOff; + y += metrics.yOff; } } if (nspec) { @@ -982,7 +991,7 @@ TkDrawAngledChars( double angle) /* What angle to put text at, in degrees. */ { const int maxCoord = 0x7FFF;/* Xft coordinates are 16 bit values */ - const int minCoord = -1000; /* Should be good enough... */ + const int minCoord = -maxCoord-1; UnixFtFont *fontPtr = (UnixFtFont *) tkfont; XGCValues values; XftColor *xftcolor; @@ -1021,7 +1030,7 @@ TkDrawAngledChars( currentFtFont = NULL; originX = originY = 0; /* lint */ - while (numBytes > 0 && x >= minCoord && y >= minCoord) { + while (numBytes > 0) { XftFont *ftFont; FcChar32 c; @@ -1050,34 +1059,54 @@ TkDrawAngledChars( * this information... but we'll be ready when it does! */ - XftDrawGlyphs(fontPtr->ftDraw, xftcolor, currentFtFont, - originX, originY, glyphs, nglyph); + XftGlyphExtents(fontPtr->display, currentFtFont, glyphs, + nglyph, &metrics); + /* + * Draw glyph only when it fits entirely into 16 bit coords. + */ + + if (x >= minCoord && y >= minCoord && + x <= maxCoord - metrics.width && + y <= maxCoord - metrics.height) { + + /* + * NOTE: + * The whole algorithm has a design problem, the choice of + * NUM_SPEC is arbitrary, and so the inter-glyph spacing could + * look arbitrary. This algorithm has to draw the whole string + * at once (or whole blocks with same font), this requires a + * dynamic 'glyphs' array. In case of overflow the array has to + * be divided until the maximal string will fit. (GC) + * Given the resolution of current displays though, this should + * not be a huge issue since NUM_SPEC is 1024 and thus able to + * cover about 6000 pixels for a 6 pixel wide font (which is + * a very small barely readable font) + */ + + XftDrawGlyphs(fontPtr->ftDraw, xftcolor, currentFtFont, + originX, originY, glyphs, nglyph); + } } originX = ROUND16(x); originY = ROUND16(y); - if (nglyph) { - XftGlyphExtents(fontPtr->display, currentFtFont, glyphs, - nglyph, &metrics); - nglyph = 0; - /* - * Breaking at this place is sub-optimal, but the whole algorithm - * has a design problem, the choice of NUM_SPEC is arbitrary, and so - * the inter-glyph spacing will look arbitrary. This algorithm - * has to draw the whole string at once (or whole blocks with same - * font), this requires a dynamic 'glyphs' array. In case of overflow - * the array has to be divided until the maximal string will fit. (GC) - */ - if ((x += metrics.xOff) >= maxCoord || (y += metrics.yOff) >= maxCoord) { - break; - } - } currentFtFont = ftFont; } glyphs[nglyph++] = XftCharIndex(fontPtr->display, ftFont, c); } if (nglyph) { - XftDrawGlyphs(fontPtr->ftDraw, xftcolor, currentFtFont, - originX, originY, glyphs, nglyph); + XftGlyphExtents(fontPtr->display, currentFtFont, glyphs, + nglyph, &metrics); + + /* + * Draw glyph only when it fits entirely into 16 bit coords. + */ + + if (x >= minCoord && y >= minCoord && + x <= maxCoord - metrics.width && + y <= maxCoord - metrics.height) { + XftDrawGlyphs(fontPtr->ftDraw, xftcolor, currentFtFont, + originX, originY, glyphs, nglyph); + } } #else /* !XFT_HAS_FIXED_ROTATED_PLACEMENT */ int clen, nspec; @@ -1105,7 +1134,7 @@ TkDrawAngledChars( XftDrawSetClip(fontPtr->ftDraw, tsdPtr->clipRegion); } nspec = 0; - while (numBytes > 0 && x >= minCoord && y >= minCoord) { + while (numBytes > 0) { XftFont *ftFont, *ft0Font; FcChar32 c; @@ -1123,21 +1152,28 @@ TkDrawAngledChars( ftFont = GetFont(fontPtr, c, angle); ft0Font = GetFont(fontPtr, c, 0.0); if (ftFont && ft0Font) { - specs[nspec].font = ftFont; specs[nspec].glyph = XftCharIndex(fontPtr->display, ftFont, c); - specs[nspec].x = ROUND16(x); - specs[nspec].y = ROUND16(y); XftGlyphExtents(fontPtr->display, ft0Font, &specs[nspec].glyph, 1, &metrics); - if ((x += metrics.xOff*cosA + metrics.yOff*sinA) > maxCoord - || (y += metrics.yOff*cosA - metrics.xOff*sinA) > maxCoord) { - break; - } - if (++nspec == NUM_SPEC) { - XftDrawGlyphFontSpec(fontPtr->ftDraw, xftcolor, - specs, nspec); - nspec = 0; + + /* + * Draw glyph only when it fits entirely into 16 bit coords. + */ + + if (x >= minCoord && y >= minCoord && + x <= maxCoord - metrics.width && + y <= maxCoord - metrics.height) { + specs[nspec].font = ftFont; + specs[nspec].x = ROUND16(x); + specs[nspec].y = ROUND16(y); + if (++nspec == NUM_SPEC) { + XftDrawGlyphFontSpec(fontPtr->ftDraw, xftcolor, + specs, nspec); + nspec = 0; + } } + x += metrics.xOff*cosA + metrics.yOff*sinA; + y += metrics.yOff*cosA - metrics.xOff*sinA; } } if (nspec) { diff --git a/unix/tkUnixScrlbr.c b/unix/tkUnixScrlbr.c index 0507211f..2446c3f0 100644 --- a/unix/tkUnixScrlbr.c +++ b/unix/tkUnixScrlbr.c @@ -289,6 +289,11 @@ TkpComputeScrollbarGeometry( scrollPtr->inset = scrollPtr->highlightWidth + scrollPtr->borderWidth; width = (scrollPtr->vertical) ? Tk_Width(scrollPtr->tkwin) : Tk_Height(scrollPtr->tkwin); + + /* + * Next line assumes that the arrow area is a square. + */ + scrollPtr->arrowLength = width - 2*scrollPtr->inset + 1; fieldLength = (scrollPtr->vertical ? Tk_Height(scrollPtr->tkwin) : Tk_Width(scrollPtr->tkwin)) diff --git a/unix/tkUnixSend.c b/unix/tkUnixSend.c index bbbdd774..0b4f05d0 100644 --- a/unix/tkUnixSend.c +++ b/unix/tkUnixSend.c @@ -261,11 +261,14 @@ RegOpen( unsigned long bytesAfter; Atom actualType; char **propertyPtr; + Tk_ErrorHandler handler; if (dispPtr->commTkwin == NULL) { SendInit(interp, dispPtr); } + handler = Tk_CreateErrorHandler(dispPtr->display, -1, -1, -1, NULL, NULL); + regPtr = ckalloc(sizeof(NameRegistry)); regPtr->dispPtr = dispPtr; regPtr->locked = 0; @@ -306,8 +309,11 @@ RegOpen( XDeleteProperty(dispPtr->display, RootWindow(dispPtr->display, 0), dispPtr->registryProperty); + XSync(dispPtr->display, False); } + Tk_DeleteErrorHandler(handler); + /* * Xlib placed an extra null byte after the end of the property, just to * make sure that it is always NULL-terminated. Be sure to include this @@ -514,6 +520,11 @@ RegClose( NameRegistry *regPtr) /* Pointer to a registry opened with a * previous call to RegOpen. */ { + Tk_ErrorHandler handler; + + handler = Tk_CreateErrorHandler(regPtr->dispPtr->display, -1, -1, -1, + NULL, NULL); + if (regPtr->modified) { if (!regPtr->locked && !localData.sendDebug) { Tcl_Panic("The name registry was modified without being locked!"); @@ -540,6 +551,8 @@ RegClose( XFlush(regPtr->dispPtr->display); + Tk_DeleteErrorHandler(handler); + if (regPtr->property != NULL) { if (regPtr->allocedByX) { XFree(regPtr->property); @@ -1095,6 +1108,31 @@ Tk_SendObjCmd( Tcl_DStringAppend(&request, " ", 1); Tcl_DStringAppend(&request, Tcl_GetString(objv[i]), -1); } + + if (!async) { + /* + * Register the fact that we're waiting for a command to complete + * (this is needed by SendEventProc and by AppendErrorProc to pass + * back the command's results). Set up a timeout handler so that + * we can check during long sends to make sure that the destination + * application is still alive. + * + * We prepare the pending struct here in order to catch potential + * early X errors from AppendPropCarefully() due to XSync(). + */ + + pending.serial = localData.sendSerial; + pending.dispPtr = dispPtr; + pending.target = destName; + pending.commWindow = commWindow; + pending.interp = interp; + pending.result = NULL; + pending.errorInfo = NULL; + pending.errorCode = NULL; + pending.gotResponse = 0; + pending.nextPtr = tsdPtr->pendingCommands; + tsdPtr->pendingCommands = &pending; + } (void) AppendPropCarefully(dispPtr->display, commWindow, dispPtr->commProperty, Tcl_DStringValue(&request), Tcl_DStringLength(&request) + 1, (async ? NULL : &pending)); @@ -1108,26 +1146,6 @@ Tk_SendObjCmd( return TCL_OK; } - /* - * Register the fact that we're waiting for a command to complete (this is - * needed by SendEventProc and by AppendErrorProc to pass back the - * command's results). Set up a timeout handler so that we can check - * during long sends to make sure that the destination application is - * still alive. - */ - - pending.serial = localData.sendSerial; - pending.dispPtr = dispPtr; - pending.target = destName; - pending.commWindow = commWindow; - pending.interp = interp; - pending.result = NULL; - pending.errorInfo = NULL; - pending.errorCode = NULL; - pending.gotResponse = 0; - pending.nextPtr = tsdPtr->pendingCommands; - tsdPtr->pendingCommands = &pending; - /* * Enter a loop processing X events until the result comes in or the * target is declared to be dead. While waiting for a result, look only at @@ -1951,6 +1969,7 @@ TkpTestsendCmd( "bogus", "prop", "serial", NULL }; TkWindow *winPtr = clientData; + Tk_ErrorHandler handler; int index; if (objc < 2) { @@ -1959,16 +1978,19 @@ TkpTestsendCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObjStruct(interp, objv[1], testsendOptions, + if (Tcl_GetIndexFromObjStruct(interp, objv[1], testsendOptions, sizeof(char *), "option", 0, &index) != TCL_OK) { - return TCL_ERROR; - } - if (index == TESTSEND_BOGUS) { + return TCL_ERROR; + } + if (index == TESTSEND_BOGUS) { + handler = Tk_CreateErrorHandler(winPtr->dispPtr->display, -1, -1, -1, + NULL, NULL); XChangeProperty(winPtr->dispPtr->display, RootWindow(winPtr->dispPtr->display, 0), winPtr->dispPtr->registryProperty, XA_INTEGER, 32, PropModeReplace, (unsigned char *) "This is bogus information", 6); + Tk_DeleteErrorHandler(handler); } else if (index == TESTSEND_PROP) { int result, actualFormat; unsigned long length, bytesAfter; @@ -2007,7 +2029,10 @@ TkpTestsendCmd( XFree(property); } } else if (Tcl_GetString(objv[4])[0] == 0) { + handler = Tk_CreateErrorHandler(winPtr->dispPtr->display, + -1, -1, -1, NULL, NULL); XDeleteProperty(winPtr->dispPtr->display, w, propName); + Tk_DeleteErrorHandler(handler); } else { Tcl_DString tmp; @@ -2018,10 +2043,12 @@ TkpTestsendCmd( *p = 0; } } - + handler = Tk_CreateErrorHandler(winPtr->dispPtr->display, + -1, -1, -1, NULL, NULL); XChangeProperty(winPtr->dispPtr->display, w, propName, XA_STRING, 8, PropModeReplace, (unsigned char*)Tcl_DStringValue(&tmp), p-Tcl_DStringValue(&tmp)); + Tk_DeleteErrorHandler(handler); Tcl_DStringFree(&tmp); } } else if (index == TESTSEND_SERIAL) { diff --git a/win/Makefile.in b/win/Makefile.in index 7e482134..e8784847 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -207,8 +207,8 @@ BUILD_TCLSH = @BUILD_TCLSH@ # Tk does not used deprecated Tcl constructs so it should # compile fine with -DTCL_NO_DEPRECATED. To remove its own # set of deprecated code uncomment the second line. -NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED -#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED -DTK_NO_DEPRECATED +NO_DEPRECATED_FLAGS = +#NO_DEPRECATED_FLAGS = -DTK_NO_DEPRECATED # TCL_EXE is the name of a tclsh executable that is available *BEFORE* # running make for the first time. Certain build targets (make genstubs) diff --git a/win/configure b/win/configure index 15d509ed..203d702f 100755 --- a/win/configure +++ b/win/configure @@ -1312,7 +1312,7 @@ SHELL=/bin/sh TK_VERSION=8.6 TK_MAJOR_VERSION=8 TK_MINOR_VERSION=6 -TK_PATCH_LEVEL=".8" +TK_PATCH_LEVEL=".9" VER=$TK_MAJOR_VERSION$TK_MINOR_VERSION #------------------------------------------------------------------------ diff --git a/win/configure.in b/win/configure.in index 5ec7c357..167fd3d0 100644 --- a/win/configure.in +++ b/win/configure.in @@ -14,7 +14,7 @@ SHELL=/bin/sh TK_VERSION=8.6 TK_MAJOR_VERSION=8 TK_MINOR_VERSION=6 -TK_PATCH_LEVEL=".8" +TK_PATCH_LEVEL=".9" VER=$TK_MAJOR_VERSION$TK_MINOR_VERSION #------------------------------------------------------------------------ diff --git a/win/makefile.vc b/win/makefile.vc index 04c97574..40506631 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -90,7 +90,6 @@ RCFILE = tk.rc # TCLINSTALL is set to 1 by rules.vc to indicate we are building against # an installed Tcl and 0 if building against Tcl source. Tk needs the latter. -!message TCLINSTALL=$(TCLINSTALL) !if $(TCLINSTALL) !message *** Warning: Tk requires the source distribution of Tcl to build from, !message *** at this time, sorry. Please set the TCLDIR macro to point to the diff --git a/win/nmakehlp.c b/win/nmakehlp.c index 025bb99f..4e3d7926 100644 --- a/win/nmakehlp.c +++ b/win/nmakehlp.c @@ -739,7 +739,7 @@ static int LocateDependencyHelper(const char *dir, const char *keypath) #if 0 /* This function is not available in Visual C++ 6 */ /* * Use numerics 0 -> FindExInfoStandard, - * 1 -> FindExSearchLimitToDirectories, + * 1 -> FindExSearchLimitToDirectories, * as these are not defined in Visual C++ 6 */ hSearch = FindFirstFileEx(path, 0, &finfo, 1, NULL, 0); @@ -754,7 +754,7 @@ static int LocateDependencyHelper(const char *dir, const char *keypath) do { int sublen; /* - * We need to check it is a directory despite the + * We need to check it is a directory despite the * FindExSearchLimitToDirectories in the above call. See SDK docs */ if ((finfo.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) == 0) @@ -785,7 +785,7 @@ static int LocateDependencyHelper(const char *dir, const char *keypath) * that is used to confirm it is the correct directory. * The search path for the package directory is currently only * the parent and grandparent of the current working directory. - * If found, the command prints + * If found, the command prints * name_DIRPATH= * and returns 0. If not found, does not print anything and returns 1. */ @@ -793,7 +793,7 @@ static int LocateDependency(const char *keypath) { int i, ret; static char *paths[] = {"..", "..\\..", "..\\..\\.."}; - + for (i = 0; i < (sizeof(paths)/sizeof(paths[0])); ++i) { ret = LocateDependencyHelper(paths[i], keypath); if (ret == 0) diff --git a/win/rules-ext.vc b/win/rules-ext.vc new file mode 100644 index 00000000..ab868764 --- /dev/null +++ b/win/rules-ext.vc @@ -0,0 +1,118 @@ +# This file should only be included in makefiles for Tcl extensions, +# NOT in the makefile for Tcl itself. + +!ifndef _RULES_EXT_VC + +# We need to run from the directory the parent makefile is located in. +# nmake does not tell us what makefile was used to invoke it so parent +# makefile has to set the MAKEFILEVC macro or we just make a guess and +# warn if we think that is not the case. +!if "$(MAKEFILEVC)" == "" + +!if exist("$(PROJECT).vc") +MAKEFILEVC = $(PROJECT).vc +!elseif exist("makefile.vc") +MAKEFILEVC = makefile.vc +!endif +!endif # "$(MAKEFILEVC)" == "" + +!if !exist("$(MAKEFILEVC)") +MSG = ^ +You must run nmake from the directory containing the project makefile.^ +If you are doing that and getting this message, set the MAKEFILEVC^ +macro to the name of the project makefile. +!message WARNING: $(MSG) +!endif + +!if "$(PROJECT)" == "tcl" +!error The rules-ext.vc file is not intended for Tcl itself. +!endif + +# We extract version numbers using the nmakehlp program. For now use +# the local copy of nmakehlp. Once we locate Tcl, we will use that +# one if it is newer. +!if [$(CC) -nologo "nmakehlp.c" -link -subsystem:console > nul] +!endif + +# First locate the Tcl directory that we are working with. +!ifdef TCLDIR + +_RULESDIR = $(TCLDIR:/=\) + +!else + +# If an installation path is specified, that is also the Tcl directory. +# Also Tk never builds against an installed Tcl, it needs Tcl sources +!if defined(INSTALLDIR) && "$(PROJECT)" != "tk" +_RULESDIR=$(INSTALLDIR:/=\) +!else +# Locate Tcl sources +!if [echo _RULESDIR = \> nmakehlp.out] \ + || [nmakehlp -L generic\tcl.h >> nmakehlp.out] +_RULESDIR = ..\..\tcl +!else +!include nmakehlp.out +!endif + +!endif # defined(INSTALLDIR).... + +!endif # ifndef TCLDIR + +# Now look for the targets.vc file under the Tcl root. Note we check this +# file and not rules.vc because the latter also exists on older systems. +!if exist("$(_RULESDIR)\lib\nmake\targets.vc") # Building against installed Tcl +_RULESDIR = $(_RULESDIR)\lib\nmake +!elseif exist("$(_RULESDIR)\win\targets.vc") # Building against Tcl sources +_RULESDIR = $(_RULESDIR)\win +!else +# If we have not located Tcl's targets file, most likely we are compiling +# against an older version of Tcl and so must use our own support files. +_RULESDIR = . +!endif + +!if "$(_RULESDIR)" != "." +# Potentially using Tcl's support files. If this extension has its own +# nmake support files, need to compare the versions and pick newer. + +!if exist("rules.vc") # The extension has its own copy + +!if [echo TCL_RULES_MAJOR = \> versions.vc] \ + && [nmakehlp -V "$(_RULESDIR)\rules.vc" RULES_VERSION_MAJOR >> versions.vc] +!endif +!if [echo TCL_RULES_MINOR = \>> versions.vc] \ + && [nmakehlp -V "$(_RULESDIR)\rules.vc" RULES_VERSION_MINOR >> versions.vc] +!endif + +!if [echo OUR_RULES_MAJOR = \>> versions.vc] \ + && [nmakehlp -V "rules.vc" RULES_VERSION_MAJOR >> versions.vc] +!endif +!if [echo OUR_RULES_MINOR = \>> versions.vc] \ + && [nmakehlp -V "rules.vc" RULES_VERSION_MINOR >> versions.vc] +!endif +!include versions.vc +# We have a newer version of the support files, use them +!if ($(TCL_RULES_MAJOR) != $(OUR_RULES_MAJOR)) || ($(TCL_RULES_MINOR) < $(OUR_RULES_MINOR)) +_RULESDIR = . +!endif + +!endif # if exist("rules.vc") + +!endif # if $(_RULESDIR) != "." + +# Let rules.vc know what copy of nmakehlp.c to use. +NMAKEHLPC = $(_RULESDIR)\nmakehlp.c + +# Get rid of our internal defines before calling rules.vc +!undef TCL_RULES_MAJOR +!undef TCL_RULES_MINOR +!undef OUR_RULES_MAJOR +!undef OUR_RULES_MINOR + +!if exist("$(_RULESDIR)\rules.vc") +!message *** Using $(_RULESDIR)\rules.vc +!include "$(_RULESDIR)\rules.vc" +!else +!error *** Could not locate rules.vc in $(_RULESDIR) +!endif + +!endif # _RULES_EXT_VC \ No newline at end of file diff --git a/win/rules.vc b/win/rules.vc index 7fc51c15..543e9595 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -24,7 +24,7 @@ _RULES_VC = 1 # For modifications that are not backward-compatible, you *must* change # the major version. RULES_VERSION_MAJOR = 1 -RULES_VERSION_MINOR = 0 +RULES_VERSION_MINOR = 1 # The PROJECT macro must be defined by parent makefile. !if "$(PROJECT)" == "" @@ -535,7 +535,6 @@ NMAKEHLPC = $(_TCLDIR)\win\nmakehlp.c # We always build nmakehlp even if it exists since we do not know # what source it was built from. -!message *** Using $(NMAKEHLPC) !if [$(cc32) -nologo "$(NMAKEHLPC)" -link -subsystem:console > nul] !endif @@ -590,7 +589,6 @@ FPOPTS = $(FPOPTS) -QI0f OPTIMIZATIONS = $(FPOPTS) !if [nmakehlp -c -O2] -!message *** Compiler has 'Optimizations' OPTIMIZING = 1 OPTIMIZATIONS = $(OPTIMIZATIONS) -O2 !else @@ -1077,12 +1075,24 @@ TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" !if $(TCLINSTALL) # Building against an installed Tcl +# When building extensions, we need to locate tclsh. Depending on version +# of Tcl we are building against, this may or may not have a "t" suffix. +# Try various possibilities in turn. TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe !if !exist("$(TCLSH)") && $(TCL_THREADS) TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX).exe !endif +!if !exist("$(TCLSH)") +TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX:t=).exe +!endif + TCLSTUBLIB = $(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib +# When building extensions, may be linking against Tcl that does not add +# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. +!if !exist("$(TCLIMPLIB)") +TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:t=).lib +!endif TCL_LIBRARY = $(_TCLDIR)\lib TCLREGLIB = $(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib TCLDDELIB = $(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib @@ -1095,8 +1105,16 @@ TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX).exe !if !exist($(TCLSH)) && $(TCL_THREADS) TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX).exe !endif +!if !exist($(TCLSH)) +TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX:t=).exe +!endif TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib +# When building extensions, may be linking against Tcl that does not add +# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. +!if !exist("$(TCLIMPLIB)") +TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:t=).lib +!endif TCL_LIBRARY = $(_TCLDIR)\library TCLREGLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib TCLDDELIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib @@ -1140,11 +1158,23 @@ TK_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" WISH = $(_TKDIR)\bin\$(WISHNAME) TKSTUBLIB = $(_TKDIR)\lib\$(TKSTUBLIBNAME) TKIMPLIB = $(_TKDIR)\lib\$(TKIMPLIBNAME) +# When building extensions, may be linking against Tk that does not add +# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. +!if !exist("$(TKIMPLIB)") +TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX:t=).lib +TKIMPLIB = $(_TKDIR)\lib\$(TKIMPLIBNAME) +!endif TK_INCLUDES = -I"$(_TKDIR)\include" !else # Building against Tk sources WISH = $(_TKDIR)\win\$(BUILDDIRTOP)\$(WISHNAME) TKSTUBLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKSTUBLIBNAME) TKIMPLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKIMPLIBNAME) +# When building extensions, may be linking against Tk that does not add +# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. +!if !exist("$(TKIMPLIB)") +TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX:t=).lib +TKIMPLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKIMPLIBNAME) +!endif TK_INCLUDES = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib" !endif # TKINSTALL tklibs = "$(TKSTUBLIB)" "$(TKIMPLIB)" @@ -1717,7 +1747,6 @@ TCLNMAKECONFIG = "$(OUT_DIR)\tcl.nmake" !message *** Output directory will be '$(OUT_DIR)' !message *** Installation, if selected, will be in '$(_INSTALLDIR)' !message *** Suffix for binaries will be '$(SUFX)' -!message *** Compiler version $(VCVER). Target machine is $(MACHINE) -!message *** Host architecture is $(NATIVE_ARCH) +!message *** Compiler version $(VCVER). Target $(MACHINE), host $(NATIVE_ARCH). !endif # ifdef _RULES_VC diff --git a/win/targets.vc b/win/targets.vc new file mode 100644 index 00000000..312022dd --- /dev/null +++ b/win/targets.vc @@ -0,0 +1,98 @@ +#------------------------------------------------------------- -*- makefile -*- +# targets.vc -- +# +# Part of the nmake based build system for Tcl and its extensions. +# This file defines some standard targets for the convenience of extensions +# and can be optionally included by the extension makefile. +# See TIP 477 (https://core.tcl.tk/tips/doc/trunk/tip/477.md) for docs. + +$(PROJECT): setup pkgindex $(PRJLIB) + +!ifdef PRJ_STUBOBJS +$(PROJECT): $(PRJSTUBLIB) +$(PRJSTUBLIB): $(PRJ_STUBOBJS) + $(LIBCMD) $** + +$(PRJ_STUBOBJS): + $(CCSTUBSCMD) %s +!endif # PRJ_STUBOBJS + +!ifdef PRJ_MANIFEST +$(PROJECT): $(PRJLIB).manifest +$(PRJLIB).manifest: $(PRJ_MANIFEST) + @nmakehlp -s << $** >$@ +@MACHINE@ $(MACHINE:IX86=X86) +<< +!endif + +!if "$(PROJECT)" != "tcl" && "$(PROJECT)" != "tk" +$(PRJLIB): $(PRJ_OBJS) $(RESFILE) +!if $(STATIC_BUILD) + $(LIBCMD) $** +!else + $(DLLCMD) $** + $(_VC_MANIFEST_EMBED_DLL) +!endif + -@del $*.exp +!endif + +!if "$(PRJ_HEADERS)" != "" && "$(PRJ_OBJS)" != "" +$(PRJ_OBJS): $(PRJ_HEADERS) +!endif + +# If parent makefile has defined stub objects, add their installation +# to the default install +!if "$(PRJ_STUBOBJS)" != "" +default-install: default-install-stubs +!endif + +# Unlike the other default targets, these cannot be in rules.vc because +# the executed command depends on existence of macro PRJ_HEADERS_PUBLIC +# that the parent makefile will not define until after including rules-ext.vc +!if "$(PRJ_HEADERS_PUBLIC)" != "" +default-install: default-install-headers +default-install-headers: + @echo Installing headers to '$(INCLUDE_INSTALL_DIR)' + @for %f in ($(PRJ_HEADERS_PUBLIC)) do @$(COPY) %f "$(INCLUDE_INSTALL_DIR)" +!endif + +!if "$(DISABLE_STANDARD_TARGETS)" == "" +DISABLE_STANDARD_TARGETS = 0 +!endif + +!if "$(DISABLE_TARGET_setup)" == "" +DISABLE_TARGET_setup = 0 +!endif +!if "$(DISABLE_TARGET_install)" == "" +DISABLE_TARGET_install = 0 +!endif +!if "$(DISABLE_TARGET_clean)" == "" +DISABLE_TARGET_clean = 0 +!endif +!if "$(DISABLE_TARGET_test)" == "" +DISABLE_TARGET_test = 0 +!endif +!if "$(DISABLE_TARGET_shell)" == "" +DISABLE_TARGET_shell = 0 +!endif + +!if !$(DISABLE_STANDARD_TARGETS) +!if !$(DISABLE_TARGET_setup) +setup: default-setup +!endif +!if !$(DISABLE_TARGET_install) +install: default-install +!endif +!if !$(DISABLE_TARGET_clean) +clean: default-clean +realclean: hose +hose: default-hose +distclean: realclean default-distclean +!endif +!if !$(DISABLE_TARGET_test) +test: default-test +!endif +!if !$(DISABLE_TARGET_shell) +shell: default-shell +!endif +!endif # DISABLE_STANDARD_TARGETS diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c index f97d8136..d6d2c7db 100644 --- a/win/tkWinDialog.c +++ b/win/tkWinDialog.c @@ -3378,7 +3378,7 @@ FontchooserConfigureCmd( if (hdPtr->fontObj) { Tcl_DecrRefCount(hdPtr->fontObj); } - (void)Tcl_GetString(objv[i+1]); + Tcl_GetString(objv[i+1]); if (objv[i+1]->length) { hdPtr->fontObj = objv[i+1]; if (Tcl_IsShared(hdPtr->fontObj)) { @@ -3393,7 +3393,7 @@ FontchooserConfigureCmd( if (hdPtr->cmdObj) { Tcl_DecrRefCount(hdPtr->cmdObj); } - (void)Tcl_GetString(objv[i+1]); + Tcl_GetString(objv[i+1]); if (objv[i+1]->length) { hdPtr->cmdObj = objv[i+1]; if (Tcl_IsShared(hdPtr->cmdObj)) { diff --git a/win/tkWinEmbed.c b/win/tkWinEmbed.c index 8bfd2954..43c5e25c 100644 --- a/win/tkWinEmbed.c +++ b/win/tkWinEmbed.c @@ -200,7 +200,7 @@ void Tk_MapEmbeddedWindow( * The TK_INFO messages are required in order to verify if the window to * use is a valid container. Without an id verification, an invalid * window attachment may cause unexpected crashes/panics (bug 1096074). - * Additional sub messages may be definded/used in future for other + * Additional sub messages may be defined/used in future for other * needs. * * We do not enforce the above protocol for the reason of backward @@ -303,10 +303,10 @@ TkpUseWindow( * order to avoid bug 1096074 in future. */ - char msg[256]; + TCHAR msg[256]; - sprintf(msg, "Unable to get information of window \"%.80s\". Attach to this\nwindow may have unpredictable results if it is not a valid container.\n\nPress Ok to proceed or Cancel to abort attaching.", string); - if (IDCANCEL == MessageBoxA(hwnd, msg, "Tk Warning", + wsprintf(msg, TEXT("Unable to get information of window \"%.40hs\". Attach to this\nwindow may have unpredictable results if it is not a valid container.\n\nPress Ok to proceed or Cancel to abort attaching."), string); + if (IDCANCEL == MessageBox(hwnd, msg, TEXT("Tk Warning"), MB_OKCANCEL | MB_ICONWARNING)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "Operation has been canceled", -1)); diff --git a/win/tkWinMenu.c b/win/tkWinMenu.c index 5dc8f8a2..a4097644 100644 --- a/win/tkWinMenu.c +++ b/win/tkWinMenu.c @@ -1482,6 +1482,15 @@ GetMenuIndicatorGeometry( Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin, menuPtr->borderWidthPtr, &borderWidth); *widthPtr = indicatorDimensions[1] - borderWidth; + + /* + * Quite dubious about the above (why would borderWidth play a role?) + * and about how indicatorDimensions[1] is obtained in SetDefaults(). + * At least don't let the result be negative! + */ + if (*widthPtr < 0) { + *widthPtr = 0; + } } } @@ -1840,7 +1849,7 @@ DrawMenuEntryArrow( int width, /* Width of menu entry */ int height, /* Height of menu entry */ int drawArrow) /* For cascade menus, whether of not to draw - * the arraw. I cannot figure out Windows' + * the arrow. I cannot figure out Windows' * algorithm for where to draw this. */ { COLORREF oldFgColor; @@ -2428,7 +2437,7 @@ DrawTearoffEntry( points[0].y = y + height/2; points[1].y = points[0].y; segmentWidth = 6; - maxX = width - 1; + maxX = x + width - 1; border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr); while (points[0].x < maxX) { @@ -2500,7 +2509,7 @@ TkpDrawMenuEntry( int strictMotif, /* Boolean flag */ int drawingParameters) /* Whether or not to draw the cascade arrow * for cascade items and accelerator - * cues. Only applies to Windows. */ + * cues. */ { GC gc, indicatorGC; TkMenu *menuPtr = mePtr->menuPtr; @@ -2874,7 +2883,7 @@ TkpComputeStandardMenuGeometry( menuPtr->entries[j]->entryFlags &= ~ENTRY_LAST_COLUMN; } x += indicatorSpace + labelWidth + accelWidth - + 2 * borderWidth; + + 2 * activeBorderWidth; indicatorSpace = labelWidth = accelWidth = 0; lastColumnBreak = i; y = borderWidth; @@ -2944,8 +2953,8 @@ TkpComputeStandardMenuGeometry( menuPtr->entries[j]->x = x; menuPtr->entries[j]->entryFlags |= ENTRY_LAST_COLUMN; } - windowWidth = x + indicatorSpace + labelWidth + accelWidth + accelSpace - + 2 * activeBorderWidth + 2 * borderWidth; + windowWidth = x + indicatorSpace + labelWidth + accelWidth + + 2 * activeBorderWidth + borderWidth; windowHeight += borderWidth; @@ -3281,6 +3290,7 @@ SetDefaults( * * The code below was given to me by Microsoft over the phone. It is the * only way to ensure menu items line up, and is not documented. + * How strange the calculation of indicatorDimensions[1] is...! */ indicatorDimensions[0] = GetSystemMetrics(SM_CYMENUCHECK); diff --git a/win/tkWinPixmap.c b/win/tkWinPixmap.c index 1cf0634d..aa1ebde2 100644 --- a/win/tkWinPixmap.c +++ b/win/tkWinPixmap.c @@ -100,13 +100,13 @@ Tk_GetPixmap( LPVOID lpMsgBuf; repeatError = 1; - if (FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER | + if (FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS, NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), - (LPSTR) &lpMsgBuf, 0, NULL)) { - MessageBoxA(NULL, (LPCSTR) lpMsgBuf, - "Tk_GetPixmap: Error from CreateDIBSection", + (LPTSTR)&lpMsgBuf, 0, NULL)) { + MessageBox(NULL, (LPTSTR) lpMsgBuf, + TEXT("Tk_GetPixmap: Error from CreateDIBSection"), MB_OK | MB_ICONINFORMATION); LocalFree(lpMsgBuf); } diff --git a/win/tkWinX.c b/win/tkWinX.c index fca72c3c..a217108b 100644 --- a/win/tkWinX.c +++ b/win/tkWinX.c @@ -82,6 +82,8 @@ typedef struct ThreadSpecificData { * screen. */ int updatingClipboard; /* If 1, we are updating the clipboard. */ int surrogateBuffer; /* Buffer for first of surrogate pair. */ + DWORD wheelTickPrev; /* For high resolution wheels. */ + short wheelAcc; /* For high resolution wheels. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -608,6 +610,8 @@ TkpOpenDisplay( ZeroMemory(tsdPtr->winDisplay, sizeof(TkDisplay)); tsdPtr->winDisplay->display = display; tsdPtr->updatingClipboard = FALSE; + tsdPtr->wheelTickPrev = GetTickCount(); + tsdPtr->wheelAcc = 0; return tsdPtr->winDisplay; } @@ -1131,7 +1135,23 @@ GenerateXEvent( */ switch (message) { - case WM_MOUSEWHEEL: + case WM_MOUSEWHEEL: { + /* + * Support for high resolution wheels. + */ + + DWORD wheelTick = GetTickCount(); + + if (wheelTick - tsdPtr->wheelTickPrev < 1500) { + tsdPtr->wheelAcc += (short) HIWORD(wParam); + } else { + tsdPtr->wheelAcc = (short) HIWORD(wParam); + } + tsdPtr->wheelTickPrev = wheelTick; + if (abs(tsdPtr->wheelAcc) < WHEEL_DELTA) { + return; + } + /* * We have invented a new X event type to handle this event. It * still uses the KeyPress struct. However, the keycode field has @@ -1143,8 +1163,10 @@ GenerateXEvent( event.type = MouseWheelEvent; event.xany.send_event = -1; event.xkey.nbytes = 0; - event.xkey.keycode = (short) HIWORD(wParam); + event.xkey.keycode = tsdPtr->wheelAcc / WHEEL_DELTA * WHEEL_DELTA; + tsdPtr->wheelAcc = tsdPtr->wheelAcc % WHEEL_DELTA; break; + } case WM_SYSKEYDOWN: case WM_KEYDOWN: /* diff --git a/xlib/X11/Xlib.h b/xlib/X11/Xlib.h index b027e286..8d8ec686 100644 --- a/xlib/X11/Xlib.h +++ b/xlib/X11/Xlib.h @@ -203,9 +203,6 @@ typedef struct { int class; /* class of screen (monochrome, etc.) */ #endif unsigned long red_mask, green_mask, blue_mask; /* mask values */ -#if defined(MAC_OSX_TK) - unsigned long alpha_mask; -#endif int bits_per_rgb; /* log base 2 of distinct color values */ int map_entries; /* color map entries */ } Visual; @@ -335,7 +332,6 @@ typedef struct _XImage { XPointer obdata; /* hook for the object routines to hang on */ #if defined(MAC_OSX_TK) int pixelpower; /* n such that pixels are 2^n x 2^n blocks*/ - unsigned long alpha_mask; #endif struct funcs { /* image manipulation routines */ struct _XImage *(*create_image)();