diff options
220 files changed, 11393 insertions, 7527 deletions
diff --git a/.fossil-settings/crnl-glob b/.fossil-settings/crnl-glob index e69de29..7175730 100644 --- a/.fossil-settings/crnl-glob +++ b/.fossil-settings/crnl-glob @@ -0,0 +1,6 @@ +win/buildall.vc.bat +win/makefile.bc +win/makefile.vc +win/mkd.bat +win/rmd.bat +win/rules.vc diff --git a/.fossil-settings/encoding-glob b/.fossil-settings/encoding-glob new file mode 100644 index 0000000..7175730 --- /dev/null +++ b/.fossil-settings/encoding-glob @@ -0,0 +1,6 @@ +win/buildall.vc.bat +win/makefile.bc +win/makefile.vc +win/mkd.bat +win/rmd.bat +win/rules.vc @@ -33,7 +33,7 @@ a better first place to look now. * library/ttk/progress.tcl: Bug [c597acdab3]: Call [$pb step] in tail position in ttk::progressbar::Autoincrement, so that the widget is in a consistent state when any write traces on - the linked -variable are fired. + the linked -variable are fired. 2013-08-14 Jan Nijtmans <nijtmans@users.sf.net> @@ -156,6 +156,12 @@ a better first place to look now. * generic/tkTextIndex.c: [Bug 3588824]: bug in image index handling * tests/textIndex.test: for weird image names +2012-11-16 Joe Mistachkin <joe@mistachkin.com> + + * generic/tkBind.c: Add support for an 'M' binding substitution + that is replaced with the number of script-based binding patterns + matched so far for the event. + 2012-11-14 Jan Nijtmans <nijtmans@users.sf.net> * win/tkWinDialog.c: [Bug 3500545]: tk_getOpenFile -multiple 1 wrong @@ -1,5 +1,5 @@ README: Tk - This is the Tk 8.6.1 source distribution. + This is the Tk 8.6.4 source distribution. http://sourceforge.net/projects/tcl/files/Tcl/ You can get any source release of Tk from the URL above. @@ -7073,3 +7073,97 @@ Many revisions to better support a Cygwin environment (nijtmans) 2013-08-25 (bug fix)[3016181] Cocoa: [destroy $scrollbar] => crash (goddard) --- Released 8.6.1, September 19, 2013 --- http://core.tcl.tk/tk/ for details + +2013-10-27 (bug fix) OSX drawing lags (deily,steffen,walzer) + +2013-10-28 (bug fix)[3603436] png wrong component indices (nijtmans) + +2013-10-31 (bug fix) C++ friendly stubs struct declarations (nijtmans) + +2013-10-31 (bug fix)[c0cc9fd] PNG parser accept uppercase -format (nijtmans) + +2013-10-31 (bug fix) double free of a TkFont (nijtmans) + +2013-11-03 (bug fix)[1632447] support PPM maxval up to 65535 (fellows) + +2013-11-05 (bug fix)[426679e] OpenBSD man page rendering (nijtmans) + +2013-11-11 (bug fix)[f214b8a] multi-interp font teardown double free (porter) + +2013-11-11 (bug fix)[0aa5e85] option file \n syntax support (nijtmans) + +2013-11-20 (platforms) Support for Windows 8.1 (nijtmans) + +2014-01-23 (bug fix)[3606644] X: correct fontconfig dependence (venable) + +2014-01-23 (bug fix) FreeBSD build fixes (cerutti) + +2014-02-06 (bug fix)[3279221] [menu] event race (danckaert,kupries) + +2014-02-07 (bug fix)[6867cc1] creative writing in [tk fontchooser] (nijtmans) + +2014-02-11 (bug fix)[52ca3e7] XkbOpenDisplay macro correction (nijtmans) + +2014-03-16 (bug fix) Xcode 5.1 update; Retina displays (walzer) + +2014-03-20 (bug fix)[2f7cbd0] FreeBSD 10.0 build failure (nijtmans) + +2014-04-01 (bug fix)[5bcb502] @TK_LIBS@ in pkgconfig (badshah400,nijtmans) + +2014-05-27 (bug fix)[a80f5d7] autoscroll initiation (crogers,english) + +2014-07-07 (bug fix) OSX alpha channel rendering (culler,walzer) + +2014-07-08 (workaround)[4955f5d] Ocaml trouble with tailcall splice (nijtmans) + +2014-07-24 (bug fix) OSX [text] image display & scrolling (culler,walzer) + +2014-08-01 (bug fix) OSX font config crash (rob@bitkeeper) + +--- Released 8.6.2, August 27, 2014 --- http://core.tcl.tk/tk/ for details + +2014-08-27 (bug) Cocoa: Crash after [$button destroy] (walzer) + +2014-09-23 (bug) Cocoa: button and scroll display fixes (walzer) + +2014-09-24 (bug) Cocoa: improved drawing performance (walzer) + +2014-10-11 (bug)[9e487e] Phony button clicks from browsers to plugin (nijtmans) + +2014-10-11 (bug)[810c43] [text] elide changes advance epoch (vogel) + +2014-10-14 (bug)[fb35eb] fix PNG transparency appearance (walton,culler) + +2014-10-18 (feature)[TIP 432] Win: updated file dialogs (nadkarni) + +2014-10-26 Support for Windows 10 (nijtmans) + +2014-10-28 (bug) OSX: Improved ttk notebook tab metrics for Yosemite (walzer) + +2014-10-30 (bug)[3417012] [scale -digits $bigValue] segfault (vogel) + +2014-11-07 (bug)[3529885] [scale] handling of negative resolution (vogel) + +--- Released 8.6.3, November 12, 2014 --- http://core.tcl.tk/tk/ for details + +2014-11-14 (bug)[d43a10] shimmer-related crash in [tk_getOpenFile] (nadkarni) + +2014-11-23 (bug)[1c0d6e] Win build trouble with SIGDN (keene) + +2014-12-03 (bug)[4a0451] [tk_getOpenFile] result (nadkarni) + +2014-12-13 fix header files installation on OS X (houben) + +2015-01-02 (bug) Stop bit loss in [winfo id] on 64-bit Cocoa (porter) + +2015-02-06 (bug) several fixes to elided context in [text] (vogel) + +2015-02-06 (new feature)[TIP 433] %M binding substitution (mistachkin) + *** POTENTIAL INCOMPATIBILITY *** + +2015-02-22 (bug)[ab6dab] corrupt dashed lines in postscript (porter) + +Tk Cocoa 2.0: App Store enabled (walzer,culler,desmera,owen,nyberg,reincke) + *** POTENTIAL INCOMPATIBILITY *** + +--- Released 8.6.4, March 12, 2015 --- http://core.tcl.tk/tk/ for details diff --git a/compat/limits.h b/compat/limits.h deleted file mode 100644 index 2cb082b..0000000 --- a/compat/limits.h +++ /dev/null @@ -1,22 +0,0 @@ -/* - * limits.h -- - * - * This is a dummy header file to #include in Tcl when there - * is no limits.h in /usr/include. There are only a few - * definitions here; also see tclPort.h, which already - * #defines some of the things here if they're not arleady - * defined. - * - * Copyright (c) 1991 The Regents of the University of California. - * Copyright (c) 1994 Sun Microsystems, Inc. - * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ - -#define LONG_MIN 0x80000000 -#define LONG_MAX 0x7fffffff -#define INT_MIN 0x80000000 -#define INT_MAX 0x7fffffff -#define SHRT_MIN 0x8000 -#define SHRT_MAX 0x7fff @@ -205,9 +205,7 @@ always routed to the window that currently has focus. When the event is received you can use the \fB%D\fR substitution to get the \fIdelta\fR field for the event, which is a integer value describing how the mouse wheel has moved. The smallest value for which the -system will report is defined by the OS. On Windows 95 & 98 machines -this value is at least 120 before it is reported. However, higher -resolution devices may be available in the future. The sign of the +system will report is defined by the OS. The sign of the value determines which direction your widget should scroll. Positive values should scroll up and negative values should scroll down. .IP "\fBKeyPress\fR, \fBKeyRelease\fR" 5 @@ -527,9 +525,7 @@ The \fIborder_width\fR field from the event. Valid only for .IP \fB%D\fR 5 This reports the \fIdelta\fR value of a \fBMouseWheel\fR event. The \fIdelta\fR value represents the rotation units the mouse wheel has -been moved. On Windows 95 & 98 systems the smallest value for the -delta is 120. Future systems may support higher resolution values for -the delta. The sign of the value represents the direction the mouse +been moved. The sign of the value represents the direction the mouse wheel was scrolled. .IP \fB%E\fR 5 The \fIsend_event\fR field from the event. Valid for all event types. @@ -541,6 +537,9 @@ event generated by \fBSendEvent\fR. .IP \fB%K\fR 5 The keysym corresponding to the event, substituted as a textual string. Valid only for \fBKeyPress\fR and \fBKeyRelease\fR events. +.IP \fB%M\fR 5 +The number of script-based binding patterns matched so far for the +event. Valid for all event types. .IP \fB%N\fR 5 The keysym corresponding to the event, substituted as a decimal number. Valid only for \fBKeyPress\fR and \fBKeyRelease\fR events. diff --git a/doc/chooseDirectory.n b/doc/chooseDirectory.n index 295c75b..86c593d 100644 --- a/doc/chooseDirectory.n +++ b/doc/chooseDirectory.n @@ -19,8 +19,11 @@ possible as command line arguments: .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, then -the directories in the current working directory are displayed. If the +when the dialog pops up. If this parameter is not specified, +the initial directory defaults to the current working directory +on non-Windows systems and on Windows systems prior to Vista. +On Vista and later systems, the initial directory defaults to the last +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 diff --git a/doc/colors.n b/doc/colors.n index ee44f7b..dc7007b 100644 --- a/doc/colors.n +++ b/doc/colors.n @@ -3,8 +3,6 @@ '\" Copyright (c) 2003 ActiveState Corporation. '\" Copyright (c) 2006-2007 Daniel A. Steffen <das@users.sourceforge.net> '\" Copyright (c) 2008 Donal K. Fellows -'\" -'\" '\" .TH colors n 8.3 Tk "Tk Built-In Commands" .so man.macros @@ -29,6 +27,7 @@ AntiqueWhite1 255 239 219 AntiqueWhite2 238 223 204 AntiqueWhite3 205 192 176 AntiqueWhite4 139 131 120 +agua 0 255 255 aquamarine 127 255 212 aquamarine1 127 255 212 aquamarine2 118 238 198 @@ -93,6 +92,7 @@ cornsilk1 255 248 220 cornsilk2 238 232 205 cornsilk3 205 200 177 cornsilk4 139 136 120 +crymson 220 20 60 cyan 0 255 255 cyan1 0 255 255 cyan2 0 238 238 @@ -191,6 +191,7 @@ floral white 255 250 240 FloralWhite 255 250 240 forest green 34 139 34 ForestGreen 34 139 34 +fuchsia 255 0 255 gainsboro 220 220 220 ghost white 248 248 255 GhostWhite 248 248 255 @@ -204,7 +205,7 @@ goldenrod1 255 193 37 goldenrod2 238 180 34 goldenrod3 205 155 29 goldenrod4 139 105 20 -gray 190 190 190 +gray 128 128 128 gray0 0 0 0 gray1 3 3 3 gray2 5 5 5 @@ -306,14 +307,14 @@ gray97 247 247 247 gray98 250 250 250 gray99 252 252 252 gray100 255 255 255 -green 0 255 0 +green 0 128 0 green yellow 173 255 47 green1 0 255 0 green2 0 238 0 green3 0 205 0 green4 0 139 0 GreenYellow 173 255 47 -grey 190 190 190 +grey 128 128 128 grey0 0 0 0 grey1 3 3 3 grey2 5 5 5 @@ -432,6 +433,7 @@ IndianRed1 255 106 106 IndianRed2 238 99 99 IndianRed3 205 85 85 IndianRed4 139 58 58 +indigo 75 0 130 ivory 255 255 240 ivory1 255 255 240 ivory2 238 238 224 @@ -523,6 +525,7 @@ LightYellow1 255 255 224 LightYellow2 238 238 209 LightYellow3 205 205 180 LightYellow4 139 139 122 +lime 0 255 0 lime green 50 205 50 LimeGreen 50 205 50 linen 250 240 230 @@ -531,7 +534,7 @@ magenta1 255 0 255 magenta2 238 0 238 magenta3 205 0 205 magenta4 139 0 139 -maroon 176 48 96 +maroon 128 0 0 maroon1 255 52 179 maroon2 238 48 167 maroon3 205 41 144 @@ -584,6 +587,7 @@ navy blue 0 0 128 NavyBlue 0 0 128 old lace 253 245 230 OldLace 253 245 230 +olive 128 128 0 olive drab 107 142 35 OliveDrab 107 142 35 OliveDrab1 192 255 62 @@ -647,7 +651,7 @@ plum3 205 150 205 plum4 139 102 139 powder blue 176 224 230 PowderBlue 176 224 230 -purple 160 32 240 +purple 128 0 128 purple1 155 48 255 purple2 145 44 238 purple3 125 38 205 @@ -694,6 +698,7 @@ sienna1 255 130 71 sienna2 238 121 66 sienna3 205 104 57 sienna4 139 71 38 +silver 192 192 192 sky blue 135 206 235 SkyBlue 135 206 235 SkyBlue1 135 206 255 @@ -736,6 +741,7 @@ tan1 255 165 79 tan2 238 154 73 tan3 205 133 63 tan4 139 90 43 +teal 0 128 128 thistle 216 191 216 thistle1 255 225 255 thistle2 238 210 238 @@ -927,19 +933,19 @@ On Windows, the following additional system colors are available .RS .DS .ta 6c -3dDarkShadow Highlight -3dLight HighlightText -ActiveBorder InactiveBorder -ActiveCaption InactiveCaption -AppWorkspace InactiveCaptionText -Background InfoBackground -ButtonFace InfoText -ButtonHighlight Menu -ButtonShadow MenuText -ButtonText Scrollbar -CaptionText Window -DisabledText WindowFrame -GrayText WindowText +system3dDarkShadow systemHighlight +system3dLight systemHighlightText +systemActiveBorder systemInactiveBorder +systemActiveCaption systemInactiveCaption +systemAppWorkspace systemInactiveCaptionText +systemBackground systemInfoBackground +systemButtonFace systemInfoText +systemButtonHighlight systemMenu +systemButtonShadow systemMenuText +systemButtonText systemScrollbar +systemCaptionText systemWindow +systemDisabledText systemWindowFrame +systemGrayText systemWindowText .DE .RE .SH "SEE ALSO" diff --git a/doc/event.n b/doc/event.n index 11782dd..7a3cfca 100644 --- a/doc/event.n +++ b/doc/event.n @@ -546,7 +546,7 @@ the physical event. .PP Bindings on a virtual event may be created before the virtual event exists. Indeed, the virtual event never actually needs to be defined, for instance, -on platforms where the specific virtual event would meaningless or +on platforms where the specific virtual event would be meaningless or ungeneratable. .PP When a definition of a virtual event changes at run time, all windows diff --git a/doc/getOpenFile.n b/doc/getOpenFile.n index 95884bb..f5e92ff 100644 --- a/doc/getOpenFile.n +++ b/doc/getOpenFile.n @@ -65,8 +65,11 @@ discussion on the contents of \fIfilePatternList\fR. \fB\-initialdir\fR \fIdirectory\fR . Specifies that the files in \fIdirectory\fR should be displayed -when the dialog pops up. If this parameter is not specified, then -the files in the current working directory are displayed. If the +when the dialog pops up. If this parameter is not specified, +the initial directory defaults to the current working directory +on non-Windows systems and on Windows systems prior to Vista. +On Vista and later systems, the initial directory defaults to the last +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 diff --git a/doc/listbox.n b/doc/listbox.n index 1da40fd..0f263b4 100644 --- a/doc/listbox.n +++ b/doc/listbox.n @@ -453,7 +453,7 @@ it and deselects any other selected item. In \fBbrowse\fR mode it is also possible to drag the selection with button 1. On button 1, the listbox will also take focus if it has a \fBnormal\fR -state and \fB\-takefocus\fR is true. +state. .PP If the selection mode is \fBmultiple\fR or \fBextended\fR, any number of elements may be selected at once, including discontiguous @@ -469,9 +469,12 @@ Most people will probably want to use \fBbrowse\fR mode for single selections and \fBextended\fR mode for multiple selections; the other modes appear to be useful only in special situations. .PP -Any time the selection changes in the listbox, the virtual event -\fB<<ListboxSelect>>\fR will be generated. It is easiest to bind -to this event to be made aware of any changes to listbox selection. +Any time the set of selected item(s) in the listbox is updated by the +user through the keyboard or mouse, the virtual event +\fB<<ListboxSelect>>\fR will be generated. This virtual event will not +be generated when adjusting the selection with the \fIpathName +\fBselection\fR command. It is easiest to bind to this event to be +made aware of any user changes to listbox selection. .PP In addition to the above behavior, the following additional behavior is defined by the default bindings: @@ -304,16 +304,10 @@ operations on the widget. It has the following general form: determine the exact behavior of the command. .PP Many of the widget commands for a menu take as one argument an -indicator of which entry of the menu to operate on. These +indicator of which entry of the menu to operate on. These indicators are called \fIindex\fRes and may be specified in any of the following forms: .TP 12 -\fInumber\fR -. -Specifies the entry numerically, where 0 corresponds -to the top-most entry of the menu, 1 to the entry below it, and -so on. -.TP 12 \fBactive\fR . Indicates the entry that is currently active. If no entry is @@ -348,6 +342,12 @@ For example, .QW \fB@0\fR indicates the top-most entry in the window. .TP 12 +\fInumber\fR +. +Specifies the entry numerically, where 0 corresponds +to the top-most entry of the menu, 1 to the entry below it, and +so on. +.TP 12 \fIpattern\fR . If the index does not satisfy one of the above forms then this @@ -356,6 +356,9 @@ each entry in the menu, in order from the top down, until a matching entry is found. The rules of \fBstring match\fR are used. .PP +If the index could match more than one of the above forms, then +the form earlier in the above list takes precedence. +.PP The following widget commands are possible for menu widgets: .TP \fIpathName \fBactivate \fIindex\fR diff --git a/doc/messageBox.n b/doc/messageBox.n index 0b4554c..5ce1745 100644 --- a/doc/messageBox.n +++ b/doc/messageBox.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 tk_messageBox n 4.2 Tk "Tk Built-In Commands" .so man.macros .BS @@ -50,9 +50,8 @@ displayed. .TP \fB\-message\fR \fIstring\fR . -Specifies the message to display in this message box. This option is ignored -on Mac OS X, where platform guidelines forbid the use of a title on this kind -of dialog. +Specifies the message to display in this message box. The +default value is an empty string. .TP \fB\-parent\fR \fIwindow\fR . @@ -61,8 +60,9 @@ box is displayed on top of its parent window. .TP \fB\-title\fR \fItitleString\fR . -Specifies a string to display as the title of the message box. The -default value is an empty string. +Specifies a string to display as the title of the message box. This option +is ignored on Mac OS X, where platform guidelines forbid the use of a title +on this kind of dialog. .TP \fB\-type\fR \fIpredefinedType\fR . diff --git a/doc/panedwindow.n b/doc/panedwindow.n index c199e63..e2c954a 100644 --- a/doc/panedwindow.n +++ b/doc/panedwindow.n @@ -29,6 +29,16 @@ 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 \-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. +.OP \-proxyborderwidth proxyBorderWidth ProxyBorderWidth +Specifies the borderwidth of the proxy. May be any value accepted by +\fBTk_GetPixels\fR. +.OP \-proxyrelief proxyRelief ProxyRelief +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). @@ -311,6 +321,15 @@ adjusted. When a pane is resized from outside (e.g. it is packed to expand and fill, and the containing toplevel is resized), space is added to the final (rightmost or bottommost) pane in the window. +.PP +Unlike slave windows managed by e.g. pack or grid, the panes managed by a +panedwindow do not change width or height to accomodate changes in the +requested widths or heights of the panes, once these have become mapped. +Therefore it may be advisable, particularly when creating layouts +interactively, to not add a pane to the panedwindow widget until after the +geometry requests of that pane has been finalized (i.e., all components of +the pane inserted, all options affecting geometry set to their proper +values, etc.). .SH "SEE ALSO" ttk::panedwindow(n) .SH KEYWORDS diff --git a/doc/spinbox.n b/doc/spinbox.n index 1e8cb3a..7227cf1 100644 --- a/doc/spinbox.n +++ b/doc/spinbox.n @@ -196,7 +196,7 @@ dangerous to mix. Any problems have been overcome so that using the the spinbox widget. Using the \fB\-textvariable\fR for read-only purposes will never cause problems. The danger comes when you try set the \fB\-textvariable\fR to something that the \fB\-validatecommand\fR would not -accept, which causes \fB\-validate\fR to become \fInone\fR (the +accept, which causes \fB\-validate\fR to become \fBnone\fR (the \fB\-invalidcommand\fR will not be triggered). The same happens when an error occurs evaluating the \fB\-validatecommand\fR. .PP @@ -216,6 +216,16 @@ in the \fB\-validatecommand\fR or \fB\-invalidcommand\fR (whichever one you were editing the spinbox widget from). It is also recommended to not set an associated \fB\-textvariable\fR during validation, as that can cause the spinbox widget to become out of sync with the \fB\-textvariable\fR. +.PP +Also, the \fBvalidate\fR option will set itself to \fBnone\fR when the +spinbox value gets changed because of adjustment of \fBfrom\fR or \fBto\fR +and the \fBvalidateCommand\fR returns false. For instance +.CS + \fIspinbox pathName \-from 1 \-to 10 \-validate all \-vcmd {return 0}\fR +.CE +will in fact set the \fBvalidate\fR option to \fBnone\fR because the default +value for the spinbox gets changed (due to the \fBfrom\fR and \fBto\fR +options) to a value not accepted by the validation script. .SH "WIDGET COMMAND" .PP The \fBspinbox\fR command creates a new Tcl command whose @@ -634,15 +634,23 @@ embedded window annotation causes a window to be displayed at a particular point in the text. There may be any number of embedded windows in a text widget, and any widget may be used as an embedded window (subject to the usual rules for geometry management, which require the text window to be the parent -of the embedded window or a descendant of its parent). The embedded window's -position on the screen will be updated as the text is modified or scrolled, -and it will be mapped and unmapped as it moves into and out of the visible -area of the text widget. Each embedded window occupies one unit's worth of -index space in the text widget, and it may be referred to either by the name -of its embedded window or by its position in the widget's index space. If the -range of text containing the embedded window is deleted then the window is -destroyed. Similarly if the text widget as a whole is deleted, then the window -is destroyed. +of the embedded window or a descendant of its parent). +.PP +The embedded window's position on the screen will be updated as the text is +modified or scrolled, and it will be mapped and unmapped as it moves into and +out of the visible area of the text widget. Each embedded window occupies one +unit's worth of index space in the text widget, and it may be referred to +either by the name of its embedded window or by its position in the widget's +index space. If the range of text containing the embedded window is deleted +then the window is destroyed. Similarly if the text widget as a whole is +deleted, then the window is destroyed. +.PP +Eliding an embedded window immediately after scheduling it for creation via +\fIpathName \fBwindow create \fIindex \fB-create\fR will prevent it from being +effectively created. Uneliding an elided embedded window scheduled for creation +via \fIpathName \fBwindow create \fIindex \fB-create\fR will automatically +trigger the associated creation script. After destroying an elided embedded +window, the latter won't get automatically recreated. .PP When an embedded window is added to a text widget with the \fIpathName \fBwindow create\fR widget command, several configuration options may be @@ -706,13 +714,22 @@ The final form of annotation in text widgets is an embedded image. Each embedded image annotation causes an image to be displayed at a particular point in the text. There may be any number of embedded images in a text widget, and a particular image may be embedded in multiple places in the same -text widget. The embedded image's position on the screen will be updated as -the text is modified or scrolled. Each embedded image occupies one unit's -worth of index space in the text widget, and it may be referred to either by -its position in the widget's index space, or the name it is assigned when the -image is inserted into the text widget with \fIpathName \fBimage create\fR. If -the range of text containing the embedded image is deleted then that copy of -the image is removed from the screen. +text widget. +.PP +The embedded image's position on the screen will be updated as the text is +modified or scrolled. Each embedded image occupies one unit's worth of index +space in the text widget, and it may be referred to either by its position in +the widget's index space, or the name it is assigned when the image is inserted +into the text widget with \fIpathName \fBimage create\fR. If the range of text +containing the embedded image is deleted then that copy of the image is removed +from the screen. +.PP +Eliding an embedded image immediately after scheduling it for creation via +\fIpathName \fBimage create \fIindex \fB-create\fR will prevent it from being +effectively created. Uneliding an elided embedded image scheduled for creation +via \fIpathName \fBimage create \fIindex \fB-create\fR will automatically +trigger the associated creation script. After destroying an elided embedded +image, the latter won't get automatically recreated. .PP When an embedded image is added to a text widget with the \fIpathName \fBimage create\fR widget command, a name unique to this instance of the image is @@ -959,11 +976,12 @@ each counting option given. Valid counting options are \fB\-chars\fR, \fB\-displaychars\fR, \fB\-displayindices\fR, \fB\-displaylines\fR, \fB\-indices\fR, \fB\-lines\fR, \fB\-xpixels\fR and \fB\-ypixels\fR. The default value, if no option is specified, is \fB\-indices\fR. There is an -additional possible option \fB\-update\fR which is a modifier. If given, then -all subsequent options ensure that any possible out of date information is -recalculated. This currently only has any effect for the \fB\-ypixels\fR count -(which, if \fB\-update\fR is not given, will use the text widget's current -cached value for each line). The count options are interpreted as follows: +additional possible option \fB\-update\fR which is a modifier. If given (and +if the text widget is managed by a geometry manager), then all subsequent +options ensure that any possible out of date information is recalculated. +This currently only has any effect for the \fB\-ypixels\fR count (which, if +\fB\-update\fR is not given, will use the text widget's current cached value +for each line). The count options are interpreted as follows: .RS .IP \fB\-chars\fR count all characters, whether elided or not. Do not count embedded windows or @@ -1071,8 +1089,8 @@ including \fIindex2\fR, including the text and information about marks, tags, and embedded windows. If \fIindex2\fR is not specified, then it defaults to one character past \fIindex1\fR. The information is returned in the following format: -.LP .RS +.LP \fIkey1 value1 index1 key2 value2 index2\fR ... .LP The possible \fIkey\fR values are \fBtext\fR, \fBmark\fR, \fBtagon\fR, @@ -1974,9 +1992,8 @@ the clipboard. Control-t reverses the order of the two characters to the right of the insertion cursor. .IP [32] -Control-z (and Control-underscore on UNIX when \fBtk_strictMotif\fR is true) -undoes the last edit action if the \fB\-undo\fR option is true. Does nothing -otherwise. +Control-z undoes the last edit action if the \fB\-undo\fR option is true. +Does nothing otherwise. .IP [33] Control-Z (or Control-y on Windows) reapplies the last undone edit action if the \fB\-undo\fR option is true. Does nothing otherwise. diff --git a/generic/tk.h b/generic/tk.h index 8f03b54..4a655a4 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 0 +#define TK_RELEASE_SERIAL 4 #define TK_VERSION "8.6" -#define TK_PATCH_LEVEL "8.6.1" +#define TK_PATCH_LEVEL "8.6.4" /* * A special definition used to allow this header file to be included from diff --git a/generic/tkBind.c b/generic/tkBind.c index fbac56d..9cd3b7b 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.c @@ -16,9 +16,9 @@ #ifdef _WIN32 #include "tkWinInt.h" -#endif - -#if !(defined(_WIN32) || defined(MAC_OSX_TK)) /* UNIX */ +#elif defined(MAC_OSX_TK) +#include "tkMacOSXInt.h" +#else #include "tkUnixInt.h" #endif @@ -167,7 +167,7 @@ typedef struct { * button (0 means any buttons are OK). For * virtual events, specifies the Tk_Uid of the * virtual event name (never 0). */ -} Pattern; +} TkPattern; /* * The following structure defines a pattern sequence, which consists of one @@ -209,7 +209,7 @@ typedef struct PatSeq { * for end of list). Needed to implement * Tk_DeleteAllBindings. In a virtual event * table, always NULL. */ - Pattern pats[1]; /* Array of "numPats" patterns. Only one + TkPattern pats[1]; /* Array of "numPats" patterns. Only one * element is declared here but in actuality * enough space will be allocated for * "numPats" patterns. To match, pats[0] must @@ -612,7 +612,8 @@ static int DeleteVirtualEvent(Tcl_Interp *interp, const char *eventString); static void DeleteVirtualEventTable(VirtualEventTable *vetPtr); static void ExpandPercents(TkWindow *winPtr, const char *before, - XEvent *eventPtr,KeySym keySym,Tcl_DString *dsPtr); + XEvent *eventPtr,KeySym keySym, + unsigned int scriptCount, Tcl_DString *dsPtr); static PatSeq * FindSequence(Tcl_Interp *interp, Tcl_HashTable *patternTablePtr, ClientData object, const char *eventString, int create, @@ -635,7 +636,7 @@ static PatSeq * MatchPatterns(TkDisplay *dispPtr, static int NameToWindow(Tcl_Interp *interp, Tk_Window main, Tcl_Obj *objPtr, Tk_Window *tkwinPtr); static int ParseEventDescription(Tcl_Interp *interp, - const char **eventStringPtr, Pattern *patPtr, + const char **eventStringPtr, TkPattern *patPtr, unsigned long *eventMaskPtr); static void DoWarp(ClientData clientData); @@ -1221,6 +1222,7 @@ Tk_BindEvent( XEvent *ringPtr; PatSeq *vMatchDetailList, *vMatchNoDetailList; int flags, oldScreen; + unsigned int scriptCount; Tcl_Interp *interp; Tcl_DString scripts; Tcl_InterpState interpState; @@ -1372,6 +1374,7 @@ Tk_BindEvent( * each object. */ + scriptCount = 0; Tcl_DStringInit(&scripts); for ( ; numObjects > 0; numObjects--, objectPtr++) { @@ -1421,7 +1424,7 @@ Tk_BindEvent( if (matchPtr != NULL) { ExpandPercents(winPtr, sourcePtr->script, eventPtr, - detail.keySym, &scripts); + detail.keySym, scriptCount++, &scripts); /* * A "" is added to the scripts string to separate the various @@ -1601,7 +1604,7 @@ MatchPatterns( for ( ; psPtr != NULL; psPtr = psPtr->nextSeqPtr) { XEvent *eventPtr = &bindPtr->eventRing[bindPtr->curEvent]; Detail *detailPtr = &bindPtr->detailRing[bindPtr->curEvent]; - Pattern *patPtr = psPtr->pats; + TkPattern *patPtr = psPtr->pats; Window window = eventPtr->xany.window; int patCount, ringCount, flags, state, modMask, i; @@ -1815,7 +1818,7 @@ MatchPatterns( */ if (bestPtr != NULL) { - Pattern *patPtr2; + TkPattern *patPtr2; if (matchPtr->numPats != bestPtr->numPats) { if (bestPtr->numPats > matchPtr->numPats) { @@ -1903,6 +1906,8 @@ ExpandPercents( * in % replacements. */ KeySym keySym, /* KeySym: only relevant for KeyPress and * KeyRelease events). */ + unsigned int scriptCount, /* The number of script-based binding patterns + * matched so far for this event. */ Tcl_DString *dsPtr) /* Dynamic string in which to append new * command. */ { @@ -2184,6 +2189,9 @@ ExpandPercents( } } goto doString; + case 'M': + number = scriptCount; + goto doNumber; case 'N': if ((flags & KEY) && (eventPtr->type != MouseWheelEvent)) { number = (int) keySym; @@ -2879,7 +2887,7 @@ HandleEventGenerate( const char *name, *windowName; int count, flags, synch, i, number, warp; Tcl_QueuePosition pos; - Pattern pat; + TkPattern pat; Tk_Window tkwin, tkwin2; TkWindow *mainPtr; unsigned long eventMask; @@ -3618,10 +3626,10 @@ FindSequence( unsigned long *maskPtr) /* *maskPtr is filled in with the event types * on which this pattern sequence depends. */ { - Pattern pats[EVENT_BUFFER_SIZE]; + TkPattern pats[EVENT_BUFFER_SIZE]; int numPats, virtualFound; const char *p; - Pattern *patPtr; + TkPattern *patPtr; PatSeq *psPtr; Tcl_HashEntry *hPtr; int flags, count, isNew; @@ -3707,7 +3715,7 @@ FindSequence( key.type = patPtr->eventType; key.detail = patPtr->detail; hPtr = Tcl_CreateHashEntry(patternTablePtr, (char *) &key, &isNew); - sequenceSize = numPats*sizeof(Pattern); + sequenceSize = numPats*sizeof(TkPattern); if (!isNew) { for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL; psPtr = psPtr->nextSeqPtr) { @@ -3733,7 +3741,7 @@ FindSequence( return NULL; } - psPtr = ckalloc(sizeof(PatSeq) + (numPats-1)*sizeof(Pattern)); + psPtr = ckalloc(sizeof(PatSeq) + (numPats-1)*sizeof(TkPattern)); psPtr->numPats = numPats; psPtr->script = NULL; psPtr->flags = flags; @@ -3777,7 +3785,7 @@ ParseEventDescription( const char **eventStringPtr,/* On input, holds a pointer to start of event * string. On exit, gets pointer to rest of * string after parsed event. */ - Pattern *patPtr, /* Filled with the pattern parsed from the + TkPattern *patPtr, /* Filled with the pattern parsed from the * event string. */ unsigned long *eventMaskPtr)/* Filled with event mask of matched event. */ { @@ -4065,7 +4073,7 @@ static Tcl_Obj * GetPatternObj( PatSeq *psPtr) { - Pattern *patPtr; + TkPattern *patPtr; int patsLeft, needMods; const ModInfo *modPtr; const EventInfo *eiPtr; @@ -4113,15 +4121,15 @@ GetPatternObj( Tcl_AppendToObj(patternObj, "<", 1); if ((psPtr->flags & PAT_NEARBY) && (patsLeft > 1) - && (memcmp(patPtr, patPtr-1, sizeof(Pattern)) == 0)) { + && (memcmp(patPtr, patPtr-1, sizeof(TkPattern)) == 0)) { patsLeft--; patPtr--; if ((patsLeft > 1) && - (memcmp(patPtr, patPtr-1, sizeof(Pattern)) == 0)) { + (memcmp(patPtr, patPtr-1, sizeof(TkPattern)) == 0)) { patsLeft--; patPtr--; if ((patsLeft > 1) && - (memcmp(patPtr, patPtr-1, sizeof(Pattern)) == 0)) { + (memcmp(patPtr, patPtr-1, sizeof(TkPattern)) == 0)) { patsLeft--; patPtr--; Tcl_AppendToObj(patternObj, "Quadruple-", 10); diff --git a/generic/tkBitmap.c b/generic/tkBitmap.c index 729fff4..88f3e2b 100644 --- a/generic/tkBitmap.c +++ b/generic/tkBitmap.c @@ -305,7 +305,7 @@ GetBitmap( TkBitmap *bitmapPtr, *existingBitmapPtr; TkPredefBitmap *predefPtr; Pixmap bitmap; - int isNew, width, height, dummy2; + int isNew, width = 0, height = 0, dummy2; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); diff --git a/generic/tkCanvUtil.c b/generic/tkCanvUtil.c index 23c73e5..cbbc2b4 100644 --- a/generic/tkCanvUtil.c +++ b/generic/tkCanvUtil.c @@ -1432,7 +1432,7 @@ Tk_CanvasPsOutline( char *p = ptr; converted = Tcl_ObjPrintf("%d", *p++ & 0xff); - for (i = dash->number-1 ; i>=0 ; i--) { + for (i = dash->number-1 ; i>0 ; i--) { Tcl_AppendPrintfToObj(converted, " %d", *p++ & 0xff); } Tcl_AppendObjToObj(psObj, converted); diff --git a/generic/tkCanvas.c b/generic/tkCanvas.c index 8e14852..9c4d60a 100644 --- a/generic/tkCanvas.c +++ b/generic/tkCanvas.c @@ -2447,6 +2447,19 @@ DisplayCanvas( goto done; } +#ifdef MAC_OSX_TK + /* + * If drawing is disabled, all we need to do is + * clear the REDRAW_PENDING flag. + */ + TkWindow *winPtr = (TkWindow *)(canvasPtr->tkwin); + MacDrawable *macWin = winPtr->privatePtr; + if (macWin && (macWin->flags & TK_DO_NOT_DRAW)){ + canvasPtr->flags &= ~REDRAW_PENDING; + return; + } +#endif + /* * Choose a new current item if that is needed (this could cause event * handlers to be invoked). diff --git a/generic/tkCmds.c b/generic/tkCmds.c index a4f2ed9..6196b17 100644 --- a/generic/tkCmds.c +++ b/generic/tkCmds.c @@ -2094,7 +2094,7 @@ TkGetDisplayOf( /* *---------------------------------------------------------------------- * - * TkDeadAppCmd -- + * TkDeadAppObjCmd -- * * If an application has been deleted then all Tk commands will be * re-bound to this function. @@ -2111,15 +2111,15 @@ TkGetDisplayOf( /* ARGSUSED */ int -TkDeadAppCmd( +TkDeadAppObjCmd( ClientData clientData, /* Dummy. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't invoke \"%s\" command: application has been destroyed", - argv[0])); + Tcl_GetString(objv[0]))); return TCL_ERROR; } diff --git a/generic/tkEntry.c b/generic/tkEntry.c index f68e1a3..36798a2 100644 --- a/generic/tkEntry.c +++ b/generic/tkEntry.c @@ -391,7 +391,7 @@ static const char *const selElementNames[] = { static int ConfigureEntry(Tcl_Interp *interp, Entry *entryPtr, int objc, Tcl_Obj *const objv[], int flags); -static void DeleteChars(Entry *entryPtr, int index, int count); +static int DeleteChars(Entry *entryPtr, int index, int count); static void DestroyEntry(void *memPtr); static void DisplayEntry(ClientData clientData); static void EntryBlinkProc(ClientData clientData); @@ -417,7 +417,7 @@ static int EntryValidateChange(Entry *entryPtr, const char *change, static void ExpandPercents(Entry *entryPtr, const char *before, const char *change, const char *newStr, int index, int type, Tcl_DString *dsPtr); -static void EntryValueChanged(Entry *entryPtr, +static int EntryValueChanged(Entry *entryPtr, const char *newValue); static void EntryVisibleRange(Entry *entryPtr, double *firstPtr, double *lastPtr); @@ -427,7 +427,7 @@ static int EntryWidgetObjCmd(ClientData clientData, static void EntryWorldChanged(ClientData instanceData); static int GetEntryIndex(Tcl_Interp *interp, Entry *entryPtr, const char *string, int *indexPtr); -static void InsertChars(Entry *entryPtr, int index, const char *string); +static int InsertChars(Entry *entryPtr, int index, const char *string); /* * These forward declarations are the spinbox specific ones: @@ -664,7 +664,7 @@ EntryWidgetObjCmd( break; case COMMAND_DELETE: { - int first, last; + int first, last, code; if ((objc < 3) || (objc > 4)) { Tcl_WrongNumArgs(interp, 2, objv, "firstIndex ?lastIndex?"); @@ -681,7 +681,10 @@ EntryWidgetObjCmd( goto error; } if ((last >= first) && (entryPtr->state == STATE_NORMAL)) { - DeleteChars(entryPtr, first, last - first); + code = DeleteChars(entryPtr, first, last - first); + if (code != TCL_OK) { + goto error; + } } break; } @@ -722,7 +725,7 @@ EntryWidgetObjCmd( } case COMMAND_INSERT: { - int index; + int index, code; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "index text"); @@ -733,7 +736,10 @@ EntryWidgetObjCmd( goto error; } if (entryPtr->state == STATE_NORMAL) { - InsertChars(entryPtr, index, Tcl_GetString(objv[3])); + code = InsertChars(entryPtr, index, Tcl_GetString(objv[3])); + if (code != TCL_OK) { + goto error; + } } break; } @@ -1098,6 +1104,7 @@ ConfigureEntry( int valuesChanged = 0; /* lint initialization */ double oldFrom = 0.0; /* lint initialization */ double oldTo = 0.0; /* lint initialization */ + int code; /* * Eliminate any existing trace on a variable monitored by the entry. @@ -1305,6 +1312,17 @@ ConfigureEntry( value = Tcl_GetVar2(interp, entryPtr->textVarName, NULL, TCL_GLOBAL_ONLY); if (value == NULL) { + + /* + * Since any trace on the textvariable was eliminated above, + * the only possible reason for EntryValueChanged to return + * an error is that the textvariable lives in a namespace + * that does not (yet) exist. Indeed, namespaces are not + * automatically created as needed. Don't trap this error + * here, better do it below when attempting to trace the + * variable. + */ + EntryValueChanged(entryPtr, NULL); } else { EntrySetValue(entryPtr, value); @@ -1323,7 +1341,13 @@ ConfigureEntry( */ Tcl_ListObjIndex(interp, sbPtr->listObj, 0, &objPtr); - EntryValueChanged(entryPtr, Tcl_GetString(objPtr)); + + /* + * No check for error return here as well, because any possible + * error will be trapped below when attempting tracing. + */ + + EntryValueChanged(entryPtr, Tcl_GetString(objPtr)); } else if ((sbPtr->valueStr == NULL) && !DOUBLES_EQ(sbPtr->fromValue, sbPtr->toValue) && (!DOUBLES_EQ(sbPtr->fromValue, oldFrom) @@ -1337,7 +1361,7 @@ ConfigureEntry( double dvalue; - if (sscanf(entryPtr->string, "%lf", &dvalue) == 0) { + if (sscanf(entryPtr->string, "%lf", &dvalue) <= 0) { /* Scan failure */ dvalue = sbPtr->fromValue; } else if (dvalue > sbPtr->toValue) { @@ -1346,6 +1370,12 @@ ConfigureEntry( dvalue = sbPtr->fromValue; } sprintf(sbPtr->formatBuf, sbPtr->valueFormat, dvalue); + + /* + * No check for error return here as well, because any possible + * error will be trapped below when attempting tracing. + */ + EntryValueChanged(entryPtr, sbPtr->formatBuf); } } @@ -1357,10 +1387,13 @@ ConfigureEntry( if ((entryPtr->textVarName != NULL) && !(entryPtr->flags & ENTRY_VAR_TRACED)) { - Tcl_TraceVar2(interp, entryPtr->textVarName, + code = Tcl_TraceVar2(interp, entryPtr->textVarName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, EntryTextVarProc, entryPtr); - entryPtr->flags |= ENTRY_VAR_TRACED; + if (code != TCL_OK) { + return TCL_ERROR; + } + entryPtr->flags |= ENTRY_VAR_TRACED; } EntryWorldChanged(entryPtr); @@ -1680,7 +1713,7 @@ DisplayEntry( Tk_CharBbox(entryPtr->textLayout, entryPtr->insertPos, &cursorX, NULL, NULL, NULL); cursorX += entryPtr->layoutX; - cursorX -= (entryPtr->insertWidth)/2; + cursorX -= (entryPtr->insertWidth == 1) ? 1 : (entryPtr->insertWidth)/2; Tk_SetCaretPos(entryPtr->tkwin, cursorX, baseY - fm.ascent, fm.ascent + fm.descent); if (entryPtr->insertPos >= entryPtr->leftIndex && cursorX < xBound) { @@ -1993,7 +2026,8 @@ EntryComputeGeometry( * Add new characters to an entry widget. * * Results: - * None. + * A standard Tcl result. If an error occurred then an error message is + * left in the interp's result. * * Side effects: * New information gets added to entryPtr; it will be redisplayed soon, @@ -2002,12 +2036,12 @@ EntryComputeGeometry( *---------------------------------------------------------------------- */ -static void +static int InsertChars( Entry *entryPtr, /* Entry that is to get the new elements. */ int index, /* Add the new elements before this character * index. */ - const char *value) /* New characters to add (NULL-terminated + const char *value) /* New characters to add (NULL-terminated * string). */ { ptrdiff_t byteIndex; @@ -2020,7 +2054,7 @@ InsertChars( byteIndex = Tcl_UtfAtIndex(string, index) - string; byteCount = strlen(value); if (byteCount == 0) { - return; + return TCL_OK; } newByteCount = entryPtr->numBytes + byteCount + 1; @@ -2034,7 +2068,7 @@ InsertChars( EntryValidateChange(entryPtr, value, newStr, index, VALIDATE_INSERT) != TCL_OK) { ckfree(newStr); - return; + return TCL_OK; } ckfree((char *)string); @@ -2082,7 +2116,7 @@ InsertChars( if (entryPtr->insertPos >= index) { entryPtr->insertPos += charsAdded; } - EntryValueChanged(entryPtr, NULL); + return EntryValueChanged(entryPtr, NULL); } /* @@ -2093,7 +2127,8 @@ InsertChars( * Remove one or more characters from an entry widget. * * Results: - * None. + * A standard Tcl result. If an error occurred then an error message is + * left in the interp's result. * * Side effects: * Memory gets freed, the entry gets modified and (eventually) @@ -2102,7 +2137,7 @@ InsertChars( *---------------------------------------------------------------------- */ -static void +static int DeleteChars( Entry *entryPtr, /* Entry widget to modify. */ int index, /* Index of first character to delete. */ @@ -2116,7 +2151,7 @@ DeleteChars( count = entryPtr->numChars - index; } if (count <= 0) { - return; + return TCL_OK; } string = entryPtr->string; @@ -2138,7 +2173,7 @@ DeleteChars( VALIDATE_DELETE) != TCL_OK) { ckfree(newStr); ckfree(toDelete); - return; + return TCL_OK; } ckfree(toDelete); @@ -2197,7 +2232,7 @@ DeleteChars( entryPtr->insertPos = index; } } - EntryValueChanged(entryPtr, NULL); + return EntryValueChanged(entryPtr, NULL); } /* @@ -2210,7 +2245,8 @@ DeleteChars( * is one, and does other bookkeeping such as arranging for redisplay. * * Results: - * None. + * A standard Tcl result. If an error occurred then an error message is + * left in the interp's result. * * Side effects: * None. @@ -2218,7 +2254,7 @@ DeleteChars( *---------------------------------------------------------------------- */ -static void +static int EntryValueChanged( Entry *entryPtr, /* Entry whose value just changed. */ const char *newValue) /* If this value is not NULL, we first force @@ -2232,7 +2268,7 @@ EntryValueChanged( newValue = NULL; } else { newValue = Tcl_SetVar2(entryPtr->interp, entryPtr->textVarName, - NULL, entryPtr->string, TCL_GLOBAL_ONLY); + NULL, entryPtr->string, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG); } if ((newValue != NULL) && (strcmp(newValue, entryPtr->string) != 0)) { @@ -2254,6 +2290,19 @@ EntryValueChanged( EntryComputeGeometry(entryPtr); EventuallyRedraw(entryPtr); } + + /* + * An error may have happened when setting the textvariable in case there + * is a trace on that variable and the trace proc triggered an error. + * Another possibility is that the textvariable is in a namespace that + * does not (yet) exist. + * Signal this error. + */ + + if ((entryPtr->textVarName != NULL) && (newValue == NULL)) { + return TCL_ERROR; + } + return TCL_OK; } /* @@ -3724,7 +3773,7 @@ SpinboxWidgetObjCmd( break; case SB_CMD_DELETE: { - int first, last; + int first, last, code; if ((objc < 3) || (objc > 4)) { Tcl_WrongNumArgs(interp, 2, objv, "firstIndex ?lastIndex?"); @@ -3743,7 +3792,10 @@ SpinboxWidgetObjCmd( } } if ((last >= first) && (entryPtr->state == STATE_NORMAL)) { - DeleteChars(entryPtr, first, last - first); + code = DeleteChars(entryPtr, first, last - first); + if (code != TCL_OK) { + goto error; + } } break; } @@ -3803,7 +3855,7 @@ SpinboxWidgetObjCmd( } case SB_CMD_INSERT: { - int index; + int index, code; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "index text"); @@ -3814,7 +3866,10 @@ SpinboxWidgetObjCmd( goto error; } if (entryPtr->state == STATE_NORMAL) { - InsertChars(entryPtr, index, Tcl_GetString(objv[3])); + code = InsertChars(entryPtr, index, Tcl_GetString(objv[3])); + if (code != TCL_OK) { + goto error; + } } break; } @@ -4024,16 +4079,22 @@ SpinboxWidgetObjCmd( break; } - case SB_CMD_SET: + case SB_CMD_SET: { + int code = TCL_OK; + if (objc > 3) { Tcl_WrongNumArgs(interp, 2, objv, "?string?"); goto error; } if (objc == 3) { - EntryValueChanged(entryPtr, Tcl_GetString(objv[2])); + code = EntryValueChanged(entryPtr, Tcl_GetString(objv[2])); + if (code != TCL_OK) { + goto error; + } } Tcl_SetObjResult(interp, Tcl_NewStringObj(entryPtr->string, -1)); break; + } case SB_CMD_VALIDATE: { int code; @@ -4174,7 +4235,7 @@ GetSpinboxElement( * TCL_OK. * * Side effects: - * An background error condition may arise when invoking the callback. + * A background error condition may arise when invoking the callback. * The widget value may change. * *-------------------------------------------------------------- @@ -4205,6 +4266,7 @@ SpinboxInvoke( return TCL_OK; } + code = TCL_OK; if (fabs(sbPtr->increment) > MIN_DBL_VAL) { if (sbPtr->listObj != NULL) { Tcl_Obj *objPtr; @@ -4250,11 +4312,11 @@ SpinboxInvoke( } } Tcl_ListObjIndex(interp, sbPtr->listObj, sbPtr->eIndex, &objPtr); - EntryValueChanged(entryPtr, Tcl_GetString(objPtr)); + code = EntryValueChanged(entryPtr, Tcl_GetString(objPtr)); } else if (!DOUBLES_EQ(sbPtr->fromValue, sbPtr->toValue)) { double dvalue; - if (sscanf(entryPtr->string, "%lf", &dvalue) == 0) { + if (sscanf(entryPtr->string, "%lf", &dvalue) <= 0) { /* * If the string doesn't scan as a double value, just * use the -from value @@ -4297,9 +4359,12 @@ SpinboxInvoke( } } sprintf(sbPtr->formatBuf, sbPtr->valueFormat, dvalue); - EntryValueChanged(entryPtr, sbPtr->formatBuf); + code = EntryValueChanged(entryPtr, sbPtr->formatBuf); } } + if (code != TCL_OK) { + return TCL_ERROR; + } if (sbPtr->command != NULL) { Tcl_DStringInit(&script); diff --git a/generic/tkEvent.c b/generic/tkEvent.c index 51eca3a..bcc6d98 100644 --- a/generic/tkEvent.c +++ b/generic/tkEvent.c @@ -356,7 +356,7 @@ CreateXIC( /* XCreateIC failed. */ return; } - + /* * Adjust the window's event mask if the IM requires it. */ diff --git a/generic/tkFont.c b/generic/tkFont.c index cbc4cf4..102fc6e 100644 --- a/generic/tkFont.c +++ b/generic/tkFont.c @@ -600,40 +600,40 @@ Tk_FontObjCmd( return result; } case FONT_CONFIGURE: { - int result; - const char *string; - Tcl_Obj *objPtr; - NamedFont *nfPtr; - Tcl_HashEntry *namedHashPtr; - - if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "fontname ?-option value ...?"); - return TCL_ERROR; - } - string = Tcl_GetString(objv[2]); - namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string); + int result; + const char *string; + Tcl_Obj *objPtr; + NamedFont *nfPtr; + Tcl_HashEntry *namedHashPtr; + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "fontname ?-option value ...?"); + return TCL_ERROR; + } + string = Tcl_GetString(objv[2]); + namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string); nfPtr = NULL; /* lint. */ - if (namedHashPtr != NULL) { - nfPtr = Tcl_GetHashValue(namedHashPtr); - } - if ((namedHashPtr == NULL) || nfPtr->deletePending) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "named font \"%s\" doesn't exist", string)); - Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT", string, NULL); - return TCL_ERROR; - } - if (objc == 3) { - objPtr = NULL; - } else if (objc == 4) { - objPtr = objv[3]; - } else { - result = ConfigAttributesObj(interp, tkwin, objc - 3, objv + 3, - &nfPtr->fa); - UpdateDependentFonts(fiPtr, tkwin, namedHashPtr); - return result; - } - return GetAttributeInfoObj(interp, &nfPtr->fa, objPtr); - } + if (namedHashPtr != NULL) { + nfPtr = Tcl_GetHashValue(namedHashPtr); + } + if ((namedHashPtr == NULL) || nfPtr->deletePending) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "named font \"%s\" doesn't exist", string)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT", string, NULL); + return TCL_ERROR; + } + if (objc == 3) { + objPtr = NULL; + } else if (objc == 4) { + objPtr = objv[3]; + } else { + result = ConfigAttributesObj(interp, tkwin, objc - 3, objv + 3, + &nfPtr->fa); + UpdateDependentFonts(fiPtr, tkwin, namedHashPtr); + return result; + } + return GetAttributeInfoObj(interp, &nfPtr->fa, objPtr); + } case FONT_CREATE: { int skip = 3, i; const char *name; @@ -2067,14 +2067,14 @@ Tk_ComputeTextLayout( NewChunk(&layoutPtr, &maxChunks, start, 1, curX, newX, baseline)->numDisplayChars = -1; start++; + curX = newX; + flags &= ~TK_AT_LEAST_ONE; if ((start < end) && ((wrapLength <= 0) || (newX <= wrapLength))) { /* * More chars can still fit on this line. */ - curX = newX; - flags &= ~TK_AT_LEAST_ONE; continue; } } else { @@ -2994,13 +2994,6 @@ PointInQuadrilateral( } static inline int -sign( - double value) -{ - return (value < 0.0) ? -1 : (value > 0.0) ? 1 : 0; -} - -static inline int SidesIntersect( double ax1, double ay1, double ax2, double ay2, double bx1, double by1, double bx2, double by2) @@ -3375,7 +3368,6 @@ ConfigAttributesObj( for (i = 0; i < objc; i += 2) { optionPtr = objv[i]; - valuePtr = objv[i + 1]; if (Tcl_GetIndexFromObj(interp, optionPtr, fontOpt, "option", 1, &index) != TCL_OK) { @@ -3396,6 +3388,7 @@ ConfigAttributesObj( } return TCL_ERROR; } + valuePtr = objv[i + 1]; switch (index) { case FONT_FAMILY: diff --git a/generic/tkGrid.c b/generic/tkGrid.c index 3e40875..2a88b76 100644 --- a/generic/tkGrid.c +++ b/generic/tkGrid.c @@ -2018,7 +2018,7 @@ ResolveConstraints( if (slavePtr->numCols > 1) { slavePtr->binNextPtr = layoutPtr[rightEdge].binNextPtr; layoutPtr[rightEdge].binNextPtr = slavePtr; - } else { + } else if (rightEdge >= 0) { int size = slavePtr->size + layoutPtr[rightEdge].pad; if (size > layoutPtr[rightEdge].minSize) { @@ -2037,7 +2037,7 @@ ResolveConstraints( if (slavePtr->numRows > 1) { slavePtr->binNextPtr = layoutPtr[rightEdge].binNextPtr; layoutPtr[rightEdge].binNextPtr = slavePtr; - } else { + } else if (rightEdge >= 0) { int size = slavePtr->size + layoutPtr[rightEdge].pad; if (size > layoutPtr[rightEdge].minSize) { diff --git a/generic/tkImage.c b/generic/tkImage.c index e22b735..359d6c6 100644 --- a/generic/tkImage.c +++ b/generic/tkImage.c @@ -283,13 +283,11 @@ Tk_ImageObjCmd( */ if ((objc == 3) || (*(arg = Tcl_GetString(objv[3])) == '-')) { - Tcl_CmdInfo dummy; - do { dispPtr->imageId++; sprintf(idString, "image%d", dispPtr->imageId); name = idString; - } while (Tcl_GetCommandInfo(interp, name, &dummy) != 0); + } while (Tcl_FindCommand(interp, name, NULL, 0) != NULL); firstOption = 3; } else { TkWindow *topWin; diff --git a/generic/tkImgGIF.c b/generic/tkImgGIF.c index 27de486..1c28b54 100644 --- a/generic/tkImgGIF.c +++ b/generic/tkImgGIF.c @@ -393,7 +393,8 @@ FileReadGIF( * image being read. */ { int fileWidth, fileHeight, imageWidth, imageHeight; - int nBytes, index = 0, argc = 0, i, result = TCL_ERROR; + unsigned int nBytes; + int index = 0, argc = 0, i, result = TCL_ERROR; Tcl_Obj **objv; unsigned char buf[100]; unsigned char *trashBuffer = NULL; @@ -410,6 +411,7 @@ FileReadGIF( * source and not a file. */ + memset(colorMap, 0, MAXCOLORMAPSIZE*4); memset(gifConfPtr, 0, sizeof(GIFImageConfig)); if (fileName == INLINE_DATA_BINARY || fileName == INLINE_DATA_BASE64) { gifConfPtr->fromData = fileName; @@ -425,8 +427,9 @@ FileReadGIF( return TCL_ERROR; } for (i = 1; i < argc; i++) { + int optionIdx; if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings, - sizeof(char *), "option name", 0, &nBytes) != TCL_OK) { + sizeof(char *), "option name", 0, &optionIdx) != TCL_OK) { return TCL_ERROR; } if (i == (argc-1)) { @@ -590,8 +593,14 @@ FileReadGIF( */ if (trashBuffer == NULL) { + if (fileWidth > (int)((UINT_MAX/3)/fileHeight)) { + goto error; + } nBytes = fileWidth * fileHeight * 3; trashBuffer = ckalloc(nBytes); + if (trashBuffer) { + memset(trashBuffer, 0, nBytes); + } } /* @@ -675,9 +684,18 @@ FileReadGIF( block.offset[1] = 1; block.offset[2] = 2; block.offset[3] = (transparent>=0) ? 3 : 0; + if (imageWidth > INT_MAX/block.pixelSize) { + goto error; + } block.pitch = block.pixelSize * imageWidth; + if (imageHeight > (int)(UINT_MAX/block.pitch)) { + goto error; + } nBytes = block.pitch * imageHeight; block.pixelPtr = ckalloc(nBytes); + if (block.pixelPtr) { + memset(block.pixelPtr, 0, nBytes); + } if (ReadImage(gifConfPtr, interp, block.pixelPtr, chan, imageWidth, imageHeight, colorMap, srcX, srcY, BitSet(buf[8], INTERLACE), diff --git a/generic/tkImgPNG.c b/generic/tkImgPNG.c index 8a740d2..2ee515b 100644 --- a/generic/tkImgPNG.c +++ b/generic/tkImgPNG.c @@ -10,6 +10,7 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +#include "assert.h" #include "tkInt.h" #define PNG_INT32(a,b,c,d) \ @@ -1846,6 +1847,13 @@ DecodeLine( if (UnfilterLine(interp, pngPtr) == TCL_ERROR) { return TCL_ERROR; } + if (pngPtr->currentLine >= pngPtr->block.height) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "PNG image data overflow")); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "DATA_OVERFLOW", NULL); + return TCL_ERROR; + } + if (pngPtr->interlace) { switch (pngPtr->phase) { @@ -2175,10 +2183,13 @@ ReadIDAT( /* * Try to read another line of pixels out of the buffer - * immediately. + * immediately, but don't allow write past end of block. */ - goto getNextLine; + if (pngPtr->currentLine < pngPtr->block.height) { + goto getNextLine; + } + } /* @@ -3345,7 +3356,7 @@ EncodePNG( pngPtr->colorType = PNG_COLOR_RGBA; pngPtr->bytesPerPixel = 4; } else { - pngPtr->colorType = PNG_COLOR_RGBA; + pngPtr->colorType = PNG_COLOR_RGB; pngPtr->bytesPerPixel = 3; } } else { diff --git a/generic/tkImgPhoto.c b/generic/tkImgPhoto.c index 9527c93..3e03f3d 100644 --- a/generic/tkImgPhoto.c +++ b/generic/tkImgPhoto.c @@ -886,6 +886,19 @@ ImgPhotoCmd( break; } dataWidth = listObjc; + /* + * Memory allocation overflow protection. + * May not be able to trigger/ demo / test this. + */ + + if (dataWidth > (int)((UINT_MAX/3) / dataHeight)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "photo image dimensions exceed Tcl memory limits", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "OVERFLOW", NULL); + break; + } + pixelPtr = ckalloc(dataWidth * dataHeight * 3); block.pixelPtr = pixelPtr; } else if (listObjc != dataWidth) { @@ -2051,8 +2064,8 @@ static int ToggleComplexAlphaIfNeeded( PhotoMaster *mPtr) { - size_t len = MAX(mPtr->userWidth, mPtr->width) * - MAX(mPtr->userHeight, mPtr->height) * 4; + size_t len = (size_t)MAX(mPtr->userWidth, mPtr->width) * + (size_t)MAX(mPtr->userHeight, mPtr->height) * 4; unsigned char *c = mPtr->pix32; unsigned char *end = c + len; @@ -2062,6 +2075,9 @@ ToggleComplexAlphaIfNeeded( */ mPtr->flags &= ~COMPLEX_ALPHA; + if (c == NULL) { + return 0; + } c += 3; /* Start at first alpha byte. */ for (; c < end; c += 4) { if (*c && *c != 255) { @@ -2192,6 +2208,10 @@ ImgPhotoSetSize( height = masterPtr->userHeight; } + if (width > INT_MAX / 4) { + /* Pitch overflows int */ + return TCL_ERROR; + } pitch = width * 4; /* @@ -2201,11 +2221,12 @@ ImgPhotoSetSize( if ((width != masterPtr->width) || (height != masterPtr->height) || (masterPtr->pix32 == NULL)) { - /* - * Not a u-long, but should be one. - */ + unsigned newPixSize; - unsigned /*long*/ newPixSize = (unsigned /*long*/) (height * pitch); + if (pitch && height > (int)(UINT_MAX / pitch)) { + return TCL_ERROR; + } + newPixSize = height * pitch; /* * Some mallocs() really hate allocating zero bytes. [Bug 619544] @@ -2257,14 +2278,14 @@ ImgPhotoSetSize( if ((masterPtr->pix32 != NULL) && ((width == masterPtr->width) || (width == validBox.width))) { if (validBox.y > 0) { - memset(newPix32, 0, (size_t) (validBox.y * pitch)); + memset(newPix32, 0, ((size_t) validBox.y * pitch)); } h = validBox.y + validBox.height; if (h < height) { - memset(newPix32 + h*pitch, 0, (size_t) ((height - h) * pitch)); + memset(newPix32 + h*pitch, 0, ((size_t) (height - h) * pitch)); } } else { - memset(newPix32, 0, (size_t) (height * pitch)); + memset(newPix32, 0, ((size_t)height * pitch)); } if (masterPtr->pix32 != NULL) { @@ -2281,7 +2302,7 @@ ImgPhotoSetSize( offset = validBox.y * pitch; memcpy(newPix32 + offset, masterPtr->pix32 + offset, - (size_t) (validBox.height * pitch)); + ((size_t)validBox.height * pitch)); } else if ((validBox.width > 0) && (validBox.height > 0)) { /* @@ -2292,7 +2313,7 @@ ImgPhotoSetSize( srcPtr = masterPtr->pix32 + (validBox.y * masterPtr->width + validBox.x) * 4; for (h = validBox.height; h > 0; h--) { - memcpy(destPtr, srcPtr, (size_t) (validBox.width * 4)); + memcpy(destPtr, srcPtr, ((size_t)validBox.width * 4)); destPtr += width * 4; srcPtr += masterPtr->width * 4; } @@ -2772,7 +2793,7 @@ Tk_PhotoPutBlock( && (blockPtr->pitch == pitch))) && (compRule == TK_PHOTO_COMPOSITE_SET)) { memmove(destLinePtr, blockPtr->pixelPtr + blockPtr->offset[0], - (size_t) (height * width * 4)); + ((size_t)height * width * 4)); /* * We know there's an alpha offset and we're setting the data, so skip @@ -2804,7 +2825,7 @@ Tk_PhotoPutBlock( && (blueOffset == 2) && (alphaOffset == 3) && (width <= blockPtr->width) && compRuleSet) { - memcpy(destLinePtr, srcLinePtr, (size_t) (width * 4)); + memcpy(destLinePtr, srcLinePtr, ((size_t)width * 4)); srcLinePtr += blockPtr->pitch; destLinePtr += pitch; continue; @@ -3454,7 +3475,7 @@ Tk_PhotoBlank( */ memset(masterPtr->pix32, 0, - (size_t) (masterPtr->width * masterPtr->height * 4)); + ((size_t)masterPtr->width * masterPtr->height * 4)); for (instancePtr = masterPtr->instancePtr; instancePtr != NULL; instancePtr = instancePtr->nextPtr) { TkImgResetDither(instancePtr); @@ -3683,6 +3704,9 @@ ImgGetPhoto( break; } } + if (!alphaOffset) { + blockPtr->offset[3]= -1; /* Tell caller alpha need not be read */ + } greenOffset = blockPtr->offset[1] - blockPtr->offset[0]; blueOffset = blockPtr->offset[2] - blockPtr->offset[0]; if (((optPtr->options & OPT_BACKGROUND) && alphaOffset) || @@ -3696,6 +3720,10 @@ ImgGetPhoto( if ((greenOffset||blueOffset) && !(optPtr->options & OPT_GRAYSCALE)) { newPixelSize += 2; } + + if (blockPtr->height > (int)((UINT_MAX/newPixelSize)/blockPtr->width)) { + return NULL; + } data = attemptckalloc(newPixelSize*blockPtr->width*blockPtr->height); if (data == NULL) { return NULL; @@ -3803,9 +3831,6 @@ ImgGetPhoto( blockPtr->offset[2] = 0; blockPtr->offset[3]= 1; } - if (!alphaOffset) { - blockPtr->offset[3]= -1; - } return data; } return NULL; @@ -3835,32 +3860,30 @@ ImgStringWrite( Tk_PhotoImageBlock *blockPtr) { int greenOffset, blueOffset; - Tcl_DString data; + Tcl_Obj *data; greenOffset = blockPtr->offset[1] - blockPtr->offset[0]; blueOffset = blockPtr->offset[2] - blockPtr->offset[0]; - Tcl_DStringInit(&data); + data = Tcl_NewObj(); if ((blockPtr->width > 0) && (blockPtr->height > 0)) { - char *line = ckalloc((8 * blockPtr->width) + 2); int row, col; for (row=0; row<blockPtr->height; row++) { + Tcl_Obj *line = Tcl_NewObj(); unsigned char *pixelPtr = blockPtr->pixelPtr + blockPtr->offset[0] + row * blockPtr->pitch; - char *linePtr = line; for (col=0; col<blockPtr->width; col++) { - sprintf(linePtr, " #%02x%02x%02x", *pixelPtr, + Tcl_AppendPrintfToObj(line, "%s#%02x%02x%02x", + col ? " " : "", *pixelPtr, pixelPtr[greenOffset], pixelPtr[blueOffset]); pixelPtr += blockPtr->pixelSize; - linePtr += 8; } - Tcl_DStringAppendElement(&data, line+1); + Tcl_ListObjAppendElement(NULL, data, line); } - ckfree(line); } - Tcl_DStringResult(interp, &data); + Tcl_SetObjResult(interp, data); return TCL_OK; } diff --git a/generic/tkInt.decls b/generic/tkInt.decls index 2ee9d1c..586b407 100644 --- a/generic/tkInt.decls +++ b/generic/tkInt.decls @@ -506,12 +506,12 @@ declare 154 { # entries needed only by tktest: declare 156 { - int TkpTestembedCmd(ClientData clientData, Tcl_Interp *interp, int argc, - const char **argv) + int TkpTestembedCmd(ClientData clientData, Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]) } declare 157 { - int TkpTesttextCmd(ClientData dummy, Tcl_Interp *interp, int argc, - const char **argv) + int TkpTesttextCmd(ClientData dummy, Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]) } declare 158 { int TkSelGetSelection(Tcl_Interp *interp, Tk_Window tkwin, @@ -684,8 +684,8 @@ declare 12 x11 { } # only needed by tktest: declare 13 x11 { - int TkpTestsendCmd(ClientData clientData, Tcl_Interp *interp, int argc, - const char **argv) + int TkpTestsendCmd(ClientData clientData, Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]) } ################################ @@ -841,8 +841,8 @@ declare 44 win { } # only needed by tktest: declare 45 win { - int TkpTestsendCmd(ClientData clientData, Tcl_Interp *interp, int argc, - const char **argv) + int TkpTestsendCmd(ClientData clientData, Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]) } ################################ @@ -1017,6 +1017,9 @@ declare 50 aqua { declare 51 aqua { void TkGenWMDestroyEvent(Tk_Window tkwin) } +declare 52 aqua { + void TkMacOSXSetDrawingEnabled(TkWindow *winPtr, int flag) +} # removed duplicate from tkPlat table (tk.decls) #declare 52 aqua { @@ -1032,6 +1035,9 @@ declare 53 aqua { declare 54 aqua { void *TkMacOSXDrawable(Drawable drawable) } +declare 55 aqua { + int TkpScanWindowId(Tcl_Interp *interp, const char *string, Window *idPtr) +} ############################################################################## diff --git a/generic/tkInt.h b/generic/tkInt.h index b71e9b9..b644c5b 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -1110,13 +1110,15 @@ MODULE_SCOPE int Tk_RaiseObjCmd(ClientData clientData, MODULE_SCOPE int Tk_ScaleObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tk_ScrollbarCmd(ClientData clientData, - Tcl_Interp *interp, int argc, const char **argv); +MODULE_SCOPE int Tk_ScrollbarObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); MODULE_SCOPE int Tk_SelectionObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tk_SendCmd(ClientData clientData, - Tcl_Interp *interp, int argc, const char **argv); +MODULE_SCOPE int Tk_SendObjCmd(ClientData clientData, + Tcl_Interp *interp,int objc, + Tcl_Obj *const objv[]); MODULE_SCOPE int Tk_SendObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -1151,8 +1153,8 @@ MODULE_SCOPE void TkFreeGeometryMaster(Tk_Window tkwin, MODULE_SCOPE void TkEventInit(void); MODULE_SCOPE void TkRegisterObjTypes(void); -MODULE_SCOPE int TkDeadAppCmd(ClientData clientData, - Tcl_Interp *interp, int argc, const char **argv); +MODULE_SCOPE int TkDeadAppObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *const argv[]); MODULE_SCOPE int TkCanvasGetCoordObj(Tcl_Interp *interp, Tk_Canvas canvas, Tcl_Obj *obj, double *doublePtr); diff --git a/generic/tkIntDecls.h b/generic/tkIntDecls.h index 67a4f4b..b8addbd 100644 --- a/generic/tkIntDecls.h +++ b/generic/tkIntDecls.h @@ -433,11 +433,11 @@ EXTERN void TkDeleteThreadExitHandler(Tcl_ExitProc *proc, /* Slot 155 is reserved */ /* 156 */ EXTERN int TkpTestembedCmd(ClientData clientData, - Tcl_Interp *interp, int argc, - const char **argv); + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); /* 157 */ EXTERN int TkpTesttextCmd(ClientData dummy, Tcl_Interp *interp, - int argc, const char **argv); + int objc, Tcl_Obj *const objv[]); /* 158 */ EXTERN int TkSelGetSelection(Tcl_Interp *interp, Tk_Window tkwin, Atom selection, Atom target, @@ -738,8 +738,8 @@ typedef struct TkIntStubs { void (*tkCreateThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 153 */ void (*tkDeleteThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 154 */ void (*reserved155)(void); - int (*tkpTestembedCmd) (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); /* 156 */ - int (*tkpTesttextCmd) (ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); /* 157 */ + int (*tkpTestembedCmd) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 156 */ + int (*tkpTesttextCmd) (ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 157 */ int (*tkSelGetSelection) (Tcl_Interp *interp, Tk_Window tkwin, Atom selection, Atom target, Tk_GetSelProc *proc, ClientData clientData); /* 158 */ int (*tkTextGetIndex) (Tcl_Interp *interp, struct TkText *textPtr, const char *string, struct TkTextIndex *indexPtr); /* 159 */ int (*tkTextIndexBackBytes) (const struct TkText *textPtr, const struct TkTextIndex *srcPtr, int count, struct TkTextIndex *dstPtr); /* 160 */ diff --git a/generic/tkIntPlatDecls.h b/generic/tkIntPlatDecls.h index 2fd66c6..e48e803 100644 --- a/generic/tkIntPlatDecls.h +++ b/generic/tkIntPlatDecls.h @@ -140,8 +140,8 @@ EXTERN void TkWmCleanup(TkDisplay *dispPtr); EXTERN void TkSendCleanup(TkDisplay *dispPtr); /* 45 */ EXTERN int TkpTestsendCmd(ClientData clientData, - Tcl_Interp *interp, int argc, - const char **argv); + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); #endif /* WIN */ #ifdef MAC_OSX_TK /* AQUA */ /* 0 */ @@ -250,11 +250,15 @@ EXTERN int TkGenerateButtonEvent(int x, int y, Window window, unsigned int state); /* 51 */ EXTERN void TkGenWMDestroyEvent(Tk_Window tkwin); -/* Slot 52 is reserved */ +/* 52 */ +EXTERN void TkMacOSXSetDrawingEnabled(TkWindow *winPtr, int flag); /* 53 */ EXTERN unsigned long TkpGetMS(void); /* 54 */ EXTERN void * TkMacOSXDrawable(Drawable drawable); +/* 55 */ +EXTERN int TkpScanWindowId(Tcl_Interp *interp, + const char *string, Window *idPtr); #endif /* AQUA */ #if !(defined(_WIN32) || defined(__CYGWIN__) || defined(MAC_OSX_TK)) /* X11 */ /* 0 */ @@ -283,8 +287,8 @@ EXTERN void TkSendCleanup(TkDisplay *dispPtr); EXTERN int TkpWmSetState(TkWindow *winPtr, int state); /* 13 */ EXTERN int TkpTestsendCmd(ClientData clientData, - Tcl_Interp *interp, int argc, - const char **argv); + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); #endif /* X11 */ typedef struct TkIntPlatStubs { @@ -337,7 +341,7 @@ typedef struct TkIntPlatStubs { void (*tkUnixSetMenubar) (Tk_Window tkwin, Tk_Window menubar); /* 42 */ void (*tkWmCleanup) (TkDisplay *dispPtr); /* 43 */ void (*tkSendCleanup) (TkDisplay *dispPtr); /* 44 */ - int (*tkpTestsendCmd) (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); /* 45 */ + int (*tkpTestsendCmd) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 45 */ #endif /* WIN */ #ifdef MAC_OSX_TK /* AQUA */ void (*tkGenerateActivateEvents) (TkWindow *winPtr, int active); /* 0 */ @@ -392,9 +396,10 @@ typedef struct TkIntPlatStubs { Window (*tkGetTransientMaster) (TkWindow *winPtr); /* 49 */ int (*tkGenerateButtonEvent) (int x, int y, Window window, unsigned int state); /* 50 */ void (*tkGenWMDestroyEvent) (Tk_Window tkwin); /* 51 */ - void (*reserved52)(void); + void (*tkMacOSXSetDrawingEnabled) (TkWindow *winPtr, int flag); /* 52 */ unsigned long (*tkpGetMS) (void); /* 53 */ void * (*tkMacOSXDrawable) (Drawable drawable); /* 54 */ + int (*tkpScanWindowId) (Tcl_Interp *interp, const char *string, Window *idPtr); /* 55 */ #endif /* AQUA */ #if !(defined(_WIN32) || defined(__CYGWIN__) || defined(MAC_OSX_TK)) /* X11 */ void (*tkCreateXEventSource) (void); /* 0 */ @@ -410,7 +415,7 @@ typedef struct TkIntPlatStubs { void (*tkSendCleanup) (TkDisplay *dispPtr); /* 10 */ void (*reserved11)(void); int (*tkpWmSetState) (TkWindow *winPtr, int state); /* 12 */ - int (*tkpTestsendCmd) (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); /* 13 */ + int (*tkpTestsendCmd) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 13 */ #endif /* X11 */ } TkIntPlatStubs; @@ -617,11 +622,14 @@ extern const TkIntPlatStubs *tkIntPlatStubsPtr; (tkIntPlatStubsPtr->tkGenerateButtonEvent) /* 50 */ #define TkGenWMDestroyEvent \ (tkIntPlatStubsPtr->tkGenWMDestroyEvent) /* 51 */ -/* Slot 52 is reserved */ +#define TkMacOSXSetDrawingEnabled \ + (tkIntPlatStubsPtr->tkMacOSXSetDrawingEnabled) /* 52 */ #define TkpGetMS \ (tkIntPlatStubsPtr->tkpGetMS) /* 53 */ #define TkMacOSXDrawable \ (tkIntPlatStubsPtr->tkMacOSXDrawable) /* 54 */ +#define TkpScanWindowId \ + (tkIntPlatStubsPtr->tkpScanWindowId) /* 55 */ #endif /* AQUA */ #if !(defined(_WIN32) || defined(__CYGWIN__) || defined(MAC_OSX_TK)) /* X11 */ #define TkCreateXEventSource \ diff --git a/generic/tkListbox.c b/generic/tkListbox.c index 22bb354..f16218b 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -412,6 +412,7 @@ static void ListboxEventProc(ClientData clientData, static int ListboxFetchSelection(ClientData clientData, int offset, char *buffer, int maxBytes); static void ListboxLostSelection(ClientData clientData); +static void GenerateListboxSelectEvent(Listbox *listPtr); static void EventuallyRedrawRange(Listbox *listPtr, int first, int last); static void ListboxScanTo(Listbox *listPtr, int x, int y); @@ -3243,12 +3244,46 @@ ListboxLostSelection( if ((listPtr->exportSelection) && (listPtr->nElements > 0)) { ListboxSelect(listPtr, 0, listPtr->nElements-1, 0); + GenerateListboxSelectEvent(listPtr); } } /* *---------------------------------------------------------------------- * + * GenerateListboxSelectEvent -- + * + * Send an event that the listbox selection was updated. This is + * equivalent to event generate $listboxWidget <<ListboxSelect>> + * + * Results: + * None + * + * Side effects: + * Any side effect possible, depending on bindings to this event. + * + *---------------------------------------------------------------------- + */ + +static void +GenerateListboxSelectEvent( + Listbox *listPtr) /* Information about widget. */ +{ + union {XEvent general; XVirtualEvent virtual;} event; + + memset(&event, 0, sizeof(event)); + event.general.xany.type = VirtualEvent; + event.general.xany.serial = NextRequest(Tk_Display(listPtr->tkwin)); + event.general.xany.send_event = False; + event.general.xany.window = Tk_WindowId(listPtr->tkwin); + event.general.xany.display = Tk_Display(listPtr->tkwin); + event.virtual.name = Tk_GetUid("ListboxSelect"); + Tk_HandleEvent(&event.general); +} + +/* + *---------------------------------------------------------------------- + * * EventuallyRedrawRange -- * * Ensure that a given range of elements is eventually redrawn on the diff --git a/generic/tkMain.c b/generic/tkMain.c index f6f4013..1b21223 100644 --- a/generic/tkMain.c +++ b/generic/tkMain.c @@ -55,7 +55,16 @@ extern int TkCygwinMainEx(int, char **, Tcl_AppInitProc *, Tcl_Interp *); * to strcmp here. */ #ifdef _WIN32 -# include "tclInt.h" +/* Little hack to eliminate the need for "tclInt.h" here: + Just copy a small portion of TclIntPlatStubs, just + enough to make it work. See [600b72bfbc] */ +typedef struct { + int magic; + void *hooks; + void (*dummy[16]) (void); /* dummy entries 0-15, not used */ + int (*tclpIsAtty) (int fd); /* 16 */ +} TclIntPlatStubs; +extern const TclIntPlatStubs *tclIntPlatStubsPtr; # include "tkWinInt.h" #else # define TCHAR char @@ -108,9 +117,9 @@ static int WinIsTty(int fd) { */ #if !defined(STATIC_BUILD) - if (tclStubsPtr->reserved9 && TclpIsAtty) { + if (tclStubsPtr->reserved9 && tclIntPlatStubsPtr->tclpIsAtty) { /* We are running on Cygwin */ - return TclpIsAtty(fd); + return tclIntPlatStubsPtr->tclpIsAtty(fd); } #endif handle = GetStdHandle(STD_INPUT_HANDLE + fd); diff --git a/generic/tkMenu.c b/generic/tkMenu.c index cd9ff08..d24516f 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.c @@ -885,9 +885,14 @@ MenuWidgetObjCmd( * Tearoff menus are posted differently on Mac and Windows than * non-tearoffs. TkpPostMenu does not actually map the menu's window * on those platforms, and popup menus have to be handled specially. + * Also, menubar menues are not intended to be posted (bug 1567681, + * 2160206). */ - if (menuPtr->menuType != TEAROFF_MENU) { + if (menuPtr->menuType == MENUBAR) { + Tcl_AppendResult(interp, "a menubar menu cannot be posted", NULL); + return TCL_ERROR; + } else if (menuPtr->menuType != TEAROFF_MENU) { result = TkpPostMenu(interp, menuPtr, x, y); } else { result = TkPostTearoffMenu(interp, menuPtr, x, y); @@ -1419,13 +1424,14 @@ DestroyMenuEntry( } } UnhookCascadeEntry(mePtr); + menuRefPtr = mePtr->childMenuRefPtr; if (menuRefPtr != NULL) { if (menuRefPtr->menuPtr == destroyThis) { menuRefPtr->menuPtr = NULL; } - if (destroyThis != NULL) { - TkDestroyMenu(destroyThis); - } + } + if (destroyThis != NULL) { + TkDestroyMenu(destroyThis); } } else { UnhookCascadeEntry(mePtr); @@ -3044,7 +3050,6 @@ TkNewMenuName( char *destString; int i; int doDot; - Tcl_CmdInfo cmdInfo; Tcl_HashTable *nameTablePtr = NULL; TkWindow *winPtr = (TkWindow *) menuPtr->tkwin; const char *parentName = Tcl_GetString(parentPtr); @@ -3084,7 +3089,7 @@ TkNewMenuName( Tcl_DecrRefCount(intPtr); } destString = Tcl_GetString(resultPtr); - if ((Tcl_GetCommandInfo(interp, destString, &cmdInfo) == 0) + if ((Tcl_FindCommand(interp, destString, NULL, 0) == NULL) && ((nameTablePtr == NULL) || (Tcl_FindHashEntry(nameTablePtr, destString) == NULL))) { break; diff --git a/generic/tkOldConfig.c b/generic/tkOldConfig.c index d2d864f..920d93e 100644 --- a/generic/tkOldConfig.c +++ b/generic/tkOldConfig.c @@ -113,6 +113,10 @@ Tk_ConfigureWidget( staticSpecs = GetCachedSpecs(interp, specs); + for (specPtr = staticSpecs; specPtr->type != TK_CONFIG_END; specPtr++) { + specPtr->specFlags &= ~TK_CONFIG_OPTION_SPECIFIED; + } + /* * Pass one: scan through all of the arguments, processing those that * match entries in the specs. @@ -167,7 +171,6 @@ Tk_ConfigureWidget( if ((specPtr->specFlags & TK_CONFIG_OPTION_SPECIFIED) || (specPtr->argvName == NULL) || (specPtr->type == TK_CONFIG_SYNONYM)) { - specPtr->specFlags &= ~TK_CONFIG_OPTION_SPECIFIED; continue; } if (((specPtr->specFlags & needFlags) != needFlags) @@ -1126,7 +1129,6 @@ GetCachedSpecs( specPtr->defValue = Tk_GetUid(specPtr->defValue); } } - specPtr->specFlags &= ~TK_CONFIG_OPTION_SPECIFIED; } } else { cachedSpecs = Tcl_GetHashValue(entryPtr); diff --git a/generic/tkOldTest.c b/generic/tkOldTest.c index 2e931b1..df1bb6c 100644 --- a/generic/tkOldTest.c +++ b/generic/tkOldTest.c @@ -81,8 +81,9 @@ static Tk_ImageType imageType = { * Forward declarations for functions defined later in this file: */ -static int ImageCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); +static int ImageObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * const objv[]); /* @@ -175,7 +176,7 @@ ImageCreate( strcpy(timPtr->imageName, name); timPtr->varName = ckalloc((unsigned) (strlen(varName) + 1)); strcpy(timPtr->varName, varName); - Tcl_CreateCommand(interp, name, ImageCmd, timPtr, NULL); + Tcl_CreateObjCommand(interp, name, ImageObjCmd, timPtr, NULL); *clientDataPtr = timPtr; Tk_ImageChanged(master, 0, 0, 30, 15, 30, 15); return TCL_OK; @@ -184,7 +185,7 @@ ImageCreate( /* *---------------------------------------------------------------------- * - * ImageCmd -- + * ImageObjCmd -- * * This function implements the commands corresponding to individual * images. @@ -200,38 +201,37 @@ ImageCreate( /* ARGSUSED */ static int -ImageCmd( +ImageObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { TImageMaster *timPtr = clientData; int x, y, width, height; - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], "option ?arg ...?", NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } - if (strcmp(argv[1], "changed") == 0) { - if (argc != 8) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " changed x y width height imageWidth imageHeight", NULL); + if (strcmp(Tcl_GetString(objv[1]), "changed") == 0) { + if (objc != 8) { + Tcl_WrongNumArgs(interp, 1, objv, "changed x y width height" + " imageWidth imageHeight"); return TCL_ERROR; } - if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) - || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK) - || (Tcl_GetInt(interp, argv[4], &width) != TCL_OK) - || (Tcl_GetInt(interp, argv[5], &height) != TCL_OK) - || (Tcl_GetInt(interp, argv[6], &timPtr->width) != TCL_OK) - || (Tcl_GetInt(interp, argv[7], &timPtr->height) != TCL_OK)) { + if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[4], &width) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[5], &height) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[6], &timPtr->width) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[7], &timPtr->height) != TCL_OK)) { return TCL_ERROR; } Tk_ImageChanged(timPtr->master, x, y, width, height, timPtr->width, timPtr->height); } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], + Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]), "\": must be changed", NULL); return TCL_ERROR; } diff --git a/generic/tkOption.c b/generic/tkOption.c index 75dc3b9..d758b6f 100644 --- a/generic/tkOption.c +++ b/generic/tkOption.c @@ -1083,7 +1083,7 @@ ReadOptionFile( char *buffer; int result, bufferSize; Tcl_Channel chan; - Tcl_DString newName; + Tcl_DString newName, optString; /* * Prevent file system access in a safe interpreter. @@ -1135,7 +1135,16 @@ ReadOptionFile( } Tcl_Close(NULL, chan); buffer[bufferSize] = 0; - result = AddFromString(interp, tkwin, buffer, priority); + if ((bufferSize>2) && !memcmp(buffer, "\357\273\277", 3)) { + /* File starts with UTF-8 BOM */ + result = AddFromString(interp, tkwin, buffer+3, priority); + } else { + Tcl_DStringInit(&optString); + Tcl_ExternalToUtfDString(NULL, buffer, bufferSize, &optString); + result = AddFromString(interp, tkwin, Tcl_DStringValue(&optString), + priority); + Tcl_DStringFree(&optString); + } ckfree(buffer); return result; } diff --git a/generic/tkPanedWindow.c b/generic/tkPanedWindow.c index 733610e..2451647 100644 --- a/generic/tkPanedWindow.c +++ b/generic/tkPanedWindow.c @@ -147,6 +147,10 @@ typedef struct PanedWindow { GC gc; /* Graphics context for copying from * off-screen pixmap onto screen. */ int proxyx, proxyy; /* Proxy x,y coordinates. */ + Tk_3DBorder proxyBackground;/* Background color used to draw proxy. If NULL, use background. */ + Tcl_Obj *proxyBorderWidthPtr; /* Tcl_Obj rep for proxyBorderWidth */ + int proxyBorderWidth; /* Borderwidth used to draw proxy. */ + int proxyRelief; /* Relief used to draw proxy, if TK_RELIEF_NULL then use relief. */ Slave **slaves; /* Pointer to array of Slaves. */ int numSlaves; /* Number of slaves. */ int sizeofSlaves; /* Number of elements in the slaves array. */ @@ -203,6 +207,8 @@ static void PanedWindowReqProc(ClientData clientData, static void ArrangePanes(ClientData clientData); static void Unlink(Slave *slavePtr); static Slave * GetPane(PanedWindow *pwPtr, Tk_Window tkwin); +static void GetFirstLastVisiblePane(PanedWindow *pwPtr, + int *firstPtr, int *lastPtr); static void SlaveStructureProc(ClientData clientData, XEvent *eventPtr); static int PanedWindowSashCommand(PanedWindow *pwPtr, @@ -296,6 +302,15 @@ static const Tk_OptionSpec optionSpecs[] = { {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient", DEF_PANEDWINDOW_ORIENT, -1, Tk_Offset(PanedWindow, orient), 0, orientStrings, GEOMETRY}, + {TK_OPTION_BORDER, "-proxybackground", "proxyBackground", "ProxyBackground", + 0, -1, Tk_Offset(PanedWindow, proxyBackground), TK_OPTION_NULL_OK, + (ClientData) DEF_PANEDWINDOW_BG_MONO}, + {TK_OPTION_PIXELS, "-proxyborderwidth", "proxyBorderWidth", "ProxyBorderWidth", + DEF_PANEDWINDOW_PROXYBORDER, Tk_Offset(PanedWindow, proxyBorderWidthPtr), + Tk_Offset(PanedWindow, proxyBorderWidth), 0, 0, GEOMETRY}, + {TK_OPTION_RELIEF, "-proxyrelief", "proxyRelief", "Relief", + 0, -1, Tk_Offset(PanedWindow, proxyRelief), + TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_RELIEF, "-relief", "relief", "Relief", DEF_PANEDWINDOW_RELIEF, -1, Tk_Offset(PanedWindow, relief), 0, 0, 0}, {TK_OPTION_CURSOR, "-sashcursor", "sashCursor", "Cursor", @@ -682,6 +697,15 @@ PanedWindowWidgetObjCmd( if (objc <= 4) { tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), pwPtr->tkwin); + if (tkwin == NULL) { + /* + * Just a plain old bad window; Tk_NameToWindow filled in an + * error message for us. + */ + + result = TCL_ERROR; + break; + } for (i = 0; i < pwPtr->numSlaves; i++) { if (pwPtr->slaves[i]->tkwin == tkwin) { resultObj = Tk_GetOptionInfo(interp, @@ -1329,6 +1353,7 @@ PanedWindowEventProc( XEvent *eventPtr) /* Information about event. */ { PanedWindow *pwPtr = clientData; + int i; if (eventPtr->type == Expose) { if (pwPtr->tkwin != NULL && !(pwPtr->flags & REDRAW_PENDING)) { @@ -1343,6 +1368,14 @@ PanedWindowEventProc( } } else if (eventPtr->type == DestroyNotify) { DestroyPanedWindow(pwPtr); + } else if (eventPtr->type == UnmapNotify) { + for (i = 0; i < pwPtr->numSlaves; i++) { + Tk_UnmapWindow(pwPtr->slaves[i]->tkwin); + } + } else if (eventPtr->type == MapNotify) { + for (i = 0; i < pwPtr->numSlaves; i++) { + Tk_MapWindow(pwPtr->slaves[i]->tkwin); + } } } @@ -1411,6 +1444,7 @@ DisplayPanedWindow( Tk_Window tkwin = pwPtr->tkwin; int i, sashWidth, sashHeight; const int horizontal = (pwPtr->orient == ORIENT_HORIZONTAL); + int first, last; pwPtr->flags &= ~REDRAW_PENDING; if ((pwPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) { @@ -1457,9 +1491,10 @@ DisplayPanedWindow( * Draw the sashes. */ + GetFirstLastVisiblePane(pwPtr, &first, &last); for (i = 0; i < pwPtr->numSlaves - 1; i++) { slavePtr = pwPtr->slaves[i]; - if (slavePtr->hide) { + if (slavePtr->hide || i == last) { continue; } if (sashWidth > 0 && sashHeight > 0) { @@ -1705,17 +1740,10 @@ ArrangePanes( Tcl_Preserve(pwPtr); /* - * Find index of last visible pane. + * Find index of first and last visible panes. */ - for (i = 0, last = 0, first = -1; i < pwPtr->numSlaves; i++) { - if (pwPtr->slaves[i]->hide == 0) { - if (first < 0) { - first = i; - } - last = i; - } - } + GetFirstLastVisiblePane(pwPtr, &first, &last); /* * First pass; compute sizes @@ -2053,6 +2081,41 @@ GetPane( } /* + *---------------------------------------------------------------------- + * + * GetFirstLastVisiblePane -- + * + * Given panedwindow, find the index of the first and last visible panes + * of that paned window. + * + * Results: + * Index of the first and last visible panes. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +GetFirstLastVisiblePane( + PanedWindow *pwPtr, /* Pointer to the paned window info. */ + int *firstPtr, /* Returned index for first. */ + int *lastPtr) /* Returned index for last. */ +{ + int i; + + for (i = 0, *lastPtr = 0, *firstPtr = -1; i < pwPtr->numSlaves; i++) { + if (pwPtr->slaves[i]->hide == 0) { + if (*firstPtr < 0) { + *firstPtr = i; + } + *lastPtr = i; + } + } +} + +/* *-------------------------------------------------------------- * * SlaveStructureProc -- @@ -2553,7 +2616,7 @@ MoveSash( slavePtr->paneWidth = slavePtr->width = slavePtr->sashx - sashOffset - slavePtr->x - (2 * slavePtr->padx); } else { - slavePtr->paneWidth = slavePtr->height = slavePtr->sashy + slavePtr->paneHeight = slavePtr->height = slavePtr->sashy - sashOffset - slavePtr->y - (2 * slavePtr->pady); } } @@ -2726,8 +2789,10 @@ DisplayProxyWindow( * Redraw the widget's background and border. */ - Tk_Fill3DRectangle(tkwin, pixmap, pwPtr->background, 0, 0, - Tk_Width(tkwin), Tk_Height(tkwin), 2, pwPtr->sashRelief); + Tk_Fill3DRectangle(tkwin, pixmap, + pwPtr->proxyBackground ? pwPtr->proxyBackground : pwPtr->background, + 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), pwPtr->proxyBorderWidth, + (pwPtr->proxyRelief != TK_RELIEF_NULL) ? pwPtr->proxyRelief : pwPtr->sashRelief); #ifndef TK_NO_DOUBLE_BUFFERING /* @@ -2771,6 +2836,7 @@ PanedWindowProxyCommand( PROXY_COORD, PROXY_FORGET, PROXY_PLACE }; int index, x, y, sashWidth, sashHeight; + int internalBW, pwWidth, pwHeight; Tcl_Obj *coords[2]; if (objc < 3) { @@ -2820,11 +2886,16 @@ PanedWindowProxyCommand( return TCL_ERROR; } + internalBW = Tk_InternalBorderWidth(pwPtr->tkwin); if (pwPtr->orient == ORIENT_HORIZONTAL) { if (x < 0) { x = 0; } - y = Tk_InternalBorderWidth(pwPtr->tkwin); + pwWidth = Tk_Width(pwPtr->tkwin) - (2 * internalBW); + if (x > pwWidth) { + x = pwWidth; + } + y = Tk_InternalBorderWidth(pwPtr->tkwin); sashWidth = pwPtr->sashWidth; sashHeight = Tk_Height(pwPtr->tkwin) - (2 * Tk_InternalBorderWidth(pwPtr->tkwin)); @@ -2832,6 +2903,10 @@ PanedWindowProxyCommand( if (y < 0) { y = 0; } + pwHeight = Tk_Height(pwPtr->tkwin) - (2 * internalBW); + if (y > pwHeight) { + y = pwHeight; + } x = Tk_InternalBorderWidth(pwPtr->tkwin); sashHeight = pwPtr->sashWidth; sashWidth = Tk_Width(pwPtr->tkwin) - @@ -2966,6 +3041,7 @@ PanedWindowIdentifyCoords( { int i, sashHeight, sashWidth, thisx, thisy; int found, isHandle, lpad, rpad, tpad, bpad; + int first, last; if (pwPtr->orient == ORIENT_HORIZONTAL) { if (Tk_IsMapped(pwPtr->tkwin)) { @@ -3005,10 +3081,11 @@ PanedWindowIdentifyCoords( lpad = rpad = 0; } + GetFirstLastVisiblePane(pwPtr, &first, &last); isHandle = 0; found = -1; for (i = 0; i < pwPtr->numSlaves - 1; i++) { - if (pwPtr->slaves[i]->hide) { + if (pwPtr->slaves[i]->hide || i == last) { continue; } thisx = pwPtr->slaves[i]->sashx; diff --git a/generic/tkScale.c b/generic/tkScale.c index 7d72990..cc7c294 100644 --- a/generic/tkScale.c +++ b/generic/tkScale.c @@ -800,6 +800,9 @@ ComputeFormat( */ numDigits = scalePtr->digits; + if (numDigits > TCL_MAX_PREC) { + numDigits = 0; + } if (numDigits <= 0) { if (scalePtr->resolution > 0) { /* @@ -880,7 +883,7 @@ static void ComputeScaleGeometry( register TkScale *scalePtr) /* Information about widget. */ { - char valueString[PRINT_CHARS]; + char valueString[TCL_DOUBLE_SPACE]; int tmp, valuePixels, x, y, extraSpace; Tk_FontMetrics fm; @@ -1296,7 +1299,7 @@ ScaleSetVariable( register TkScale *scalePtr) /* Info about widget. */ { if (scalePtr->varNamePtr != NULL) { - char string[PRINT_CHARS]; + char string[TCL_DOUBLE_SPACE]; sprintf(string, scalePtr->format, scalePtr->value); scalePtr->flags |= SETTING_VAR; diff --git a/generic/tkScale.h b/generic/tkScale.h index af35978..4fd9995 100644 --- a/generic/tkScale.h +++ b/generic/tkScale.h @@ -215,12 +215,6 @@ typedef struct TkScale { #define SPACING 2 /* - * How many characters of space to provide when formatting the scale's value: - */ - -#define PRINT_CHARS 150 - -/* * Declaration of procedures used in the implementation of the scale widget. */ diff --git a/generic/tkScrollbar.c b/generic/tkScrollbar.c index 2d91db6..5017d30 100644 --- a/generic/tkScrollbar.c +++ b/generic/tkScrollbar.c @@ -12,10 +12,6 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -/* - * TODO: Convert scrollbars to the Tcl_Obj API. - */ - #include "tkInt.h" #include "tkScrollbar.h" #include "default.h" @@ -101,16 +97,16 @@ static const Tk_ConfigSpec configSpecs[] = { */ static int ConfigureScrollbar(Tcl_Interp *interp, - TkScrollbar *scrollPtr, int argc, - const char **argv, int flags); + TkScrollbar *scrollPtr, int objc, + Tcl_Obj *const objv[], int flags); static void ScrollbarCmdDeletedProc(ClientData clientData); -static int ScrollbarWidgetCmd(ClientData clientData, - Tcl_Interp *, int argc, const char **argv); +static int ScrollbarWidgetObjCmd(ClientData clientData, + Tcl_Interp *, int objc, Tcl_Obj *const objv[]); /* *-------------------------------------------------------------- * - * Tk_ScrollbarCmd -- + * Tk_ScrollbarObjCmd -- * * This function is invoked to process the "scrollbar" Tcl command. See * the user documentation for details on what it does. @@ -125,25 +121,22 @@ static int ScrollbarWidgetCmd(ClientData clientData, */ int -Tk_ScrollbarCmd( +Tk_ScrollbarObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { Tk_Window tkwin = clientData; register TkScrollbar *scrollPtr; Tk_Window newWin; - if (argc < 2) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s pathName ?-option value ...?\"", - argv[0])); - Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?"); return TCL_ERROR; } - newWin = Tk_CreateWindowFromPath(interp, tkwin, argv[1], NULL); + newWin = Tk_CreateWindowFromPath(interp, tkwin, Tcl_GetString(objv[1]), NULL); if (newWin == NULL) { return TCL_ERROR; } @@ -162,8 +155,8 @@ Tk_ScrollbarCmd( scrollPtr->tkwin = newWin; scrollPtr->display = Tk_Display(newWin); scrollPtr->interp = interp; - scrollPtr->widgetCmd = Tcl_CreateCommand(interp, - Tk_PathName(scrollPtr->tkwin), ScrollbarWidgetCmd, + scrollPtr->widgetCmd = Tcl_CreateObjCommand(interp, + Tk_PathName(scrollPtr->tkwin), ScrollbarWidgetObjCmd, scrollPtr, ScrollbarCmdDeletedProc); scrollPtr->vertical = 0; scrollPtr->width = 0; @@ -196,7 +189,7 @@ Tk_ScrollbarCmd( scrollPtr->takeFocus = NULL; scrollPtr->flags = 0; - if (ConfigureScrollbar(interp, scrollPtr, argc-2, argv+2, 0) != TCL_OK) { + if (ConfigureScrollbar(interp, scrollPtr, objc-2, objv+2, 0) != TCL_OK) { Tk_DestroyWindow(scrollPtr->tkwin); return TCL_ERROR; } @@ -208,7 +201,7 @@ Tk_ScrollbarCmd( /* *-------------------------------------------------------------- * - * ScrollbarWidgetCmd -- + * ScrollbarWidgetObjCmd -- * * This function is invoked to process the Tcl command that corresponds * to a widget managed by this module. See the user documentation for @@ -224,30 +217,44 @@ Tk_ScrollbarCmd( */ static int -ScrollbarWidgetCmd( +ScrollbarWidgetObjCmd( ClientData clientData, /* Information about scrollbar widget. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { register TkScrollbar *scrollPtr = clientData; int result = TCL_OK; - size_t length; - int c; - - if (argc < 2) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s option ?arg ...?\"", argv[0])); - Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); + int length, cmdIndex; + static const char *const commandNames[] = { + "activate", "cget", "configure", "delta", "fraction", + "get", "identify", "set", NULL + }; + enum command { + COMMAND_ACTIVATE, COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DELTA, + COMMAND_FRACTION, COMMAND_GET, COMMAND_IDENTIFY, COMMAND_SET + }; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } + /* + * Parse the command by looking up the second argument in the list of + * valid subcommand names + */ + + result = Tcl_GetIndexFromObj(interp, objv[1], commandNames, + "option", 0, &cmdIndex); + if (result != TCL_OK) { + return result; + } Tcl_Preserve(scrollPtr); - c = argv[1][0]; - length = strlen(argv[1]); - if ((c == 'a') && (strncmp(argv[1], "activate", length) == 0)) { - int oldActiveField; + switch (cmdIndex) { + case COMMAND_ACTIVATE: { + int oldActiveField, c; - if (argc == 2) { + if (objc == 2) { const char *zone = ""; switch (scrollPtr->activeField) { @@ -258,21 +265,17 @@ ScrollbarWidgetCmd( Tcl_SetObjResult(interp, Tcl_NewStringObj(zone, -1)); goto done; } - if (argc != 3) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s activate element\"", - argv[0])); - Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "activate element"); goto error; } - c = argv[2][0]; - length = strlen(argv[2]); + c = Tcl_GetStringFromObj(objv[2], &length)[0]; oldActiveField = scrollPtr->activeField; - if ((c == 'a') && (strcmp(argv[2], "arrow1") == 0)) { + if ((c == 'a') && (strcmp(Tcl_GetString(objv[2]), "arrow1") == 0)) { scrollPtr->activeField = TOP_ARROW; - } else if ((c == 'a') && (strcmp(argv[2], "arrow2") == 0)) { + } else if ((c == 'a') && (strcmp(Tcl_GetString(objv[2]), "arrow2") == 0)) { scrollPtr->activeField = BOTTOM_ARROW; - } else if ((c == 's') && (strncmp(argv[2], "slider", length) == 0)) { + } else if ((c == 's') && (strncmp(Tcl_GetString(objv[2]), "slider", length) == 0)) { scrollPtr->activeField = SLIDER; } else { scrollPtr->activeField = OUTSIDE; @@ -280,41 +283,40 @@ ScrollbarWidgetCmd( if (oldActiveField != scrollPtr->activeField) { TkScrollbarEventuallyRedraw(scrollPtr); } - } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0) - && (length >= 2)) { - if (argc != 3) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s cget option\"", argv[0])); - Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); + break; + } + case COMMAND_CGET: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "cget option"); goto error; } result = Tk_ConfigureValue(interp, scrollPtr->tkwin, - configSpecs, (char *) scrollPtr, argv[2], 0); - } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0) - && (length >= 2)) { - if (argc == 2) { + configSpecs, (char *) scrollPtr, Tcl_GetString(objv[2]), 0); + break; + } + case COMMAND_CONFIGURE: { + if (objc == 2) { result = Tk_ConfigureInfo(interp, scrollPtr->tkwin, configSpecs, (char *) scrollPtr, NULL, 0); - } else if (argc == 3) { + } else if (objc == 3) { result = Tk_ConfigureInfo(interp, scrollPtr->tkwin, - configSpecs, (char *) scrollPtr, argv[2], 0); + configSpecs, (char *) scrollPtr, Tcl_GetString(objv[2]), 0); } else { - result = ConfigureScrollbar(interp, scrollPtr, argc-2, argv+2, - TK_CONFIG_ARGV_ONLY); + result = ConfigureScrollbar(interp, scrollPtr, objc-2, + objv+2, TK_CONFIG_ARGV_ONLY); } - } else if ((c == 'd') && (strncmp(argv[1], "delta", length) == 0)) { + break; + } + case COMMAND_DELTA: { int xDelta, yDelta, pixels, length; double fraction; - if (argc != 4) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s delta xDelta yDelta\"", - argv[0])); - Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "delta xDelta yDelta"); goto error; } - if ((Tcl_GetInt(interp, argv[2], &xDelta) != TCL_OK) - || (Tcl_GetInt(interp, argv[3], &yDelta) != TCL_OK)) { + if ((Tcl_GetIntFromObj(interp, objv[2], &xDelta) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[3], &yDelta) != TCL_OK)) { goto error; } if (scrollPtr->vertical) { @@ -332,18 +334,18 @@ ScrollbarWidgetCmd( fraction = ((double) pixels / (double) length); } Tcl_SetObjResult(interp, Tcl_NewDoubleObj(fraction)); - } else if ((c == 'f') && (strncmp(argv[1], "fraction", length) == 0)) { + break; + } + case COMMAND_FRACTION: { int x, y, pos, length; double fraction; - if (argc != 4) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s fraction x y\"", argv[0])); - Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "fraction x y"); goto error; } - if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) - || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) { + if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) { goto error; } if (scrollPtr->vertical) { @@ -366,13 +368,13 @@ ScrollbarWidgetCmd( fraction = 1.0; } Tcl_SetObjResult(interp, Tcl_NewDoubleObj(fraction)); - } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) { + break; + } + case COMMAND_GET: { Tcl_Obj *resObjs[4]; - if (argc != 2) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s get\"", argv[0])); - Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "get"); goto error; } if (scrollPtr->flags & NEW_STYLE_COMMANDS) { @@ -386,18 +388,18 @@ ScrollbarWidgetCmd( resObjs[3] = Tcl_NewIntObj(scrollPtr->lastUnit); Tcl_SetObjResult(interp, Tcl_NewListObj(4, resObjs)); } - } else if ((c == 'i') && (strncmp(argv[1], "identify", length) == 0)) { + break; + } + case COMMAND_IDENTIFY: { int x, y; const char *zone = ""; - if (argc != 4) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s identify x y\"", argv[0])); - Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "identify x y"); goto error; } - if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) - || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) { + if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) { goto error; } switch (TkpScrollbarPosition(scrollPtr, x, y)) { @@ -408,16 +410,18 @@ ScrollbarWidgetCmd( case BOTTOM_ARROW: zone = "arrow2"; break; } Tcl_SetObjResult(interp, Tcl_NewStringObj(zone, -1)); - } else if ((c == 's') && (strncmp(argv[1], "set", length) == 0)) { + break; + } + case COMMAND_SET: { int totalUnits, windowUnits, firstUnit, lastUnit; - if (argc == 4) { + if (objc == 4) { double first, last; - if (Tcl_GetDouble(interp, argv[2], &first) != TCL_OK) { + if (Tcl_GetDoubleFromObj(interp, objv[2], &first) != TCL_OK) { goto error; } - if (Tcl_GetDouble(interp, argv[3], &last) != TCL_OK) { + if (Tcl_GetDoubleFromObj(interp, objv[3], &last) != TCL_OK) { goto error; } if (first < 0) { @@ -435,23 +439,23 @@ ScrollbarWidgetCmd( scrollPtr->lastFraction = last; } scrollPtr->flags |= NEW_STYLE_COMMANDS; - } else if (argc == 6) { - if (Tcl_GetInt(interp, argv[2], &totalUnits) != TCL_OK) { + } else if (objc == 6) { + if (Tcl_GetIntFromObj(interp, objv[2], &totalUnits) != TCL_OK) { goto error; } if (totalUnits < 0) { totalUnits = 0; } - if (Tcl_GetInt(interp, argv[3], &windowUnits) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[3], &windowUnits) != TCL_OK) { goto error; } if (windowUnits < 0) { windowUnits = 0; } - if (Tcl_GetInt(interp, argv[4], &firstUnit) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[4], &firstUnit) != TCL_OK) { goto error; } - if (Tcl_GetInt(interp, argv[5], &lastUnit) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[5], &lastUnit) != TCL_OK) { goto error; } if (totalUnits > 0) { @@ -474,23 +478,15 @@ ScrollbarWidgetCmd( } scrollPtr->flags &= ~NEW_STYLE_COMMANDS; } else { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be " - "\"%s set firstFraction lastFraction\" or " - "\"%s set totalUnits windowUnits firstUnit lastUnit\"", - argv[0], argv[0])); - Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); + Tcl_WrongNumArgs(interp, 1, objv, "set firstFraction lastFraction"); + Tcl_AppendResult(interp, " or \"", Tcl_GetString(objv[0]), + " set totalUnits windowUnits firstUnit lastUnit\"", NULL); goto error; } TkpComputeScrollbarGeometry(scrollPtr); TkScrollbarEventuallyRedraw(scrollPtr); - } else { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad option \"%s\": must be activate, cget, configure," - " delta, fraction, get, identify, or set", argv[1])); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", - argv[1], NULL); - goto error; + break; + } } done: @@ -528,12 +524,12 @@ ConfigureScrollbar( register TkScrollbar *scrollPtr, /* Information about widget; may or may not * already have values for some fields. */ - int argc, /* Number of valid entries in argv. */ - const char **argv, /* Arguments. */ + int objc, /* Number of valid entries in argv. */ + Tcl_Obj *const objv[], /* Arguments. */ int flags) /* Flags to pass to Tk_ConfigureWidget. */ { - if (Tk_ConfigureWidget(interp, scrollPtr->tkwin, configSpecs, - argc, argv, (char *) scrollPtr, flags) != TCL_OK) { + if (Tk_ConfigureWidget(interp, scrollPtr->tkwin, configSpecs, objc, + (const char **)objv, (char *) scrollPtr, flags|TK_CONFIG_OBJS) != TCL_OK) { return TCL_ERROR; } @@ -626,6 +622,8 @@ TkScrollbarEventProc( TkScrollbarEventuallyRedraw(scrollPtr); } } + } else if (eventPtr->type == MapNotify) { + TkScrollbarEventuallyRedraw(scrollPtr); } } diff --git a/generic/tkStubInit.c b/generic/tkStubInit.c index 5a3e1ce..f08d7f4 100644 --- a/generic/tkStubInit.c +++ b/generic/tkStubInit.c @@ -556,9 +556,10 @@ static const TkIntPlatStubs tkIntPlatStubs = { TkGetTransientMaster, /* 49 */ TkGenerateButtonEvent, /* 50 */ TkGenWMDestroyEvent, /* 51 */ - 0, /* 52 */ + TkMacOSXSetDrawingEnabled, /* 52 */ TkpGetMS, /* 53 */ TkMacOSXDrawable, /* 54 */ + TkpScanWindowId, /* 55 */ #endif /* AQUA */ #if !(defined(_WIN32) || defined(__CYGWIN__) || defined(MAC_OSX_TK)) /* X11 */ TkCreateXEventSource, /* 0 */ diff --git a/generic/tkTest.c b/generic/tkTest.c index 562b2c8..fa9e073 100644 --- a/generic/tkTest.c +++ b/generic/tkTest.c @@ -139,8 +139,9 @@ typedef struct TrivialCommandHeader { * Forward declarations for functions defined later in this file: */ -static int ImageCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); +static int ImageObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * const objv[]); static int TestbitmapObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj * const objv[]); @@ -153,20 +154,24 @@ static int TestcolorObjCmd(ClientData dummy, static int TestcursorObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj * const objv[]); -static int TestdeleteappsCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); +static int TestdeleteappsObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * const objv[]); static int TestfontObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int TestmakeexistCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); +static int TestmakeexistObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); #if !(defined(_WIN32) || defined(MAC_OSX_TK) || defined(__CYGWIN__)) -static int TestmenubarCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); +static int TestmenubarObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); #endif #if defined(_WIN32) || defined(MAC_OSX_TK) -static int TestmetricsCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); +static int TestmetricsObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * const objv[]); #endif static int TestobjconfigObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, @@ -184,11 +189,13 @@ static void CustomOptionRestore(ClientData clientData, char *saveInternalPtr); static void CustomOptionFree(ClientData clientData, Tk_Window tkwin, char *internalPtr); -static int TestpropCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); +static int TestpropObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * const objv[]); #if !(defined(_WIN32) || defined(MAC_OSX_TK) || defined(__CYGWIN__)) -static int TestwrapperCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); +static int TestwrapperObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * const objv[]); #endif static void TrivialCmdDeletedProc(ClientData clientData); static int TrivialConfigObjCmd(ClientData dummy, @@ -231,7 +238,7 @@ Tktest_Init( * Create additional commands for testing Tk. */ - if (Tcl_PkgProvideEx(interp, "Tktest", TK_VERSION, NULL) == TCL_ERROR) { + if (Tcl_PkgProvideEx(interp, "Tktest", TK_PATCH_LEVEL, NULL) == TCL_ERROR) { return TCL_ERROR; } @@ -244,30 +251,30 @@ Tktest_Init( (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateObjCommand(interp, "testcursor", TestcursorObjCmd, (ClientData) Tk_MainWindow(interp), NULL); - Tcl_CreateCommand(interp, "testdeleteapps", TestdeleteappsCmd, + Tcl_CreateObjCommand(interp, "testdeleteapps", TestdeleteappsObjCmd, (ClientData) Tk_MainWindow(interp), NULL); - Tcl_CreateCommand(interp, "testembed", TkpTestembedCmd, + Tcl_CreateObjCommand(interp, "testembed", TkpTestembedCmd, (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateObjCommand(interp, "testobjconfig", TestobjconfigObjCmd, (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateObjCommand(interp, "testfont", TestfontObjCmd, (ClientData) Tk_MainWindow(interp), NULL); - Tcl_CreateCommand(interp, "testmakeexist", TestmakeexistCmd, + Tcl_CreateObjCommand(interp, "testmakeexist", TestmakeexistObjCmd, (ClientData) Tk_MainWindow(interp), NULL); - Tcl_CreateCommand(interp, "testprop", TestpropCmd, + Tcl_CreateObjCommand(interp, "testprop", TestpropObjCmd, (ClientData) Tk_MainWindow(interp), NULL); - Tcl_CreateCommand(interp, "testtext", TkpTesttextCmd, + Tcl_CreateObjCommand(interp, "testtext", TkpTesttextCmd, (ClientData) Tk_MainWindow(interp), NULL); #if defined(_WIN32) || defined(MAC_OSX_TK) - Tcl_CreateCommand(interp, "testmetrics", TestmetricsCmd, + Tcl_CreateObjCommand(interp, "testmetrics", TestmetricsObjCmd, (ClientData) Tk_MainWindow(interp), NULL); #elif !defined(__CYGWIN__) - Tcl_CreateCommand(interp, "testmenubar", TestmenubarCmd, + Tcl_CreateObjCommand(interp, "testmenubar", TestmenubarObjCmd, (ClientData) Tk_MainWindow(interp), NULL); - Tcl_CreateCommand(interp, "testsend", TkpTestsendCmd, + Tcl_CreateObjCommand(interp, "testsend", TkpTestsendCmd, (ClientData) Tk_MainWindow(interp), NULL); - Tcl_CreateCommand(interp, "testwrapper", TestwrapperCmd, + Tcl_CreateObjCommand(interp, "testwrapper", TestwrapperObjCmd, (ClientData) Tk_MainWindow(interp), NULL); #endif /* _WIN32 || MAC_OSX_TK */ @@ -436,7 +443,7 @@ TestcursorObjCmd( /* *---------------------------------------------------------------------- * - * TestdeleteappsCmd -- + * TestdeleteappsObjCmd -- * * This function implements the "testdeleteapps" command. It cleans up * all the interpreters left behind by the "testnewapp" command. @@ -453,11 +460,11 @@ TestcursorObjCmd( /* ARGSUSED */ static int -TestdeleteappsCmd( +TestdeleteappsObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { NewApp *nextPtr; @@ -1407,7 +1414,7 @@ ImageCreate( strcpy(timPtr->imageName, name); timPtr->varName = ckalloc(strlen(varName) + 1); strcpy(timPtr->varName, varName); - Tcl_CreateCommand(interp, name, ImageCmd, timPtr, NULL); + Tcl_CreateObjCommand(interp, name, ImageObjCmd, timPtr, NULL); *clientDataPtr = timPtr; Tk_ImageChanged(master, 0, 0, 30, 15, 30, 15); return TCL_OK; @@ -1416,7 +1423,7 @@ ImageCreate( /* *---------------------------------------------------------------------- * - * ImageCmd -- + * ImageObjCmd -- * * This function implements the commands corresponding to individual * images. @@ -1432,38 +1439,37 @@ ImageCreate( /* ARGSUSED */ static int -ImageCmd( +ImageObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { TImageMaster *timPtr = (TImageMaster *) clientData; int x, y, width, height; - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], "option ?arg ...?", NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } - if (strcmp(argv[1], "changed") == 0) { - if (argc != 8) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " changed x y width height imageWidth imageHeight", NULL); + if (strcmp(Tcl_GetString(objv[1]), "changed") == 0) { + if (objc != 8) { + Tcl_WrongNumArgs(interp, 1, objv, "changed x y width height" + " imageWidth imageHeight"); return TCL_ERROR; } - if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) - || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK) - || (Tcl_GetInt(interp, argv[4], &width) != TCL_OK) - || (Tcl_GetInt(interp, argv[5], &height) != TCL_OK) - || (Tcl_GetInt(interp, argv[6], &timPtr->width) != TCL_OK) - || (Tcl_GetInt(interp, argv[7], &timPtr->height) != TCL_OK)) { + if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[4], &width) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[5], &height) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[6], &timPtr->width) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[7], &timPtr->height) != TCL_OK)) { return TCL_ERROR; } Tk_ImageChanged(timPtr->master, x, y, width, height, timPtr->width, timPtr->height); } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], + Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]), "\": must be changed", NULL); return TCL_ERROR; } @@ -1636,7 +1642,7 @@ ImageDelete( /* *---------------------------------------------------------------------- * - * TestmakeexistCmd -- + * TestmakeexistObjCmd -- * * This function implements the "testmakeexist" command. It calls * Tk_MakeWindowExist on each of its arguments to force the windows to be @@ -1653,18 +1659,18 @@ ImageDelete( /* ARGSUSED */ static int -TestmakeexistCmd( +TestmakeexistObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { Tk_Window mainWin = (Tk_Window) clientData; int i; Tk_Window tkwin; - for (i = 1; i < argc; i++) { - tkwin = Tk_NameToWindow(interp, argv[i], mainWin); + for (i = 1; i < objc; i++) { + tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[i]), mainWin); if (tkwin == NULL) { return TCL_ERROR; } @@ -1677,7 +1683,7 @@ TestmakeexistCmd( /* *---------------------------------------------------------------------- * - * TestmenubarCmd -- + * TestmenubarObjCmd -- * * This function implements the "testmenubar" command. It is used to test * the Unix facilities for creating space above a toplevel window for a @@ -1695,43 +1701,41 @@ TestmakeexistCmd( /* ARGSUSED */ #if !(defined(_WIN32) || defined(MAC_OSX_TK) || defined(__CYGWIN__)) static int -TestmenubarCmd( +TestmenubarObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { #ifdef __UNIX__ Tk_Window mainWin = (Tk_Window) clientData; Tk_Window tkwin, menubar; - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - " option ?arg ...?\"", NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } - if (strcmp(argv[1], "window") == 0) { - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - "window toplevel menubar\"", NULL); + if (strcmp(Tcl_GetString(objv[1]), "window") == 0) { + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "windows toplevel menubar"); return TCL_ERROR; } - tkwin = Tk_NameToWindow(interp, argv[2], mainWin); + tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), mainWin); if (tkwin == NULL) { return TCL_ERROR; } - if (argv[3][0] == 0) { + if (Tcl_GetString(objv[3])[0] == 0) { TkUnixSetMenubar(tkwin, NULL); } else { - menubar = Tk_NameToWindow(interp, argv[3], mainWin); + menubar = Tk_NameToWindow(interp, Tcl_GetString(objv[3]), mainWin); if (menubar == NULL) { return TCL_ERROR; } TkUnixSetMenubar(tkwin, menubar); } } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], + Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]), "\": must be window", NULL); return TCL_ERROR; } @@ -1747,7 +1751,7 @@ TestmenubarCmd( /* *---------------------------------------------------------------------- * - * TestmetricsCmd -- + * TestmetricsObjCmd -- * * This function implements the testmetrics command. It provides a way to * determine the size of various widget components. @@ -1763,51 +1767,49 @@ TestmenubarCmd( #if defined(_WIN32) || defined(MAC_OSX_TK) static int -TestmetricsCmd( +TestmetricsObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { char buf[TCL_INTEGER_SPACE]; int val; #ifdef _WIN32 - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - " option ?arg ...?\"", NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } #else Tk_Window tkwin = (Tk_Window) clientData; TkWindow *winPtr; - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - " option window\"", NULL); + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "option window"); return TCL_ERROR; } - winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin); + winPtr = (TkWindow *) Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); if (winPtr == NULL) { return TCL_ERROR; } #endif - if (strcmp(argv[1], "cyvscroll") == 0) { + if (strcmp(Tcl_GetString(objv[1]), "cyvscroll") == 0) { #ifdef _WIN32 val = GetSystemMetrics(SM_CYVSCROLL); #else val = ((TkScrollbar *) winPtr->instanceData)->width; #endif - } else if (strcmp(argv[1], "cxhscroll") == 0) { + } 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 \"", argv[1], + Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]), "\": must be cxhscroll or cyvscroll", NULL); return TCL_ERROR; } @@ -1820,7 +1822,7 @@ TestmetricsCmd( /* *---------------------------------------------------------------------- * - * TestpropCmd -- + * TestpropObjCmd -- * * This function implements the "testprop" command. It fetches and prints * the value of a property on a window. @@ -1836,11 +1838,11 @@ TestmetricsCmd( /* ARGSUSED */ static int -TestpropCmd( +TestpropObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { Tk_Window mainWin = (Tk_Window) clientData; int result, actualFormat; @@ -1851,14 +1853,13 @@ TestpropCmd( Window w; char buffer[30]; - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - " window property\"", NULL); + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "window property"); return TCL_ERROR; } - w = strtoul(argv[1], &end, 0); - propName = Tk_InternAtom(mainWin, argv[2]); + w = strtoul(Tcl_GetString(objv[1]), &end, 0); + propName = Tk_InternAtom(mainWin, Tcl_GetString(objv[2])); property = NULL; result = XGetWindowProperty(Tk_Display(mainWin), w, propName, 0, 100000, False, AnyPropertyType, @@ -1899,7 +1900,7 @@ TestpropCmd( /* *---------------------------------------------------------------------- * - * TestwrapperCmd -- + * TestwrapperObjCmd -- * * This function implements the "testwrapper" command. It provides a way * from Tcl to determine the extra window Tk adds in between the toplevel @@ -1916,23 +1917,22 @@ TestpropCmd( /* ARGSUSED */ static int -TestwrapperCmd( +TestwrapperObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { TkWindow *winPtr, *wrapperPtr; Tk_Window tkwin; - if (argc != 2) { - Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - " window\"", NULL); + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "window"); return TCL_ERROR; } tkwin = (Tk_Window) clientData; - winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin); + winPtr = (TkWindow *) Tk_NameToWindow(interp, Tcl_GetString(objv[1]), tkwin); if (winPtr == NULL) { return TCL_ERROR; } diff --git a/generic/tkText.c b/generic/tkText.c index 2c7eec3..4edf652 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -580,14 +580,6 @@ CreateWidget( textPtr->end = NULL; } - /* - * Register with the B-tree. In some sense it would be best if we could do - * this later (after configuration options), so that any changes to - * start,end do not require a total recalculation. - */ - - TkBTreeAddClient(sharedPtr->tree, textPtr, textPtr->charHeight); - textPtr->state = TK_TEXT_STATE_NORMAL; textPtr->relief = TK_RELIEF_FLAT; textPtr->cursor = None; @@ -598,6 +590,14 @@ CreateWidget( textPtr->prevHeight = Tk_Height(newWin); /* + * Register with the B-tree. In some sense it would be best if we could do + * this later (after configuration options), so that any changes to + * start,end do not require a total recalculation. + */ + + TkBTreeAddClient(sharedPtr->tree, textPtr, textPtr->charHeight); + + /* * This will add refCounts to textPtr. */ @@ -881,7 +881,7 @@ TextWidgetObjCmd( } else if (c == 'd' && (length > 8) && !strncmp("-displaylines", option, (unsigned) length)) { TkTextLine *fromPtr, *lastPtr; - TkTextIndex index; + TkTextIndex index, index2; int compare = TkTextIndexCmp(indexFromPtr, indexToPtr); value = 0; @@ -916,35 +916,44 @@ TextWidgetObjCmd( /* * We're going to count up all display lines in the logical * line of 'indexFromPtr' up to, but not including the logical - * line of 'indexToPtr', and then subtract off what we didn't - * want from 'from' and add on what we didn't count from 'to. + * line of 'indexToPtr' (except if this line is elided), and + * then subtract off what came in too much from elided lines, + * also subtract off what we didn't want from 'from' and add + * on what we didn't count from 'to'. */ - while (index.linePtr != indexToPtr->linePtr) { - value += TkTextUpdateOneLine(textPtr, fromPtr,0,&index,0); - - /* - * We might have skipped past indexToPtr, if we have - * multiple logical lines in a single display line. - */ - if (TkTextIndexCmp(&index,indexToPtr) > 0) { - break; - } + while (TkTextIndexCmp(&index,indexToPtr) < 0) { + value += TkTextUpdateOneLine(textPtr, index.linePtr, + 0, &index, 0); } - /* - * Now we need to adjust the count to add on the number of - * display lines in the last logical line, and subtract off - * the number of display lines overcounted in the first - * logical line. This logic is still ok if both indices are in - * the same logical line. - */ + index2 = index; + + /* + * Now we need to adjust the count to: + * - subtract off the number of display lines between + * indexToPtr and index2, since we might have skipped past + * indexToPtr, if we have several logical lines in a + * single display line + * - subtract off the number of display lines overcounted + * in the first logical line + * - add on the number of display lines in the last logical + * line + * This logic is still ok if both indexFromPtr and indexToPtr + * are in the same logical line. + */ + index = *indexToPtr; + index.byteIndex = 0; + while (TkTextIndexCmp(&index,&index2) < 0) { + value -= TkTextUpdateOneLine(textPtr, index.linePtr, + 0, &index, 0); + } index.linePtr = indexFromPtr->linePtr; index.byteIndex = 0; while (1) { TkTextFindDisplayLineEnd(textPtr, &index, 1, NULL); - if (index.byteIndex >= indexFromPtr->byteIndex) { + if (TkTextIndexCmp(&index,indexFromPtr) >= 0) { break; } TkTextIndexForwBytes(textPtr, &index, 1, &index); @@ -956,7 +965,7 @@ TextWidgetObjCmd( index.byteIndex = 0; while (1) { TkTextFindDisplayLineEnd(textPtr, &index, 1, NULL); - if (index.byteIndex >= indexToPtr->byteIndex) { + if (TkTextIndexCmp(&index,indexToPtr) >= 0) { break; } TkTextIndexForwBytes(textPtr, &index, 1, &index); @@ -2335,6 +2344,7 @@ TextWorldChanged( { Tk_FontMetrics fm; int border; + int oldCharHeight = textPtr->charHeight; textPtr->charWidth = Tk_TextWidth(textPtr->tkfont, "0", 1); if (textPtr->charWidth <= 0) { @@ -2346,6 +2356,9 @@ TextWorldChanged( if (textPtr->charHeight <= 0) { textPtr->charHeight = 1; } + if (textPtr->charHeight != oldCharHeight) { + TkBTreeClientRangeChanged(textPtr, textPtr->charHeight); + } border = textPtr->borderWidth + textPtr->highlightWidth; Tk_GeometryRequest(textPtr->tkwin, textPtr->width * textPtr->charWidth + 2*textPtr->padX + 2*border, @@ -3013,11 +3026,9 @@ DeleteIndexRange( * The code below is ugly, but it's needed to make sure there is always a * dummy empty line at the end of the text. If the final newline of the * file (just before the dummy line) is being deleted, then back up index - * to just before the newline. If there is a newline just before the first - * character being deleted, then back up the first index too, so that an - * even number of lines gets deleted. Furthermore, remove any tags that - * are present on the newline that isn't going to be deleted after all - * (this simulates deleting the newline and then adding a "clean" one back + * to just before the newline. Furthermore, remove any tags that are + * present on the newline that isn't going to be deleted after all (this + * simulates deleting the newline and then adding a "clean" one back * again). Note that index1 and index2 might now be equal again which * means that no text will be deleted but tags might be removed. */ @@ -3032,10 +3043,6 @@ DeleteIndexRange( oldIndex2 = index2; TkTextIndexBackChars(NULL, &oldIndex2, 1, &index2, COUNT_INDICES); line2--; - if ((index1.byteIndex == 0) && (line1 != 0)) { - TkTextIndexBackChars(NULL, &index1, 1, &index1, COUNT_INDICES); - line1--; - } arrayPtr = TkBTreeGetTags(&index2, NULL, &arraySize); if (arrayPtr != NULL) { for (i = 0; i < arraySize; i++) { @@ -4231,7 +4238,11 @@ TextSearchFoundMatch( matchOffset += Tcl_NumUtfChars(segPtr->body.chars, -1); } } else { - leftToScan -= segPtr->size; + if (searchSpecPtr->exact) { + leftToScan -= segPtr->size; + } else { + leftToScan -= Tcl_NumUtfChars(segPtr->body.chars, -1); + } } curIndex.byteIndex += segPtr->size; } @@ -6658,8 +6669,8 @@ int TkpTesttextCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { TkText *textPtr; size_t len; @@ -6668,45 +6679,41 @@ TkpTesttextCmd( char buf[64]; Tcl_CmdInfo info; - if (argc < 3) { + if (objc < 3) { return TCL_ERROR; } - if (Tcl_GetCommandInfo(interp, argv[1], &info) == 0) { + if (Tcl_GetCommandInfo(interp, Tcl_GetString(objv[1]), &info) == 0) { return TCL_ERROR; } - if (info.isNativeObjectProc) { - textPtr = info.objClientData; - } else { - textPtr = info.clientData; - } - len = strlen(argv[2]); - if (strncmp(argv[2], "byteindex", len) == 0) { - if (argc != 5) { + textPtr = info.objClientData; + len = strlen(Tcl_GetString(objv[2])); + if (strncmp(Tcl_GetString(objv[2]), "byteindex", len) == 0) { + if (objc != 5) { return TCL_ERROR; } - lineIndex = atoi(argv[3]) - 1; - byteIndex = atoi(argv[4]); + lineIndex = atoi(Tcl_GetString(objv[3])) - 1; + byteIndex = atoi(Tcl_GetString(objv[4])); TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, lineIndex, byteIndex, &index); - } else if (strncmp(argv[2], "forwbytes", len) == 0) { - if (argc != 5) { + } else if (strncmp(Tcl_GetString(objv[2]), "forwbytes", len) == 0) { + if (objc != 5) { return TCL_ERROR; } - if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) { + if (TkTextGetIndex(interp, textPtr, Tcl_GetString(objv[3]), &index) != TCL_OK) { return TCL_ERROR; } - byteOffset = atoi(argv[4]); + byteOffset = atoi(Tcl_GetString(objv[4])); TkTextIndexForwBytes(textPtr, &index, byteOffset, &index); - } else if (strncmp(argv[2], "backbytes", len) == 0) { - if (argc != 5) { + } else if (strncmp(Tcl_GetString(objv[2]), "backbytes", len) == 0) { + if (objc != 5) { return TCL_ERROR; } - if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) { + if (TkTextGetIndex(interp, textPtr, Tcl_GetString(objv[3]), &index) != TCL_OK) { return TCL_ERROR; } - byteOffset = atoi(argv[4]); + byteOffset = atoi(Tcl_GetString(objv[4])); TkTextIndexBackBytes(textPtr, &index, byteOffset, &index); } else { return TCL_ERROR; diff --git a/generic/tkText.h b/generic/tkText.h index fb9eab2..78a99a9 100644 --- a/generic/tkText.h +++ b/generic/tkText.h @@ -168,7 +168,7 @@ typedef struct TkTextSegment { int size; /* Size of this segment (# of bytes of index * space it occupies). */ union { - char chars[1]; /* Characters that make up character info. + char chars[2]; /* Characters that make up character info. * Actual length varies to hold as many * characters as needed.*/ TkTextToggle toggle; /* Information about tag toggle. */ @@ -1066,6 +1066,9 @@ MODULE_SCOPE void TkTextIndexBackChars(const TkText *textPtr, TkTextIndex *dstPtr, TkTextCountType type); MODULE_SCOPE int TkTextIndexCmp(const TkTextIndex *index1Ptr, const TkTextIndex *index2Ptr); +MODULE_SCOPE int TkTextIndexCountBytes(const TkText *textPtr, + const TkTextIndex *index1Ptr, + const TkTextIndex *index2Ptr); MODULE_SCOPE int TkTextIndexCount(const TkText *textPtr, const TkTextIndex *index1Ptr, const TkTextIndex *index2Ptr, diff --git a/generic/tkTextBTree.c b/generic/tkTextBTree.c index e34dae7..0fdc280 100644 --- a/generic/tkTextBTree.c +++ b/generic/tkTextBTree.c @@ -1112,7 +1112,7 @@ TkBTreeInsertChars( /* * I don't believe it's possible for either of the two lines passed to * this function to be the last line of text, but the function is robust - * to that case anyway. (We must never re-calculated the line height of + * to that case anyway. (We must never re-calculate the line height of * the last line). */ @@ -1879,8 +1879,7 @@ TkBTreePreviousLine( * number of pixels in the widget. * * Results: - * The result is the index of linePtr within the tree, where 0 - * corresponds to the first line in the tree. + * The result is the pixel height of the top of the given line. * * Side effects: * None. @@ -1989,7 +1988,7 @@ TkBTreeLinesTo( } } if (textPtr != NULL) { - /* + /* * The index to return must be relative to textPtr, not to the entire * tree. Take care to never return a negative index when linePtr * denotes a line before -startline, or an index larger than the @@ -3616,20 +3615,6 @@ TkTextIsElided( infoPtr->elidePriority = -1; for (i = infoPtr->numTags-1; i >=0; i--) { if (infoPtr->tagCnts[i] & 1) { - /* - * Who would make the selection elided? - */ - - if ((tagPtr == textPtr->selTagPtr) - && !(textPtr->flags & GOT_FOCUS) - && (textPtr->inactiveSelBorder == NULL -#ifdef MAC_OSX_TK - /* Don't show inactive selection in disabled widgets. */ - || textPtr->state == TK_TEXT_STATE_DISABLED -#endif - )) { - continue; - } infoPtr->elide = infoPtr->tagPtrs[i]->elide; /* diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index aebdcc6..a57c24b 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -243,7 +243,8 @@ typedef struct DLine { * top to bottom. Note: the next DLine doesn't * always correspond to the next line of text: * (a) can have multiple DLines for one text - * line, and (b) can have gaps where DLine's + * line (wrapping), (b) can have elided newlines, + * and (c) can have gaps where DLine's * have been deleted because they're out of * date. */ int flags; /* Various flag bits: see below for values. */ @@ -543,7 +544,8 @@ static void DisplayDLine(TkText *textPtr, DLine *dlPtr, static void DisplayLineBackground(TkText *textPtr, DLine *dlPtr, DLine *prevPtr, Pixmap pixmap); static void DisplayText(ClientData clientData); -static DLine * FindDLine(DLine *dlPtr, const TkTextIndex *indexPtr); +static DLine * FindDLine(TkText *textPtr, DLine *dlPtr, + const TkTextIndex *indexPtr); static void FreeDLines(TkText *textPtr, DLine *firstPtr, DLine *lastPtr, int action); static void FreeStyle(TkText *textPtr, TextStyle *stylePtr); @@ -590,6 +592,8 @@ static int TextGetScrollInfoObj(Tcl_Interp *interp, int *intPtr); static void AsyncUpdateLineMetrics(ClientData clientData); static void AsyncUpdateYScrollbar(ClientData clientData); +static int IsStartOfNotMergedLine(TkText *textPtr, + CONST TkTextIndex *indexPtr); /* * Result values returned by TextGetScrollInfoObj: @@ -655,17 +659,8 @@ TkTextCreateDInfo( dInfoPtr->metricEpoch = -1; dInfoPtr->metricIndex.textPtr = NULL; dInfoPtr->metricIndex.linePtr = NULL; - - /* - * Add a refCount for each of the idle call-backs. - */ - - textPtr->refCount++; - dInfoPtr->lineUpdateTimer = Tcl_CreateTimerHandler(0, - AsyncUpdateLineMetrics, textPtr); - textPtr->refCount++; - dInfoPtr->scrollbarTimer = Tcl_CreateTimerHandler(200, - AsyncUpdateYScrollbar, textPtr); + dInfoPtr->lineUpdateTimer = NULL; + dInfoPtr->scrollbarTimer = NULL; textPtr->dInfoPtr = dInfoPtr; } @@ -1020,7 +1015,7 @@ FreeStyle( * whose leftmost character is given by indexPtr. * * Results: - * The return value is a pointer to a DLine structure desribing the + * The return value is a pointer to a DLine structure describing the * display line. All fields are filled in and correct except for y and * nextPtr. * @@ -1759,7 +1754,7 @@ UpdateDisplayInfo( */ index = textPtr->topIndex; - dlPtr = FindDLine(dInfoPtr->dLinePtr, &index); + dlPtr = FindDLine(textPtr, dInfoPtr->dLinePtr, &index); if ((dlPtr != NULL) && (dlPtr != dInfoPtr->dLinePtr)) { FreeDLines(textPtr, dInfoPtr->dLinePtr, dlPtr, DLINE_UNLINK); } @@ -1909,7 +1904,7 @@ UpdateDisplayInfo( prevPtr->index.linePtr) != lineHeight)) { /* * The logical line height we just calculated is actually - * differnt to the currently cached height of the text line. + * different to the currently cached height of the text line. * That is fine (the text line heights are only calculated * asynchronously), but we must update the cached height so * that any counts made with DLine pointers are the same as @@ -2222,7 +2217,7 @@ UpdateDisplayInfo( * Here's a problem: see the tests textDisp-29.2.1-4 * * If the widget is being created, but has not yet been configured it will - * have a maxY of 1 above, and we we won't have examined all the lines + * have a maxY of 1 above, and we won't have examined all the lines * (just the first line, in fact), and so maxOffset will not be a true * reflection of the widget's lines. Therefore we must not overwrite the * original newXPixelOffset in this case. @@ -2537,7 +2532,7 @@ DisplayLineBackground( * current x coordinate? */ int matchRight; /* Does line's style match its neighbor just * to the right of the current x-coord? */ - int minX, maxX, xOffset; + int minX, maxX, xOffset, bw; StyleValues *sValuePtr; Display *display; #ifndef TK_NO_DOUBLE_BUFFERING @@ -2608,16 +2603,25 @@ DisplayLineBackground( rightX = leftX + 32767; } + /* + * Prevent the borders from leaking on adjacent characters, + * which would happen for too large border width. + */ + + bw = sValuePtr->borderWidth; + if (leftX + sValuePtr->borderWidth > rightX) { + bw = rightX - leftX; + } + XFillRectangle(display, pixmap, chunkPtr->stylePtr->bgGC, leftX + xOffset, y, (unsigned int) (rightX - leftX), (unsigned int) dlPtr->height); if (sValuePtr->relief != TK_RELIEF_FLAT) { Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border, - leftX + xOffset, y, sValuePtr->borderWidth, - dlPtr->height, 1, sValuePtr->relief); + leftX + xOffset, y, bw, dlPtr->height, 1, + sValuePtr->relief); Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border, - rightX - sValuePtr->borderWidth + xOffset, - y, sValuePtr->borderWidth, dlPtr->height, 0, + rightX - bw + xOffset, y, bw, dlPtr->height, 0, sValuePtr->relief); } } @@ -2714,22 +2718,29 @@ DisplayLineBackground( matchRight = (nextPtr2 != NULL) && SAME_BACKGROUND(nextPtr2->stylePtr, chunkPtr->stylePtr); if (matchLeft && !matchRight) { + bw = sValuePtr->borderWidth; + if (rightX2 - sValuePtr->borderWidth < leftX) { + bw = rightX2 - leftX; + } if (sValuePtr->relief != TK_RELIEF_FLAT) { Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border, - rightX2 - sValuePtr->borderWidth + xOffset, y, - sValuePtr->borderWidth, sValuePtr->borderWidth, 0, - sValuePtr->relief); + rightX2 - bw + xOffset, y, bw, + sValuePtr->borderWidth, 0, sValuePtr->relief); } - leftX = rightX2 - sValuePtr->borderWidth; + leftX = rightX2 - bw; leftXIn = 0; } else if (!matchLeft && matchRight && (sValuePtr->relief != TK_RELIEF_FLAT)) { + bw = sValuePtr->borderWidth; + if (rightX2 + sValuePtr->borderWidth > rightX) { + bw = rightX - rightX2; + } Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border, - rightX2 + xOffset, y, sValuePtr->borderWidth, - sValuePtr->borderWidth, 1, sValuePtr->relief); + rightX2 + xOffset, y, bw, sValuePtr->borderWidth, + 1, sValuePtr->relief); Tk_3DHorizontalBevel(textPtr->tkwin, pixmap, sValuePtr->border, - leftX + xOffset, y, rightX2 + sValuePtr->borderWidth - - leftX, sValuePtr->borderWidth, leftXIn, 0, 1, + leftX + xOffset, y, rightX2 + bw - leftX, + sValuePtr->borderWidth, leftXIn, 0, 1, sValuePtr->relief); } @@ -2761,7 +2772,7 @@ DisplayLineBackground( chunkPtr2 = NULL; if (dlPtr->nextPtr != NULL && dlPtr->nextPtr->chunkPtr != NULL) { /* - * Find the chunk in the previous line that covers leftX. + * Find the chunk in the next line that covers leftX. */ nextPtr2 = dlPtr->nextPtr->chunkPtr; @@ -2817,26 +2828,33 @@ DisplayLineBackground( matchRight = (nextPtr2 != NULL) && SAME_BACKGROUND(nextPtr2->stylePtr, chunkPtr->stylePtr); if (matchLeft && !matchRight) { + bw = sValuePtr->borderWidth; + if (rightX2 - sValuePtr->borderWidth < leftX) { + bw = rightX2 - leftX; + } if (sValuePtr->relief != TK_RELIEF_FLAT) { Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border, - rightX2 - sValuePtr->borderWidth + xOffset, + rightX2 - bw + xOffset, y + dlPtr->height - sValuePtr->borderWidth, - sValuePtr->borderWidth, sValuePtr->borderWidth, 0, - sValuePtr->relief); + bw, sValuePtr->borderWidth, 0, sValuePtr->relief); } - leftX = rightX2 - sValuePtr->borderWidth; + leftX = rightX2 - bw; leftXIn = 1; } else if (!matchLeft && matchRight && (sValuePtr->relief != TK_RELIEF_FLAT)) { + bw = sValuePtr->borderWidth; + if (rightX2 + sValuePtr->borderWidth > rightX) { + bw = rightX - rightX2; + } Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border, - rightX2 + xOffset, y + dlPtr->height - - sValuePtr->borderWidth, sValuePtr->borderWidth, + rightX2 + xOffset, + y + dlPtr->height - sValuePtr->borderWidth, bw, sValuePtr->borderWidth, 1, sValuePtr->relief); Tk_3DHorizontalBevel(textPtr->tkwin, pixmap, sValuePtr->border, - leftX + xOffset, y + dlPtr->height - - sValuePtr->borderWidth, rightX2 + sValuePtr->borderWidth - - leftX, sValuePtr->borderWidth, leftXIn, 1, 0, - sValuePtr->relief); + leftX + xOffset, + y + dlPtr->height - sValuePtr->borderWidth, + rightX2 + bw - leftX, sValuePtr->borderWidth, leftXIn, + 1, 0, sValuePtr->relief); } nextChunk2b: @@ -2886,9 +2904,10 @@ AsyncUpdateLineMetrics( dInfoPtr->lineUpdateTimer = NULL; - if ((textPtr->tkwin == NULL) || (textPtr->flags & DESTROYED)) { + if ((textPtr->tkwin == NULL) || (textPtr->flags & DESTROYED) + || !Tk_IsMapped(textPtr->tkwin)) { /* - * The widget has been deleted. Don't do anything. + * The widget has been deleted, or is not mapped. Don't do anything. */ if (--textPtr->refCount == 0) { @@ -3385,7 +3404,7 @@ TkTextFindDisplayLineEnd( { TkTextIndex index; - if (!end && indexPtr->byteIndex == 0) { + if (!end && IsStartOfNotMergedLine(textPtr, indexPtr)) { /* * Nothing to do. */ @@ -3463,7 +3482,8 @@ TkTextFindDisplayLineEnd( */ *xOffset = DlineXOfIndex(textPtr, dlPtr, - indexPtr->byteIndex - dlPtr->index.byteIndex); + TkTextIndexCountBytes(textPtr, &dlPtr->index, + indexPtr)); } if (end) { /* @@ -3533,6 +3553,27 @@ CalculateDisplayLineHeight( DLine *dlPtr; int pixelHeight; + if (tkTextDebug) { + int oldtkTextDebug = tkTextDebug; + /* + * Check that the indexPtr we are given really is at the start of a + * display line. The gymnastics with tkTextDebug is to prevent + * failure of a test suite test, that checks that lines are rendered + * exactly once. TkTextFindDisplayLineEnd is used here for checking + * indexPtr but it calls LayoutDLine/FreeDLine which makes the + * counting wrong. The debug mode shall therefore be switched off + * when calling TkTextFindDisplayLineEnd. + */ + + TkTextIndex indexPtr2 = *indexPtr; + tkTextDebug = 0; + TkTextFindDisplayLineEnd(textPtr, &indexPtr2, 0, NULL); + tkTextDebug = oldtkTextDebug; + if (TkTextIndexCmp(&indexPtr2,indexPtr) != 0) { + Tcl_Panic("CalculateDisplayLineHeight called with bad indexPtr"); + } + } + /* * Special case for artificial last line. May be better to move this * inside LayoutDLine. @@ -3599,26 +3640,44 @@ TkTextIndexYPixels( { int pixelHeight; TkTextIndex index; + int alreadyStartOfLine = 1; - pixelHeight = TkBTreePixelsTo(textPtr, indexPtr->linePtr); + /* + * Find the index denoting the closest position being at the same time + * the start of a logical line above indexPtr and the start of a display + * line. + */ + + index = *indexPtr; + while (1) { + TkTextFindDisplayLineEnd(textPtr, &index, 0, NULL); + if (index.byteIndex == 0) { + break; + } + TkTextIndexBackBytes(textPtr, &index, 1, &index); + alreadyStartOfLine = 0; + } + + pixelHeight = TkBTreePixelsTo(textPtr, index.linePtr); /* - * Iterate through all display-lines corresponding to the single logical - * line belonging to indexPtr, adding up the pixel height of each such - * display line as we go along, until we go past 'indexPtr'. + * Shortcut to avoid layout of a superfluous display line. We know there + * is nothing more to add up to the height if the index we were given was + * already on the first display line of a logical line. */ - if (indexPtr->byteIndex == 0) { - return pixelHeight; + if (alreadyStartOfLine) { + return pixelHeight; } - index.tree = textPtr->sharedTextPtr->tree; - index.linePtr = indexPtr->linePtr; - index.byteIndex = 0; - index.textPtr = NULL; + /* + * Iterate through display lines, starting at the logical line belonging + * to index, adding up the pixel height of each such display line as we + * go along, until we go past 'indexPtr'. + */ while (1) { - int bytes, height; + int bytes, height, compare; /* * Currently this call doesn't have many side-effects. However, if in @@ -3630,9 +3689,10 @@ TkTextIndexYPixels( height = CalculateDisplayLineHeight(textPtr, &index, &bytes, NULL); - index.byteIndex += bytes; + TkTextIndexForwBytes(textPtr, &index, bytes, &index); - if (index.byteIndex > indexPtr->byteIndex) { + compare = TkTextIndexCmp(&index,indexPtr); + if (compare > 0) { return pixelHeight; } @@ -3640,7 +3700,7 @@ TkTextIndexYPixels( pixelHeight += height; } - if (index.byteIndex == indexPtr->byteIndex) { + if (compare == 0) { return pixelHeight; } } @@ -3704,10 +3764,26 @@ TkTextUpdateOneLine( } /* + * CalculateDisplayLineHeight _must_ be called (below) with an index at + * the beginning of a display line. Force this to happen. This is needed + * when TkTextUpdateOneLine is called with a line that is merged with its + * previous line: the number of merged logical lines in a display line is + * calculated correctly only when CalculateDisplayLineHeight receives + * an index at the beginning of a display line. In turn this causes the + * merged lines to receive their correct zero pixel height in + * TkBTreeAdjustPixelHeight. + */ + + TkTextFindDisplayLineEnd(textPtr, indexPtr, 0, NULL); + linePtr = indexPtr->linePtr; + + /* * Iterate through all display-lines corresponding to the single logical - * line 'linePtr', adding up the pixel height of each such display line as - * we go along. The final total is, therefore, the height of the logical - * line. + * line 'linePtr' (and lines merged into this line due to eol elision), + * adding up the pixel height of each such display line as we go along. + * The final total is, therefore, the total height of all display lines + * made up by the logical line 'linePtr' and subsequent logical lines + * merged into this line. */ displayLines = 0; @@ -3724,7 +3800,7 @@ TkTextUpdateOneLine( * test below this while loop. */ - height = CalculateDisplayLineHeight(textPtr, indexPtr, &bytes, + height = CalculateDisplayLineHeight(textPtr, indexPtr, &bytes, &logicalLines); if (height > 0) { @@ -3738,44 +3814,31 @@ TkTextUpdateOneLine( break; } - if (logicalLines == 0) { - if (indexPtr->linePtr != linePtr) { - /* - * If we reached the end of the logical line, then either way - * we don't have a partial calculation. - */ + if (mergedLines == 0) { + if (indexPtr->linePtr != linePtr) { + /* + * If we reached the end of the logical line, then either way + * we don't have a partial calculation. + */ - partialCalc = 0; - break; - } - } else if (indexPtr->byteIndex != 0) { - /* - * We must still be on the same wrapped line. - */ - } else { - /* - * Must check if indexPtr is really a new logical line which is - * not merged with the previous line. The only code that would - * really know this is LayoutDLine, which doesn't pass the - * information on, so we have to check manually here. - */ - - TkTextIndex idx; - - TkTextIndexBackChars(textPtr, indexPtr, 1, &idx, COUNT_INDICES); - if (!TkTextIsElided(textPtr, &idx, NULL)) { - /* - * We've ended a logical line. - */ - - partialCalc = 0; - break; - } + partialCalc = 0; + break; + } + } else { + if (IsStartOfNotMergedLine(textPtr, indexPtr)) { + /* + * We've ended a logical line. + */ + + partialCalc = 0; + break; + } - /* - * We must still be on the same wrapped line. - */ - } + /* + * We must still be on the same wrapped line, on a new logical + * line merged with the logical line 'linePtr'. + */ + } if (partialCalc && displayLines > 50 && mergedLines == 0) { /* * Only calculate 50 display lines at a time, to avoid huge @@ -3900,6 +3963,19 @@ DisplayText( * warnings. */ Tcl_Interp *interp; +#ifdef MAC_OSX_TK + /* + * If drawing is disabled, all we need to do is + * clear the REDRAW_PENDING flag. + */ + TkWindow *winPtr = (TkWindow *)(textPtr->tkwin); + MacDrawable *macWin = winPtr->privatePtr; + if (macWin && (macWin->flags & TK_DO_NOT_DRAW)){ + dInfoPtr->flags &= ~REDRAW_PENDING; + return; + } +#endif + if ((textPtr->tkwin == NULL) || (textPtr->flags & DESTROYED)) { /* * The widget has been deleted. Don't do anything. @@ -3915,14 +3991,6 @@ DisplayText( Tcl_SetVar2(interp, "tk_textRelayout", NULL, "", TCL_GLOBAL_ONLY); } - if ((textPtr->tkwin == NULL) || (textPtr->flags & DESTROYED)) { - /* - * The widget has been deleted. Don't do anything. - */ - - goto end; - } - if (!Tk_IsMapped(textPtr->tkwin) || (dInfoPtr->maxX <= dInfoPtr->x) || (dInfoPtr->maxY <= dInfoPtr->y)) { UpdateDisplayInfo(textPtr); @@ -3934,14 +4002,6 @@ DisplayText( Tcl_SetVar2(interp, "tk_textRedraw", NULL, "", TCL_GLOBAL_ONLY); } - if ((textPtr->tkwin == NULL) || (textPtr->flags & DESTROYED)) { - /* - * The widget has been deleted. Don't do anything. - */ - - goto end; - } - /* * Choose a new current item if that is needed (this could cause event * handlers to be invoked, hence the preserve/release calls and the loop, @@ -4035,7 +4095,7 @@ DisplayText( */ if ((y + height) > dInfoPtr->maxY) { - height = dInfoPtr->maxY -y; + height = dInfoPtr->maxY - y; } oldY = dlPtr->oldY; if (y < dInfoPtr->y) { @@ -4091,6 +4151,7 @@ DisplayText( oldY, dInfoPtr->maxX-dInfoPtr->x, height, 0, y-oldY, damageRgn)) { TextInvalidateRegion(textPtr, damageRgn); + } numCopies++; TkDestroyRegion(damageRgn); @@ -4539,6 +4600,8 @@ TextChanged( TextDInfo *dInfoPtr = textPtr->dInfoPtr; DLine *firstPtr, *lastPtr; TkTextIndex rounded; + TkTextLine *linePtr; + int notBegin; /* * Schedule both a redisplay and a recomputation of display information. @@ -4564,23 +4627,78 @@ TextChanged( /* * Find the DLines corresponding to index1Ptr and index2Ptr. There is one * tricky thing here, which is that we have to relayout in units of whole - * text lines: round index1Ptr back to the beginning of its text line, and - * include all the display lines after index2, up to the end of its text - * line. This is necessary because the indices stored in the display lines - * will no longer be valid. It's also needed because any edit could change - * the way lines wrap. + * text lines: This is necessary because the indices stored in the display + * lines will no longer be valid. It's also needed because any edit could + * change the way lines wrap. + * To relayout in units of whole text (logical) lines, round index1Ptr + * back to the beginning of its text line (or, if this line start is + * elided, to the beginning of the text line that starts the display line + * it is included in), and include all the display lines after index2Ptr, + * up to the end of its text line (or, if this line end is elided, up to + * the end of the first non elided text line after this line end). */ rounded = *index1Ptr; rounded.byteIndex = 0; - firstPtr = FindDLine(dInfoPtr->dLinePtr, &rounded); + notBegin = 0; + while (!IsStartOfNotMergedLine(textPtr, &rounded) && notBegin) { + notBegin = !TkTextIndexBackBytes(textPtr, &rounded, 1, &rounded); + rounded.byteIndex = 0; + } + + /* + * 'rounded' now points to the start of a display line as well as the + * real (non elided) start of a logical line, and this index is the + * closest before index1Ptr. + */ + + firstPtr = FindDLine(textPtr, dInfoPtr->dLinePtr, &rounded); + if (firstPtr == NULL) { + /* + * index1Ptr pertains to no display line, i.e this index is after + * the last display line. Since index2Ptr is after index1Ptr, there + * is no display line to free/redisplay and we can return early. + */ + return; } - lastPtr = FindDLine(dInfoPtr->dLinePtr, index2Ptr); - while ((lastPtr != NULL) - && (lastPtr->index.linePtr == index2Ptr->linePtr)) { - lastPtr = lastPtr->nextPtr; + + rounded = *index2Ptr; + linePtr = index2Ptr->linePtr; + do { + linePtr = TkBTreeNextLine(textPtr, linePtr); + if (linePtr == NULL) { + break; + } + rounded.linePtr = linePtr; + rounded.byteIndex = 0; + } while (!IsStartOfNotMergedLine(textPtr, &rounded)); + + if (linePtr == NULL) { + lastPtr = NULL; + } else { + /* + * 'rounded' now points to the start of a display line as well as the + * start of a logical line not merged with its previous line, and + * this index is the closest after index2Ptr. + */ + + lastPtr = FindDLine(textPtr, dInfoPtr->dLinePtr, &rounded); + + /* + * At least one display line is supposed to change. This makes the + * redisplay OK in case the display line we expect to get here was + * unlinked by a previous call to TkTextChanged and the text widget + * did not update before reaching this point. This happens for + * instance when moving the cursor up one line. + * Note that lastPtr != NULL here, otherwise we would have returned + * earlier when we tested for firstPtr being NULL. + */ + + if (lastPtr == firstPtr) { + lastPtr = lastPtr->nextPtr; + } } /* @@ -4687,9 +4805,16 @@ TextRedrawTag( /* * Round up the starting position if it's before the first line visible on - * the screen (we only care about what's on the screen). + * the screen (we only care about what's on the screen). Beware that the + * display info structure might need update, for instance if we arrived + * here from an 'after idle' script removing tags in a range whose + * display lines (and dInfo) were partially invalidated by a previous + * delete operation in the text widget. */ + if (dInfoPtr->flags & DINFO_OUT_OF_DATE) { + UpdateDisplayInfo(textPtr); + } dlPtr = dInfoPtr->dLinePtr; if (dlPtr == NULL) { return; @@ -4760,14 +4885,13 @@ TextRedrawTag( * the line containing the previous character. */ - if (curIndexPtr->byteIndex == 0) { - dlPtr = FindDLine(dlPtr, curIndexPtr); + if (IsStartOfNotMergedLine(textPtr, curIndexPtr)) { + dlPtr = FindDLine(textPtr, dlPtr, curIndexPtr); } else { - TkTextIndex tmp; + TkTextIndex tmp = *curIndexPtr; - tmp = *curIndexPtr; - tmp.byteIndex -= 1; - dlPtr = FindDLine(dlPtr, &tmp); + TkTextIndexBackBytes(textPtr, &tmp, 1, &tmp); + dlPtr = FindDLine(textPtr, dlPtr, &tmp); } if (dlPtr == NULL) { break; @@ -4783,9 +4907,9 @@ TextRedrawTag( curIndexPtr = &search.curIndex; endIndexPtr = curIndexPtr; } - endPtr = FindDLine(dlPtr, endIndexPtr); - if ((endPtr != NULL) && (endPtr->index.linePtr == endIndexPtr->linePtr) - && (endPtr->index.byteIndex < endIndexPtr->byteIndex)) { + endPtr = FindDLine(textPtr, dlPtr, endIndexPtr); + if ((endPtr != NULL) + && (TkTextIndexCmp(&endPtr->index,endIndexPtr) < 0)) { endPtr = endPtr->nextPtr; } @@ -4903,7 +5027,7 @@ TkTextRelayoutWindow( * could change the way lines wrap. */ - if (textPtr->topIndex.byteIndex != 0) { + if (!IsStartOfNotMergedLine(textPtr, &textPtr->topIndex)) { TkTextFindDisplayLineEnd(textPtr, &textPtr->topIndex, 0, NULL); } @@ -5016,9 +5140,9 @@ TkTextSetYView( */ textPtr->topIndex = *indexPtr; - if (indexPtr->byteIndex != 0) { - TkTextFindDisplayLineEnd(textPtr, &textPtr->topIndex, 0, NULL); - } + if (!IsStartOfNotMergedLine(textPtr, indexPtr)) { + TkTextFindDisplayLineEnd(textPtr, &textPtr->topIndex, 0, NULL); + } dInfoPtr->newTopPixelOffset = pickPlace; goto scheduleUpdate; } @@ -5032,7 +5156,7 @@ TkTextSetYView( if (dInfoPtr->flags & DINFO_OUT_OF_DATE) { UpdateDisplayInfo(textPtr); } - dlPtr = FindDLine(dInfoPtr->dLinePtr, indexPtr); + dlPtr = FindDLine(textPtr, dInfoPtr->dLinePtr, indexPtr); if (dlPtr != NULL) { if ((dlPtr->y + dlPtr->height) > dInfoPtr->maxY) { /* @@ -5041,19 +5165,20 @@ TkTextSetYView( */ dlPtr = NULL; - } else if ((dlPtr->index.linePtr == indexPtr->linePtr) - && (dlPtr->index.byteIndex <= indexPtr->byteIndex)) { - if (dInfoPtr->dLinePtr == dlPtr && dInfoPtr->topPixelOffset != 0) { - /* - * It is on the top line, but that line is hanging off the top - * of the screen. Change the top overlap to zero and update. - */ - - dInfoPtr->newTopPixelOffset = 0; - goto scheduleUpdate; - } - return; - } + } else { + if (TkTextIndexCmp(&dlPtr->index, indexPtr) <= 0) { + if (dInfoPtr->dLinePtr == dlPtr && dInfoPtr->topPixelOffset != 0) { + /* + * It is on the top line, but that line is hanging off the top + * of the screen. Change the top overlap to zero and update. + */ + + dInfoPtr->newTopPixelOffset = 0; + goto scheduleUpdate; + } + return; + } + } } /* @@ -5064,7 +5189,9 @@ TkTextSetYView( * If the line is not close, place it in the center of the window. */ - lineHeight = CalculateDisplayLineHeight(textPtr, indexPtr, NULL, NULL); + tmpIndex = *indexPtr; + TkTextFindDisplayLineEnd(textPtr, &tmpIndex, 0, NULL); + lineHeight = CalculateDisplayLineHeight(textPtr, &tmpIndex, NULL, NULL); /* * It would be better if 'bottomY' were calculated using the actual height @@ -5105,12 +5232,21 @@ TkTextSetYView( MeasureUp(textPtr, indexPtr, close + lineHeight - textPtr->charHeight/2, &tmpIndex, &overlap); - if (FindDLine(dInfoPtr->dLinePtr, &tmpIndex) != NULL) { + if (FindDLine(textPtr, dInfoPtr->dLinePtr, &tmpIndex) != NULL) { bottomY = dInfoPtr->maxY - dInfoPtr->y; } } /* + * If the window height is smaller than the line height, prefer to make + * the top of the line visible. + */ + + if (dInfoPtr->maxY - dInfoPtr->y < lineHeight) { + bottomY = lineHeight; + } + + /* * Our job now is to arrange the display so that indexPtr appears as low * on the screen as possible but with its bottom no lower than bottomY. * BottomY is the bottom of the window if the desired line is just below @@ -5243,6 +5379,8 @@ MeasureUp( index.linePtr = TkBTreeFindLine(srcPtr->tree, textPtr, lineNum); index.byteIndex = 0; + TkTextFindDisplayLineEnd(textPtr, &index, 0, NULL); + lineNum = TkBTreeLinesTo(textPtr, index.linePtr); lowestPtr = NULL; do { dlPtr = LayoutDLine(textPtr, &index); @@ -5263,8 +5401,21 @@ MeasureUp( for (dlPtr = lowestPtr; dlPtr != NULL; dlPtr = dlPtr->nextPtr) { distance -= dlPtr->height; if (distance <= 0) { - *dstPtr = dlPtr->index; - if (overlap != NULL) { + *dstPtr = dlPtr->index; + + /* + * dstPtr is the start of a display line that is or is not + * the start of a logical line. If it is the start of a + * logical line, we must check whether this line is merged + * with the previous logical line, and if so we must adjust + * dstPtr to the start of the display line since a display + * line start needs to be returned. + */ + if (!IsStartOfNotMergedLine(textPtr, dstPtr)) { + TkTextFindDisplayLineEnd(textPtr, dstPtr, 0, NULL); + } + + if (overlap != NULL) { *overlap = -distance; } break; @@ -5364,16 +5515,24 @@ TkTextSeeCmd( } /* - * Find the chunk that contains the desired index. dlPtr may be NULL if - * the widget is not mapped. [Bug #641778] + * Find the display line containing the desired index. dlPtr may be NULL + * if the widget is not mapped. [Bug #641778] */ - dlPtr = FindDLine(dInfoPtr->dLinePtr, &index); + dlPtr = FindDLine(textPtr, dInfoPtr->dLinePtr, &index); if (dlPtr == NULL) { return TCL_OK; } - byteCount = index.byteIndex - dlPtr->index.byteIndex; + /* + * Find the chunk within the display line that contains the desired + * index. The chunks making the display line are skipped up to but not + * including the one crossing index. Skipping is done based on a + * byteCount offset possibly spanning several logical lines in case + * they are elided. + */ + + byteCount = TkTextIndexCountBytes(textPtr, &dlPtr->index, &index); for (chunkPtr = dlPtr->chunkPtr; chunkPtr != NULL ; chunkPtr = chunkPtr->nextPtr) { if (byteCount < chunkPtr->numBytes) { @@ -5389,29 +5548,30 @@ TkTextSeeCmd( */ if (chunkPtr != NULL) { - chunkPtr->bboxProc(textPtr, chunkPtr, byteCount, - dlPtr->y + dlPtr->spaceAbove, - dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow, - dlPtr->baseline - dlPtr->spaceAbove, &x, &y, &width, - &height); - delta = x - dInfoPtr->curXPixelOffset; - oneThird = lineWidth/3; - if (delta < 0) { - if (delta < -oneThird) { - dInfoPtr->newXPixelOffset = x - lineWidth/2; - } else { - dInfoPtr->newXPixelOffset += delta; - } - } else { - delta -= lineWidth - width; - if (delta <= 0) { - return TCL_OK; - } else if (delta > oneThird) { - dInfoPtr->newXPixelOffset = x - lineWidth/2; - } else { - dInfoPtr->newXPixelOffset += delta; - } - } + chunkPtr->bboxProc(textPtr, chunkPtr, byteCount, + dlPtr->y + dlPtr->spaceAbove, + dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow, + dlPtr->baseline - dlPtr->spaceAbove, &x, &y, &width, + &height); + delta = x - dInfoPtr->curXPixelOffset; + oneThird = lineWidth/3; + if (delta < 0) { + if (delta < -oneThird) { + dInfoPtr->newXPixelOffset = x - lineWidth/2; + } else { + dInfoPtr->newXPixelOffset += delta; + } + } else { + delta -= lineWidth - width; + if (delta <= 0) { + return TCL_OK; + } + if (delta > oneThird) { + dInfoPtr->newXPixelOffset = x - lineWidth/2; + } else { + dInfoPtr->newXPixelOffset += delta; + } + } } dInfoPtr->flags |= DINFO_OUT_OF_DATE; if (!(dInfoPtr->flags & REDRAW_PENDING)) { @@ -5648,7 +5808,25 @@ YScrollByLines( offset++; if (offset == 0) { textPtr->topIndex = dlPtr->index; - break; + + /* + * topIndex is the start of a logical line. However, if + * the eol of the previous logical line is elided, then + * topIndex may be elsewhere than the first character of + * a display line, which is unwanted. Adjust to the start + * of the display line, if needed. + * topIndex is the start of a display line that is or is + * not the start of a logical line. If it is the start of + * a logical line, we must check whether this line is + * merged with the previous logical line, and if so we + * must adjust topIndex to the start of the display line. + */ + if (!IsStartOfNotMergedLine(textPtr, &textPtr->topIndex)) { + TkTextFindDisplayLineEnd(textPtr, &textPtr->topIndex, + 0, NULL); + } + + break; } } @@ -6135,13 +6313,10 @@ GetYPixelCount( /* * For the common case where this dlPtr is also the start of the logical - * line, we can return right away. Note the implicit assumption here that - * the start of a logical line is always the start of a display line (if - * the 'elide won't elide first newline' bug is fixed, this will no longer - * necessarily be true). + * line, we can return right away. */ - if (dlPtr->index.byteIndex == 0) { + if (IsStartOfNotMergedLine(textPtr, &dlPtr->index)) { return count; } @@ -6428,11 +6603,12 @@ AsyncUpdateYScrollbar( static DLine * FindDLine( + TkText *textPtr, /* Widget record for text widget. */ register DLine *dlPtr, /* Pointer to first in list of DLines to * search. */ const TkTextIndex *indexPtr)/* Index of desired character. */ { - TkTextLine *linePtr; + DLine *dlPtrPrev; if (dlPtr == NULL) { return NULL; @@ -6447,43 +6623,89 @@ FindDLine( } /* - * Find the first display line that covers the desired text line. + * The display line containing the desired index is such that the index + * of the first character of this display line is at or before the + * desired index, and the index of the first character of the next + * display line is after the desired index. */ - linePtr = dlPtr->index.linePtr; - while (linePtr != indexPtr->linePtr) { - while (dlPtr->index.linePtr == linePtr) { - dlPtr = dlPtr->nextPtr; - if (dlPtr == NULL) { - return NULL; - } - } + while (TkTextIndexCmp(&dlPtr->index,indexPtr) < 0) { + dlPtrPrev = dlPtr; + dlPtr = dlPtr->nextPtr; + if (dlPtr == NULL) { + TkTextIndex indexPtr2; + /* + * We're past the last display line, either because the desired + * index lies past the visible text, or because the desired index + * is on the last display line showing the last logical line. + */ + indexPtr2 = dlPtrPrev->index; + TkTextIndexForwBytes(textPtr, &indexPtr2, dlPtrPrev->byteCount, + &indexPtr2); + if (TkTextIndexCmp(&indexPtr2,indexPtr) > 0) { + dlPtr = dlPtrPrev; + break; + } else { + return NULL; + } + } + if (TkTextIndexCmp(&dlPtr->index,indexPtr) > 0) { + dlPtr = dlPtrPrev; + break; + } + } - /* - * VMD: some concern here as to whether this logic, or the caller's - * logic will work well with partial peer widgets. - */ + return dlPtr; +} + +/* + *---------------------------------------------------------------------- + * + * IsStartOfNotMergedLine -- + * + * This function checks whether the given index is the start of a + * logical line that is not merged with the previous logical line + * (due to elision of the eol of the previous line). + * + * Results: + * Returns whether the given index denotes the first index of a +* logical line not merged with its previous line. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ - linePtr = TkBTreeNextLine(NULL, linePtr); - if (linePtr == NULL) { - Tcl_Panic("FindDLine reached end of text"); - } - } - if (indexPtr->linePtr != dlPtr->index.linePtr) { - return dlPtr; +static int +IsStartOfNotMergedLine( + TkText *textPtr, /* Widget record for text widget. */ + CONST TkTextIndex *indexPtr) /* Index to check. */ +{ + TkTextIndex indexPtr2; + + if (indexPtr->byteIndex != 0) { + /* + * Not the start of a logical line. + */ + return 0; } - /* - * Now get to the right position within the text line. - */ + if (TkTextIndexBackBytes(textPtr, indexPtr, 1, &indexPtr2)) { + /* + * indexPtr is the first index of the text widget. + */ + return 1; + } - while (indexPtr->byteIndex >= (dlPtr->index.byteIndex+dlPtr->byteCount)) { - dlPtr = dlPtr->nextPtr; - if ((dlPtr == NULL) || (dlPtr->index.linePtr != indexPtr->linePtr)) { - break; - } + if (!TkTextIsElided(textPtr, &indexPtr2, NULL)) { + /* + * The eol of the line just before indexPtr is elided. + */ + return 1; } - return dlPtr; + + return 0; } /* @@ -6654,10 +6876,15 @@ DlineIndexOfX( * We've reached the end of the text. */ + TkTextIndexBackChars(NULL, indexPtr, 1, indexPtr, COUNT_INDICES); return; } if (chunkPtr->nextPtr == NULL) { - TkTextIndexBackChars(NULL, indexPtr, 1, indexPtr, COUNT_INDICES); + /* + * We've reached the end of the display line. + */ + + TkTextIndexBackChars(NULL, indexPtr, 1, indexPtr, COUNT_INDICES); return; } chunkPtr = chunkPtr->nextPtr; @@ -6813,7 +7040,7 @@ TkTextIndexBbox( TextDInfo *dInfoPtr = textPtr->dInfoPtr; DLine *dlPtr; register TkTextDispChunk *chunkPtr; - int byteIndex; + int byteCount; /* * Make sure that all of the screen layout information is up to date. @@ -6827,24 +7054,37 @@ TkTextIndexBbox( * Find the display line containing the desired index. */ - dlPtr = FindDLine(dInfoPtr->dLinePtr, indexPtr); + dlPtr = FindDLine(textPtr, dInfoPtr->dLinePtr, indexPtr); + + /* + * Two cases shall be trapped here because the logic later really + * needs dlPtr to be the display line containing indexPtr: + * 1. if no display line contains the desired index (NULL dlPtr) + * 2. if indexPtr is before the first display line, in which case + * dlPtr currently points to the first display line + */ + if ((dlPtr == NULL) || (TkTextIndexCmp(&dlPtr->index, indexPtr) > 0)) { return -1; } /* - * Find the chunk within the line that contains the desired index. + * Find the chunk within the display line that contains the desired + * index. The chunks making the display line are skipped up to but not + * including the one crossing indexPtr. Skipping is done based on + * a byteCount offset possibly spanning several logical lines in case + * they are elided. */ - byteIndex = indexPtr->byteIndex - dlPtr->index.byteIndex; + byteCount = TkTextIndexCountBytes(textPtr, &dlPtr->index, indexPtr); for (chunkPtr = dlPtr->chunkPtr; ; chunkPtr = chunkPtr->nextPtr) { if (chunkPtr == NULL) { return -1; } - if (byteIndex < chunkPtr->numBytes) { + if (byteCount < chunkPtr->numBytes) { break; } - byteIndex -= chunkPtr->numBytes; + byteCount -= chunkPtr->numBytes; } /* @@ -6854,13 +7094,13 @@ TkTextIndexBbox( * coordinate on the screen. Translate it to reflect horizontal scrolling. */ - chunkPtr->bboxProc(textPtr, chunkPtr, byteIndex, + chunkPtr->bboxProc(textPtr, chunkPtr, byteCount, dlPtr->y + dlPtr->spaceAbove, dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow, dlPtr->baseline - dlPtr->spaceAbove, xPtr, yPtr, widthPtr, heightPtr); *xPtr = *xPtr + dInfoPtr->x - dInfoPtr->curXPixelOffset; - if ((byteIndex == chunkPtr->numBytes-1) && (chunkPtr->nextPtr == NULL)) { + if ((byteCount == chunkPtr->numBytes-1) && (chunkPtr->nextPtr == NULL)) { /* * Last character in display line. Give it all the space up to the * line. @@ -6958,7 +7198,16 @@ TkTextDLineInfo( * Find the display line containing the desired index. */ - dlPtr = FindDLine(dInfoPtr->dLinePtr, indexPtr); + dlPtr = FindDLine(textPtr, dInfoPtr->dLinePtr, indexPtr); + + /* + * Two cases shall be trapped here because the logic later really + * needs dlPtr to be the display line containing indexPtr: + * 1. if no display line contains the desired index (NULL dlPtr) + * 2. if indexPtr is before the first display line, in which case + * dlPtr currently points to the first display line + */ + if ((dlPtr == NULL) || (TkTextIndexCmp(&dlPtr->index, indexPtr) > 0)) { return -1; } diff --git a/generic/tkTextIndex.c b/generic/tkTextIndex.c index 55a4907..8820191 100644 --- a/generic/tkTextIndex.c +++ b/generic/tkTextIndex.c @@ -40,6 +40,9 @@ static const char * StartEnd(TkText *textPtr, const char *string, static int GetIndex(Tcl_Interp *interp, TkSharedText *sharedPtr, TkText *textPtr, const char *string, TkTextIndex *indexPtr, int *canCachePtr); +static int IndexCountBytesOrdered(CONST TkText *textPtr, + CONST TkTextIndex *indexPtr1, + CONST TkTextIndex *indexPtr2); /* * The "textindex" Tcl_Obj definition: @@ -759,11 +762,11 @@ GetIndex( } if (TkTextWindowIndex(textPtr, string, indexPtr) != 0) { - return TCL_OK; + goto done; } if (TkTextImageIndex(textPtr, string, indexPtr) != 0) { - return TCL_OK; + goto done; } /* @@ -1616,6 +1619,90 @@ TkTextIndexForwChars( /* *--------------------------------------------------------------------------- * + * TkTextIndexCountBytes -- + * + * Given a pair of indices in a text widget, this function counts how + * many bytes are between the two indices. The two indices do not need + * to be ordered. + * + * Results: + * The number of bytes in the given range. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +int +TkTextIndexCountBytes( + CONST TkText *textPtr, + CONST TkTextIndex *indexPtr1, /* Index describing one location. */ + CONST TkTextIndex *indexPtr2) /* Index describing second location. */ +{ + int compare = TkTextIndexCmp(indexPtr1, indexPtr2); + + if (compare == 0) { + return 0; + } else if (compare > 0) { + return IndexCountBytesOrdered(textPtr, indexPtr2, indexPtr1); + } else { + return IndexCountBytesOrdered(textPtr, indexPtr1, indexPtr2); + } +} + +static int +IndexCountBytesOrdered( + CONST TkText *textPtr, + CONST TkTextIndex *indexPtr1, + /* Index describing location of character from + * which to count. */ + CONST TkTextIndex *indexPtr2) + /* Index describing location of last character + * at which to stop the count. */ +{ + int byteCount, offset; + TkTextSegment *segPtr, *segPtr1; + TkTextLine *linePtr; + + if (indexPtr1->linePtr == indexPtr2->linePtr) { + return indexPtr2->byteIndex - indexPtr1->byteIndex; + } + + /* + * indexPtr2 is on a line strictly after the line containing indexPtr1. + * Add up: + * bytes between indexPtr1 and end of its line + * bytes in lines strictly between indexPtr1 and indexPtr2 + * bytes between start of the indexPtr2 line and indexPtr2 + */ + + segPtr1 = TkTextIndexToSeg(indexPtr1, &offset); + byteCount = -offset; + for (segPtr = segPtr1; segPtr != NULL; segPtr = segPtr->nextPtr) { + byteCount += segPtr->size; + } + + linePtr = TkBTreeNextLine(textPtr, indexPtr1->linePtr); + while (linePtr != indexPtr2->linePtr) { + for (segPtr = linePtr->segPtr; segPtr != NULL; + segPtr = segPtr->nextPtr) { + byteCount += segPtr->size; + } + linePtr = TkBTreeNextLine(textPtr, linePtr); + if (linePtr == NULL) { + Tcl_Panic("TextIndexCountBytesOrdered ran out of lines"); + } + } + + byteCount += indexPtr2->byteIndex; + + return byteCount; +} + +/* + *--------------------------------------------------------------------------- + * * TkTextIndexCount -- * * Given an ordered pair of indices in a text widget, this function @@ -2118,7 +2205,7 @@ StartEnd( TkText *textPtr, /* Information about text widget. */ const char *string, /* String to parse for additional info about * modifier (count and units). Points to first - * character of modifer word. */ + * character of modifier word. */ TkTextIndex *indexPtr) /* Index to modify based on string. */ { const char *p; @@ -2240,7 +2327,7 @@ StartEnd( int offset; if (modifier == TKINDEX_DISPLAY) { - TkTextIndexForwChars(NULL, indexPtr, 0, indexPtr, + TkTextIndexForwChars(textPtr, indexPtr, 0, indexPtr, COUNT_DISPLAY_INDICES); } @@ -2269,11 +2356,20 @@ StartEnd( } firstChar = 0; } - offset -= chSize; - indexPtr->byteIndex -= chSize; + if (offset == 0) { + if (modifier == TKINDEX_DISPLAY) { + TkTextIndexBackChars(textPtr, indexPtr, 1, indexPtr, + COUNT_DISPLAY_INDICES); + } else { + TkTextIndexBackChars(NULL, indexPtr, 1, indexPtr, + COUNT_INDICES); + } + } else { + indexPtr->byteIndex -= chSize; + } + offset -= chSize; if (offset < 0) { - if (indexPtr->byteIndex < 0) { - indexPtr->byteIndex = 0; + if (indexPtr->byteIndex == 0) { goto done; } segPtr = TkTextIndexToSeg(indexPtr, &offset); diff --git a/generic/tkTextMark.c b/generic/tkTextMark.c index 56a21f9..6a41c77 100644 --- a/generic/tkTextMark.c +++ b/generic/tkTextMark.c @@ -40,9 +40,9 @@ static int MarkLayoutProc(TkText *textPtr, TkTextIndex *indexPtr, int maxChars, int noCharsYet, TkWrapMode wrapMode, TkTextDispChunk *chunkPtr); static int MarkFindNext(Tcl_Interp *interp, - TkText *textPtr, const char *markName); + TkText *textPtr, Tcl_Obj *markName); static int MarkFindPrev(Tcl_Interp *interp, - TkText *textPtr, const char *markName); + TkText *textPtr, Tcl_Obj *markName); /* @@ -205,13 +205,13 @@ TkTextMarkCmd( Tcl_WrongNumArgs(interp, 3, objv, "index"); return TCL_ERROR; } - return MarkFindNext(interp, textPtr, Tcl_GetString(objv[3])); + return MarkFindNext(interp, textPtr, objv[3]); case MARK_PREVIOUS: if (objc != 4) { Tcl_WrongNumArgs(interp, 3, objv, "index"); return TCL_ERROR; } - return MarkFindPrev(interp, textPtr, Tcl_GetString(objv[3])); + return MarkFindPrev(interp, textPtr, objv[3]); case MARK_SET: if (objc != 5) { Tcl_WrongNumArgs(interp, 3, objv, "markName index"); @@ -805,12 +805,13 @@ static int MarkFindNext( Tcl_Interp *interp, /* For error reporting */ TkText *textPtr, /* The widget */ - const char *string) /* The starting index or mark name */ + Tcl_Obj *obj) /* The starting index or mark name */ { TkTextIndex index; Tcl_HashEntry *hPtr; register TkTextSegment *segPtr; int offset; + const char *string = Tcl_GetString(obj); if (!strcmp(string, "insert")) { segPtr = textPtr->insertMarkPtr; @@ -838,7 +839,7 @@ MarkFindNext( * right at the index. */ - if (TkTextGetIndex(interp, textPtr, string, &index) != TCL_OK) { + if (TkTextGetObjIndex(interp, textPtr, obj, &index) != TCL_OK) { return TCL_ERROR; } for (offset = 0, segPtr = index.linePtr->segPtr; @@ -895,12 +896,13 @@ static int MarkFindPrev( Tcl_Interp *interp, /* For error reporting */ TkText *textPtr, /* The widget */ - const char *string) /* The starting index or mark name */ + Tcl_Obj *obj) /* The starting index or mark name */ { TkTextIndex index; Tcl_HashEntry *hPtr; register TkTextSegment *segPtr, *seg2Ptr, *prevPtr; int offset; + const char *string = Tcl_GetString(obj); if (!strcmp(string, "insert")) { segPtr = textPtr->insertMarkPtr; @@ -925,7 +927,7 @@ MarkFindPrev( * right at the index. */ - if (TkTextGetIndex(interp, textPtr, string, &index) != TCL_OK) { + if (TkTextGetObjIndex(interp, textPtr, obj, &index) != TCL_OK) { return TCL_ERROR; } for (offset = 0, segPtr = index.linePtr->segPtr; diff --git a/generic/tkTextTag.c b/generic/tkTextTag.c index a34b74b..af3f235 100644 --- a/generic/tkTextTag.c +++ b/generic/tkTextTag.c @@ -169,6 +169,14 @@ TkTextTagCmd( return TCL_ERROR; } tagPtr = TkTextCreateTag(textPtr, Tcl_GetString(objv[3]), NULL); + if (tagPtr->elide) { + /* + * Indices are potentially obsolete after adding or removing + * elided character ranges, especially indices having "display" + * or "any" submodifier, therefore increase the epoch. + */ + textPtr->sharedTextPtr->stateEpoch++; + } for (i = 4; i < objc; i += 2) { if (TkTextGetObjIndex(interp, textPtr, objv[i], &index1) != TCL_OK) { diff --git a/generic/tkTextWind.c b/generic/tkTextWind.c index bd61d75..c9fc20f 100644 --- a/generic/tkTextWind.c +++ b/generic/tkTextWind.c @@ -1134,6 +1134,16 @@ TkTextEmbWinDisplayProc( &lineX, &windowY, &width, &height); windowX = lineX - chunkPtr->x + x; + /* + * Mark the window as displayed so that it won't get unmapped. + * This needs to be done before the next instruction block because + * Tk_MaintainGeometry/Tk_MapWindow will run event handlers, in + * particular for the <Map> event, and if the bound script deletes + * the embedded window its clients will get freed. + */ + + client->displayed = 1; + if (textPtr->tkwin == Tk_Parent(tkwin)) { if ((windowX != Tk_X(tkwin)) || (windowY != Tk_Y(tkwin)) || (Tk_ReqWidth(tkwin) != Tk_Width(tkwin)) @@ -1145,12 +1155,6 @@ TkTextEmbWinDisplayProc( Tk_MaintainGeometry(tkwin, textPtr->tkwin, windowX, windowY, width, height); } - - /* - * Mark the window as displayed so that it won't get unmapped. - */ - - client->displayed = 1; } /* diff --git a/generic/tkUndo.c b/generic/tkUndo.c index a642e72..8359e0a 100644 --- a/generic/tkUndo.c +++ b/generic/tkUndo.c @@ -392,7 +392,7 @@ TkUndoSetDepth( prevelem = elem; elem = elem->next; } - CLANG_ASSERT(prevelem); + CLANG_ASSERT(prevelem); prevelem->next = NULL; while (elem != NULL) { prevelem = elem; diff --git a/generic/tkWindow.c b/generic/tkWindow.c index 53b368c..b5cbbab 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -97,9 +97,8 @@ static const XSetWindowAttributes defAtts= { #define ISSAFE 1 #define PASSMAINWINDOW 2 -#define NOOBJPROC 4 -#define WINMACONLY 8 -#define USEINITPROC 16 +#define WINMACONLY 4 +#define USEINITPROC 8 typedef int (TkInitProc)(Tcl_Interp *interp, ClientData clientData); typedef struct { @@ -155,8 +154,7 @@ static const TkCmd commands[] = { {"panedwindow", Tk_PanedWindowObjCmd, ISSAFE}, {"radiobutton", Tk_RadiobuttonObjCmd, ISSAFE}, {"scale", Tk_ScaleObjCmd, ISSAFE}, - {"scrollbar", (Tcl_ObjCmdProc *) Tk_ScrollbarCmd, - NOOBJPROC|PASSMAINWINDOW|ISSAFE}, + {"scrollbar", Tk_ScrollbarObjCmd, PASSMAINWINDOW|ISSAFE}, {"spinbox", Tk_SpinboxObjCmd, ISSAFE}, {"text", Tk_TextObjCmd, PASSMAINWINDOW|ISSAFE}, {"toplevel", Tk_ToplevelObjCmd, 0}, @@ -178,8 +176,7 @@ static const TkCmd commands[] = { {"::tk::panedwindow",Tk_PanedWindowObjCmd, ISSAFE}, {"::tk::radiobutton",Tk_RadiobuttonObjCmd, ISSAFE}, {"::tk::scale", Tk_ScaleObjCmd, ISSAFE}, - {"::tk::scrollbar", (Tcl_ObjCmdProc *) Tk_ScrollbarCmd, - NOOBJPROC|PASSMAINWINDOW|ISSAFE}, + {"::tk::scrollbar", Tk_ScrollbarObjCmd, PASSMAINWINDOW|ISSAFE}, {"::tk::spinbox", Tk_SpinboxObjCmd, ISSAFE}, {"::tk::text", Tk_TextObjCmd, PASSMAINWINDOW|ISSAFE}, {"::tk::toplevel", Tk_ToplevelObjCmd, 0}, @@ -976,9 +973,6 @@ TkCreateMainWindow( } if (cmdPtr->flags & USEINITPROC) { ((TkInitProc *) cmdPtr->objProc)(interp, clientData); - } else if (cmdPtr->flags & NOOBJPROC) { - Tcl_CreateCommand(interp, cmdPtr->name, - (Tcl_CmdProc *) cmdPtr->objProc, clientData, NULL); } else { Tcl_CreateObjCommand(interp, cmdPtr->name, cmdPtr->objProc, clientData, NULL); @@ -1543,11 +1537,11 @@ Tk_DestroyWindow( if ((winPtr->mainPtr->interp != NULL) && !Tcl_InterpDeleted(winPtr->mainPtr->interp)) { for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) { - Tcl_CreateCommand(winPtr->mainPtr->interp, cmdPtr->name, - TkDeadAppCmd, NULL, NULL); + Tcl_CreateObjCommand(winPtr->mainPtr->interp, cmdPtr->name, + TkDeadAppObjCmd, NULL, NULL); } - Tcl_CreateCommand(winPtr->mainPtr->interp, "send", - TkDeadAppCmd, NULL, NULL); + Tcl_CreateObjCommand(winPtr->mainPtr->interp, "send", + TkDeadAppObjCmd, NULL, NULL); Tcl_UnlinkVar(winPtr->mainPtr->interp, "tk_strictMotif"); Tcl_UnlinkVar(winPtr->mainPtr->interp, "::tk::AlwaysShowSelection"); diff --git a/generic/ttk/ttkGenStubs.tcl b/generic/ttk/ttkGenStubs.tcl index 034f405..56ba2fa 100644 --- a/generic/ttk/ttkGenStubs.tcl +++ b/generic/ttk/ttkGenStubs.tcl @@ -12,7 +12,7 @@ # # SOURCE: tcl/tools/genStubs.tcl, revision 1.44 # -# CHANGES: +# CHANGES: # + Second argument to "declare" is used as a status guard # instead of a platform guard. # + Allow trailing semicolon in function declarations @@ -678,7 +678,7 @@ proc genStubs::addGuard {status text} { set upName [string toupper $libraryName] switch -- $status { - current { + current { # No change } deprecated { @@ -691,7 +691,7 @@ proc genStubs::addGuard {status text} { puts stderr "Unrecognized status code $status" } } - return $text + return $text } proc genStubs::ifdeffed {macro text} { diff --git a/generic/ttk/ttkLabel.c b/generic/ttk/ttkLabel.c index d51388b..1037840 100644 --- a/generic/ttk/ttkLabel.c +++ b/generic/ttk/ttkLabel.c @@ -293,6 +293,7 @@ static void ImageCleanup(ImageElement *image) TtkFreeImageSpec(image->imageSpec); } +#ifndef MAC_OSX_TK /* * StippleOver -- * Draw a stipple over the image area, to make it look "grayed-out" @@ -317,6 +318,7 @@ static void StippleOver( Tk_FreeBitmapFromObj(tkwin, image->stippleObj); } } +#endif static void ImageDraw( ImageElement *image, Tk_Window tkwin,Drawable d,Ttk_Box b,Ttk_State state) diff --git a/library/bgerror.tcl b/library/bgerror.tcl index d1ed60a..b15387e 100644 --- a/library/bgerror.tcl +++ b/library/bgerror.tcl @@ -98,7 +98,7 @@ proc ::tk::dialog::error::ReturnInDetails w { # err - The error message. # proc ::tk::dialog::error::bgerror err { - global errorInfo tcl_platform + global errorInfo variable button set info $errorInfo diff --git a/library/button.tcl b/library/button.tcl index 815b137..b2bafb2 100644 --- a/library/button.tcl +++ b/library/button.tcl @@ -17,6 +17,7 @@ #------------------------------------------------------------------------- if {[tk windowingsystem] eq "aqua"} { + bind Radiobutton <Enter> { tk::ButtonEnter %W } @@ -143,7 +144,7 @@ bind Radiobutton <Leave> { if {"win32" eq [tk windowingsystem]} { ######################### -# Windows implementation +# Windows implementation ######################### # ::tk::ButtonEnter -- diff --git a/library/choosedir.tcl b/library/choosedir.tcl index c0ab326..68dd9b0 100644 --- a/library/choosedir.tcl +++ b/library/choosedir.tcl @@ -122,7 +122,7 @@ proc ::tk::dialog::file::chooseDir:: {args} { # Return value to user # - + return $Priv(selectFilePath) } @@ -164,7 +164,7 @@ proc ::tk::dialog::file::chooseDir::Config {dataName argList} { if {$data(-title) eq ""} { set data(-title) "[mc "Choose Directory"]" } - + # Stub out the -multiple value for the dialog; it doesn't make sense for # choose directory dialogs, but we have to have something there because we # share so much code with the file dialogs. diff --git a/library/clrpick.tcl b/library/clrpick.tcl index 3772a30..600be16 100644 --- a/library/clrpick.tcl +++ b/library/clrpick.tcl @@ -12,7 +12,7 @@ # # (1): Find out how many free colors are left in the colormap and # don't allocate too many colors. -# (2): Implement HSV color selection. +# (2): Implement HSV color selection. # # Make sure namespaces exist @@ -54,11 +54,11 @@ proc ::tk::dialog::color:: {args} { set data(BARS_WIDTH) 160 # PLGN_WIDTH is the number of pixels wide of the triangular selection - # polygon. This also results in the definition of the padding on the + # polygon. This also results in the definition of the padding on the # left and right sides which is half of PLGN_WIDTH. Make this number even. set data(PLGN_HEIGHT) 10 - # PLGN_HEIGHT is the height of the selection polygon and the height of the + # PLGN_HEIGHT is the height of the selection polygon and the height of the # selection rectangle at the bottom of the color bar. No restrictions. set data(PLGN_WIDTH) 10 @@ -328,7 +328,7 @@ proc ::tk::dialog::color::BuildDialog {w} { # Sets the current selection of the dialog box # proc ::tk::dialog::color::SetRGBValue {w color} { - upvar ::tk::dialog::color::[winfo name $w] data + upvar ::tk::dialog::color::[winfo name $w] data set data(red,intensity) [lindex $color 0] set data(green,intensity) [lindex $color 1] @@ -368,7 +368,7 @@ proc ::tk::dialog::color::RgbToX {w color} { } # ::tk::dialog::color::DrawColorScale -- -# +# # Draw color scale is called whenever the size of one of the color # scale canvases is changed. # @@ -507,7 +507,7 @@ proc ::tk::dialog::color::RedrawColorBars {w colorChanged} { upvar ::tk::dialog::color::[winfo name $w] data switch $colorChanged { - red { + red { DrawColorScale $w green DrawColorScale $w blue } @@ -537,7 +537,7 @@ proc ::tk::dialog::color::RedrawColorBars {w colorChanged} { # Handles a mousedown button event over the selector polygon. # Adds the bindings for moving the mouse while the button is # pressed. Sets the binding for the button-release event. -# +# # Params: sel is the selector canvas window, color is the color of the strip. # proc ::tk::dialog::color::StartMove {w sel color x delta {dontMove 0}} { @@ -549,7 +549,7 @@ proc ::tk::dialog::color::StartMove {w sel color x delta {dontMove 0}} { } # ::tk::dialog::color::MoveSelector -- -# +# # Moves the polygon selector so that its middle point has the same # x value as the specified x. If x is outside the bounds [0,255], # the selector is set to the closest endpoint. @@ -583,7 +583,7 @@ proc ::tk::dialog::color::MoveSelector {w sel color x delta} { # x is the x-coord of the mouse. # proc ::tk::dialog::color::ReleaseMouse {w sel color x delta} { - upvar ::tk::dialog::color::[winfo name $w] data + upvar ::tk::dialog::color::[winfo name $w] data set x [MoveSelector $w $sel $color $x $delta] @@ -602,7 +602,7 @@ proc ::tk::dialog::color::ResizeColorBars {w} { upvar ::tk::dialog::color::[winfo name $w] data if { - ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) || + ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) || (($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0) } then { set data(BARS_WIDTH) $data(NUM_COLORBARS) @@ -660,7 +660,7 @@ proc ::tk::dialog::color::HandleRGBEntry {w} { SetRGBValue $w "$data(red,intensity) \ $data(green,intensity) $data(blue,intensity)" -} +} # mouse cursor enters a color bar # diff --git a/library/comdlg.tcl b/library/comdlg.tcl index f89754c..18df8a6 100644 --- a/library/comdlg.tcl +++ b/library/comdlg.tcl @@ -180,7 +180,7 @@ proc ::tk::FocusGroup_Destroy {t w} { if {$t eq $w} { unset Priv(fg,$t) - unset Priv(focus,$t) + unset Priv(focus,$t) foreach name [array names FocusIn $t,*] { unset FocusIn($name) @@ -277,7 +277,7 @@ proc ::tk::FDGetFileTypes {string} { continue } - # Validate each macType. This is to agree with the + # Validate each macType. This is to agree with the # behaviour of TkGetFileFilters(). This list may be # empty. foreach macType [lindex $t 2] { @@ -286,7 +286,7 @@ proc ::tk::FDGetFileTypes {string} { "bad Macintosh file type \"$macType\"" } } - + set name "$label \(" set sep "" set doAppend 1 diff --git a/library/console.tcl b/library/console.tcl index e93a39d..ba68ccc 100644 --- a/library/console.tcl +++ b/library/console.tcl @@ -41,8 +41,6 @@ interp alias {} EvalAttached {} consoleinterp eval # None. proc ::tk::ConsoleInit {} { - global tcl_platform - if {![consoleinterp eval {set tcl_interactive}]} { wm withdraw . } @@ -78,7 +76,7 @@ proc ::tk::ConsoleInit {} { AmpMenuArgs .menubar.edit add command -label [mc P&aste] -accel "$mod+V"\ -command {event generate .console <<Paste>>} - if {$tcl_platform(platform) ne "windows"} { + if {[tk windowingsystem] ne "win32"} { AmpMenuArgs .menubar.edit add command -label [mc Cl&ear] \ -command {event generate .console <<Clear>>} } else { @@ -114,6 +112,8 @@ proc ::tk::ConsoleInit {} { -accel "$mod++" -command {event generate .console <<Console_FontSizeIncr>>} AmpMenuArgs .menubar.edit add command -label [mc "&Decrease Font Size"] \ -accel "$mod+-" -command {event generate .console <<Console_FontSizeDecr>>} + AmpMenuArgs .menubar.edit add command -label [mc "Fit To Screen Width"] \ + -command {event generate .console <<Console_FitScreenWidth>>} if {[tk windowingsystem] eq "aqua"} { .menubar add cascade -label [mc Window] -menu [menu .menubar.window] @@ -193,7 +193,7 @@ proc ::tk::ConsoleInit {} { $w mark set promptEnd insert $w mark gravity promptEnd left - if {$tcl_platform(platform) eq "windows"} { + if {[tk windowingsystem] ne "aqua"} { # Subtle work-around to erase the '% ' that tclMain.c prints out after idle [subst -nocommand { if {[$con get 1.0 output] eq "% "} { $con delete 1.0 output } @@ -311,7 +311,7 @@ proc ::tk::ConsoleHistory {cmd} { # ::tk::ConsolePrompt -- # This procedure draws the prompt. If tcl_prompt1 or tcl_prompt2 -# exists in the main interpreter it will be called to generate the +# exists in the main interpreter it will be called to generate the # prompt. Otherwise, a hard coded default prompt is printed. # # Arguments: @@ -378,6 +378,26 @@ proc ::tk::console::Paste {w} { } } +# Fit TkConsoleFont to window width +proc ::tk::console::FitScreenWidth {w} { + set width [winfo screenwidth $w] + set cwidth [$w cget -width] + set s -50 + set fit 0 + array set fi [font configure TkConsoleFont] + while {$s < 0} { + set fi(-size) $s + set f [font create {*}[array get fi]] + set c [font measure $f "eM"] + font delete $f + if {$c * $cwidth < 1.667 * $width} { + font configure TkConsoleFont -size $s + break + } + incr s 2 + } +} + # ::tk::ConsoleBind -- # This procedure first ensures that the default bindings for the Text # class have been defined. Then certain bindings are overridden for @@ -600,6 +620,9 @@ proc ::tk::ConsoleBind {w} { tk fontchooser configure -font TkConsoleFont } } + bind Console <<Console_FitScreenWidth>> { + ::tk::console::FitScreenWidth %W + } ## ## Bindings for doing special things based on certain keys @@ -781,7 +804,7 @@ proc ::tk::console::TagProc w { # c2 - second char of pair # # Calls: ::tk::console::Blink - + proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} { if {!$::tk::console::magicKeys} { return @@ -836,7 +859,7 @@ proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} { # w - console text widget # # Calls: ::tk::console::Blink - + proc ::tk::console::MatchQuote {w {lim 1.0}} { if {!$::tk::console::magicKeys} { return @@ -971,7 +994,7 @@ proc ::tk::console::Expand {w {type ""}} { # # Returns: list containing longest unique match followed by all the # possible further matches - + proc ::tk::console::ExpandPathname str { set pwd [EvalAttached pwd] if {[catch {EvalAttached [list cd [file dirname $str]]} err opt]} { @@ -987,8 +1010,7 @@ proc ::tk::console::ExpandPathname str { set match {} } else { if {[llength $m] > 1} { - global tcl_platform - if {[string match windows $tcl_platform(platform)]} { + if { $::tcl_platform(platform) eq "windows" } { ## Windows is screwy because it's case insensitive set tmp [ExpandBestMatch [string tolower $m] \ [string tolower $dir]] diff --git a/library/demos/aniwave.tcl b/library/demos/aniwave.tcl index 6122132..a7539fb 100644 --- a/library/demos/aniwave.tcl +++ b/library/demos/aniwave.tcl @@ -17,7 +17,7 @@ wm title $w "Animated Wave Demonstration" wm iconname $w "aniwave" positionWindow $w -label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration contains a canvas widget with a line item inside it. The animation routines work by adjusting the coordinates list of the line; a trace on a variable is used so updates to the variable result in a change of position of the line." +label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration contains a canvas widget with a line item inside it. The animation routines work by adjusting the coordinates list of the line; a trace on a variable is used so updates to the variable result in a change of position of the line." pack $w.msg -side top ## See Code / Dismiss buttons diff --git a/library/demos/bind.tcl b/library/demos/bind.tcl index d9bc22f..03f6d3b 100644 --- a/library/demos/bind.tcl +++ b/library/demos/bind.tcl @@ -22,7 +22,7 @@ pack $btns -side bottom -fill x text $w.text -yscrollcommand "$w.scroll set" -setgrid true \ -width 60 -height 24 -font $font -wrap word -scrollbar $w.scroll -command "$w.text yview" +ttk::scrollbar $w.scroll -command "$w.text yview" pack $w.scroll -side right -fill y pack $w.text -expand yes -fill both diff --git a/library/demos/entry2.tcl b/library/demos/entry2.tcl index d0ca35a..9e3f4ef 100644 --- a/library/demos/entry2.tcl +++ b/library/demos/entry2.tcl @@ -27,15 +27,15 @@ frame $w.frame -borderwidth 10 pack $w.frame -side top -fill x -expand 1 entry $w.frame.e1 -xscrollcommand "$w.frame.s1 set" -scrollbar $w.frame.s1 -relief sunken -orient horiz -command \ +ttk::scrollbar $w.frame.s1 -orient horiz -command \ "$w.frame.e1 xview" frame $w.frame.spacer1 -width 20 -height 10 entry $w.frame.e2 -xscrollcommand "$w.frame.s2 set" -scrollbar $w.frame.s2 -relief sunken -orient horiz -command \ +ttk::scrollbar $w.frame.s2 -orient horiz -command \ "$w.frame.e2 xview" frame $w.frame.spacer2 -width 20 -height 10 entry $w.frame.e3 -xscrollcommand "$w.frame.s3 set" -scrollbar $w.frame.s3 -relief sunken -orient horiz -command \ +ttk::scrollbar $w.frame.s3 -orient horiz -command \ "$w.frame.e3 xview" pack $w.frame.e1 $w.frame.s1 $w.frame.spacer1 $w.frame.e2 $w.frame.s2 \ $w.frame.spacer2 $w.frame.e3 $w.frame.s3 -side top -fill x diff --git a/library/demos/floor.tcl b/library/demos/floor.tcl index 827600b..c36979b 100644 --- a/library/demos/floor.tcl +++ b/library/demos/floor.tcl @@ -1307,8 +1307,8 @@ pack $btns -side bottom -fill x set f [frame $w.frame] pack $f -side top -fill both -expand yes -set h [scrollbar $f.hscroll -orient horizontal] -set v [scrollbar $f.vscroll -orient vertical] +set h [ttk::scrollbar $f.hscroll -orient horizontal] +set v [ttk::scrollbar $f.vscroll -orient vertical] set f1 [frame $f.f1 -borderwidth 2 -relief sunken] set c [canvas $f1.c -width 900 -height 500 -highlightthickness 0 \ -xscrollcommand [list $h set] \ diff --git a/library/demos/fontchoose.tcl b/library/demos/fontchoose.tcl index def30c3..8b34377 100644 --- a/library/demos/fontchoose.tcl +++ b/library/demos/fontchoose.tcl @@ -57,7 +57,7 @@ grid columnconfigure $f 0 -weight 1 grid rowconfigure $f 0 -weight 1 bind $w <Visibility> { bind %W <Visibility> {} - grid propagate %W.f 0 + grid propagate %W.f 0 } ## See Code / Dismiss buttons diff --git a/library/demos/image2.tcl b/library/demos/image2.tcl index a17da31..2d7ba03 100644 --- a/library/demos/image2.tcl +++ b/library/demos/image2.tcl @@ -92,7 +92,7 @@ pack $w.dir.b -side left -fill y -padx {0 2m} -pady 2m labelframe $w.f -text "File:" -padx 2m -pady 2m listbox $w.f.list -width 20 -height 10 -yscrollcommand "$w.f.scroll set" -scrollbar $w.f.scroll -command "$w.f.list yview" +ttk::scrollbar $w.f.scroll -command "$w.f.list yview" pack $w.f.list $w.f.scroll -side left -fill y -expand 1 $w.f.list insert 0 earth.gif earthris.gif teapot.ppm bind $w.f.list <Double-1> "loadImage $w %x %y" diff --git a/library/demos/items.tcl b/library/demos/items.tcl index 177e9a4..000e4cb 100644 --- a/library/demos/items.tcl +++ b/library/demos/items.tcl @@ -31,8 +31,8 @@ canvas $c -scrollregion {0c 0c 30c 24c} -width 15c -height 10c \ -relief sunken -borderwidth 2 \ -xscrollcommand "$w.frame.hscroll set" \ -yscrollcommand "$w.frame.vscroll set" -scrollbar $w.frame.vscroll -command "$c yview" -scrollbar $w.frame.hscroll -orient horiz -command "$c xview" +ttk::scrollbar $w.frame.vscroll -command "$c yview" +ttk::scrollbar $w.frame.hscroll -orient horiz -command "$c xview" grid $c -in $w.frame \ -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news diff --git a/library/demos/ixset b/library/demos/ixset index 06b644d..ee6e072 100644 --- a/library/demos/ixset +++ b/library/demos/ixset @@ -186,12 +186,12 @@ proc createwindows {} { # frame .buttons - button .buttons.ok -default active -command ok -text "Ok" + button .buttons.ok -default active -command ok -text "Ok" button .buttons.apply -default normal -command apply -text "Apply" \ -state disabled button .buttons.cancel -default normal -command cancel -text "Cancel" \ -state disabled - button .buttons.quit -default normal -command quit -text "Quit" + button .buttons.quit -default normal -command quit -text "Quit" pack .buttons.ok .buttons.apply .buttons.cancel .buttons.quit \ -side left -expand yes -pady 5 diff --git a/library/demos/knightstour.tcl b/library/demos/knightstour.tcl index 73ca3a3..6113db2 100644 --- a/library/demos/knightstour.tcl +++ b/library/demos/knightstour.tcl @@ -221,7 +221,7 @@ proc CreateGUI {} { $c bind knight <ButtonPress-1> [namespace code [list DragStart %W %x %y]] $c bind knight <Motion> [namespace code [list DragMotion %W %x %y]] $c bind knight <ButtonRelease-1> [namespace code [list DragEnd %W %x %y]] - + grid $c $f.txt $f.vs -sticky news grid rowconfigure $f 0 -weight 1 grid columnconfigure $f 1 -weight 1 @@ -244,7 +244,7 @@ proc CreateGUI {} { if {[info exists ::widgetDemo]} { grid [addSeeDismiss $dlg.buttons $dlg] - - - - - -sticky ew } - + grid rowconfigure $dlg 0 -weight 1 grid columnconfigure $dlg 0 -weight 1 diff --git a/library/demos/menu.tcl b/library/demos/menu.tcl index e19df57..e32b54f 100644 --- a/library/demos/menu.tcl +++ b/library/demos/menu.tcl @@ -16,7 +16,7 @@ wm title $w "Menu Demonstration" wm iconname $w "menu" positionWindow $w -label $w.msg -font $font -wraplength 4i -justify left +label $w.msg -font $font -wraplength 4i -justify left if {[tk windowingsystem] eq "aqua"} { catch {set origUseCustomMDEF $::tk::mac::useCustomMDEF; set ::tk::mac::useCustomMDEF 1} $w.msg configure -text "This window has a menubar with cascaded menus. You can invoke entries with an accelerator by typing Command+x, where \"x\" is the character next to the command key symbol. The rightmost menu can be torn off into a palette by selecting the first item in the menu." diff --git a/library/demos/menubu.tcl b/library/demos/menubu.tcl index 86326b5..96e3b15 100644 --- a/library/demos/menubu.tcl +++ b/library/demos/menubu.tcl @@ -21,7 +21,7 @@ pack $w.body -expand 1 -fill both if {[tk windowingsystem] eq "aqua"} {catch {set origUseCustomMDEF $::tk::mac::useCustomMDEF; set ::tk::mac::useCustomMDEF 1}} menubutton $w.body.below -text "Below" -underline 0 -direction below -menu $w.body.below.m -relief raised -menu $w.body.below.m -tearoff 0 +menu $w.body.below.m -tearoff 0 $w.body.below.m add command -label "Below menu: first item" -command "puts \"You have selected the first item from the Below menu.\"" $w.body.below.m add command -label "Below menu: second item" -command "puts \"You have selected the second item from the Below menu.\"" grid $w.body.below -row 0 -column 1 -sticky n diff --git a/library/demos/msgbox.tcl b/library/demos/msgbox.tcl index bd98bf2..2c2cc2d 100644 --- a/library/demos/msgbox.tcl +++ b/library/demos/msgbox.tcl @@ -23,7 +23,7 @@ pack [addSeeDismiss $w.buttons $w {} { }] -side bottom -fill x #pack $w.buttons.dismiss $w.buttons.code $w.buttons.vars -side left -expand 1 -frame $w.left +frame $w.left frame $w.right pack $w.left $w.right -side left -expand yes -fill y -pady .5c -padx .5c @@ -56,7 +56,7 @@ proc showMessageBox {w} { set button [tk_messageBox -icon $msgboxIcon -type $msgboxType \ -title Message -parent $w\ -message "This is a \"$msgboxType\" type messagebox with the \"$msgboxIcon\" icon"] - + tk_messageBox -icon info -message "You have selected \"$button\"" -type ok\ -parent $w } diff --git a/library/demos/paned2.tcl b/library/demos/paned2.tcl index f481d14..c549249 100644 --- a/library/demos/paned2.tcl +++ b/library/demos/paned2.tcl @@ -54,7 +54,7 @@ listbox $f.list -listvariable paneList -yscrollcommand "$f.scr set" # Invert the first item to highlight it $f.list itemconfigure 0 \ -background [$f.list cget -fg] -foreground [$f.list cget -bg] -scrollbar $f.scr -orient vertical -command "$f.list yview" +ttk::scrollbar $f.scr -orient vertical -command "$f.list yview" pack $f.scr -side right -fill y pack $f.list -fill both -expand 1 @@ -62,8 +62,8 @@ pack $f.list -fill both -expand 1 set f [frame $w.pane.bottom] text $f.text -xscrollcommand "$f.xscr set" -yscrollcommand "$f.yscr set" \ -width 30 -height 8 -wrap none -scrollbar $f.xscr -orient horizontal -command "$f.text xview" -scrollbar $f.yscr -orient vertical -command "$f.text yview" +ttk::scrollbar $f.xscr -orient horizontal -command "$f.text xview" +ttk::scrollbar $f.yscr -orient vertical -command "$f.text yview" grid $f.text $f.yscr -sticky nsew grid $f.xscr -sticky nsew grid columnconfigure $f 0 -weight 1 diff --git a/library/demos/puzzle.tcl b/library/demos/puzzle.tcl index fb8ab4c..4f7f955 100644 --- a/library/demos/puzzle.tcl +++ b/library/demos/puzzle.tcl @@ -54,7 +54,7 @@ pack $btns -side bottom -fill x scrollbar $w.s # The button metrics are a bit bigger in Aqua, and since we are -# using place which doesn't autosize, then we need to have a +# using place which doesn't autosize, then we need to have a # slightly larger frame here... if {[tk windowingsystem] eq "aqua"} { diff --git a/library/demos/sayings.tcl b/library/demos/sayings.tcl index 4d26ffe..aa3479c 100644 --- a/library/demos/sayings.tcl +++ b/library/demos/sayings.tcl @@ -28,8 +28,8 @@ frame $w.frame -borderwidth 10 pack $w.frame -side top -expand yes -fill both -padx 1c -scrollbar $w.frame.yscroll -command "$w.frame.list yview" -scrollbar $w.frame.xscroll -orient horizontal \ +ttk::scrollbar $w.frame.yscroll -command "$w.frame.list yview" +ttk::scrollbar $w.frame.xscroll -orient horizontal \ -command "$w.frame.list xview" listbox $w.frame.list -width 20 -height 10 -setgrid 1 \ -yscroll "$w.frame.yscroll set" -xscroll "$w.frame.xscroll set" diff --git a/library/demos/search.tcl b/library/demos/search.tcl index 9f44e16..a1a3d7f 100644 --- a/library/demos/search.tcl +++ b/library/demos/search.tcl @@ -109,7 +109,7 @@ pack $w.string.button -side left -pady 5 -padx 10 bind $w.string.entry <Return> "textSearch $w.text \$searchString search" text $w.text -yscrollcommand "$w.scroll set" -setgrid true -scrollbar $w.scroll -command "$w.text yview" +ttk::scrollbar $w.scroll -command "$w.text yview" pack $w.file $w.string -side top -fill x pack $w.scroll -side right -fill y pack $w.text -expand yes -fill both diff --git a/library/demos/square b/library/demos/square index 08c362b..1d7eb20 100644 --- a/library/demos/square +++ b/library/demos/square @@ -7,7 +7,7 @@ exec wish "$0" ${1+"$@"} # widget. It's only usable in the "tktest" application or if Tk has # been compiled with tkSquare.c. This demo arranges the following # bindings for the widget: -# +# # Button-1 press/drag: moves square to mouse # "a": toggle size animation on/off diff --git a/library/demos/states.tcl b/library/demos/states.tcl index 09d2718..41ce0bf 100644 --- a/library/demos/states.tcl +++ b/library/demos/states.tcl @@ -35,7 +35,7 @@ pack $btns -side bottom -fill x frame $w.frame -borderwidth .5c pack $w.frame -side top -expand yes -fill y -scrollbar $w.frame.scroll -command "$w.frame.list yview" +ttk::scrollbar $w.frame.scroll -command "$w.frame.list yview" listbox $w.frame.list -yscroll "$w.frame.scroll set" -setgrid 1 -height 12 pack $w.frame.scroll -side right -fill y pack $w.frame.list -side left -expand 1 -fill both diff --git a/library/demos/style.tcl b/library/demos/style.tcl index 614ea1f..a529a03 100644 --- a/library/demos/style.tcl +++ b/library/demos/style.tcl @@ -26,7 +26,7 @@ set family Courier text $w.text -yscrollcommand "$w.scroll set" -setgrid true \ -width 70 -height 32 -wrap word -font "$family 12" -scrollbar $w.scroll -command "$w.text yview" +ttk::scrollbar $w.scroll -command "$w.text yview" pack $w.scroll -side right -fill y pack $w.text -expand yes -fill both diff --git a/library/demos/text.tcl b/library/demos/text.tcl index 785e9e6..d1801d1 100644 --- a/library/demos/text.tcl +++ b/library/demos/text.tcl @@ -23,7 +23,7 @@ pack $btns -side bottom -fill x text $w.text -yscrollcommand [list $w.scroll set] -setgrid 1 \ -height 30 -undo 1 -autosep 1 -scrollbar $w.scroll -command [list $w.text yview] +ttk::scrollbar $w.scroll -command [list $w.text yview] pack $w.scroll -side right -fill y pack $w.text -expand yes -fill both diff --git a/library/demos/textpeer.tcl b/library/demos/textpeer.tcl index e94284e..83e8e14 100644 --- a/library/demos/textpeer.tcl +++ b/library/demos/textpeer.tcl @@ -36,7 +36,7 @@ proc makeClone {w parent} { global count set t [$parent peer create $w.text[incr count] -yscroll "$w.sb$count set"\ -height 10 -wrap word] - set sb [scrollbar $w.sb$count -command "$t yview" -orient vertical] + set sb [ttk::scrollbar $w.sb$count -command "$t yview" -orient vertical] set b1 [button $w.clone$count -command "makeClone $w $t" \ -text "Make Peer"] set b2 [button $w.kill$count -command "killClone $w $count" \ diff --git a/library/demos/twind.tcl b/library/demos/twind.tcl index 8f3c12e..bafb57e 100644 --- a/library/demos/twind.tcl +++ b/library/demos/twind.tcl @@ -25,7 +25,7 @@ set t $w.f.text text $t -yscrollcommand "$w.scroll set" -setgrid true -font $font -width 70 \ -height 35 -wrap word -highlightthickness 0 -borderwidth 0 pack $t -expand yes -fill both -scrollbar $w.scroll -command "$t yview" +ttk::scrollbar $w.scroll -command "$t yview" pack $w.scroll -side right -fill y panedwindow $w.pane pack $w.pane -expand yes -fill both @@ -166,7 +166,7 @@ $t image create end -image \ proc textWindBigB w { - $w configure -borderwidth 15 + $w configure -borderwidth 15 } proc textWindBigH w { @@ -193,7 +193,7 @@ proc textWindSmallP w { proc textWindOn w { catch {destroy $w.scroll2} set t $w.f.text - scrollbar $w.scroll2 -orient horizontal -command "$t xview" + ttk::scrollbar $w.scroll2 -orient horizontal -command "$t xview" pack $w.scroll2 -after $w.buttons -side bottom -fill x $t configure -xscrollcommand "$w.scroll2 set" -wrap none } @@ -230,7 +230,7 @@ proc createPlot {t} { $c create line 100 250 400 250 -width 2 $c create line 100 250 100 50 -width 2 $c create text 225 20 -text "A Simple Plot" -font $font -fill brown - + for {set i 0} {$i <= 10} {incr i} { set x [expr {100 + ($i*30)}] $c create line $x 250 $x 245 -width 2 @@ -241,7 +241,7 @@ proc createPlot {t} { $c create line 100 $y 105 $y -width 2 $c create text 96 $y -text [expr {$i*50}].0 -anchor e -font $font } - + foreach point { {12 56} {20 94} {33 98} {32 120} {61 180} {75 160} {98 223} } { @@ -303,7 +303,7 @@ proc textMakePeer {parent} { set t [$parent peer create $w.f.text -yscrollcommand "$w.scroll set" \ -borderwidth 0 -highlightthickness 0] pack $t -expand yes -fill both - scrollbar $w.scroll -command "$t yview" + ttk::scrollbar $w.scroll -command "$t yview" pack $w.scroll -side right -fill y pack $w.f -expand yes -fill both } diff --git a/library/demos/widget b/library/demos/widget index 8b92f9a..7604341 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -145,7 +145,7 @@ catch { } ttk::frame .textFrame -scrollbar .s -orient vertical -command {.t yview} -takefocus 1 +ttk::scrollbar .s -orient vertical -command {.t yview} -takefocus 1 pack .s -in .textFrame -side right -fill y text .t -yscrollcommand {.s set} -wrap word -width 70 -height $textheight \ -font mainFont -setgrid 1 -highlightthickness 0 \ @@ -565,8 +565,10 @@ proc showCode w { -xscrollcommand [list $t.xscroll set] \ -yscrollcommand [list $t.yscroll set] \ -setgrid 1 -highlightthickness 0 -pady 2 -padx 3] - scrollbar $t.xscroll -command [list $t.text xview] -orient horizontal - scrollbar $t.yscroll -command [list $t.text yview] -orient vertical + ttk::scrollbar $t.xscroll -command [list $t.text xview] \ + -orient horizontal + ttk::scrollbar $t.yscroll -command [list $t.text yview] \ + -orient vertical grid $t.text $t.yscroll -sticky news #grid $t.xscroll diff --git a/library/dialog.tcl b/library/dialog.tcl index 6a9babb..c751621 100644 --- a/library/dialog.tcl +++ b/library/dialog.tcl @@ -28,7 +28,6 @@ # bottom of the dialog box. proc ::tk_dialog {w title text bitmap default args} { - global tcl_platform variable ::tk::Priv # Check that $default was properly given @@ -149,7 +148,7 @@ proc ::tk_dialog {w title text bitmap default args} { # so we know how big it wants to be, then center the window in the # display (Motif style) and de-iconify it. - ::tk::PlaceWindow $w + ::tk::PlaceWindow $w tkwait visibility $w # 7. Set a grab and claim the focus too. diff --git a/library/entry.tcl b/library/entry.tcl index f28547e..6243d26 100644 --- a/library/entry.tcl +++ b/library/entry.tcl @@ -46,7 +46,6 @@ bind Entry <<Copy>> { } } bind Entry <<Paste>> { - global tcl_platform catch { if {[tk windowingsystem] ne "x11"} { catch { @@ -69,8 +68,8 @@ bind Entry <<PasteSelection>> { } bind Entry <<TraverseIn>> { - %W selection range 0 end - %W icursor end + %W selection range 0 end + %W icursor end } # Standard Motif bindings: @@ -358,12 +357,18 @@ proc ::tk::EntryMouseSelect {w x} { } } word { - if {$cur < [$w index anchor]} { + if {$cur < $anchor} { set before [tcl_wordBreakBefore [$w get] $cur] set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]] - } else { + } elseif {$cur > $anchor} { set before [tcl_wordBreakBefore [$w get] $anchor] set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]] + } else { + if {[$w index @$Priv(pressX)] < $anchor} { + incr anchor -1 + } + set before [tcl_wordBreakBefore [$w get] $anchor] + set after [tcl_wordBreakAfter [$w get] $anchor] } if {$before < 0} { set before 0 diff --git a/library/fontchooser.tcl b/library/fontchooser.tcl index 8b3f87e..8f91ade 100644 --- a/library/fontchooser.tcl +++ b/library/fontchooser.tcl @@ -105,7 +105,7 @@ proc ::tk::fontchooser::Configure {args} { "bad option \"$option\": must be\ -command, -font, -parent, -title or -visible" } - + set cache [dict create -parent $S(-parent) -title $S(-title) \ -font $S(-font) -command $S(-command)] set r [tclParseConfigSpec [namespace which -variable S] $specs "" $args] diff --git a/library/images/lamp.png b/library/images/lamp.png Binary files differdeleted file mode 100644 index 5445746..0000000 --- a/library/images/lamp.png +++ /dev/null diff --git a/library/images/lamp.svg b/library/images/lamp.svg deleted file mode 100644 index aa34765..0000000 --- a/library/images/lamp.svg +++ /dev/null @@ -1,114 +0,0 @@ -<?xml version="1.0" encoding="UTF-8" standalone="no"?> -<!-- Created with Inkscape (http://www.inkscape.org/) --> -<svg - xmlns:dc="http://purl.org/dc/elements/1.1/" - xmlns:cc="http://creativecommons.org/ns#" - xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" - xmlns:svg="http://www.w3.org/2000/svg" - xmlns="http://www.w3.org/2000/svg" - xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd" - xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape" - width="256" - height="256" - id="svg2" - sodipodi:version="0.32" - inkscape:version="0.46" - version="1.0" - sodipodi:docname="lamp.svg" - inkscape:output_extension="org.inkscape.output.svg.inkscape" - inkscape:export-filename="C:\Users\pat\Documents\SVG\wish\lamp.png" - inkscape:export-xdpi="45" - inkscape:export-ydpi="45"> - <defs - id="defs4"> - <inkscape:perspective - sodipodi:type="inkscape:persp3d" - inkscape:vp_x="0 : 526.18109 : 1" - inkscape:vp_y="0 : 1000 : 0" - inkscape:vp_z="744.09448 : 526.18109 : 1" - inkscape:persp3d-origin="372.04724 : 350.78739 : 1" - id="perspective10" /> - <inkscape:perspective - id="perspective4202" - inkscape:persp3d-origin="372.04724 : 350.78739 : 1" - inkscape:vp_z="744.09448 : 526.18109 : 1" - inkscape:vp_y="0 : 1000 : 0" - inkscape:vp_x="0 : 526.18109 : 1" - sodipodi:type="inkscape:persp3d" /> - </defs> - <sodipodi:namedview - id="base" - pagecolor="#ffffff" - bordercolor="#666666" - borderopacity="1.0" - gridtolerance="10000" - guidetolerance="10" - objecttolerance="10" - inkscape:pageopacity="0.0" - inkscape:pageshadow="2" - inkscape:zoom="1.9765625" - inkscape:cx="122.94071" - inkscape:cy="132.27976" - inkscape:document-units="px" - inkscape:current-layer="layer1" - showgrid="false" - inkscape:window-width="1253" - inkscape:window-height="696" - inkscape:window-x="155" - inkscape:window-y="130" /> - <metadata - id="metadata7"> - <rdf:RDF> - <cc:Work - rdf:about=""> - <dc:format>image/svg+xml</dc:format> - <dc:type - rdf:resource="http://purl.org/dc/dcmitype/StillImage" /> - <dc:title>Wish</dc:title> - <cc:license - rdf:resource="http://creativecommons.org/licenses/by-nc-sa/3.0/" /> - </cc:Work> - <cc:License - rdf:about="http://creativecommons.org/licenses/by-nc-sa/3.0/"> - <cc:permits - rdf:resource="http://creativecommons.org/ns#Reproduction" /> - <cc:permits - rdf:resource="http://creativecommons.org/ns#Distribution" /> - <cc:requires - rdf:resource="http://creativecommons.org/ns#Notice" /> - <cc:requires - rdf:resource="http://creativecommons.org/ns#Attribution" /> - <cc:prohibits - rdf:resource="http://creativecommons.org/ns#CommercialUse" /> - <cc:permits - rdf:resource="http://creativecommons.org/ns#DerivativeWorks" /> - <cc:requires - rdf:resource="http://creativecommons.org/ns#ShareAlike" /> - </cc:License> - </rdf:RDF> - </metadata> - <g - inkscape:label="Layer 1" - inkscape:groupmode="layer" - id="layer1"> - <path - id="path4244" - d="M 415.15644,157.10949 C 415.95395,156.55285 413.63871,156.20026 408.98022,156.16891 C 400.39605,156.11114 394.03714,153.62619 389.90404,148.71428 C 386.80837,145.03529 386.70005,142.56479 389.55139,140.67157 C 392.33793,138.82138 391.59696,137.74624 384.94986,133.99485 C 377.10186,129.56571 367.45876,120.11083 361.01771,110.52982 C 356.2238,103.39891 354.835,102.02199 351.39782,100.99218 C 348.07028,99.995225 347.3807,99.349945 347.3807,97.233135 C 347.3807,95.827615 348.28389,93.409235 349.38778,91.858965 C 350.70625,90.007345 351.00116,88.909055 350.24734,88.657785 C 348.52268,88.082895 349.12369,71.212775 351.01049,67.236642 C 352.72697,63.619426 358.4038,59.341601 362.8807,58.291741 C 368.19851,57.044683 371.3807,54.944074 371.3807,52.68077 C 371.3807,51.505545 370.0325,48.443002 368.38469,45.875118 C 364.6377,40.035936 363.56213,33.352517 365.70314,29.212273 C 368.86873,23.090696 378.69381,16.159436 389.80945,12.206085 C 396.16957,9.9440683 409.19029,7.9006403 416.8807,7.9576143 C 429.56583,8.0515923 430.45121,10.684797 418.52387,12.844573 C 408.41402,14.675243 395.40533,18.738492 389.39058,21.944323 C 382.19817,25.777834 375.3807,32.024842 375.3807,34.781896 C 375.3807,35.961118 376.7307,39.600271 378.3807,42.868903 C 381.7881,49.618923 382.10517,53.281819 379.7158,58.292375 C 377.80005,62.30975 372.62836,64.868903 366.42556,64.868903 C 361.00253,64.868903 357.56106,66.378947 356.20597,69.353051 C 354.65926,72.747705 355.39815,73.177385 359.69504,71.382035 C 364.84442,69.230481 369.94545,69.499889 378.3807,72.368905 C 386.08854,74.990505 393.19753,75.572485 396.42352,73.845985 C 399.16382,72.379425 400.20168,69.980487 401.8714,61.253678 C 402.8156,56.318785 404.11402,52.717225 405.46884,51.27508 C 409.57057,46.908996 417.3263,46.188254 435.8807,48.4489 C 440.51899,49.014024 441.21999,48.798052 445.57071,45.463499 C 448.15021,43.486471 450.93616,41.868903 451.76169,41.868903 C 456.39638,41.868903 453.00898,47.459001 446.28417,50.908252 C 444.30607,51.922844 437.33107,53.551117 430.78417,54.526637 C 415.93531,56.739186 415.13628,57.382184 413.51607,68.422706 C 412.86967,72.827445 411.54206,77.483105 410.53723,78.868905 C 407.37979,83.223475 398.88397,87.099935 391.31007,87.641845 C 382.34323,88.283415 380.33433,87.656565 374.36395,82.354025 C 370.03354,78.508005 368.69669,77.868905 364.98218,77.868905 C 360.03038,77.868905 356.23453,80.317105 353.75648,85.109115 C 352.31064,87.905065 352.31073,88.250245 353.75754,89.059915 C 354.62947,89.547875 358.14729,92.392935 361.57494,95.382295 C 373.67667,105.93659 385.05189,109.87945 387.55431,104.38722 C 389.01862,101.17342 400.23138,93.868905 403.70042,93.868905 C 405.61476,93.868905 406.3807,93.354525 406.3807,92.068905 C 406.3807,89.300765 408.42915,87.865755 412.3307,87.900705 C 416.2925,87.936195 418.45173,89.238425 420.29952,92.706685 C 421.27351,94.534825 422.08643,94.908595 424.02848,94.421175 C 425.97033,93.933795 427.14185,94.472205 429.40044,96.890035 C 430.98913,98.590725 433.7721,100.41478 435.58483,100.94347 C 438.47789,101.78726 439.06063,101.62756 440.35288,99.636815 C 445.10643,92.313915 453.6284,87.868905 462.91432,87.868905 C 471.25226,87.868905 477.3762,94.861065 477.37915,104.38451 C 477.38132,111.40533 474.73351,115.99375 469.63732,117.8004 C 465.8216,119.15312 465.3143,119.09082 460.41928,116.6683 L 455.23918,114.10469 L 455.55994,118.7368 C 455.85694,123.02582 455.69553,123.39336 453.3807,123.69898 C 452.0057,123.88052 449.0807,125.72311 446.8807,127.79362 C 444.6807,129.86413 441.3057,132.60737 439.3807,133.88971 C 437.4557,135.17205 435.71687,136.34329 435.51663,136.49247 C 435.3164,136.64165 436.1039,138.303 437.26663,140.18434 C 440.00489,144.61494 439.95186,145.14881 436.36797,149.23063 C 433.17349,152.86894 427.63954,155.56972 421.9273,156.27821 C 420.02228,156.51449 417.43247,156.99854 416.17217,157.35387 C 414.69967,157.76902 414.33665,157.68168 415.15644,157.10949 z M 461.66289,105.49411 C 466.02111,106.09147 466.3807,105.96302 467.55302,103.39006 C 468.64455,100.9944 468.56244,100.47497 466.9,99.259355 C 463.50165,96.774425 454.03816,98.379955 450.76501,101.99675 C 449.2334,103.68915 449.23826,104.00257 450.83387,106.43778 L 452.55063,109.05789 L 454.78597,106.9579 C 456.6536,105.20335 457.78484,104.96256 461.66289,105.49411 z M 480.08955,157.24443 C 479.03653,156.19141 479.23148,154.86891 480.43972,154.86891 C 481.02218,154.86891 481.22062,155.31891 480.8807,155.86891 C 480.53516,156.42801 481.28072,156.85424 482.57168,156.83564 L 484.8807,156.80237 L 482.82974,155.08564 C 481.26204,153.77341 480.78031,152.19079 480.78523,148.36891 C 480.78878,145.61891 480.4093,142.24744 479.94194,140.87675 C 479.17159,138.6174 479.24977,138.51536 480.77884,139.78437 C 482.10899,140.8883 482.72069,140.92526 483.67308,139.95921 C 484.61817,139.00056 484.50928,138.45979 483.17218,137.47168 C 480.67758,135.62817 479.8077,125.30277 482.07374,124.43321 C 484.50372,123.50074 486.09262,125.4993 484.69743,127.73335 C 484.07418,128.73133 483.86705,130.0378 484.23714,130.63662 C 484.60722,131.23543 484.90343,137.49517 484.89536,144.54714 C 484.88148,156.68738 484.7722,157.38444 482.83955,157.66109 C 481.71692,157.82179 480.47942,157.63429 480.08955,157.24443 z M 482.25305,118.70224 C 481.74301,109.37956 481.9401,107.3904 483.40197,107.10616 C 484.64333,106.86478 484.91924,108.04245 484.9015,113.50646 C 484.88705,117.95665 484.46065,120.34226 483.63023,120.61907 C 482.88848,120.86632 482.32882,120.08736 482.25305,118.70224 z M 379.00441,69.349758 C 376.06529,66.410633 377.10113,63.67485 383.3807,57.791426 C 389.1743,52.363315 389.3807,51.996847 389.3807,47.13811 C 389.3807,42.527633 389.68488,41.874271 393.01325,39.335601 C 396.00346,37.054853 398.10542,36.431883 404.90027,35.812562 C 416.73834,34.733574 419.96577,32.472032 421.51698,24.168809 C 422.76442,17.491595 424.77273,15.934307 435.02949,13.690888 C 444.53714,11.61132 473.5654,10.035808 469.8807,11.799335 C 462.39978,15.379766 448.69837,19.973669 443.16225,20.757679 C 434.68965,21.957548 433.72397,22.530265 426.73194,30.502062 C 423.51376,34.171199 419.46171,37.767608 417.72739,38.494081 C 415.99308,39.220554 410.20812,40.121839 404.87193,40.496935 C 392.82345,41.34386 390.96003,42.710991 391.65408,50.194442 C 392.08855,54.878864 391.98999,55.090456 388.28416,57.429845 C 384.39732,59.883502 381.94201,63.096875 383.08255,64.23742 C 383.42987,64.584736 386.14059,64.868903 389.10639,64.868903 C 395.04346,64.868903 395.33233,66.026622 389.95576,68.273094 C 383.92501,70.792905 380.75884,71.104181 379.00441,69.349758 z M 434.60321,38.312199 C 427.83023,33.568222 439.44607,28.281864 448.8156,31.844152 C 452.78899,33.354831 451.84999,34.868903 446.93972,34.868903 C 442.58714,34.868903 440.3344,36.104222 442.3807,37.368903 C 442.94864,37.719911 443.15443,38.426005 442.838,38.938001 C 441.93507,40.398969 437.05277,40.027939 434.60321,38.312199 z M 399.1307,26.788804 C 398.1682,26.228199 397.3807,24.907716 397.3807,23.854397 C 397.3807,19.888982 404.86882,18.583104 410.97957,21.482844 C 414.6962,23.2465 415.79992,26.473299 412.3807,25.579154 C 411.08084,25.239232 410.3807,25.548472 410.3807,26.462523 C 410.3807,28.151255 401.89255,28.397435 399.1307,26.788804 z" - style="fill:#a19ea5" /> - <path - id="path4242" - d="M 105.76326,194.33186 C 96.199481,191.3282 86.035511,183.95952 84.415432,178.8551 C 83.669624,176.50526 84.619431,173.43151 87.043677,170.34958 C 89.131529,167.6953 90.839771,164.85771 90.839771,164.04381 C 90.839771,163.22992 85.918717,159.94111 79.904096,156.73534 C 65.654177,149.14022 48.534772,133.52161 39.035518,119.44956 C 25.94837,100.06246 20.676575,94.528555 15.260318,94.492261 C 12.544659,94.474078 9.7834525,93.586577 9.1243032,92.52005 C 7.1111542,89.262706 9.8582449,82.714405 14.697759,79.234457 L 19.284506,75.93627 L 32.226689,86.830368 C 45.242318,97.786283 61.932601,107.70092 70.896763,109.80181 C 74.874966,110.73415 76.973245,109.63504 82.823316,103.55448 C 91.577415,94.455454 106.5437,84.581571 109.7288,85.803804 C 112.30619,86.792846 119.14001,82.528975 119.50937,79.701372 C 119.63551,78.735652 119.84193,77.072338 119.96808,76.00515 C 120.1008,74.882421 123.45816,74.302552 127.93568,74.629009 C 134.42967,75.102512 136.37445,76.225828 140.03071,81.615217 C 142.42694,85.147312 144.93094,87.89196 145.59516,87.714438 C 146.25938,87.536916 148.11372,86.880753 149.71593,86.256298 C 151.55372,85.540025 154.60158,87.11622 157.97278,90.526315 C 160.91183,93.499275 166.37382,96.761572 170.11052,97.77588 C 176.63713,99.547487 177.10469,99.356038 181.99078,92.911204 C 189.2319,83.360053 193.30348,80.314122 203.42538,76.876064 C 213.99829,73.284813 227.86298,74.099195 234.92479,78.726276 C 249.97261,88.585994 246.13011,121.71137 229.57839,124.81649 C 217.25776,127.12786 203.68336,119.34028 204.912,110.66549 C 205.47565,106.68593 206.35069,106.38575 217.3878,106.38575 C 228.7903,106.38575 229.33057,106.17926 231.11535,101.13898 C 232.77591,96.449555 232.39214,95.427248 227.50256,91.5151 C 221.01109,86.321288 212.43622,85.84151 203.33017,90.162611 C 193.1595,94.988901 192.26182,99.390772 198.85898,112.08736 C 201.94886,118.03401 204.71121,125.78933 204.99756,129.32143 C 205.44391,134.8274 204.9522,135.7516 201.55033,135.80083 C 199.36802,135.83241 193.58823,139.5894 188.70635,144.14971 C 183.82446,148.71 177.14673,154.02271 173.86693,155.95573 C 170.58712,157.88875 167.90365,160.16082 167.90365,161.00476 C 167.90365,161.8487 169.76144,165.83259 172.03207,169.85786 L 176.16049,177.17652 L 169.56843,183.28424 C 155.87761,195.96917 126.9335,200.98073 105.76326,194.33186 z" - style="fill:#edd400" - sodipodi:nodetypes="cssssssscccsssssssssssssssssssssssssscccc" /> - <path - id="path4238" - d="M 105.76326,195.26015 C 91.2682,190.70773 79.926103,178.96138 85.064191,173.82331 C 86.412111,172.47539 90.329525,173.11166 98.078673,175.93715 C 114.43988,181.90274 127.59098,183.59079 140.28535,181.35472 C 153.94689,178.94829 158.14857,176.20124 155.47497,171.42379 C 153.72375,168.29452 151.50157,168.02067 131.82394,168.50911 C 119.87893,168.8056 106.35554,168.19755 101.77196,167.15787 C 89.698721,164.41931 70.093174,152.93068 56.939947,140.88681 C 44.534571,129.52772 29.195171,107.81695 31.238758,104.51038 C 31.937342,103.38006 30.70876,100.53908 28.508587,98.197089 C 25.268931,94.748645 23.184206,94.116538 17.545112,94.872902 C 13.258048,95.447908 10.071549,94.981011 9.2539007,93.658026 C 7.1231945,90.210482 9.7375867,83.729446 14.697767,80.162746 L 19.284499,76.864559 L 32.226699,87.758658 C 47.530117,100.64033 63.263112,109.42753 74.136789,111.1663 C 82.555064,112.51244 85.287914,115.79329 81.646114,120.18138 C 77.940809,124.646 66.533098,123.44089 54.981809,117.36455 C 49.183358,114.31439 44.065729,112.19224 43.609327,112.64866 C 42.195407,114.06256 58.535133,129.40174 68.983105,136.4687 C 82.893943,145.87792 99.314337,150.64583 118.36258,150.80678 C 145.52872,151.03631 162.76551,145.71413 177.25684,132.62207 C 188.34716,122.60263 188.94814,120.5505 182.73878,113.90333 C 175.81472,106.49109 168.70623,106.44964 158.32432,113.76097 C 147.98605,121.04152 132.76454,123.60855 116.61147,120.79561 C 102.20671,118.28713 93.486961,114.8298 92.037334,111.05211 C 91.442016,109.50075 89.277658,108.23147 87.227649,108.23147 C 85.17764,108.23147 83.500363,107.13687 83.500363,105.79902 C 83.500363,100.44846 105.44657,85.088853 110.38429,86.983634 C 112.97609,87.978198 112.0154,89.694925 104.72512,97.096507 L 95.944216,106.01146 L 108.89174,108.95633 C 125.60393,112.75743 132.19327,112.622 141.75698,108.28088 C 150.27283,104.41539 151.12833,102.11981 146.51015,95.52644 C 143.6484,91.440733 143.6695,91.029744 146.86084,88.696177 C 151.48792,85.312779 152.0368,85.452081 158.05294,91.536605 C 160.9479,94.464463 166.37382,97.689862 170.11052,98.704169 C 176.63713,100.47578 177.10469,100.28433 181.99078,93.839493 C 189.2319,84.288343 193.30348,81.242411 203.42538,77.804353 C 214.46761,74.053691 228.66626,75.111117 235.46998,80.190801 C 246.39872,88.350288 247.47071,106.01058 237.63431,115.84696 C 231.52704,121.95423 223.54183,122.71682 215.49179,117.96155 C 204.60894,111.53288 206.6535,105.81232 219.23735,107.48162 C 226.96374,108.50657 228.35458,108.17571 230.11029,104.8951 C 232.76067,99.942824 232.67127,92.999442 229.92172,90.249895 C 226.72145,87.049615 210.78434,87.553668 203.33017,91.0909 C 193.1595,95.917191 192.26182,100.31906 198.85898,113.01565 C 201.94886,118.9623 204.71121,126.71762 204.99756,130.24972 C 205.44391,135.75569 204.9522,136.67989 201.55033,136.72912 C 199.36802,136.7607 193.58823,140.51769 188.70635,145.078 C 183.82446,149.63829 177.14673,154.951 173.86693,156.88402 C 170.58712,158.81704 167.90365,161.08911 167.90365,161.93305 C 167.90365,162.77699 169.76144,166.76088 172.03207,170.78615 L 176.16049,178.10481 L 169.56843,184.21253 C 155.87761,196.89746 126.9335,201.90902 105.76326,195.26015 z M 124.39689,92.286528 C 123.73252,90.555233 124.16318,88.866818 125.37189,88.463902 C 128.82997,87.311229 127.89606,85.131073 122.98588,82.893835 C 115.70755,79.577611 118.94662,74.88732 128.04458,75.568657 C 133.65369,75.988728 136.35232,77.369401 139.27998,81.316906 L 143.13312,86.512278 L 137.98496,90.949892 C 131.98533,96.12141 126.09095,96.701224 124.39689,92.286528 z" - style="fill:#555753" - sodipodi:nodetypes="cssssssssssscccsssssssssssssscccsssssssssssssssssssscccccssscccc" /> - <path - id="path4234" - d="M 110.50482,194.3016 C 101.29684,192.13337 94.533525,188.48684 89.271383,182.85325 C 82.390918,175.4871 85.936884,174.28107 99.528813,179.36455 C 115.59245,185.37247 143.30992,186.28633 152.7661,181.11982 C 159.03409,177.69523 160.98588,170.45868 156.43581,167.51383 C 155.17435,166.69739 142.9955,165.96174 129.37171,165.87907 C 108.80987,165.75428 102.74285,165.05333 93.663859,161.75352 C 73.025491,154.25244 49.561448,135.01491 39.768427,117.56612 C 35.780389,110.46041 36.411322,110.85564 48.942698,123.31318 C 70.302623,144.54723 92.258893,154.15548 119.15432,154.03838 C 135.83546,153.96576 152.56346,150.85172 163.02604,145.87134 C 172.41161,141.40363 189.9219,125.23231 189.9219,121.03213 C 189.9219,119.19248 187.7843,115.1469 185.17167,112.04198 C 178.58784,104.21754 168.03965,104.18244 155.55484,111.94343 C 150.18536,115.28129 142.95424,117.92581 137.39714,118.58397 C 127.97216,119.70021 104.80591,116.69758 100.01936,113.73933 C 94.450094,110.29735 100.24351,109.86707 113.23644,112.75774 C 127.9361,116.02809 138.20198,114.95313 146.93857,109.22869 C 153.28212,105.07225 154.19121,101.72283 150.50345,96.094621 C 148.24619,92.649609 147.93449,90.769617 149.38072,89.323385 C 150.82695,87.877153 153.0819,88.968084 157.50247,93.252689 C 160.86829,96.51495 166.83523,100.07126 170.76237,101.15561 C 177.28458,102.95648 178.14485,102.76481 180.70126,98.941361 C 190.46478,84.338673 203.44977,77.038962 219.66199,77.038962 C 239.73552,77.038962 249.19265,98.555619 235.51724,113.11244 C 230.28699,118.67977 219.45458,118.99815 214.68225,113.7248 C 210.40882,109.00271 211.87531,107.60004 218.46592,110.10579 C 222.73772,111.72993 224.48175,111.47356 228.23768,108.66934 C 235.27205,103.41743 237.01116,96.063887 232.61714,90.15151 C 228.70991,84.894138 221.3182,83.243302 210.64805,85.245036 C 203.22425,86.637745 191.75676,96.268143 191.75676,101.10994 C 191.75676,103.03903 194.23381,109.00645 197.26132,114.37093 C 203.6019,125.60581 204.5447,133.91945 199.47821,133.91945 C 197.66998,133.91945 192.50945,137.70093 188.01037,142.32275 C 183.51127,146.94454 176.32104,152.80279 172.03207,155.34108 C 163.73389,160.25204 162.48268,163.20921 167.08641,167.02996 C 171.28,170.51035 173.54029,175.47679 172.34649,178.58776 C 170.71762,182.83253 158.4385,190.19925 147.65345,193.40206 C 137.09511,196.53755 121.59442,196.91291 110.50482,194.3016 z M 56.408298,114.61872 C 49.129046,110.97705 38.716927,103.92466 33.270272,98.946719 L 23.367251,89.895915 L 16.969775,92.568949 C 9.3420288,95.756035 8.6495364,95.306148 9.7405408,87.872639 C 10.344685,83.75629 11.031471,82.8609 12.211447,84.651204 C 13.540212,86.667268 14.305567,86.530535 16.306604,83.919666 C 17.660139,82.153618 19.320682,80.708671 19.996697,80.708671 C 20.672694,80.708671 26.554779,85.229385 33.067979,90.7547 C 45.470438,101.27603 59.192323,109.15379 71.573791,112.86101 C 75.610471,114.06964 78.913208,116.20591 78.913208,117.60829 C 78.913208,122.46961 69.63857,121.23756 56.408298,114.61872 z M 87.170053,103.7711 C 87.170053,101.119 98.339717,92.839094 105.19954,90.406132 C 109.67365,88.819295 99.599675,99.261745 92.756946,103.30384 C 87.921829,106.16003 87.170053,106.22289 87.170053,103.7711 z M 129.35231,88.988873 C 132.38564,85.333953 130.37875,80.708671 125.7596,80.708671 C 123.70957,80.708671 122.03229,79.882986 122.03229,78.873816 C 122.03229,76.472212 130.46732,76.514212 134.9969,78.938366 C 141.6449,82.496277 137.51074,91.717796 129.26767,91.717796 C 127.62199,91.717796 127.64274,91.04879 129.35231,88.988873 z" - style="fill:#000000;fill-opacity:1" - sodipodi:nodetypes="cssssssssssssssssssssssssssssssssssssscccccsssssssccssccssssc" /> - </g> -</svg> diff --git a/library/listbox.tcl b/library/listbox.tcl index 3270b5d..17c03c0 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -118,7 +118,7 @@ bind Listbox <Control-Home> { %W see 0 %W selection clear 0 end %W selection set 0 - event generate %W <<ListboxSelect>> + tk::FireListboxSelectEvent %W } bind Listbox <Control-Shift-Home> { tk::ListboxDataExtend %W 0 @@ -128,7 +128,7 @@ bind Listbox <Control-End> { %W see end %W selection clear 0 end %W selection set end - event generate %W <<ListboxSelect>> + tk::FireListboxSelectEvent %W } bind Listbox <Control-Shift-End> { tk::ListboxDataExtend %W [%W index end] @@ -163,7 +163,7 @@ bind Listbox <<SelectAll>> { bind Listbox <<SelectNone>> { if {[%W cget -selectmode] ne "browse"} { %W selection clear 0 end - event generate %W <<ListboxSelect>> + tk::FireListboxSelectEvent %W } } @@ -256,7 +256,7 @@ proc ::tk::ListboxBeginSelect {w el {focus 1}} { set Priv(listboxSelection) {} set Priv(listboxPrev) $el } - event generate $w <<ListboxSelect>> + tk::FireListboxSelectEvent $w # check existence as ListboxSelect may destroy us if {$focus && [winfo exists $w] && [$w cget -state] eq "normal"} { focus $w @@ -284,7 +284,7 @@ proc ::tk::ListboxMotion {w el} { $w selection clear 0 end $w selection set $el set Priv(listboxPrev) $el - event generate $w <<ListboxSelect>> + tk::FireListboxSelectEvent $w } extended { set i $Priv(listboxPrev) @@ -315,7 +315,7 @@ proc ::tk::ListboxMotion {w el} { incr i -1 } set Priv(listboxPrev) $el - event generate $w <<ListboxSelect>> + tk::FireListboxSelectEvent $w } } } @@ -366,7 +366,7 @@ proc ::tk::ListboxBeginToggle {w el} { } else { $w selection set $el } - event generate $w <<ListboxSelect>> + tk::FireListboxSelectEvent $w } } @@ -418,7 +418,7 @@ proc ::tk::ListboxUpDown {w amount} { browse { $w selection clear 0 end $w selection set active - event generate $w <<ListboxSelect>> + tk::FireListboxSelectEvent $w } extended { $w selection clear 0 end @@ -426,7 +426,7 @@ proc ::tk::ListboxUpDown {w amount} { $w selection anchor active set Priv(listboxPrev) [$w index active] set Priv(listboxSelection) {} - event generate $w <<ListboxSelect>> + tk::FireListboxSelectEvent $w } } } @@ -514,7 +514,7 @@ proc ::tk::ListboxCancel w { } incr first } - event generate $w <<ListboxSelect>> + tk::FireListboxSelectEvent $w } # ::tk::ListboxSelectAll @@ -534,5 +534,19 @@ proc ::tk::ListboxSelectAll w { } else { $w selection set 0 end } - event generate $w <<ListboxSelect>> + tk::FireListboxSelectEvent $w +} + +# ::tk::FireListboxSelectEvent +# +# Fire the <<ListboxSelect>> event if the listbox is not in disabled +# state. +# +# Arguments: +# w - The listbox widget. + +proc ::tk::FireListboxSelectEvent w { + if {[$w cget -state] eq "normal"} { + event generate $w <<ListboxSelect>> + } } diff --git a/library/menu.tcl b/library/menu.tcl index d05740f..a7aaa3f 100644 --- a/library/menu.tcl +++ b/library/menu.tcl @@ -248,7 +248,6 @@ proc ::tk::MbLeave w { proc ::tk::MbPost {w {x {}} {y {}}} { global errorInfo variable ::tk::Priv - global tcl_platform if {[$w cget -state] eq "disabled" || $w eq $Priv(postedMb)} { return @@ -313,6 +312,9 @@ proc ::tk::MbPost {w {x {}} {y {}}} { set x [expr {[winfo rootx $w] - [winfo reqwidth $menu]}] set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}] set entry [MenuFindName $menu [$w cget -text]] + if {$entry eq ""} { + set entry 0 + } if {[$w cget -indicatoron]} { if {$entry == [$menu index last]} { incr y [expr {-([$menu yposition $entry] \ @@ -333,6 +335,9 @@ proc ::tk::MbPost {w {x {}} {y {}}} { set x [expr {[winfo rootx $w] + [winfo width $w]}] set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}] set entry [MenuFindName $menu [$w cget -text]] + if {$entry eq ""} { + set entry 0 + } if {[$w cget -indicatoron]} { if {$entry == [$menu index last]} { incr y [expr {-([$menu yposition $entry] \ @@ -396,7 +401,6 @@ proc ::tk::MbPost {w {x {}} {y {}}} { # is a posted menubutton. proc ::tk::MenuUnpost menu { - global tcl_platform variable ::tk::Priv set mb $Priv(postedMb) @@ -525,7 +529,6 @@ proc ::tk::MbMotion {w upDown rootx rooty} { proc ::tk::MbButtonUp w { variable ::tk::Priv - global tcl_platform set menu [$w cget -menu] set tearoff [expr {[tk windowingsystem] eq "x11" || \ @@ -600,7 +603,6 @@ proc ::tk::MenuMotion {menu x y state} { proc ::tk::MenuButtonDown menu { variable ::tk::Priv - global tcl_platform if {![winfo viewable $menu]} { return @@ -1030,7 +1032,7 @@ proc ::tk::MenuFind {w char} { proc ::tk::TraverseToMenu {w char} { variable ::tk::Priv - if {$char eq ""} { + if {![winfo exists $w] || $char eq ""} { return } while {[winfo class $w] eq "Menu"} { @@ -1212,8 +1214,6 @@ proc ::tk::MenuFindName {menu s} { # upper-left corner goes at (x,y). proc ::tk::PostOverPoint {menu x y {entry {}}} { - global tcl_platform - if {$entry ne ""} { if {$entry == [$menu index last]} { incr y [expr {-([$menu yposition $entry] \ @@ -1228,8 +1228,8 @@ proc ::tk::PostOverPoint {menu x y {entry {}}} { if {[tk windowingsystem] eq "win32"} { # osVersion is not available in safe interps set ver 5 - if {[info exists tcl_platform(osVersion)]} { - scan $tcl_platform(osVersion) %d ver + if {[info exists ::tcl_platform(osVersion)]} { + scan $::tcl_platform(osVersion) %d ver } # We need to fix some problems with menu posting on Windows, @@ -1334,7 +1334,6 @@ proc ::tk::GenerateMenuSelect {menu} { proc ::tk_popup {menu x y {entry {}}} { variable ::tk::Priv - global tcl_platform if {$Priv(popup) ne "" || $Priv(postedMb) ne ""} { tk::MenuUnpost {} } diff --git a/library/mkpsenc.tcl b/library/mkpsenc.tcl index 50224eb..b3fd13d 100644 --- a/library/mkpsenc.tcl +++ b/library/mkpsenc.tcl @@ -1163,11 +1163,11 @@ namespace eval ::tk { 0 exch 0 exch { dup type /stringtype eq - { stringwidth } { + { stringwidth } { currentfont /Encoding get exch 1 exch put (\001) - stringwidth + stringwidth } - ifelse + ifelse exch 3 1 roll add 3 1 roll add exch } forall } diff --git a/library/msgbox.tcl b/library/msgbox.tcl index 10e91f1..6d329c2 100644 --- a/library/msgbox.tcl +++ b/library/msgbox.tcl @@ -129,7 +129,7 @@ static unsigned char w3_bits[] = { # See the user documentation for details on what tk_messageBox does. # proc ::tk::MessageBox {args} { - global tcl_platform tk_strictMotif + global tk_strictMotif variable ::tk::Priv set w ::tk::PrivMsgBox @@ -137,7 +137,7 @@ proc ::tk::MessageBox {args} { # # The default value of the title is space (" ") not the empty string - # because for some window managers, a + # because for some window managers, a # wm title .foo "" # causes the window title to be "foo" instead of the empty string. # @@ -175,7 +175,7 @@ proc ::tk::MessageBox {args} { } switch -- $data(-type) { - abortretryignore { + abortretryignore { set names [list abort retry ignore] set labels [list &Abort &Retry &Ignore] set cancel abort @@ -218,7 +218,7 @@ proc ::tk::MessageBox {args} { lappend buttons [list $name -text [mc $lab]] } - # If no default button was specified, the default default is the + # If no default button was specified, the default default is the # first button (Bug: 2218). if {$data(-default) eq ""} { diff --git a/library/msgs/es.msg b/library/msgs/es.msg index 991711b..578c52c 100644 --- a/library/msgs/es.msg +++ b/library/msgs/es.msg @@ -1,7 +1,7 @@ namespace eval ::tk { ::msgcat::mcset es "&Abort" "&Abortar" ::msgcat::mcset es "&About..." "&Acerca de ..." - ::msgcat::mcset es "All Files" "Todos los archivos" + ::msgcat::mcset es "All Files" "Todos los archivos" ::msgcat::mcset es "Application Error" "Error de la aplicaci\u00f3n" ::msgcat::mcset es "&Blue" "&Azul" ::msgcat::mcset es "Cancel" "Cancelar" @@ -61,7 +61,7 @@ namespace eval ::tk { ::msgcat::mcset es "Tcl Scripts" "Scripts Tcl" ::msgcat::mcset es "Tcl for Windows" "Tcl para Windows" ::msgcat::mcset es "Text Files" "Archivos de texto" - ::msgcat::mcset es "&Yes" "&S\u00ed" + ::msgcat::mcset es "&Yes" "&S\u00ed" ::msgcat::mcset es "abort" "abortar" ::msgcat::mcset es "blue" "azul" ::msgcat::mcset es "cancel" "cancelar" diff --git a/library/msgs/ru.msg b/library/msgs/ru.msg index be2b551..2aac5bb 100644 --- a/library/msgs/ru.msg +++ b/library/msgs/ru.msg @@ -18,7 +18,7 @@ namespace eval ::tk { ::msgcat::mcset ru "Details >>" "\u041f\u043e\u0434\u0440\u043e\u0431\u043d\u0435\u0435 >>" ::msgcat::mcset ru "Directory \"%1\$s\" does not exist." "\u041a\u0430\u0442\u0430\u043b\u043e\u0433\u0430 \"%1\$s\" \u043d\u0435 \u0441\u0443\u0449\u0435\u0441\u0442\u0432\u0443\u0435\u0442." ::msgcat::mcset ru "&Directory:" "&\u041a\u0430\u0442\u0430\u043b\u043e\u0433:" - ::msgcat::mcset ru "Error: %1\$s" "\u041e\u0448\u0438\u0431\u043a\u0430: %1\$s" + ::msgcat::mcset ru "Error: %1\$s" "\u041e\u0448\u0438\u0431\u043a\u0430: %1\$s" ::msgcat::mcset ru "E&xit" "\u0412\u044b\u0445\u043e\u0434" ::msgcat::mcset ru "File \"%1\$s\" already exists.\nDo you want to overwrite it?" \ "\u0424\u0430\u0439\u043b \"%1\$s\" \u0443\u0436\u0435 \u0441\u0443\u0449\u0435\u0441\u0442\u0432\u0443\u0435\u0442.\n\u0417\u0430\u043c\u0435\u043d\u0438\u0442\u044c \u0435\u0433\u043e?" @@ -34,7 +34,7 @@ namespace eval ::tk { ::msgcat::mcset ru "Hi" "\u041f\u0440\u0438\u0432\u0435\u0442" ::msgcat::mcset ru "&Hide Console" "\u0421\u043f\u0440\u044f\u0442\u0430\u0442\u044c \u043a\u043e\u043d\u0441\u043e\u043b\u044c" ::msgcat::mcset ru "&Ignore" "&\u0418\u0433\u043d\u043e\u0440\u0438\u0440\u043e\u0432\u0430\u0442\u044c" - ::msgcat::mcset ru "Invalid file name \"%1\$s\"." "\u041d\u0435\u0432\u0435\u0440\u043d\u043e\u0435 \u0438\u043c\u044f \u0444\u0430\u0439\u043b\u0430 \"%1\$s\"." + ::msgcat::mcset ru "Invalid file name \"%1\$s\"." "\u041d\u0435\u0432\u0435\u0440\u043d\u043e\u0435 \u0438\u043c\u044f \u0444\u0430\u0439\u043b\u0430 \"%1\$s\"." ::msgcat::mcset ru "Log Files" "\u0424\u0430\u0439\u043b\u044b \u0436\u0443\u0440\u043d\u0430\u043b\u0430" ::msgcat::mcset ru "&No" "&\u041d\u0435\u0442" ::msgcat::mcset ru "&OK" "&\u041e\u041a" diff --git a/library/palette.tcl b/library/palette.tcl index 924dd61..9cecf5b 100644 --- a/library/palette.tcl +++ b/library/palette.tcl @@ -100,7 +100,7 @@ proc ::tk_setPalette {args} { set new(troughColor) $darkerBg } - # let's make one of each of the widgets so we know what the + # let's make one of each of the widgets so we know what the # defaults are currently for this platform. toplevel .___tk_set_palette wm withdraw .___tk_set_palette @@ -113,12 +113,12 @@ proc ::tk_setPalette {args} { } # Walk the widget hierarchy, recoloring all existing windows. - # The option database must be set according to what we do here, - # but it breaks things if we set things in the database while + # The option database must be set according to what we do here, + # but it breaks things if we set things in the database while # we are changing colors...so, ::tk::RecolorTree now returns the # option database changes that need to be made, and they # need to be evalled here to take effect. - # We have to walk the whole widget tree instead of just + # We have to walk the whole widget tree instead of just # relying on the widgets we've created above to do the work # because different extensions may provide other kinds # of widgets that we don't currently know about, so we'll @@ -144,7 +144,7 @@ proc ::tk_setPalette {args} { # ::tk::RecolorTree -- # This procedure changes the colors in a window and all of its # descendants, according to information provided by the colors -# argument. This looks at the defaults provided by the option +# argument. This looks at the defaults provided by the option # database, if it exists, and if not, then it looks at the default # value of the widget itself. # diff --git a/library/scale.tcl b/library/scale.tcl index d9e7d27..fb9b81b 100644 --- a/library/scale.tcl +++ b/library/scale.tcl @@ -223,7 +223,13 @@ proc ::tk::ScaleIncrement {w dir big repeat} { set inc [$w cget -resolution] } if {([$w cget -from] > [$w cget -to]) ^ ($dir eq "up")} { - set inc [expr {-$inc}] + if {$inc > 0} { + set inc [expr {-$inc}] + } + } else { + if {$inc < 0} { + set inc [expr {-$inc}] + } } $w set [expr {[$w get] + $inc}] diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index 1f8c7d2..b7be014 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -15,7 +15,7 @@ #------------------------------------------------------------------------- # Standard Motif bindings: -if {[tk windowingsystem] eq "x11"} { +if {[tk windowingsystem] eq "x11" || [tk windowingsystem] eq "aqua"} { bind Scrollbar <Enter> { if {$tk_strictMotif} { @@ -152,6 +152,12 @@ switch [tk windowingsystem] { } } "x11" { + bind Scrollbar <MouseWheel> { + tk::ScrollByUnits %W v [expr {- (%D /120 ) * 4}] + } + bind Scrollbar <Shift-MouseWheel> { + tk::ScrollByUnits %W h [expr {- (%D /120 ) * 4}] + } bind Scrollbar <4> {tk::ScrollByUnits %W v -5} bind Scrollbar <5> {tk::ScrollByUnits %W v 5} bind Scrollbar <Shift-4> {tk::ScrollByUnits %W h -5} diff --git a/library/spinbox.tcl b/library/spinbox.tcl index 641584d..6a5f829 100644 --- a/library/spinbox.tcl +++ b/library/spinbox.tcl @@ -52,7 +52,6 @@ bind Spinbox <<Copy>> { } } bind Spinbox <<Paste>> { - global tcl_platform catch { if {[tk windowingsystem] ne "x11"} { catch { @@ -74,8 +73,8 @@ bind Spinbox <<PasteSelection>> { } bind Spinbox <<TraverseIn>> { - %W selection range 0 end - %W icursor end + %W selection range 0 end + %W icursor end } # Standard Motif bindings: diff --git a/library/tearoff.tcl b/library/tearoff.tcl index 6da2a0f..b500023 100644 --- a/library/tearoff.tcl +++ b/library/tearoff.tcl @@ -150,7 +150,7 @@ proc ::tk::MenuDup {src dst type} { set tags [bindtags $src] set srcLen [string length $src] - + # Copy tags to x, replacing each substring of src with dst. while {[set index [string first $src $tags]] != -1} { diff --git a/library/text.tcl b/library/text.tcl index 279e2d9..2bf1b2b 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -85,7 +85,16 @@ bind Text <ButtonRelease-1> { } bind Text <Control-1> { %W mark set insert @%x,%y + # An operation that moves the insert mark without making it + # one end of the selection must insert an autoseparator + if {[%W cget -autoseparators]} { + %W edit separator + } } +# stop an accidental double click triggering <Double-Button-1> +bind Text <Double-Control-1> { # nothing } +# stop an accidental movement triggering <B1-Motion> +bind Text <Control-B1-Motion> { # nothing } bind Text <<PrevChar>> { tk::TextSetCursor %W insert-1displayindices } @@ -245,6 +254,11 @@ bind Text <<SelectAll>> { } bind Text <<SelectNone>> { %W tag remove sel 1.0 end + # An operation that clears the selection must insert an autoseparator, + # because the selection operation may have moved the insert mark + if {[%W cget -autoseparators]} { + %W edit separator + } } bind Text <<Cut>> { tk_textCut %W @@ -256,7 +270,15 @@ bind Text <<Paste>> { tk_textPaste %W } bind Text <<Clear>> { + # Make <<Clear>> an atomic operation on the Undo stack, + # i.e. separate it from other delete operations on either side + if {[%W cget -autoseparators]} { + %W edit separator + } catch {%W delete sel.first sel.last} + if {[%W cget -autoseparators]} { + %W edit separator + } } bind Text <<PasteSelection>> { if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)] @@ -314,7 +336,16 @@ bind Text <Control-t> { } bind Text <<Undo>> { + # An Undo operation may remove the separator at the top of the Undo stack. + # Then the item at the top of the stack gets merged with the subsequent changes. + # Place separators before and after Undo to prevent this. + if {[%W cget -autoseparators]} { + %W edit separator + } catch { %W edit undo } + if {[%W cget -autoseparators]} { + %W edit separator + } } bind Text <<Redo>> { @@ -543,7 +574,6 @@ proc ::tk::TextAnchor {w} { } proc ::tk::TextSelectTo {w x y {extend 0}} { - global tcl_platform variable ::tk::Priv set anchorname [tk::TextAnchor $w] @@ -1022,9 +1052,18 @@ proc ::tk_textCopy w { proc ::tk_textCut w { if {![catch {set data [$w get sel.first sel.last]}]} { + # make <<Cut>> an atomic operation on the Undo stack, + # i.e. separate it from other delete operations on either side + set oldSeparator [$w cget -autoseparators] + if {$oldSeparator} { + $w edit separator + } clipboard clear -displayof $w clipboard append -displayof $w $data $w delete sel.first sel.last + if {$oldSeparator} { + $w edit separator + } } } @@ -1036,7 +1075,6 @@ proc ::tk_textCut w { # w - Name of a text widget. proc ::tk_textPaste w { - global tcl_platform if {![catch {::tk::GetSelection $w CLIPBOARD} sel]} { set oldSeparator [$w cget -autoseparators] if {$oldSeparator} { diff --git a/library/tk.tcl b/library/tk.tcl index c490797..946ab7e 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -13,7 +13,7 @@ # Insist on running with compatible version of Tcl package require Tcl 8.6 # Verify that we have Tk binary and script components from the same release -package require -exact Tk 8.6.1 +package require -exact Tk 8.6.4 # Create a ::tk namespace namespace eval ::tk { @@ -24,7 +24,7 @@ namespace eval ::tk { # The msgcat package is not available. Supply our own # minimal replacement. proc mc {src args} { - tailcall format $src {*}$args + return [format $src {*}$args] } proc mcmax {args} { set max 0 @@ -253,7 +253,6 @@ proc ::tk::ScreenChanged screen { uplevel #0 [list upvar #0 ::tk::Priv.$disp ::tk::Priv] variable ::tk::Priv - global tcl_platform if {[info exists Priv]} { set Priv(screen) $screen @@ -302,7 +301,7 @@ tk::ScreenChanged [winfo screen .] proc ::tk::EventMotifBindings {n1 dummy dummy} { upvar $n1 name - + if {$name} { set op delete } else { @@ -312,7 +311,6 @@ proc ::tk::EventMotifBindings {n1 dummy dummy} { event $op <<Cut>> <Control-Key-w> <Control-Lock-Key-W> <Shift-Key-Delete> event $op <<Copy>> <Meta-Key-w> <Meta-Lock-Key-W> <Control-Key-Insert> event $op <<Paste>> <Control-Key-y> <Control-Lock-Key-Y> <Shift-Key-Insert> - event $op <<Undo>> <Control-underscore> event $op <<PrevChar>> <Control-Key-b> <Control-Lock-Key-B> event $op <<NextChar>> <Control-Key-f> <Control-Lock-Key-F> event $op <<PrevLine>> <Control-Key-p> <Control-Lock-Key-P> @@ -328,41 +326,41 @@ proc ::tk::EventMotifBindings {n1 dummy dummy} { } #---------------------------------------------------------------------- -# Define common dialogs on platforms where they are not implemented +# Define common dialogs on platforms where they are not implemented # using compiled code. #---------------------------------------------------------------------- if {![llength [info commands tk_chooseColor]]} { proc ::tk_chooseColor {args} { - tailcall ::tk::dialog::color:: {*}$args + return [::tk::dialog::color:: {*}$args] } } if {![llength [info commands tk_getOpenFile]]} { proc ::tk_getOpenFile {args} { if {$::tk_strictMotif} { - tailcall ::tk::MotifFDialog open {*}$args + return [::tk::MotifFDialog open {*}$args] } else { - tailcall ::tk::dialog::file:: open {*}$args + return [::tk::dialog::file:: open {*}$args] } } } if {![llength [info commands tk_getSaveFile]]} { proc ::tk_getSaveFile {args} { if {$::tk_strictMotif} { - tailcall ::tk::MotifFDialog save {*}$args + return [::tk::MotifFDialog save {*}$args] } else { - tailcall ::tk::dialog::file:: save {*}$args + return [::tk::dialog::file:: save {*}$args] } } } if {![llength [info commands tk_messageBox]]} { proc ::tk_messageBox {args} { - tailcall ::tk::MessageBox {*}$args + return [::tk::MessageBox {*}$args] } } if {![llength [info command tk_chooseDirectory]]} { proc ::tk_chooseDirectory {args} { - tailcall ::tk::dialog::file::chooseDir:: {*}$args + return [::tk::dialog::file::chooseDir:: {*}$args] } } @@ -543,7 +541,7 @@ proc ::tk::CancelRepeat {} { # ::tk::TabToWindow -- # This procedure moves the focus to the given widget. -# It sends a <<TraverseOut>> virtual event to the previous focus window, +# It sends a <<TraverseOut>> virtual event to the previous focus window, # if any, before changing the focus, and a <<TraverseIn>> event # to the new focus window afterwards. # @@ -571,7 +569,7 @@ proc ::tk::UnderlineAmpersand {text} { return [list [string map {\ufeff {}} $s] $idx] } -# ::tk::SetAmpText -- +# ::tk::SetAmpText -- # Given widget path and text with "magic ampersands", sets -text and # -underline options for the widget # diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl index 6604575..a52465a 100644 --- a/library/tkfbox.tcl +++ b/library/tkfbox.tcl @@ -1169,6 +1169,10 @@ proc ::tk::dialog::file::GlobFiltered {dir type {overrideFilter 0}} { if {$f eq "." || $f eq ".."} { continue } + # See ticket [1641721], $f might be a link pointing to a dir + if {$type != "d" && [file isdir [file join $dir $f]]} { + continue + } lappend result $f } } @@ -1176,7 +1180,6 @@ proc ::tk::dialog::file::GlobFiltered {dir type {overrideFilter 0}} { } proc ::tk::dialog::file::CompleteEnt {w} { - variable showHiddenVar upvar ::tk::dialog::file::[winfo name $w] data set f [$data(ent) get] if {$data(-multiple)} { diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl index be2299f..b3ebcbd 100644 --- a/library/ttk/entry.tcl +++ b/library/ttk/entry.tcl @@ -14,7 +14,7 @@ namespace eval ttk { variable State set State(x) 0 - set State(selectMode) char + set State(selectMode) none set State(anchor) 0 set State(scanX) 0 set State(scanIndex) 0 @@ -74,9 +74,9 @@ bind TEntry <Double-ButtonPress-1> { ttk::entry::Select %W %x word } bind TEntry <Triple-ButtonPress-1> { ttk::entry::Select %W %x line } bind TEntry <B1-Motion> { ttk::entry::Drag %W %x } -bind TEntry <B1-Leave> { ttk::Repeatedly ttk::entry::AutoScroll %W } -bind TEntry <B1-Enter> { ttk::CancelRepeat } -bind TEntry <ButtonRelease-1> { ttk::CancelRepeat } +bind TEntry <B1-Leave> { ttk::entry::DragOut %W %m } +bind TEntry <B1-Enter> { ttk::entry::DragIn %W } +bind TEntry <ButtonRelease-1> { ttk::entry::Release %W } bind TEntry <<ToggleSelection>> { %W instate {!readonly !disabled} { %W icursor @%x ; focus %W } @@ -400,14 +400,40 @@ proc ttk::entry::DragTo {w x} { char { CharSelect $w $State(anchor) $cur } word { WordSelect $w $State(anchor) $cur } line { LineSelect $w $State(anchor) $cur } + none { # no-op } } } +## <B1-Leave> binding: +# Begin autoscroll. +# +proc ttk::entry::DragOut {w mode} { + variable State + if {$State(selectMode) ne "none" && $mode eq "NotifyNormal"} { + ttk::Repeatedly ttk::entry::AutoScroll $w + } +} + +## <B1-Enter> binding +# Suspend autoscroll. +# +proc ttk::entry::DragIn {w} { + ttk::CancelRepeat +} + +## <ButtonRelease-1> binding +# +proc ttk::entry::Release {w} { + variable State + set State(selectMode) none + ttk::CancelRepeat ;# suspend autoscroll +} + ## 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 is, and extend the selection -# according to the current selection mode. +# 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. # TODO: Need a way for Repeat scripts to cancel themselves. diff --git a/library/unsupported.tcl b/library/unsupported.tcl index 2c68e78..b5f404a 100644 --- a/library/unsupported.tcl +++ b/library/unsupported.tcl @@ -16,7 +16,7 @@ namespace eval ::tk::unsupported { # Map from the old global names of Tk private commands to their # new namespace-encapsulated names. - variable PrivateCommands + variable PrivateCommands array set PrivateCommands { tkButtonAutoInvoke ::tk::ButtonAutoInvoke tkButtonDown ::tk::ButtonDown diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl index 0578361..aa66f7f 100644 --- a/library/xmfbox.tcl +++ b/library/xmfbox.tcl @@ -27,7 +27,7 @@ namespace eval ::tk::dialog::file {} # When -multiple is set to 0, this returns the absolute pathname # of the selected file. (NOTE: This is not the same as a single # element list.) -# +# # When -multiple is set to > 0, this returns a Tcl list of absolute # pathnames. The argument for -multiple is ignored, but for consistency # with Windows it defines the maximum amount of memory to allocate for @@ -505,7 +505,7 @@ proc ::tk::MotifFDialog_InterpFilter {w} { if {[file pathtype $text] eq "relative"} { set relative 1 } elseif {$badTilde} { - set relative 1 + set relative 1 } if {$relative} { @@ -552,7 +552,7 @@ proc ::tk::MotifFDialog_Update {w} { $data(sEnt) delete 0 end $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \ $data(selectFile)] - + MotifFDialog_LoadFiles $w } @@ -626,7 +626,7 @@ proc ::tk::MotifFDialog_LoadFiles {w} { # w The pathname of the dialog box. # # Results: -# None. +# None. proc ::tk::MotifFDialog_BrowseDList {w} { upvar ::tk::dialog::file::[winfo name $w] data @@ -672,7 +672,7 @@ proc ::tk::MotifFDialog_BrowseDList {w} { # w The pathname of the dialog box. # # Results: -# None. +# None. proc ::tk::MotifFDialog_ActivateDList {w} { upvar ::tk::dialog::file::[winfo name $w] data @@ -720,7 +720,7 @@ proc ::tk::MotifFDialog_ActivateDList {w} { # w The pathname of the dialog box. # # Results: -# None. +# None. proc ::tk::MotifFDialog_BrowseFList {w} { upvar ::tk::dialog::file::[winfo name $w] data @@ -740,9 +740,9 @@ proc ::tk::MotifFDialog_BrowseFList {w} { $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \ $data(filter)] $data(fEnt) xview end - - # if it's a multiple selection box, just put in the filenames - # otherwise put in the full path as usual + + # if it's a multiple selection box, just put in the filenames + # otherwise put in the full path as usual $data(sEnt) delete 0 end if {$data(-multiple) != 0} { $data(sEnt) insert 0 $data(selectFile) @@ -762,7 +762,7 @@ proc ::tk::MotifFDialog_BrowseFList {w} { # w The pathname of the dialog box. # # Results: -# None. +# None. proc ::tk::MotifFDialog_ActivateFList {w} { upvar ::tk::dialog::file::[winfo name $w] data @@ -788,7 +788,7 @@ proc ::tk::MotifFDialog_ActivateFList {w} { # w The pathname of the dialog box. # # Results: -# None. +# None. proc ::tk::MotifFDialog_ActivateFEnt {w} { upvar ::tk::dialog::file::[winfo name $w] data @@ -803,7 +803,7 @@ proc ::tk::MotifFDialog_ActivateFEnt {w} { # ::tk::MotifFDialog_ActivateSEnt -- # # This procedure is called when the user presses Return inside -# the "selection" entry. It sets the ::tk::Priv(selectFilePath) +# the "selection" entry. It sets the ::tk::Priv(selectFilePath) # variable so that the vwait loop in tk::MotifFDialog will be # terminated. # @@ -811,7 +811,7 @@ proc ::tk::MotifFDialog_ActivateFEnt {w} { # w The pathname of the dialog box. # # Results: -# None. +# None. proc ::tk::MotifFDialog_ActivateSEnt {w} { variable ::tk::Priv @@ -930,7 +930,7 @@ proc ::tk::ListBoxKeyAccel_Unset {w} { # key The key which the user just pressed. # # Results: -# None. +# None. proc ::tk::ListBoxKeyAccel_Key {w key} { variable ::tk::Priv diff --git a/macosx/GNUmakefile b/macosx/GNUmakefile index 333961c..02240ed 100644 --- a/macosx/GNUmakefile +++ b/macosx/GNUmakefile @@ -134,7 +134,7 @@ endif INSTALL_TARGETS = install-binaries install-libraries ifeq (${EMBEDDED_BUILD},) -INSTALL_TARGETS += install-private-headers install-demos +INSTALL_TARGETS += install-private-headers install-headers install-demos endif ifeq (${INSTALL_BUILD}_${EMBEDDED_BUILD}_${BUILD_STYLE},1__Deployment) INSTALL_TARGETS += html-tk diff --git a/macosx/README b/macosx/README index 69be037..202dbbd 100644 --- a/macosx/README +++ b/macosx/README @@ -388,3 +388,64 @@ make overrides to the tk/macosx GNUmakefile, e.g. sudo make -C tk${ver}/macosx install \ TCL_FRAMEWORK_DIR=$HOME/Library/Frameworks TCLSH_DIR=$HOME/usr/bin The Makefile variables TCL_FRAMEWORK_DIR and TCLSH_DIR were added with Tk 8.4.3. + +4. About the event loop in Tk for Mac OSX +----------------------------------------- + +The main program in a typical OSX application looks like this (see *) + + void NSApplicationMain(int argc, char *argv[]) { + [NSApplication sharedApplication]; + [NSBundle loadNibNamed:@"myMain" owner:NSApp]; + [NSApp run]; + } + +The run method implements the event loop for the application. There +are three key steps in the run method. First it calls +[NSApp finishLaunching], which creates the bouncing application icon +and does other mysterious things. Second it creates an +NSAutoreleasePool. Third, it starts an event loop which drains the +NSAutoreleasePool every time the queue is empty, and replaces the +drained pool with a new one. This third step is essential to +preventing memory leaks, since the internal methods of Appkit objects +all assume that an autorelease pool is in scope and will be drained +when the event processing cycle ends. + +Mac OSX Tk does not call the [NSApp run] method at all. Instead it +uses the event loop built in to Tk. So we must take care to replicate +the important features of the method ourselves. Here is how this +works in outline. + +We add a private NSAUtoreleasePool* property to our subclass of +NSApplication. (The subclass is called TKApplication but can be +referenced with the global variable NSApp). The TkpInit +function calls [NSApp _setup] which initializes this property by +creating an NSAutoreleasePool. A bit later on, TkpInit calls +[NSAPP _setupEventLoop] which in turn calls the +[NSApp finishLaunching] method. + +Each time that Tcl processes an event in its queue, it calls a +platform specific function which, in the case of Mac OSX, is named +TkMacOSXEventsCheckProc. In the unix implementations of Tk, including +the Mac OSX version, this function collects events from an "event +source", and transfers them to the Tcl event queue. In Mac OSX the +event source is the NSApplication event queue. Each NSEvent is +converted to a Tcl event which is added to the Tcl event queue. The +NSEvent is also passed to [NSApp sendevent], which sends the event on +to the application's NSWindows, which send it to their NSViews, etc. +Since the CheckProc function gets called for every Tk event, it is an +appropriate place to drain the main NSAutoreleasePool and replace it +with a new pool. This is done by calling the method +[NSApp _resetAutoreleasePool], where _resetAutoreleasePool is a method +which we define for the subclass TKApplication. + +One minor caveat is that there are several steps of the Tk +initialization which precede the call to TkpInit. Notably, the font +package is initialized first. Since there is no NSAUtoreleasePool in +scope prior to calling TkpInit, the functions called in these +preliminary stages need to create and drain their own +NSAutoreleasePools whenever they call methods of Appkit objects +(e.g. NSFont). + +* https://developer.apple.com/library/mac/documentation/Cocoa/\ +Reference/ApplicationKit/Classes/NSApplication_Class diff --git a/macosx/Tk-Info.plist.in b/macosx/Tk-Info.plist.in index 50b9d24..7b0c305 100644 --- a/macosx/Tk-Info.plist.in +++ b/macosx/Tk-Info.plist.in @@ -17,6 +17,10 @@ <string>Tk @TK_WINDOWINGSYSTEM@ @TK_VERSION@@TK_PATCH_LEVEL@, Copyright © 1989-@TK_YEAR@ Tcl Core Team, Copyright © 2002-@TK_YEAR@ Daniel A. Steffen, + Copyright © 1989-@TK_YEAR@ Contributors, + Copyright © 2011-@TK_YEAR@ Kevin Walzer/WordTech + Communications LLC, + Copyright © 2014-@TK_YEAR@ Marc Culler, Copyright © 2001-2009 Apple Inc., Copyright © 2001-2002 Jim Ingham & Ian Reid</string> <key>CFBundleIdentifier</key> diff --git a/macosx/Wish-Info.plist.in b/macosx/Wish-Info.plist.in index 90e00a4..db75cf2 100644 --- a/macosx/Wish-Info.plist.in +++ b/macosx/Wish-Info.plist.in @@ -40,10 +40,14 @@ <string>Wish</string> <key>CFBundleGetInfoString</key> <string>Wish Shell @TK_VERSION@@TK_PATCH_LEVEL@, -Copyright © 1989-@TK_YEAR@ Tcl Core Team, -Copyright © 2002-@TK_YEAR@ Daniel A. Steffen, -Copyright © 2001-2009 Apple Inc., -Copyright © 2001-2002 Jim Ingham & Ian Reid</string> + Copyright © 1989-@TK_YEAR@ Tcl Core Team, + Copyright © 1989-@TK_YEAR@ Contributors, + Copyright © 2011-@TK_YEAR@ Kevin Walzer/WordTech + Communications LLC, + Copyright © 2014-@TK_YEAR@ Marc Culler, + Copyright © 2002-@TK_YEAR@ Daniel A. Steffen, + Copyright © 2001-2009 Apple Inc., + Copyright © 2001-2002 Jim Ingham & Ian Reid</string> <key>CFBundleIconFile</key> <string>Wish.icns</string> <key>CFBundleIdentifier</key> @@ -72,5 +76,7 @@ Copyright © 2001-2002 Jim Ingham & Ian Reid</string> <true/> <key>OSAScriptingDefinition</key> <string>Wish.sdef</string> + <key>NSHighResolutionCapable</key> + <string>True</string> </dict> </plist> diff --git a/macosx/tkMacOSXButton.c b/macosx/tkMacOSXButton.c index 036624d..59d394e 100644 --- a/macosx/tkMacOSXButton.c +++ b/macosx/tkMacOSXButton.c @@ -5,11 +5,15 @@ * button widgets. * * Copyright (c) 1996-1997 by Sun Microsystems, Inc. - * Copyright 2001-2009, Apple Inc. - * Copyright (c) 2006-2009 Daniel A. Steffen <das@users.sourceforge.net> + * Copyright 2001, Apple Computer, Inc. + * Copyright (c) 2006-2007 Daniel A. Steffen <das@users.sourceforge.net> + * Copyright 2007 Revar Desmera. + * Copyright 2015 Kevin Walzer/WordTech Communications LLC. + * Copyright 2015 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" @@ -17,60 +21,82 @@ #include "tkMacOSXFont.h" #include "tkMacOSXDebug.h" + +#define FIRST_DRAW 2 +#define ACTIVE 4 + + /* -#ifdef TK_MAC_DEBUG -#define TK_MAC_DEBUG_BUTTON -#endif -*/ - -typedef struct MacButton { - TkButton info; - NSButton *button; - NSImage *image, *selectImage, *tristateImage; -#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS - int fix; -#endif -} MacButton; + * Default insets for controls + */ + +#define DEF_INSET_LEFT 12 +#define DEF_INSET_RIGHT 12 +#define DEF_INSET_TOP 1 +#define DEF_INSET_BOTTOM 1 -#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS +/* + * Some defines used to control what type of control is drawn. + */ -int tkMacOSXUseCompatibilityMetrics = 1; +#define DRAW_LABEL 0 /* Labels are treated genericly. */ +#define DRAW_CONTROL 1 /* Draw using the Native control. */ +#define DRAW_CUSTOM 2 /* Make our own button drawing. */ +#define DRAW_BEVEL 3 /* - * Use the following heuristic conversion constants to make NSButton-based - * widget metrics match up with the old Carbon control buttons (for the - * default Lucida Grande 13 font). + * The delay in milliseconds between pulsing default button redraws. + */ +#define PULSE_TIMER_MSECS 62 /* Largest value that didn't look stuttery */ + +/* + * Declaration of Mac specific button structure. */ -#define NATIVE_BUTTON_INSET 2 -#define NATIVE_BUTTON_EXTRA_H 2 typedef struct { - int trimW, trimH, inset, shrinkH, offsetX, offsetY; -} BoundsFix; - -#define fixForTypeStyle(type, style) ( \ - type == NSSwitchButton ? 0 : \ - type == NSRadioButton ? 1 : \ - style == NSRoundedBezelStyle ? 2 : \ - style == NSRegularSquareBezelStyle ? 3 : \ - style == NSShadowlessSquareBezelStyle ? 4 : \ - INT_MIN) - -static const BoundsFix boundsFixes[] = { - [fixForTypeStyle(NSSwitchButton,0)] = { 2, 2, -1, 0, 2, 1 }, - [fixForTypeStyle(NSRadioButton,0)] = { 0, 2, -1, 0, 1, 1 }, - [fixForTypeStyle(0,NSRoundedBezelStyle)] = { 28, 16, -6, 0, 0, 3 }, - [fixForTypeStyle(0,NSRegularSquareBezelStyle)] = { 28, 15, -2, -1 }, - [fixForTypeStyle(0,NSShadowlessSquareBezelStyle)] = { 2, 2 }, -}; + int drawType; + Tk_3DBorder border; + int relief; + int offset; /* 0 means this is a normal widget. 1 means + * it is an image button, so we offset the + * image to make the button appear to move + * up and down as the relief changes. */ + GC gc; + int hasImageOrBitmap; +} DrawParams; -#endif +typedef struct { + TkButton info; /* Generic button info */ + int id; + int usingControl; + int useTkText; + int flags; /* Initialisation status */ + ThemeButtonKind btnkind; + HIThemeButtonDrawInfo drawinfo; + HIThemeButtonDrawInfo lastdrawinfo; + DrawParams drawParams; + Tcl_TimerToken defaultPulseHandler; +} MacButton; + +/* + * Forward declarations for procedures defined later in this file: + */ + + +static void ButtonBackgroundDrawCB (const HIRect *btnbounds, MacButton *ptr, + SInt16 depth, Boolean isColorDev); +static void ButtonContentDrawCB (const HIRect *bounds, ThemeButtonKind kind, + const HIThemeButtonDrawInfo *info, MacButton *ptr, SInt16 depth, + Boolean isColorDev); +static void ButtonEventProc(ClientData clientData, XEvent *eventPtr); +static void TkMacOSXComputeButtonParams (TkButton * butPtr, ThemeButtonKind* btnkind, + HIThemeButtonDrawInfo* drawinfo); +static int TkMacOSXComputeButtonDrawParams (TkButton * butPtr, DrawParams * dpPtr); +static void TkMacOSXDrawButton (MacButton *butPtr, GC gc, Pixmap pixmap); +static void DrawButtonImageAndText(TkButton* butPtr); +static void PulseDefaultButtonProc(ClientData clientData); -static void DisplayNativeButton(TkButton *butPtr); -static void ComputeNativeButtonGeometry(TkButton *butPtr); -static void DisplayUnixButton(TkButton *butPtr); -static void ComputeUnixButtonGeometry(TkButton *butPtr); /* * The class procedure table for the button widgets. @@ -79,67 +105,67 @@ static void ComputeUnixButtonGeometry(TkButton *butPtr); const Tk_ClassProcs tkpButtonProcs = { sizeof(Tk_ClassProcs), /* size */ TkButtonWorldChanged, /* worldChangedProc */ - NULL, /* createProc */ - NULL /* modalProc */ }; - +static int bCount; + /* *---------------------------------------------------------------------- * - * TkpCreateButton -- + * TkpButtonSetDefaults -- * - * Allocate a new TkButton structure. + * This procedure is invoked before option tables are created for + * buttons. It modifies some of the default values to match the current + * values defined for this platform. * * Results: - * Returns a newly allocated TkButton structure. + * Some of the default values in *specPtr are modified. * * Side effects: - * Registers an event handler for the widget. + * Updates some of. * *---------------------------------------------------------------------- */ -TkButton * -TkpCreateButton( - Tk_Window tkwin) +void +TkpButtonSetDefaults() { - MacButton *macButtonPtr = ckalloc(sizeof(MacButton)); - - macButtonPtr->button = nil; - macButtonPtr->image = nil; - macButtonPtr->selectImage = nil; - macButtonPtr->tristateImage = nil; - - return (TkButton *) macButtonPtr; +/*No-op.*/ } + /* *---------------------------------------------------------------------- * - * TkpDestroyButton -- + * TkpCreateButton -- * - * Free data structures associated with the button control. + * Allocate a new TkButton structure. * * Results: - * None. + * Returns a newly allocated TkButton structure. * * Side effects: - * Restores the default control state. + * Registers an event handler for the widget. * *---------------------------------------------------------------------- */ -void -TkpDestroyButton( - TkButton *butPtr) +TkButton * +TkpCreateButton( + Tk_Window tkwin) { - MacButton *macButtonPtr = (MacButton *) butPtr; - - TkMacOSXMakeCollectableAndRelease(macButtonPtr->button); - TkMacOSXMakeCollectableAndRelease(macButtonPtr->selectImage); - TkMacOSXMakeCollectableAndRelease(macButtonPtr->selectImage); - TkMacOSXMakeCollectableAndRelease(macButtonPtr->tristateImage); + MacButton *macButtonPtr = (MacButton *) ckalloc(sizeof(MacButton)); + + Tk_CreateEventHandler(tkwin, ActivateMask, + ButtonEventProc, (ClientData) macButtonPtr); + macButtonPtr->id = bCount++; + macButtonPtr->flags = FIRST_DRAW; + macButtonPtr->btnkind = kThemePushButton; + macButtonPtr->defaultPulseHandler = NULL; + bzero(&macButtonPtr->drawinfo, sizeof(macButtonPtr->drawinfo)); + bzero(&macButtonPtr->lastdrawinfo, sizeof(macButtonPtr->lastdrawinfo)); + + return (TkButton *)macButtonPtr; } /* @@ -164,22 +190,61 @@ void TkpDisplayButton( ClientData clientData) /* Information about widget. */ { + MacButton *macButtonPtr = (MacButton *) clientData; TkButton *butPtr = (TkButton *) clientData; + Tk_Window tkwin = butPtr->tkwin; + Pixmap pixmap; + DrawParams* dpPtr = &macButtonPtr->drawParams; + int needhighlight = 0; butPtr->flags &= ~REDRAW_PENDING; - if (!butPtr->tkwin || !Tk_IsMapped(butPtr->tkwin)) { + if ((butPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) { return; } + pixmap = (Pixmap) Tk_WindowId(tkwin); + TkMacOSXSetUpClippingRgn(Tk_WindowId(tkwin)); - switch (butPtr->type) { - case TYPE_LABEL: - DisplayUnixButton(butPtr); - break; - case TYPE_BUTTON: - case TYPE_CHECK_BUTTON: - case TYPE_RADIO_BUTTON: - DisplayNativeButton(butPtr); - break; + if (TkMacOSXComputeButtonDrawParams(butPtr, dpPtr) ) { + macButtonPtr->useTkText = 0; + } else { + macButtonPtr->useTkText = 1; + } + + + /* + * Set up clipping region. Make sure the we are using the port + * for this button, or we will set the wrong window's clip. + */ + + if (macButtonPtr->useTkText) { + if (butPtr->type == TYPE_BUTTON) { + Tk_Fill3DRectangle(tkwin, pixmap, butPtr->highlightBorder, 0, 0, + Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT); + } else { + Tk_Fill3DRectangle(tkwin, pixmap, butPtr->normalBorder, 0, 0, + Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT); + } + + /* Display image or bitmap or text for labels or custom controls. */ + DrawButtonImageAndText(butPtr); + needhighlight = 1; + } else { + /* Draw the native portion of the buttons. */ + TkMacOSXDrawButton(macButtonPtr, dpPtr->gc, pixmap); + + /* Draw highlight border, if needed. */ + if (butPtr->highlightWidth < 3) { + needhighlight = 1; + } + } + + /* Draw highlight border, if needed. */ + if (needhighlight) { + if ((butPtr->flags & GOT_FOCUS)) { + Tk_Draw3DRectangle(tkwin, pixmap, butPtr->normalBorder, 0, 0, + Tk_Width(tkwin), Tk_Height(tkwin), + butPtr->highlightWidth, TK_RELIEF_SOLID); + } } } @@ -203,977 +268,946 @@ TkpDisplayButton( void TkpComputeButtonGeometry( - register TkButton *butPtr) /* Button whose geometry may have changed. */ + TkButton *butPtr) /* Button whose geometry may have changed. */ { - MacButton *macButtonPtr = (MacButton *) butPtr; + int width = 0, height = 0, charWidth = 1, haveImage = 0, haveText = 0; + int txtWidth = 0, txtHeight = 0; + MacButton *mbPtr = (MacButton*)butPtr; + Tk_FontMetrics fm; + DrawParams drawParams; - switch (butPtr->type) { - case TYPE_LABEL: - if (macButtonPtr->button && [macButtonPtr->button superview]) { - [macButtonPtr->button removeFromSuperviewWithoutNeedingDisplay]; - } - ComputeUnixButtonGeometry(butPtr); - break; - case TYPE_BUTTON: - case TYPE_CHECK_BUTTON: - case TYPE_RADIO_BUTTON: - if (!macButtonPtr->button) { - NSButton *button = [[NSButton alloc] initWithFrame:NSZeroRect]; - macButtonPtr->button = TkMacOSXMakeUncollectable(button); - } - ComputeNativeButtonGeometry(butPtr); + /* + * First figure out the size of the contents of the button. + */ + + TkMacOSXComputeButtonParams(butPtr, &mbPtr->btnkind, &mbPtr->drawinfo); + + /* + * If the indicator is on, get its size. + */ + + if ( butPtr->indicatorOn ) { + switch (butPtr->type) { + case TYPE_RADIO_BUTTON: + GetThemeMetric(kThemeMetricRadioButtonWidth, &butPtr->indicatorDiameter); + break; + case TYPE_CHECK_BUTTON: + GetThemeMetric(kThemeMetricCheckBoxWidth, &butPtr->indicatorDiameter); + break; + default: break; + } + /* Allow 2px extra space next to the indicator. */ + butPtr->indicatorSpace = butPtr->indicatorDiameter + 2; + } else { + butPtr->indicatorSpace = 0; + butPtr->indicatorDiameter = 0; } -} - -/* - *---------------------------------------------------------------------- - * - * TkpButtonSetDefaults -- - * - * This procedure is invoked before option tables are created for - * buttons. It modifies some of the default values to match the current - * values defined for this platform. - * - * Results: - * Some of the default values in *specPtr are modified. - * - * Side effects: - * Updates some of. - * - *---------------------------------------------------------------------- - */ -void -TkpButtonSetDefaults() -{ -#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS - if (!tkMacOSXUseCompatibilityMetrics) { - strcpy(tkDefButtonHighlightWidth, DEF_BUTTON_HIGHLIGHT_WIDTH_NOCM); - strcpy(tkDefLabelHighlightWidth, DEF_BUTTON_HIGHLIGHT_WIDTH_NOCM); - strcpy(tkDefButtonPadx, DEF_BUTTON_PADX_NOCM); - strcpy(tkDefLabelPadx, DEF_BUTTON_PADX_NOCM); - strcpy(tkDefButtonPady, DEF_BUTTON_PADY_NOCM); - strcpy(tkDefLabelPady, DEF_BUTTON_PADY_NOCM); + if (butPtr->image != NULL) { + Tk_SizeOfImage(butPtr->image, &width, &height); + haveImage = 1; + } else if (butPtr->bitmap != None) { + Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height); + haveImage = 1; } -#endif -} -#pragma mark - -#pragma mark Native Buttons: + if (haveImage == 0 || butPtr->compound != COMPOUND_NONE) { + Tk_FreeTextLayout(butPtr->textLayout); + butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont, + Tcl_GetString(butPtr->textPtr), -1, butPtr->wrapLength, + butPtr->justify, 0, &butPtr->textWidth, &butPtr->textHeight); - -/* - *---------------------------------------------------------------------- - * - * DisplayNativeButton -- - * - * This procedure is invoked to display a button widget. It is - * normally invoked as an idle handler. - * - * Results: - * None. - * - * Side effects: - * Commands are output to X to display the button in its - * current mode. The REDRAW_PENDING flag is cleared. - * - *---------------------------------------------------------------------- - */ + txtWidth = butPtr->textWidth + DEF_INSET_LEFT + DEF_INSET_RIGHT; + txtHeight = butPtr->textHeight + DEF_INSET_BOTTOM + DEF_INSET_TOP; + charWidth = Tk_TextWidth(butPtr->tkfont, "0", 1); + Tk_GetFontMetrics(butPtr->tkfont, &fm); + haveText = (txtWidth != 0 && txtHeight != 0); + } -static void -DisplayNativeButton( - TkButton *butPtr) -{ - MacButton *macButtonPtr = (MacButton *) butPtr; - NSButton *button = macButtonPtr->button; - Tk_Window tkwin = butPtr->tkwin; - TkWindow *winPtr = (TkWindow *) tkwin; - MacDrawable *macWin = (MacDrawable *) winPtr->window; - TkMacOSXDrawingContext dc; - NSView *view = TkMacOSXDrawableView(macWin); - CGFloat viewHeight = [view bounds].size.height; - CGAffineTransform t = { .a = 1, .b = 0, .c = 0, .d = -1, .tx = 0, - .ty = viewHeight}; - NSRect frame; - int enabled; - NSCellStateValue state; - - if (!view || - !TkMacOSXSetupDrawingContext((Drawable) macWin, NULL, 1, &dc)) { - return; + if (haveImage && haveText) { /* Image and Text */ + switch ((enum compound) butPtr->compound) { + case COMPOUND_TOP: + case COMPOUND_BOTTOM: + /* + * Image is above or below text. + */ + + height += txtHeight + butPtr->padY; + width = (width > txtWidth ? width : txtWidth); + break; + case COMPOUND_LEFT: + case COMPOUND_RIGHT: + /* + * Image is left or right of text. + */ + + width += txtWidth + butPtr->padX; + height = (height > txtHeight ? height : txtHeight); + break; + case COMPOUND_CENTER: + /* + * Image and text are superimposed. + */ + + width = (width > txtWidth ? width : txtWidth); + height = (height > txtHeight ? height : txtHeight); + break; + default: + break; + } + width += butPtr->indicatorSpace; + + } else if (haveImage) { /* Image only */ + width = butPtr->width > 0 ? butPtr->width : width + butPtr->indicatorSpace; + height = butPtr->height > 0 ? butPtr->height : height; + + } else { /* Text only */ + width = txtWidth + butPtr->indicatorSpace; + height = txtHeight; + if (butPtr->width > 0) { + width = butPtr->width * charWidth; + } + if (butPtr->height > 0) { + height = butPtr->height * fm.linespace; + } } - CGContextConcatCTM(dc.context, t); + + /* Add padding */ + width += 2 * butPtr->padX; + height += 2 * butPtr->padY; /* - * We cannot change the background color of the button itself, only the - * color of the background of its container. - * This will be the color that peeks around the rounded corners of the - * button. We make this the highlightbackground rather than the background, - * because if you color the background of a frame containing a - * button, you usually also color the highlightbackground as well, - * or you will get a thin grey ring around the button. + * Now figure out the size of the border decorations for the button. */ - Tk_Fill3DRectangle(tkwin, (Pixmap) macWin, butPtr->type == TYPE_BUTTON ? - butPtr->highlightBorder : butPtr->normalBorder, 0, 0, - Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT); - if ([button superview] != view) { - [view addSubview:button]; - } - if (macButtonPtr->tristateImage) { - NSImage *selectImage = macButtonPtr->selectImage ? - macButtonPtr->selectImage : macButtonPtr->image; - [button setImage:(butPtr->flags & TRISTATED ? - selectImage : macButtonPtr->image)]; - [button setAlternateImage:(butPtr->flags & TRISTATED ? - macButtonPtr->tristateImage : selectImage)]; - } - if (butPtr->flags & SELECTED) { - state = NSOnState; - } else if (butPtr->flags & TRISTATED) { - state = NSMixedState; - } else { - state = NSOffState; - } - [button setState:state]; - enabled = !(butPtr->state == STATE_DISABLED); - [button setEnabled:enabled]; - if (enabled) { - //[button highlight:(butPtr->state == STATE_ACTIVE)]; - //[cell setHighlighted:(butPtr->state == STATE_ACTIVE)]; + if (butPtr->highlightWidth < 0) { + butPtr->highlightWidth = 0; } - if (butPtr->type == TYPE_BUTTON && butPtr->defaultState == STATE_ACTIVE) { - //[[view window] setDefaultButtonCell:cell]; - [button setKeyEquivalent:@"\r"]; + + butPtr->inset = 0; + butPtr->inset += butPtr->highlightWidth; + + if (TkMacOSXComputeButtonDrawParams(butPtr,&drawParams)) { + HIRect tmpRect; + HIRect contBounds; + int paddingx = 0; + int paddingy = 0; + + tmpRect = CGRectMake(0, 0, width, height); + + HIThemeGetButtonContentBounds(&tmpRect, &mbPtr->drawinfo, &contBounds); + /* If the content region has a minimum height, match it. */ + if (height < contBounds.size.height) { + height = contBounds.size.height; + } + + /* If the content region has a minimum width, match it. */ + if (width < contBounds.size.width) { + width = contBounds.size.width; + } + + /* Pad to fill difference between content bounds and button bounds. */ + paddingx = contBounds.origin.x; + paddingy = contBounds.origin.y; + + if (height < paddingx - 4) { + /* can't have buttons much shorter than button side diameter. */ + height = paddingx - 4; + } + } else { - [button setKeyEquivalent:@""]; - } - frame = NSMakeRect(macWin->xOff, macWin->yOff, Tk_Width(tkwin), - Tk_Height(tkwin)); -#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS - if (tkMacOSXUseCompatibilityMetrics) { - BoundsFix boundsFix = boundsFixes[macButtonPtr->fix]; - frame = NSOffsetRect(frame, boundsFix.offsetX, boundsFix.offsetY); - frame.size.height -= boundsFix.shrinkH + NATIVE_BUTTON_EXTRA_H; - frame = NSInsetRect(frame, boundsFix.inset + NATIVE_BUTTON_INSET, - boundsFix.inset + NATIVE_BUTTON_INSET); + height += butPtr->borderWidth*2; + width += butPtr->borderWidth*2; } -#endif - frame.origin.y = viewHeight - (frame.origin.y + frame.size.height); - if (!NSEqualRects(frame, [button frame])) { - [button setFrame:frame]; - } - [button displayRectIgnoringOpacity:[button bounds]]; - TkMacOSXRestoreDrawingContext(&dc); -#ifdef TK_MAC_DEBUG_BUTTON - TKLog(@"button %s frame %@ width %d height %d", - ((TkWindow *)butPtr->tkwin)->pathName, NSStringFromRect(frame), - Tk_Width(tkwin), Tk_Height(tkwin)); -#endif + + width += butPtr->inset*2; + height += butPtr->inset*2; + + Tk_GeometryRequest(butPtr->tkwin, width, height); + Tk_SetInternalBorder(butPtr->tkwin, butPtr->inset); } - + /* *---------------------------------------------------------------------- * - * ComputeNativeButtonGeometry -- + * DrawButtonImageAndText -- * - * After changes in a button's text or bitmap, this procedure - * recomputes the button's geometry and passes this information - * along to the geometry manager for the window. + * Draws the image and text associated with a button or label. * * Results: - * None. + * None. * * Side effects: - * The button's window may change size. + * The image and text are drawn. * *---------------------------------------------------------------------- */ - static void -ComputeNativeButtonGeometry( - TkButton *butPtr) /* Button whose geometry may have changed. */ +DrawButtonImageAndText( + TkButton* butPtr) { - MacButton *macButtonPtr = (MacButton *) butPtr; - NSButton *button = macButtonPtr->button; - NSButtonCell *cell = [button cell]; - NSButtonType type = -1; - NSBezelStyle style = 0; - NSInteger highlightsBy = 0, showsStateBy = 0; - NSFont *font; - NSRect bounds = NSZeroRect, titleRect = NSZeroRect; - int haveImage = (butPtr->image || butPtr->bitmap != None), haveText = 0; - int haveCompound = (butPtr->compound != COMPOUND_NONE); - int width, height, border = 0; - - butPtr->indicatorSpace = 0; - butPtr->inset = 0; - if (butPtr->highlightWidth < 0) { - butPtr->highlightWidth = 0; - } - switch (butPtr->type) { - case TYPE_BUTTON: - type = NSMomentaryPushInButton; - if (!haveImage) { - style = NSRoundedBezelStyle; - butPtr->inset = butPtr->defaultState != STATE_DISABLED ? - butPtr->highlightWidth : 0; - [button setImage:nil]; - [button setImagePosition:NSNoImage]; - } else { - style = NSShadowlessSquareBezelStyle; - highlightsBy = butPtr->selectImage || butPtr->bitmap ? - NSContentsCellMask : 0; - border = butPtr->borderWidth; - } - break; - case TYPE_RADIO_BUTTON: - case TYPE_CHECK_BUTTON: - if (!haveImage /*|| butPtr->indicatorOn*/) { // TODO: indicatorOn - type = butPtr->type == TYPE_RADIO_BUTTON ? - NSRadioButton : NSSwitchButton; - butPtr->inset = /*butPtr->indicatorOn ? 0 :*/ butPtr->borderWidth; - } else { - type = NSPushOnPushOffButton; - style = NSShadowlessSquareBezelStyle; - highlightsBy = butPtr->selectImage || butPtr->bitmap ? - NSContentsCellMask : 0; - showsStateBy = butPtr->selectImage || butPtr->tristateImage ? - NSContentsCellMask : 0; -#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS - if (tkMacOSXUseCompatibilityMetrics) { - border = butPtr->borderWidth > 1 ? butPtr->borderWidth - 1 : 1; - } else -#endif - { - border = butPtr->borderWidth; - } - } - break; - } - [button setButtonType:type]; - if (style) { - [button setBezelStyle:style]; - } - if (highlightsBy) { - [cell setHighlightsBy:highlightsBy|[cell highlightsBy]]; - } - if (showsStateBy) { - [cell setShowsStateBy:showsStateBy|[cell showsStateBy]]; + + MacButton *mbPtr = (MacButton*)butPtr; + Tk_Window tkwin = butPtr->tkwin; + Pixmap pixmap; + int haveImage = 0; + int haveText = 0; + int imageWidth = 0; + int imageHeight = 0; + int imageXOffset = 0; + int imageYOffset = 0; + int textXOffset = 0; + int textYOffset = 0; + int width = 0; + int height = 0; + int fullWidth = 0; + int fullHeight = 0; + int pressed = 0; + + + if (tkwin == NULL || !Tk_IsMapped(tkwin)) { + return; } -#if 0 - if (style == NSShadowlessSquareBezelStyle) { - NSControlSize controlSize = NSRegularControlSize; - - if (butPtr->borderWidth <= 2) { - controlSize = NSMiniControlSize; - } else if (butPtr->borderWidth == 3) { - controlSize = NSSmallControlSize; - } - [cell setControlSize:controlSize]; + + DrawParams* dpPtr = &mbPtr->drawParams; + pixmap = (Pixmap)Tk_WindowId(tkwin); + + if (butPtr->image != None) { + Tk_SizeOfImage(butPtr->image, &width, &height); + haveImage = 1; + } else if (butPtr->bitmap != None) { + Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height); + haveImage = 1; } -#endif - [button setAllowsMixedState:YES]; - - if (!haveImage || haveCompound) { - int len; - char *text = Tcl_GetStringFromObj(butPtr->textPtr, &len); - - if (len) { - NSString *title = [[NSString alloc] initWithBytes:text length:len - encoding:NSUTF8StringEncoding]; - [button setTitle:title]; - [title release]; - haveText = 1; - } + + imageWidth = width; + imageHeight = height; + + if (mbPtr->drawinfo.state == kThemeStatePressed) { + /* Offset bitmaps by a bit when the button is pressed. */ + pressed = 1; } - haveCompound = (haveCompound && haveImage && haveText); - if (haveText) { - NSTextAlignment alignment = NSNaturalTextAlignment; - - switch (butPtr->justify) { - case TK_JUSTIFY_LEFT: - alignment = NSLeftTextAlignment; - break; - case TK_JUSTIFY_RIGHT: - alignment = NSRightTextAlignment; - break; - case TK_JUSTIFY_CENTER: - alignment = NSCenterTextAlignment; - break; + + haveText = (butPtr->textWidth != 0 && butPtr->textHeight != 0); + if (haveImage && haveText) { /* Image and Text */ + int x; + int y; + textXOffset = 0; + textYOffset = 0; + fullWidth = 0; + fullHeight = 0; + + switch ((enum compound) butPtr->compound) { + case COMPOUND_TOP: + case COMPOUND_BOTTOM: { + /* Image is above or below text */ + if (butPtr->compound == COMPOUND_TOP) { + textYOffset = height + butPtr->padY; + } else { + imageYOffset = butPtr->textHeight + butPtr->padY; + } + fullHeight = height + butPtr->textHeight + butPtr->padY; + fullWidth = (width > butPtr->textWidth ? width : + butPtr->textWidth); + textXOffset = (fullWidth - butPtr->textWidth)/2; + imageXOffset = (fullWidth - width)/2; + break; } - [button setAlignment:alignment]; - } else { - [button setTitle:@""]; - } - font = TkMacOSXNSFontForFont(butPtr->tkfont); - if (font) { - [button setFont:font]; - } - TkMacOSXMakeCollectableAndRelease(macButtonPtr->image); - TkMacOSXMakeCollectableAndRelease(macButtonPtr->selectImage); - TkMacOSXMakeCollectableAndRelease(macButtonPtr->tristateImage); - if (haveImage) { - int width, height; - NSImage *image, *selectImage = nil, *tristateImage = nil; - NSCellImagePosition pos = NSImageOnly; - - if (butPtr->image) { - Tk_SizeOfImage(butPtr->image, &width, &height); - image = TkMacOSXGetNSImageWithTkImage(butPtr->display, - butPtr->image, width, height); - if (butPtr->selectImage) { - selectImage = TkMacOSXGetNSImageWithTkImage(butPtr->display, - butPtr->selectImage, width, height); - } - if (butPtr->tristateImage) { - tristateImage = TkMacOSXGetNSImageWithTkImage(butPtr->display, - butPtr->tristateImage, width, height); - } - } else { - Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height); - image = TkMacOSXGetNSImageWithBitmap(butPtr->display, - butPtr->bitmap, butPtr->normalTextGC, width, height); - selectImage = TkMacOSXGetNSImageWithBitmap(butPtr->display, - butPtr->bitmap, butPtr->activeTextGC, width, height); + case COMPOUND_LEFT: + case COMPOUND_RIGHT: { + /* + * Image is left or right of text + */ + + if (butPtr->compound == COMPOUND_LEFT) { + textXOffset = width + butPtr->padX; + } else { + imageXOffset = butPtr->textWidth + butPtr->padX; + } + fullWidth = butPtr->textWidth + butPtr->padX + width; + fullHeight = (height > butPtr->textHeight ? height : + butPtr->textHeight); + textYOffset = (fullHeight - butPtr->textHeight)/2; + imageYOffset = (fullHeight - height)/2; + break; } - [button setImage:image]; - if (selectImage) { - [button setAlternateImage:selectImage]; + case COMPOUND_CENTER: { + /* + * Image and text are superimposed + */ + + fullWidth = (width > butPtr->textWidth ? width : + butPtr->textWidth); + fullHeight = (height > butPtr->textHeight ? height : + butPtr->textHeight); + textXOffset = (fullWidth - butPtr->textWidth)/2; + imageXOffset = (fullWidth - width)/2; + textYOffset = (fullHeight - butPtr->textHeight)/2; + imageYOffset = (fullHeight - height)/2; + break; } - if (tristateImage) { - macButtonPtr->image = TkMacOSXMakeUncollectableAndRetain(image); - if (selectImage) { - macButtonPtr->selectImage = - TkMacOSXMakeUncollectableAndRetain(selectImage); - } - macButtonPtr->tristateImage = - TkMacOSXMakeUncollectableAndRetain(tristateImage); + default: + break; } - if (haveCompound) { - switch ((enum compound) butPtr->compound) { - case COMPOUND_TOP: - pos = NSImageAbove; - break; - case COMPOUND_BOTTOM: - pos = NSImageBelow; - break; - case COMPOUND_LEFT: - pos = NSImageLeft; - break; - case COMPOUND_RIGHT: - pos = NSImageRight; - break; - case COMPOUND_CENTER: - pos = NSImageOverlaps; - break; - case COMPOUND_NONE: - pos = NSImageOnly; - break; - } + + TkComputeAnchor(butPtr->anchor, tkwin, + butPtr->padX + butPtr->borderWidth, + butPtr->padY + butPtr->borderWidth, + fullWidth + butPtr->indicatorSpace, fullHeight, &x, &y); + x += butPtr->indicatorSpace; + + if (dpPtr->relief == TK_RELIEF_SUNKEN) { + x += dpPtr->offset; + y += dpPtr->offset; + } else if (dpPtr->relief == TK_RELIEF_RAISED) { + x -= dpPtr->offset; + y -= dpPtr->offset; + } + if (pressed) { + x += dpPtr->offset; + y += dpPtr->offset; + } + imageXOffset += x; + imageYOffset += y; + textYOffset -= 1; + + if (butPtr->image != NULL) { + if ((butPtr->selectImage != NULL) && + (butPtr->flags & SELECTED)) { + Tk_RedrawImage(butPtr->selectImage, 0, 0, + width, height, pixmap, imageXOffset, imageYOffset); + } else if ((butPtr->tristateImage != NULL) && + (butPtr->flags & TRISTATED)) { + Tk_RedrawImage(butPtr->tristateImage, 0, 0, + width, height, pixmap, imageXOffset, imageYOffset); + } else { + Tk_RedrawImage(butPtr->image, 0, 0, width, + height, pixmap, imageXOffset, imageYOffset); + } + } else { + XSetClipOrigin(butPtr->display, dpPtr->gc, + imageXOffset, imageYOffset); + XCopyPlane(butPtr->display, butPtr->bitmap, pixmap, dpPtr->gc, + 0, 0, (unsigned int) width, (unsigned int) height, + imageXOffset, imageYOffset, 1); + XSetClipOrigin(butPtr->display, dpPtr->gc, 0, 0); + } + + Tk_DrawTextLayout(butPtr->display, pixmap, + dpPtr->gc, butPtr->textLayout, + x + textXOffset, y + textYOffset, 0, -1); + Tk_UnderlineTextLayout(butPtr->display, pixmap, dpPtr->gc, + butPtr->textLayout, + x + textXOffset, y + textYOffset, + butPtr->underline); + } else if (haveImage) { /* Image only */ + int x = 0; + int y; + TkComputeAnchor(butPtr->anchor, tkwin, + butPtr->padX + butPtr->borderWidth, + butPtr->padY + butPtr->borderWidth, + width + butPtr->indicatorSpace, + height, &x, &y); + x += butPtr->indicatorSpace; + if (pressed) { + x += dpPtr->offset; + y += dpPtr->offset; } - [button setImagePosition:pos]; - } + imageXOffset += x; + imageYOffset += y; - // if font is too tall, we can't use the fixed-height rounded bezel - if (!haveImage && haveText && style == NSRoundedBezelStyle) { - Tk_FontMetrics fm; - Tk_GetFontMetrics(butPtr->tkfont, &fm); - if (fm.linespace > 18) { - [button setBezelStyle:(style = NSShadowlessSquareBezelStyle)]; - } - } + if (butPtr->image != NULL) { - bounds.size = [cell cellSize]; - if (haveText) { - titleRect = [cell titleRectForBounds:bounds]; - if (butPtr->wrapLength > 0 && - titleRect.size.width > butPtr->wrapLength) { - if (style == NSRoundedBezelStyle) { - [button setBezelStyle:(style = NSRegularSquareBezelStyle)]; - bounds.size = [cell cellSize]; - titleRect = [cell titleRectForBounds:bounds]; - } - bounds.size.width -= titleRect.size.width - butPtr->wrapLength; - bounds.size.height = 40000.0; - [cell setWraps:YES]; - bounds.size = [cell cellSizeForBounds:bounds]; -#ifdef TK_MAC_DEBUG_BUTTON - titleRect = [cell titleRectForBounds:bounds]; -#endif -#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS - if (tkMacOSXUseCompatibilityMetrics) { - bounds.size.height += 3; - } -#endif + if ((butPtr->selectImage != NULL) && + (butPtr->flags & SELECTED)) { + Tk_RedrawImage(butPtr->selectImage, 0, 0, width, + height, pixmap, imageXOffset, imageYOffset); + } else if ((butPtr->tristateImage != NULL) && + (butPtr->flags & TRISTATED)) { + Tk_RedrawImage(butPtr->tristateImage, 0, 0, width, + height, pixmap, imageXOffset, imageYOffset); + } else { + Tk_RedrawImage(butPtr->image, 0, 0, width, height, + pixmap, imageXOffset, imageYOffset); + } + } else { + XSetClipOrigin(butPtr->display, dpPtr->gc, x, y); + XCopyPlane(butPtr->display, butPtr->bitmap, + pixmap, dpPtr->gc, + 0, 0, (unsigned int) width, + (unsigned int) height, + imageXOffset, imageYOffset, 1); + XSetClipOrigin(butPtr->display, dpPtr->gc, 0, 0); } + } else { /* Text only */ + int x, y; + TkComputeAnchor(butPtr->anchor, tkwin, butPtr->padX, butPtr->padY, + butPtr->textWidth + butPtr->indicatorSpace, + butPtr->textHeight, &x, &y); + x += butPtr->indicatorSpace; + Tk_DrawTextLayout(butPtr->display, pixmap, dpPtr->gc, butPtr->textLayout, + x, y - DEF_INSET_BOTTOM, 0, -1); } - width = lround(bounds.size.width); - height = lround(bounds.size.height); -#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS - if (tkMacOSXUseCompatibilityMetrics) { - macButtonPtr->fix = fixForTypeStyle(type, style); - width -= boundsFixes[macButtonPtr->fix].trimW; - height -= boundsFixes[macButtonPtr->fix].trimH; - } -#endif - if (haveImage || haveCompound) { - if (butPtr->width > 0) { - width = butPtr->width; - } - if (butPtr->height > 0) { - height = butPtr->height; - } - } else { - if (butPtr->width > 0) { - int avgWidth = Tk_TextWidth(butPtr->tkfont, "0", 1); - width = butPtr->width * avgWidth; - } - if (butPtr->height > 0) { - Tk_FontMetrics fm; + /* + * If the button is disabled with a stipple rather than a special + * foreground color, generate the stippled effect. If the widget + * is selected and we use a different background color when selected, + * must temporarily modify the GC so the stippling is the right color. + */ - Tk_GetFontMetrics(butPtr->tkfont, &fm); - height = butPtr->height * fm.linespace; - } - } - if (!haveImage || haveCompound) { - width += 2*butPtr->padX; - height += 2*butPtr->padY; - } - if (haveImage) { - width += 2*border; - height += 2*border; + if (mbPtr->useTkText) { + if ((butPtr->state == STATE_DISABLED) + && ((butPtr->disabledFg == NULL) || (butPtr->image != NULL))) { + if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn + && (butPtr->selectBorder != NULL)) { + XSetForeground(butPtr->display, butPtr->stippleGC, + Tk_3DBorderColor(butPtr->selectBorder)->pixel); + } + /* + * Stipple the whole button if no disabledFg was specified, + * otherwise restrict stippling only to displayed image + */ + if (butPtr->disabledFg == NULL) { + XFillRectangle(butPtr->display, pixmap, butPtr->stippleGC, + 0, 0, (unsigned) Tk_Width(tkwin), + (unsigned) Tk_Height(tkwin)); + } else { + XFillRectangle(butPtr->display, pixmap, butPtr->stippleGC, + imageXOffset, imageYOffset, + (unsigned) imageWidth, (unsigned) imageHeight); + } + if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn + && (butPtr->selectBorder != NULL) + ) { + XSetForeground(butPtr->display, butPtr->stippleGC, + Tk_3DBorderColor(butPtr->normalBorder)->pixel); + } + } + + /* + * Draw the border and traversal highlight last. This way, if the + * button's contents overflow they'll be covered up by the border. + */ + + if (dpPtr->relief != TK_RELIEF_FLAT) { + int inset = butPtr->highlightWidth; + Tk_Draw3DRectangle(tkwin, pixmap, dpPtr->border, inset, inset, + Tk_Width(tkwin) - 2*inset, Tk_Height(tkwin) - 2*inset, + butPtr->borderWidth, dpPtr->relief); + } } -#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS - if (tkMacOSXUseCompatibilityMetrics) { - width += 2*NATIVE_BUTTON_INSET; - height += 2*NATIVE_BUTTON_INSET + NATIVE_BUTTON_EXTRA_H; - } -#endif - Tk_GeometryRequest(butPtr->tkwin, width, height); - Tk_SetInternalBorder(butPtr->tkwin, butPtr->inset); -#ifdef TK_MAC_DEBUG_BUTTON - TKLog(@"button %s bounds %@ titleRect %@ width %d height %d inset %d borderWidth %d", - ((TkWindow *)butPtr->tkwin)->pathName, NSStringFromRect(bounds), - NSStringFromRect(titleRect), width, height, butPtr->inset, - butPtr->borderWidth); -#endif -} -#pragma mark - -#pragma mark Unix Buttons: + } + + + - /* *---------------------------------------------------------------------- * - * DisplayUnixButton -- + * TkpDestroyButton -- * - * This procedure is invoked to display a button widget. It is - * normally invoked as an idle handler. + * Free data structures associated with the button control. * * Results: * None. * * Side effects: - * Commands are output to X to display the button in its - * current mode. The REDRAW_PENDING flag is cleared. + * Restores the default control state. * *---------------------------------------------------------------------- */ void -DisplayUnixButton( +TkpDestroyButton( TkButton *butPtr) { - GC gc; - Tk_3DBorder border; - Pixmap pixmap; - int x = 0; /* Initialization only needed to stop compiler - * warning. */ - int y, relief; - Tk_Window tkwin = butPtr->tkwin; - int width = 0, height = 0, fullWidth, fullHeight; - int textXOffset, textYOffset; - int haveImage = 0, haveText = 0; - int imageWidth, imageHeight; - int imageXOffset = 0, imageYOffset = 0; - /* image information that will be used to - * restrict disabled pixmap as well */ - - border = butPtr->normalBorder; - if ((butPtr->state == STATE_DISABLED) && (butPtr->disabledFg != NULL)) { - gc = butPtr->disabledGC; - } else if ((butPtr->state == STATE_ACTIVE) - && !Tk_StrictMotif(butPtr->tkwin)) { - gc = butPtr->activeTextGC; - border = butPtr->activeBorder; - } else { - gc = butPtr->normalTextGC; - } - if ((butPtr->flags & SELECTED) && (butPtr->state != STATE_ACTIVE) - && (butPtr->selectBorder != NULL) && !butPtr->indicatorOn) { - border = butPtr->selectBorder; + MacButton *mbPtr = (MacButton *) butPtr; /* Mac button. */ + if (mbPtr->defaultPulseHandler) { + Tcl_DeleteTimerHandler(mbPtr->defaultPulseHandler); } +} + +/* + *-------------------------------------------------------------- + * + * TkMacOSXDrawButton -- + * + * This function draws the tk button using Mac controls + * In addition, this code may apply custom colors passed + * in the TkButton. + * + * Results: + * None. + * + * Side effects: + * The control is created, or reinitialised as needed + * + *-------------------------------------------------------------- + */ - relief = butPtr->relief; - - pixmap = (Pixmap) Tk_WindowId(tkwin); - Tk_Fill3DRectangle(tkwin, pixmap, border, 0, 0, Tk_Width(tkwin), - Tk_Height(tkwin), 0, TK_RELIEF_FLAT); - - /* - * Display image or bitmap or text for button. - */ +static void +TkMacOSXDrawButton( + MacButton *mbPtr, /* Mac button. */ + GC gc, /* The GC we are drawing into - needed for + * the bevel button */ + Pixmap pixmap) /* The pixmap we are drawing into - needed + * for the bevel button */ +{ + TkButton * butPtr = ( TkButton *)mbPtr; + TkWindow * winPtr; + HIRect cntrRect; + TkMacOSXDrawingContext dc; + DrawParams* dpPtr = &mbPtr->drawParams; + int useNewerHITools = 1; - if (butPtr->image != NULL) { - Tk_SizeOfImage(butPtr->image, &width, &height); - haveImage = 1; - } else if (butPtr->bitmap != None) { - Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height); - haveImage = 1; - } - imageWidth = width; - imageHeight = height; + winPtr = (TkWindow *)butPtr->tkwin; - haveText = (butPtr->textWidth != 0 && butPtr->textHeight != 0); + TkMacOSXComputeButtonParams(butPtr, &mbPtr->btnkind, &mbPtr->drawinfo); - if (butPtr->compound != COMPOUND_NONE && haveImage && haveText) { - textXOffset = 0; - textYOffset = 0; - fullWidth = 0; - fullHeight = 0; + cntrRect = CGRectMake(winPtr->privatePtr->xOff, + winPtr->privatePtr->yOff, + Tk_Width(butPtr->tkwin), + Tk_Height(butPtr->tkwin)); - switch ((enum compound) butPtr->compound) { - case COMPOUND_TOP: - case COMPOUND_BOTTOM: - /* - * Image is above or below text. - */ + cntrRect = CGRectInset(cntrRect, butPtr->inset, butPtr->inset); - if (butPtr->compound == COMPOUND_TOP) { - textYOffset = height + butPtr->padY; - } else { - imageYOffset = butPtr->textHeight + butPtr->padY; - } - fullHeight = height + butPtr->textHeight + butPtr->padY; - fullWidth = (width > butPtr->textWidth ? width : - butPtr->textWidth); - textXOffset = (fullWidth - butPtr->textWidth)/2; - imageXOffset = (fullWidth - width)/2; - break; - case COMPOUND_LEFT: - case COMPOUND_RIGHT: - /* - * Image is left or right of text. - */ + if (useNewerHITools == 1) { + HIRect contHIRec; + static HIThemeButtonDrawInfo hiinfo; - if (butPtr->compound == COMPOUND_LEFT) { - textXOffset = width + butPtr->padX; - } else { - imageXOffset = butPtr->textWidth + butPtr->padX; - } - fullWidth = butPtr->textWidth + butPtr->padX + width; - fullHeight = (height > butPtr->textHeight ? height : - butPtr->textHeight); - textYOffset = (fullHeight - butPtr->textHeight)/2; - imageYOffset = (fullHeight - height)/2; - break; - case COMPOUND_CENTER: - /* - * Image and text are superimposed. - */ + ButtonBackgroundDrawCB(&cntrRect, mbPtr, 32, true); - fullWidth = (width > butPtr->textWidth ? width : - butPtr->textWidth); - fullHeight = (height > butPtr->textHeight ? height : - butPtr->textHeight); - textXOffset = (fullWidth - butPtr->textWidth)/2; - imageXOffset = (fullWidth - width)/2; - textYOffset = (fullHeight - butPtr->textHeight)/2; - imageYOffset = (fullHeight - height)/2; - break; - case COMPOUND_NONE: - break; + if (!TkMacOSXSetupDrawingContext(pixmap, dpPtr->gc, 1, &dc)) { + return; } - TkComputeAnchor(butPtr->anchor, tkwin, butPtr->padX, butPtr->padY, - fullWidth, fullHeight, &x, &y); - - imageXOffset += x; - imageYOffset += y; - if (butPtr->image != NULL) { + if (mbPtr->btnkind == kThemePushButton) { /* - * Do boundary clipping, so that Tk_RedrawImage is passed valid - * coordinates. [Bug 979239] + * For some reason, pushbuttons get drawn a bit + * too low, normally. Correct for this. */ - - if (imageXOffset < 0) { - imageXOffset = 0; - } - if (imageYOffset < 0) { - imageYOffset = 0; - } - if (width > Tk_Width(tkwin)) { - width = Tk_Width(tkwin); - } - if (height > Tk_Height(tkwin)) { - height = Tk_Height(tkwin); - } - if ((width + imageXOffset) > Tk_Width(tkwin)) { - imageXOffset = Tk_Width(tkwin) - width; + if (cntrRect.size.height < 22) { + cntrRect.origin.y -= 1; + } else if (cntrRect.size.height < 23) { + cntrRect.origin.y -= 2; } - if ((height + imageYOffset) > Tk_Height(tkwin)) { - imageYOffset = Tk_Height(tkwin) - height; - } - - if ((butPtr->selectImage != NULL) && (butPtr->flags & SELECTED)) { - Tk_RedrawImage(butPtr->selectImage, 0, 0, - width, height, pixmap, imageXOffset, imageYOffset); - } else if ((butPtr->tristateImage != NULL) && (butPtr->flags & TRISTATED)) { - Tk_RedrawImage(butPtr->tristateImage, 0, 0, - width, height, pixmap, imageXOffset, imageYOffset); - } else { - Tk_RedrawImage(butPtr->image, 0, 0, width, - height, pixmap, imageXOffset, imageYOffset); - } - } else { - XSetClipOrigin(butPtr->display, gc, imageXOffset, imageYOffset); - XCopyPlane(butPtr->display, butPtr->bitmap, pixmap, gc, - 0, 0, (unsigned int) width, (unsigned int) height, - imageXOffset, imageYOffset, 1); - XSetClipOrigin(butPtr->display, gc, 0, 0); } - Tk_DrawTextLayout(butPtr->display, pixmap, gc, - butPtr->textLayout, x + textXOffset, y + textYOffset, 0, -1); - Tk_UnderlineTextLayout(butPtr->display, pixmap, gc, - butPtr->textLayout, x + textXOffset, y + textYOffset, - butPtr->underline); - y += fullHeight/2; - } else { - if (haveImage) { - TkComputeAnchor(butPtr->anchor, tkwin, 0, 0, - width, height, &x, &y); - imageXOffset += x; - imageYOffset += y; - if (butPtr->image != NULL) { - /* - * Do boundary clipping, so that Tk_RedrawImage is passed - * valid coordinates. [Bug 979239] - */ + hiinfo.version = 0; + hiinfo.state = mbPtr->drawinfo.state; + hiinfo.kind = mbPtr->btnkind; + hiinfo.value = mbPtr->drawinfo.value; + hiinfo.adornment = mbPtr->drawinfo.adornment; + hiinfo.animation.time.current = CFAbsoluteTimeGetCurrent(); + if (hiinfo.animation.time.start == 0) { + hiinfo.animation.time.start = hiinfo.animation.time.current; + } - if (imageXOffset < 0) { - imageXOffset = 0; - } - if (imageYOffset < 0) { - imageYOffset = 0; - } - if (width > Tk_Width(tkwin)) { - width = Tk_Width(tkwin); - } - if (height > Tk_Height(tkwin)) { - height = Tk_Height(tkwin); - } - if ((width + imageXOffset) > Tk_Width(tkwin)) { - imageXOffset = Tk_Width(tkwin) - width; - } - if ((height + imageYOffset) > Tk_Height(tkwin)) { - imageYOffset = Tk_Height(tkwin) - height; - } + HIThemeDrawButton(&cntrRect, &hiinfo, dc.context, kHIThemeOrientationNormal, + &contHIRec); - if ((butPtr->selectImage != NULL) && - (butPtr->flags & SELECTED)) { - Tk_RedrawImage(butPtr->selectImage, 0, 0, width, - height, pixmap, imageXOffset, imageYOffset); - } else if ((butPtr->tristateImage != NULL) && - (butPtr->flags & TRISTATED)) { - Tk_RedrawImage(butPtr->tristateImage, 0, 0, width, - height, pixmap, imageXOffset, imageYOffset); - } else { - Tk_RedrawImage(butPtr->image, 0, 0, width, height, pixmap, - imageXOffset, imageYOffset); - } - } else { - XSetClipOrigin(butPtr->display, gc, x, y); - XCopyPlane(butPtr->display, butPtr->bitmap, pixmap, gc, 0, 0, - (unsigned int) width, (unsigned int) height, x, y, 1); - XSetClipOrigin(butPtr->display, gc, 0, 0); - } - y += height/2; - } else { - TkComputeAnchor(butPtr->anchor, tkwin, butPtr->padX, butPtr->padY, - butPtr->textWidth, butPtr->textHeight, &x, &y); - - Tk_DrawTextLayout(butPtr->display, pixmap, gc, butPtr->textLayout, - x, y, 0, -1); - Tk_UnderlineTextLayout(butPtr->display, pixmap, gc, - butPtr->textLayout, x, y, butPtr->underline); - y += butPtr->textHeight/2; + TkMacOSXRestoreDrawingContext(&dc); + ButtonContentDrawCB(&contHIRec, mbPtr->btnkind, &mbPtr->drawinfo, + (MacButton *)mbPtr, 32, true); + + } else { + if (!TkMacOSXSetupDrawingContext(pixmap, dpPtr->gc, 1, &dc)) { + return; } + + TkMacOSXRestoreDrawingContext(&dc); } + mbPtr->lastdrawinfo = mbPtr->drawinfo; +} + +/* + *-------------------------------------------------------------- + * + * ButtonBackgroundDrawCB -- + * + * This function draws the background that + * lies under checkboxes and radiobuttons. + * + * Results: + * None. + * + * Side effects: + * The background gets updated to the current color. + * + *-------------------------------------------------------------- + */ +static void +ButtonBackgroundDrawCB ( + const HIRect * btnbounds, + MacButton *ptr, + SInt16 depth, + Boolean isColorDev) +{ + MacButton* mbPtr = (MacButton*)ptr; + TkButton* butPtr = (TkButton*)mbPtr; + Tk_Window tkwin = butPtr->tkwin; + Pixmap pixmap; + int usehlborder = 0; - /* - * If the button is disabled with a stipple rather than a special - * foreground color, generate the stippled effect. If the widget is - * selected and we use a different background color when selected, must - * temporarily modify the GC so the stippling is the right color. - */ + if (tkwin == NULL || !Tk_IsMapped(tkwin)) { + return; + } + pixmap = (Pixmap)Tk_WindowId(tkwin); + + if (butPtr->type != TYPE_LABEL) { + switch (mbPtr->btnkind) { + case kThemeSmallBevelButton: + case kThemeBevelButton: + case kThemeRoundedBevelButton: + case kThemePushButton: + usehlborder = 1; + break; + } + } + if (usehlborder) { + Tk_Fill3DRectangle(tkwin, pixmap, butPtr->highlightBorder, 0, 0, + Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT); + } else { + Tk_Fill3DRectangle(tkwin, pixmap, butPtr->normalBorder, 0, 0, + Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT); + } +} + +/* + *-------------------------------------------------------------- + * + * ButtonContentDrawCB -- + * + * This function draws the label and image for the button. + * + * Results: + * None. + * + * Side effects: + * The content of the button gets updated. + * + *-------------------------------------------------------------- + */ +static void +ButtonContentDrawCB ( + const HIRect * btnbounds, + ThemeButtonKind kind, + const HIThemeButtonDrawInfo *drawinfo, + MacButton *ptr, + SInt16 depth, + Boolean isColorDev) +{ + TkButton *butPtr = (TkButton *)ptr; + Tk_Window tkwin = butPtr->tkwin; - if ((butPtr->state == STATE_DISABLED) - && ((butPtr->disabledFg == NULL) || (butPtr->image != NULL))) { - if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn - && (butPtr->selectBorder != NULL)) { - XSetForeground(butPtr->display, butPtr->stippleGC, - Tk_3DBorderColor(butPtr->selectBorder)->pixel); - } + if (tkwin == NULL || !Tk_IsMapped(tkwin)) { + return; + } - /* - * Stipple the whole button if no disabledFg was specified, otherwise - * restrict stippling only to displayed image - */ + /*Overlay Tk elements over button native region: drawing elements within button boundaries/native region causes unpredictable metrics.*/ + DrawButtonImageAndText( butPtr); +} + +/* + *-------------------------------------------------------------- + * + * ButtonEventProc -- + * + * This procedure is invoked by the Tk dispatcher for various + * events on buttons. + * + * Results: + * None. + * + * Side effects: + * When it gets exposed, it is redisplayed. + * + *-------------------------------------------------------------- + */ + +static void +ButtonEventProc( + ClientData clientData, /* Information about window. */ + XEvent *eventPtr) /* Information about event. */ +{ + TkButton *buttonPtr = (TkButton *) clientData; + MacButton *mbPtr = (MacButton *) clientData; - if (butPtr->disabledFg == NULL) { - XFillRectangle(butPtr->display, pixmap, butPtr->stippleGC, 0, 0, - (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin)); + if (eventPtr->type == ActivateNotify + || eventPtr->type == DeactivateNotify) { + if ((buttonPtr->tkwin == NULL) || (!Tk_IsMapped(buttonPtr->tkwin))) { + return; + } + if (eventPtr->type == ActivateNotify) { + mbPtr->flags |= ACTIVE; } else { - XFillRectangle(butPtr->display, pixmap, butPtr->stippleGC, - imageXOffset, imageYOffset, - (unsigned) imageWidth, (unsigned) imageHeight); + mbPtr->flags &= ~ACTIVE; } - if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn - && (butPtr->selectBorder != NULL)) { - XSetForeground(butPtr->display, butPtr->stippleGC, - Tk_3DBorderColor(butPtr->normalBorder)->pixel); + if ((buttonPtr->flags & REDRAW_PENDING) == 0) { + Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) buttonPtr); + buttonPtr->flags |= REDRAW_PENDING; } } +} + +/* + *---------------------------------------------------------------------- + * + * TkMacOSXComputeButtonParams -- + * + * This procedure computes the various parameters used + * when creating a Carbon Appearance control. + * These are determined by the various tk button parameters + * + * Results: + * None. + * + * Side effects: + * Sets the btnkind and drawinfo parameters + * + *---------------------------------------------------------------------- + */ - /* - * Draw the border and traversal highlight last. This way, if the button's - * contents overflow they'll be covered up by the border. This code is - * complicated by the possible combinations of focus highlight and default - * rings. We draw the focus and highlight rings using the highlight border - * and highlight foreground color. - */ - - if (relief != TK_RELIEF_FLAT) { - int inset = butPtr->highlightWidth; - - if (butPtr->defaultState == DEFAULT_ACTIVE) { - /* - * Draw the default ring with 2 pixels of space between the - * default ring and the button and the default ring and the focus - * ring. Note that we need to explicitly draw the space in the - * highlightBorder color to ensure that we overwrite any overflow - * text and/or a different button background color. - */ - - Tk_Draw3DRectangle(tkwin, pixmap, butPtr->highlightBorder, inset, - inset, Tk_Width(tkwin) - 2*inset, - Tk_Height(tkwin) - 2*inset, 2, TK_RELIEF_FLAT); - inset += 2; - Tk_Draw3DRectangle(tkwin, pixmap, butPtr->highlightBorder, inset, - inset, Tk_Width(tkwin) - 2*inset, - Tk_Height(tkwin) - 2*inset, 1, TK_RELIEF_SUNKEN); - inset++; - Tk_Draw3DRectangle(tkwin, pixmap, butPtr->highlightBorder, inset, - inset, Tk_Width(tkwin) - 2*inset, - Tk_Height(tkwin) - 2*inset, 2, TK_RELIEF_FLAT); - - inset += 2; - } else if (butPtr->defaultState == DEFAULT_NORMAL) { - /* - * Leave room for the default ring and write over any text or - * background color. - */ +static void +TkMacOSXComputeButtonParams( + TkButton * butPtr, + ThemeButtonKind* btnkind, + HIThemeButtonDrawInfo *drawinfo) +{ + MacButton *mbPtr = (MacButton *)butPtr; + + if (butPtr->borderWidth <= 2) { + *btnkind = kThemeSmallBevelButton; + } else if (butPtr->borderWidth == 3) { + *btnkind = kThemeBevelButton; + } else if (butPtr->borderWidth == 4) { + *btnkind = kThemeRoundedBevelButton; + } else { + *btnkind = kThemePushButton; + } - Tk_Draw3DRectangle(tkwin, pixmap, butPtr->highlightBorder, 0, - 0, Tk_Width(tkwin), Tk_Height(tkwin), 5, TK_RELIEF_FLAT); - inset += 5; + if ((butPtr->image == None) && (butPtr->bitmap == None)) { + switch (butPtr->type) { + case TYPE_BUTTON: + *btnkind = kThemePushButton; + break; + case TYPE_RADIO_BUTTON: + if (butPtr->borderWidth <= 1) { + *btnkind = kThemeSmallRadioButton; + } else { + *btnkind = kThemeRadioButton; + } + break; + case TYPE_CHECK_BUTTON: + if (butPtr->borderWidth <= 1) { + *btnkind = kThemeSmallCheckBox; + } else { + *btnkind = kThemeCheckBox; + } + break; } + } - /* - * Draw the button border. - */ + if (butPtr->indicatorOn) { + switch (butPtr->type) { + case TYPE_RADIO_BUTTON: + if (butPtr->borderWidth <= 1) { + *btnkind = kThemeSmallRadioButton; + } else { + *btnkind = kThemeRadioButton; + } + break; + case TYPE_CHECK_BUTTON: + if (butPtr->borderWidth <= 1) { + *btnkind = kThemeSmallCheckBox; + } else { + *btnkind = kThemeCheckBox; + } + break; + } + } else { + if (butPtr->type == TYPE_RADIO_BUTTON || + butPtr->type == TYPE_CHECK_BUTTON + ) { + if (*btnkind == kThemePushButton) { + *btnkind = kThemeBevelButton; + } + } + } - Tk_Draw3DRectangle(tkwin, pixmap, border, inset, inset, - Tk_Width(tkwin) - 2*inset, Tk_Height(tkwin) - 2*inset, - butPtr->borderWidth, relief); + if (butPtr->flags & SELECTED) { + drawinfo->value = kThemeButtonOn; + } else if (butPtr->flags & TRISTATED) { + drawinfo->value = kThemeButtonMixed; + } else { + drawinfo->value = kThemeButtonOff; } - if (butPtr->highlightWidth > 0) { - GC gc; - if (butPtr->flags & GOT_FOCUS) { - gc = Tk_GCForColor(butPtr->highlightColorPtr, pixmap); - } else { - gc = Tk_GCForColor(Tk_3DBorderColor(butPtr->highlightBorder), - pixmap); + if ((mbPtr->flags & FIRST_DRAW) != 0) { + mbPtr->flags &= ~FIRST_DRAW; + if (Tk_MacOSXIsAppInFront()) { + mbPtr->flags |= ACTIVE; } + } - /* - * Make sure the focus ring shrink-wraps the actual button, not the - * padding space left for a default ring. - */ + drawinfo->state = kThemeStateInactive; + if ((mbPtr->flags & ACTIVE) == 0) { + if (butPtr->state == STATE_DISABLED) { + drawinfo->state = kThemeStateUnavailableInactive; + } else { + drawinfo->state = kThemeStateInactive; + } + } else if (butPtr->state == STATE_DISABLED) { + drawinfo->state = kThemeStateUnavailable; + } else if (butPtr->state == STATE_ACTIVE) { + drawinfo->state = kThemeStatePressed; + } else { + drawinfo->state = kThemeStateActive; + } - if (butPtr->defaultState == DEFAULT_NORMAL) { - TkDrawInsetFocusHighlight(tkwin, gc, butPtr->highlightWidth, - pixmap, 5); - } else { - Tk_DrawFocusHighlight(tkwin, gc, butPtr->highlightWidth, pixmap); - } + drawinfo->adornment = kThemeAdornmentNone; + if (butPtr->defaultState == DEFAULT_ACTIVE) { + drawinfo->adornment |= kThemeAdornmentDefault; + if (!mbPtr->defaultPulseHandler) { + mbPtr->defaultPulseHandler = Tcl_CreateTimerHandler( + PULSE_TIMER_MSECS, PulseDefaultButtonProc, + (ClientData) butPtr); + } + } else if (mbPtr->defaultPulseHandler) { + Tcl_DeleteTimerHandler(mbPtr->defaultPulseHandler); + } + if (butPtr->highlightWidth >= 3) { + if ((butPtr->flags & GOT_FOCUS)) { + drawinfo->adornment |= kThemeAdornmentFocus; + } } } /* *---------------------------------------------------------------------- * - * ComputeUnixButtonGeometry -- + * TkMacOSXComputeButtonDrawParams -- * - * After changes in a button's text or bitmap, this procedure - * recomputes the button's geometry and passes this information - * along to the geometry manager for the window. + * This procedure computes the various parameters used + * when drawing a button + * These are determined by the various tk button parameters * * Results: - * None. + * 1 if control will be used, 0 otherwise. * * Side effects: - * The button's window may change size. + * Sets the button draw parameters * *---------------------------------------------------------------------- */ -void -ComputeUnixButtonGeometry( - register TkButton *butPtr) /* Button whose geometry may have changed. */ +static int +TkMacOSXComputeButtonDrawParams( + TkButton *butPtr, + DrawParams *dpPtr) { - int width, height, avgWidth, txtWidth, txtHeight; - int haveImage = 0, haveText = 0; - Tk_FontMetrics fm; - - butPtr->inset = butPtr->highlightWidth + butPtr->borderWidth; - - /* - * Leave room for the default ring if needed. - */ - - if (butPtr->defaultState != DEFAULT_DISABLED) { - butPtr->inset += 5; + MacButton *mbPtr = (MacButton *)butPtr; + + dpPtr->hasImageOrBitmap = ((butPtr->image != NULL) + || (butPtr->bitmap != None)); + + if (butPtr->type != TYPE_LABEL) { + dpPtr->offset = 0; + if (dpPtr->hasImageOrBitmap) { + switch (mbPtr->btnkind) { + case kThemeSmallBevelButton: + case kThemeBevelButton: + case kThemeRoundedBevelButton: + case kThemePushButton: + dpPtr->offset = 1; + break; + } + } } - butPtr->indicatorSpace = 0; - width = 0; - height = 0; - txtWidth = 0; - txtHeight = 0; - avgWidth = 0; - if (butPtr->image != NULL) { - Tk_SizeOfImage(butPtr->image, &width, &height); - haveImage = 1; - } else if (butPtr->bitmap != None) { - Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height); - haveImage = 1; + dpPtr->border = butPtr->normalBorder; + if ((butPtr->state == STATE_DISABLED) && (butPtr->disabledFg != NULL)) { + dpPtr->gc = butPtr->disabledGC; + } else if (butPtr->type == TYPE_BUTTON && butPtr->state == STATE_ACTIVE) { + dpPtr->gc = butPtr->activeTextGC; + dpPtr->border = butPtr->activeBorder; + } else { + dpPtr->gc = butPtr->normalTextGC; } - if (haveImage == 0 || butPtr->compound != COMPOUND_NONE) { - Tk_FreeTextLayout(butPtr->textLayout); - - butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont, - Tcl_GetString(butPtr->textPtr), -1, butPtr->wrapLength, - butPtr->justify, 0, &butPtr->textWidth, &butPtr->textHeight); - - txtWidth = butPtr->textWidth; - txtHeight = butPtr->textHeight; - avgWidth = Tk_TextWidth(butPtr->tkfont, "0", 1); - Tk_GetFontMetrics(butPtr->tkfont, &fm); - haveText = (txtWidth != 0 && txtHeight != 0); + if ((butPtr->flags & SELECTED) && (butPtr->state != STATE_ACTIVE) + && (butPtr->selectBorder != NULL) && !butPtr->indicatorOn) { + dpPtr->border = butPtr->selectBorder; } /* - * If the button is compound (i.e., it shows both an image and text), the - * new geometry is a combination of the image and text geometry. We only - * honor the compound bit if the button has both text and an image, - * because otherwise it is not really a compound button. + * Override the relief specified for the button if this is a + * checkbutton or radiobutton and there's no indicator. */ - if (butPtr->compound != COMPOUND_NONE && haveImage && haveText) { - switch ((enum compound) butPtr->compound) { - case COMPOUND_TOP: - case COMPOUND_BOTTOM: - /* - * Image is above or below text. - */ + dpPtr->relief = butPtr->relief; - height += txtHeight + butPtr->padY; - width = (width > txtWidth ? width : txtWidth); - break; - case COMPOUND_LEFT: - case COMPOUND_RIGHT: - /* - * Image is left or right of text. - */ - - width += txtWidth + butPtr->padX; - height = (height > txtHeight ? height : txtHeight); - break; - case COMPOUND_CENTER: - /* - * Image and text are superimposed. - */ - - width = (width > txtWidth ? width : txtWidth); - height = (height > txtHeight ? height : txtHeight); - break; - case COMPOUND_NONE: - break; - } - if (butPtr->width > 0) { - width = butPtr->width; - } - if (butPtr->height > 0) { - height = butPtr->height; + if ((butPtr->type >= TYPE_CHECK_BUTTON) && !butPtr->indicatorOn) { + if (!dpPtr->hasImageOrBitmap) { + dpPtr->relief = (butPtr->flags & SELECTED) ? TK_RELIEF_SUNKEN + : TK_RELIEF_RAISED; } + } - width += 2*butPtr->padX; - height += 2*butPtr->padY; - } else { - if (haveImage) { - if (butPtr->width > 0) { - width = butPtr->width; - } - if (butPtr->height > 0) { - height = butPtr->height; - } - } else { - width = txtWidth; - height = txtHeight; + /* + * Determine the draw type + */ - if (butPtr->width > 0) { - width = butPtr->width * avgWidth; - } - if (butPtr->height > 0) { - height = butPtr->height * fm.linespace; - } + if (butPtr->type == TYPE_LABEL) { + dpPtr->drawType = DRAW_LABEL; + } else if (butPtr->type == TYPE_BUTTON) { + if (!dpPtr->hasImageOrBitmap) { + dpPtr->drawType = DRAW_CONTROL; + } else { + dpPtr->drawType = DRAW_BEVEL; } + } else if (butPtr->indicatorOn) { + dpPtr->drawType = DRAW_CONTROL; + } else if (dpPtr->hasImageOrBitmap) { + dpPtr->drawType = DRAW_BEVEL; + } else { + dpPtr->drawType = DRAW_CUSTOM; } - if (!haveImage) { - width += 2*butPtr->padX; - height += 2*butPtr->padY; + if ((dpPtr->drawType == DRAW_CONTROL) || (dpPtr->drawType == DRAW_BEVEL)) { + return 1; + } else { + return 0; } - Tk_GeometryRequest(butPtr->tkwin, (int) (width - + 2*butPtr->inset), (int) (height + 2*butPtr->inset)); - Tk_SetInternalBorder(butPtr->tkwin, butPtr->inset); } /* - * Local Variables: - * mode: objc - * c-basic-offset: 4 - * fill-column: 79 - * coding: utf-8 - * End: + *-------------------------------------------------------------- + * + * PulseDefaultButtonProc -- + * + * This function redraws the button on a timer, to pulse + * default buttons. + * + * Results: + * None. + * + * Side effects: + * Sets a timer to run itself again. + * + *-------------------------------------------------------------- */ +static void +PulseDefaultButtonProc(ClientData clientData) +{ + MacButton *mbPtr = (MacButton *)clientData; + TkpDisplayButton(clientData); + mbPtr->defaultPulseHandler = Tcl_CreateTimerHandler( + PULSE_TIMER_MSECS, PulseDefaultButtonProc, clientData); +} + diff --git a/macosx/tkMacOSXCursor.c b/macosx/tkMacOSXCursor.c index 53c2cd2..b6394b7 100644 --- a/macosx/tkMacOSXCursor.c +++ b/macosx/tkMacOSXCursor.c @@ -344,7 +344,7 @@ FindCursorByName( macCursor = [[NSCursor alloc] initWithImage:image hotSpot:hotSpot]; [image release]; } - macCursorPtr->macCursor = TkMacOSXMakeUncollectable(macCursor); + macCursorPtr->macCursor = macCursor; } /* @@ -454,7 +454,8 @@ TkpFreeCursor( { TkMacOSXCursor *macCursorPtr = (TkMacOSXCursor *) cursorPtr; - TkMacOSXMakeCollectableAndRelease(macCursorPtr->macCursor); + [macCursorPtr->macCursor release]; + macCursorPtr->macCursor = NULL; if (macCursorPtr == gCurrentCursor) { gCurrentCursor = NULL; } diff --git a/macosx/tkMacOSXDefault.h b/macosx/tkMacOSXDefault.h index 903f5f9..dc73188 100644 --- a/macosx/tkMacOSXDefault.h +++ b/macosx/tkMacOSXDefault.h @@ -16,9 +16,9 @@ #ifndef _TKMACDEFAULT #define _TKMACDEFAULT -#ifndef TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS -#define TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS 1 -#endif +//#ifndef TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS +//#define TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS 1 +//#endif /* * The definitions below provide symbolic names for the default colors. @@ -72,12 +72,12 @@ #define DEF_BUTTON_HIGHLIGHT_BG_MONO DEF_BUTTON_BG_MONO #define DEF_BUTTON_HIGHLIGHT "systemButtonFrame" #define DEF_LABEL_HIGHLIGHT_WIDTH "0" -#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS -#define DEF_BUTTON_HIGHLIGHT_WIDTH "4" -#define DEF_BUTTON_HIGHLIGHT_WIDTH_NOCM "1" -#else +//#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS +//#define DEF_BUTTON_HIGHLIGHT_WIDTH "4" +//#define DEF_BUTTON_HIGHLIGHT_WIDTH_NOCM "1" +//#else #define DEF_BUTTON_HIGHLIGHT_WIDTH "1" -#endif +//#endif #define DEF_BUTTON_IMAGE ((char *) NULL) #define DEF_BUTTON_INDICATOR "1" #define DEF_BUTTON_JUSTIFY "center" @@ -85,19 +85,19 @@ #define DEF_BUTTON_ON_VALUE "1" #define DEF_BUTTON_TRISTATE_VALUE "" #define DEF_BUTTON_OVER_RELIEF "" -#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS -#define DEF_BUTTON_PADX "12" -#define DEF_BUTTON_PADX_NOCM "1" -#else +//#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS +//#define DEF_BUTTON_PADX "12" +//#define DEF_BUTTON_PADX_NOCM "1" +//#else #define DEF_BUTTON_PADX "1" -#endif +//#endif #define DEF_LABCHKRAD_PADX "1" -#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS -#define DEF_BUTTON_PADY "3" -#define DEF_BUTTON_PADY_NOCM "1" -#else +//#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS +//#define DEF_BUTTON_PADY "3" +//#define DEF_BUTTON_PADY_NOCM "1" +//#else #define DEF_BUTTON_PADY "1" -#endif +//#endif #define DEF_LABCHKRAD_PADY "1" #define DEF_BUTTON_RELIEF "flat" #define DEF_LABCHKRAD_RELIEF "flat" @@ -410,6 +410,7 @@ #define DEF_PANEDWINDOW_HEIGHT "" #define DEF_PANEDWINDOW_OPAQUERESIZE "1" #define DEF_PANEDWINDOW_ORIENT "horizontal" +#define DEF_PANEDWINDOW_PROXYBORDER "2" #define DEF_PANEDWINDOW_RELIEF "flat" #define DEF_PANEDWINDOW_SASHCURSOR "" #define DEF_PANEDWINDOW_SASHPAD "0" diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c index a66939a..257f16d 100644 --- a/macosx/tkMacOSXDialog.c +++ b/macosx/tkMacOSXDialog.c @@ -14,6 +14,17 @@ #include "tkMacOSXPrivate.h" #include "tkFileFilter.h" +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090 +#define modalOK NSOKButton +#define modalCancel NSCancelButton +#else +#define modalOK NSModalResponseOK +#define modalCancel NSModalResponseCancel +#endif +#define modalOther -1 +#define modalError -2 + + static const char *const colorOptionStrings[] = { "-initialcolor", "-parent", "-title", NULL }; @@ -130,6 +141,23 @@ static const short alertNativeButtonIndexAndTypeToButtonIndex[][3] = { [TYPE_YESNO] = {5, 6, 0}, [TYPE_YESNOCANCEL] = {5, 6, 4}, }; + +/* + * Construct a file URL from directory and filename. Either may + * be nil. If both are nil, returns nil. + */ +#if MAC_OS_X_VERSION_MIN_REQUIRED > 1050 +static NSURL *getFileURL(NSString *directory, NSString *filename) { + NSURL *url = nil; + if (directory) { + url = [NSURL fileURLWithPath:directory]; + } + if (filename) { + url = [NSURL URLWithString:filename relativeToURL:url]; + } + return url; +} +#endif #pragma mark TKApplication(TKDialog) @@ -149,12 +177,12 @@ static const short alertNativeButtonIndexAndTypeToButtonIndex[][3] = { if (callbackInfo->multiple) { resultObj = Tcl_NewListObj(0, NULL); - for (NSString *name in [(NSOpenPanel*)panel filenames]) { + for (NSURL *url in [(NSOpenPanel*)panel URLs]) { Tcl_ListObjAppendElement(callbackInfo->interp, resultObj, - Tcl_NewStringObj([name UTF8String], -1)); + Tcl_NewStringObj([[url path] UTF8String], -1)); } } else { - resultObj = Tcl_NewStringObj([[panel filename] UTF8String], -1); + resultObj = Tcl_NewStringObj([[[panel URL]path] UTF8String], -1); } if (callbackInfo->cmdObj) { Tcl_Obj **objv, **tmpv; @@ -189,7 +217,7 @@ static const short alertNativeButtonIndexAndTypeToButtonIndex[][3] = { { AlertCallbackInfo *callbackInfo = contextInfo; - if (returnCode != NSAlertErrorReturn) { + if (returnCode >= NSAlertFirstButtonReturn) { Tcl_Obj *resultObj = Tcl_NewStringObj(alertButtonStrings[ alertNativeButtonIndexAndTypeToButtonIndex[callbackInfo-> typeIndex][returnCode - NSAlertFirstButtonReturn]], -1); @@ -309,7 +337,7 @@ Tk_ChooseColorObjCmd( [colorPanel setColor:initialColor]; } returnCode = [NSApp runModalForWindow:colorPanel]; - if (returnCode == NSOKButton) { + if (returnCode == modalOK) { color = [[colorPanel color] colorUsingColorSpace: [NSColorSpace genericRGBColorSpace]]; numberOfComponents = [color numberOfComponents]; @@ -369,7 +397,8 @@ Tk_GetOpenFileObjCmd( NSWindow *parent; NSMutableArray *fileTypes = nil; NSOpenPanel *panel = [NSOpenPanel openPanel]; - NSInteger returnCode = NSAlertErrorReturn; + NSInteger modalReturnCode = modalError; + BOOL parentIsKey = NO; TkInitFileFilters(&fl); for (i = 1; i < objc; i += 2) { @@ -439,6 +468,7 @@ Tk_GetOpenFileObjCmd( break; } } + [panel setAllowsMultipleSelection:multiple]; if (fl.filters) { fileTypes = [NSMutableArray array]; for (FileFilter *filterPtr = fl.filters; filterPtr; @@ -471,7 +501,7 @@ Tk_GetOpenFileObjCmd( } } } - [panel setAllowsMultipleSelection:multiple]; + [panel setAllowedFileTypes:fileTypes]; if (cmdObj) { callbackInfo = ckalloc(sizeof(FilePanelCallbackInfo)); if (Tcl_IsShared(cmdObj)) { @@ -484,19 +514,41 @@ Tk_GetOpenFileObjCmd( callbackInfo->multiple = multiple; parent = TkMacOSXDrawableWindow(((TkWindow *) tkwin)->window); if (haveParentOption && parent && ![parent attachedSheet]) { - [panel beginSheetForDirectory:directory file:filename types:fileTypes - modalForWindow:parent modalDelegate:NSApp didEndSelector: - @selector(tkFilePanelDidEnd:returnCode:contextInfo:) - contextInfo:callbackInfo]; - returnCode = cmdObj ? NSAlertOtherReturn : - [NSApp runModalForWindow:panel]; + parentIsKey = [parent isKeyWindow]; +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1060 + [panel beginSheetForDirectory:directory + file:filename + types:fileTypes + modalForWindow:parent + modalDelegate:NSApp + didEndSelector: + @selector(tkFilePanelDidEnd:returnCode:contextInfo:) + contextInfo:callbackInfo]; +#else + [panel setAllowedFileTypes:fileTypes]; + [panel setDirectoryURL:getFileURL(directory, filename)]; + [panel beginSheetModalForWindow:parent + completionHandler:^(NSInteger returnCode) + { [NSApp tkFilePanelDidEnd:panel + returnCode:returnCode + contextInfo:callbackInfo ]; } ]; +#endif + modalReturnCode = cmdObj ? modalOther : [NSApp runModalForWindow:panel]; } else { - returnCode = [panel runModalForDirectory:directory file:filename - types:fileTypes]; - [NSApp tkFilePanelDidEnd:panel returnCode:returnCode +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1060 + modalReturnCode = [panel runModalForDirectory:directory + file:filename]; +#else + [panel setDirectoryURL:getFileURL(directory, filename)]; + modalReturnCode = [panel runModal]; +#endif + [NSApp tkFilePanelDidEnd:panel returnCode:modalReturnCode contextInfo:callbackInfo]; } - result = (returnCode != NSAlertErrorReturn) ? TCL_OK : TCL_ERROR; + result = (modalReturnCode != modalError) ? TCL_OK : TCL_ERROR; + if (parentIsKey) { + [parent makeKeyWindow]; + } if (typeVariablePtr && result == TCL_OK) { /* * The -typevariable option is not really supported. @@ -548,7 +600,8 @@ Tk_GetSaveFileObjCmd( NSWindow *parent; NSMutableArray *fileTypes = nil; NSSavePanel *panel = [NSSavePanel savePanel]; - NSInteger returnCode = NSAlertErrorReturn; + NSInteger modalReturnCode = modalError; + BOOL parentIsKey = NO; TkInitFileFilters(&fl); for (i = 1; i < objc; i += 2) { @@ -665,19 +718,38 @@ Tk_GetSaveFileObjCmd( callbackInfo->multiple = 0; parent = TkMacOSXDrawableWindow(((TkWindow *) tkwin)->window); if (haveParentOption && parent && ![parent attachedSheet]) { - [panel beginSheetForDirectory:directory file:filename - modalForWindow:parent modalDelegate:NSApp didEndSelector: - @selector(tkFilePanelDidEnd:returnCode:contextInfo:) - contextInfo:callbackInfo]; - returnCode = cmdObj ? NSAlertOtherReturn : - [NSApp runModalForWindow:panel]; + parentIsKey = [parent isKeyWindow]; +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1060 + [panel beginSheetForDirectory:directory + file:filename + modalForWindow:parent + modalDelegate:NSApp + didEndSelector: + @selector(tkFilePanelDidEnd:returnCode:contextInfo:) + contextInfo:callbackInfo]; +#else + [panel setDirectoryURL:getFileURL(directory, filename)]; + [panel beginSheetModalForWindow:parent + completionHandler:^(NSInteger returnCode) + { [NSApp tkFilePanelDidEnd:panel + returnCode:returnCode + contextInfo:callbackInfo ]; } ]; +#endif + modalReturnCode = cmdObj ? modalOther : [NSApp runModalForWindow:panel]; } else { - returnCode = [panel runModalForDirectory:directory file:filename]; - [NSApp tkFilePanelDidEnd:panel returnCode:returnCode +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1060 + modalReturnCode = [panel runModalForDirectory:directory file:filename]; +#else + [panel setDirectoryURL:getFileURL(directory, filename)]; + modalReturnCode = [panel runModal]; +#endif + [NSApp tkFilePanelDidEnd:panel returnCode:modalReturnCode contextInfo:callbackInfo]; } - result = (returnCode != NSAlertErrorReturn) ? TCL_OK : TCL_ERROR; - + result = (modalReturnCode != modalError) ? TCL_OK : TCL_ERROR; + if (parentIsKey) { + [parent makeKeyWindow]; + } end: TkFreeFileFilters(&fl); return result; @@ -719,7 +791,8 @@ Tk_ChooseDirectoryObjCmd( NSString *message, *title; NSWindow *parent; NSOpenPanel *panel = [NSOpenPanel openPanel]; - NSInteger returnCode = NSAlertErrorReturn; + NSInteger modalReturnCode = modalError; + BOOL parentIsKey = NO; for (i = 1; i < objc; i += 2) { if (Tcl_GetIndexFromObjStruct(interp, objv[i], chooseOptionStrings, @@ -787,19 +860,37 @@ Tk_ChooseDirectoryObjCmd( callbackInfo->multiple = 0; parent = TkMacOSXDrawableWindow(((TkWindow *) tkwin)->window); if (haveParentOption && parent && ![parent attachedSheet]) { - [panel beginSheetForDirectory:directory file:filename - modalForWindow:parent modalDelegate:NSApp didEndSelector: - @selector(tkFilePanelDidEnd:returnCode:contextInfo:) + parentIsKey = [parent isKeyWindow]; +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1060 + [panel beginSheetForDirectory:directory + file:filename + modalForWindow:parent + modalDelegate:NSApp + didEndSelector: @selector(tkFilePanelDidEnd:returnCode:contextInfo:) contextInfo:callbackInfo]; - returnCode = cmdObj ? NSAlertOtherReturn : - [NSApp runModalForWindow:panel]; +#else + [panel setDirectoryURL:getFileURL(directory, filename)]; + [panel beginSheetModalForWindow:parent + completionHandler:^(NSInteger returnCode) + { [NSApp tkFilePanelDidEnd:panel + returnCode:returnCode + contextInfo:callbackInfo ]; } ]; +#endif + modalReturnCode = cmdObj ? modalOther : [NSApp runModalForWindow:panel]; } else { - returnCode = [panel runModalForDirectory:directory file:filename]; - [NSApp tkFilePanelDidEnd:panel returnCode:returnCode +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1060 + modalReturnCode = [panel runModalForDirectory:directory file:nil]; +#else + [panel setDirectoryURL:getFileURL(directory, filename)]; + modalReturnCode = [panel runModal]; +#endif + [NSApp tkFilePanelDidEnd:panel returnCode:modalReturnCode contextInfo:callbackInfo]; } - result = (returnCode != NSAlertErrorReturn) ? TCL_OK : TCL_ERROR; - + result = (modalReturnCode != modalError) ? TCL_OK : TCL_ERROR; + if (parentIsKey) { + [parent makeKeyWindow]; + } end: return result; } @@ -857,6 +948,9 @@ TkAboutDlg(void) [[[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" @@ -896,7 +990,7 @@ TkMacOSXStandardAboutPanelObjCmd( Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } - [NSApp orderFrontStandardAboutPanelWithOptions:nil]; + [NSApp orderFrontStandardAboutPanelWithOptions:[NSDictionary dictionary]]; return TCL_OK; } @@ -934,8 +1028,9 @@ Tk_MessageBoxObjCmd( NSWindow *parent; NSArray *buttons; NSAlert *alert = [NSAlert new]; - NSInteger returnCode = NSAlertErrorReturn; - + NSInteger modalReturnCode = 1; + BOOL parentIsKey = NO; + iconIndex = ICON_INFO; typeIndex = TYPE_OK; for (i = 1; i < objc; i += 2) { @@ -1061,19 +1156,32 @@ Tk_MessageBoxObjCmd( callbackInfo->typeIndex = typeIndex; parent = TkMacOSXDrawableWindow(((TkWindow *) tkwin)->window); if (haveParentOption && parent && ![parent attachedSheet]) { - [alert beginSheetModalForWindow:parent modalDelegate:NSApp - didEndSelector:@selector(tkAlertDidEnd:returnCode:contextInfo:) - contextInfo:callbackInfo]; - returnCode = cmdObj ? NSAlertOtherReturn : - [NSApp runModalForWindow:[alert window]]; + parentIsKey = [parent isKeyWindow]; +#if MAC_OS_X_VERSION_MIN_REQUIRED > 1090 + [alert beginSheetModalForWindow:parent + completionHandler:^(NSModalResponse returnCode) + { [NSApp tkAlertDidEnd:alert + returnCode:returnCode + contextInfo:callbackInfo ]; } ]; +#else + [alert beginSheetModalForWindow:parent + modalDelegate:NSApp + didEndSelector:@selector(tkAlertDidEnd:returnCode:contextInfo:) + contextInfo:callbackInfo]; +#endif + modalReturnCode = cmdObj ? 0 : + [NSApp runModalForWindow:[alert window]]; } else { - returnCode = [alert runModal]; - [NSApp tkAlertDidEnd:alert returnCode:returnCode + modalReturnCode = [alert runModal]; + [NSApp tkAlertDidEnd:alert returnCode:modalReturnCode contextInfo:callbackInfo]; } - result = (returnCode != NSAlertErrorReturn) ? TCL_OK : TCL_ERROR; + result = (modalReturnCode >= NSAlertFirstButtonReturn) ? TCL_OK : TCL_ERROR; end: [alert release]; + if (parentIsKey) { + [parent makeKeyWindow]; + } return result; } @@ -1643,9 +1751,7 @@ TkInitFontchooser( Tcl_SetAssocData(interp, "::tk::fontchooser", DeleteFontchooserData, fcdPtr); if (!fontPanelFontAttributes) { - NSAutoreleasePool *pool = [NSAutoreleasePool new]; fontPanelFontAttributes = [NSMutableDictionary new]; - [pool drain]; } return TCL_OK; } diff --git a/macosx/tkMacOSXDraw.c b/macosx/tkMacOSXDraw.c index 0727b26..6a0b409 100644 --- a/macosx/tkMacOSXDraw.c +++ b/macosx/tkMacOSXDraw.c @@ -8,6 +8,7 @@ * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright 2001-2009, Apple Inc. * Copyright (c) 2006-2009 Daniel A. Steffen <das@users.sourceforge.net> + * Copyright 2014 Marc Culler. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -16,7 +17,7 @@ #include "tkMacOSXPrivate.h" #include "tkMacOSXDebug.h" #include "xbytes.h" - +#include "tkButton.h" /* #ifdef TK_MAC_DEBUG @@ -100,13 +101,6 @@ TkMacOSXInitCGDrawing( (char *) &useThemedFrame, TCL_LINK_BOOLEAN) != TCL_OK) { Tcl_ResetResult(interp); } -#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS - if (Tcl_LinkVar(interp, "::tk::mac::useCompatibilityMetrics", - (char *) &tkMacOSXUseCompatibilityMetrics, TCL_LINK_BOOLEAN) - != TCL_OK) { - Tcl_ResetResult(interp); - } -#endif } return TCL_OK; } @@ -114,10 +108,81 @@ TkMacOSXInitCGDrawing( /* *---------------------------------------------------------------------- * + * BitmapRepFromDrawableRect + * + * Extract bitmap data from a MacOSX drawable as an NSBitmapImageRep. + * + * Results: + * Returns an autoreleased NSBitmapRep representing the image of the given + * rectangle of the given drawable. + * + * NOTE: The x,y coordinates should be relative to a coordinate system with + * origin at the top left, as used by XImage and CGImage, not bottom + * left as used by NSView. + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ +NSBitmapImageRep* +BitmapRepFromDrawableRect( + Drawable drawable, + int x, + int y, + unsigned int width, + unsigned int height) +{ + MacDrawable *mac_drawable = (MacDrawable *) drawable; + 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. + */ + cg_context = GetCGContextForDrawable(drawable); + CGRect image_rect = CGRectMake(x, y, width, height); + cg_image = CGBitmapContextCreateImage( (CGContextRef) cg_context); + sub_cg_image = CGImageCreateWithImageInRect(cg_image, image_rect); + if ( sub_cg_image ) { + /*This can be dealloc'ed prematurely if set for autorelease, causing crashes.*/ + bitmap_rep = [NSBitmapImageRep alloc]; + [bitmap_rep initWithCGImage:sub_cg_image]; + } + if ( cg_image ) { + CGImageRelease(cg_image); + } + } else if ( (view = TkMacOSXDrawableView(mac_drawable)) ) { + /* convert top-left coordinates to NSView 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] ) { + /*This can be dealloc'ed prematurely if set for autorelease, causing crashes.*/ + bitmap_rep = [NSBitmapImageRep alloc]; + bitmap_rep = [bitmap_rep initWithFocusedViewRect:view_rect]; + [view unlockFocus]; + } else { + TkMacOSXDbgMsg("Could not lock focus on view."); + } + + } else { + TkMacOSXDbgMsg("Invalid source drawable"); + } + return bitmap_rep; +} + +/* + *---------------------------------------------------------------------- + * * XCopyArea -- * - * Copies data from one drawable to another using block transfer - * routines. + * Copies data from one drawable to another. * * Results: * None. @@ -134,86 +199,63 @@ XCopyArea( Display *display, /* Display. */ Drawable src, /* Source drawable. */ Drawable dst, /* Destination drawable. */ - GC gc, /* GC to use. */ + GC gc, /* GC to use. */ int src_x, /* X & Y, width & height */ int src_y, /* define the source rectangle */ - unsigned int width, /* that will be copied. */ + unsigned int width, /* that will be copied. */ unsigned int height, int dest_x, /* Dest X & Y on dest rect. */ int dest_y) { TkMacOSXDrawingContext dc; MacDrawable *srcDraw = (MacDrawable *) src; + NSBitmapImageRep *bitmap_rep = NULL; + CGImageRef img = NULL; display->request++; + if (!width || !height) { - /* TkMacOSXDbgMsg("Drawing of emtpy area requested"); */ + /* This happens all the time. + TkMacOSXDbgMsg("Drawing of empty area requested"); + */ return; } - if (srcDraw->flags & TK_IS_PIXMAP) { - if (!TkMacOSXSetupDrawingContext(dst, gc, 1, &dc)) { - return; - } - if (dc.context) { - CGImageRef img = TkMacOSXCreateCGImageWithDrawable(src); - if (img) { - DrawCGImage(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)); - CFRelease(img); - } else { - TkMacOSXDbgMsg("Invalid source drawable"); + if (!TkMacOSXSetupDrawingContext(dst, gc, 1, &dc)) { + return; + /*TkMacOSXDbgMsg("Failed to setup drawing context.");*/ + } + + if ( dc.context ) { + if (srcDraw->flags & TK_IS_PIXMAP) { + img = TkMacOSXCreateCGImageWithDrawable(src); + }else if (TkMacOSXDrawableWindow(src)) { + bitmap_rep = BitmapRepFromDrawableRect(src, src_x, src_y, width, height); + if ( bitmap_rep ) { + img = [bitmap_rep CGImage]; } } else { - TkMacOSXDbgMsg("Invalid destination drawable"); - } - TkMacOSXRestoreDrawingContext(&dc); - } else if (TkMacOSXDrawableWindow(src)) { - NSView *view = TkMacOSXDrawableView(srcDraw); - NSWindow *w = [view window]; - NSInteger gs = [w windowNumber] > 0 ? [w gState] : 0; - /* // alternative using per-view gState: - NSInteger gs = [view gState]; - if (!gs) { - [view allocateGState]; - if ([view lockFocusIfCanDraw]) { - [view unlockFocus]; - } - gs = [view gState]; + TkMacOSXDbgMsg("Invalid source drawable - neither window nor pixmap."); } - */ - if (!gs || !TkMacOSXSetupDrawingContext(dst, gc, 1, &dc)) { - return; - } - if (dc.context) { - NSGraphicsContext *gc = nil; - CGFloat boundsH = [view bounds].size.height; - NSRect srcRect = NSMakeRect(srcDraw->xOff + src_x, boundsH - - height - (srcDraw->yOff + src_y), width, height); - - if (((MacDrawable *) dst)->flags & TK_IS_PIXMAP) { - gc = [NSGraphicsContext graphicsContextWithGraphicsPort: - dc.context flipped:NO]; - if (gc) { - [NSGraphicsContext saveGraphicsState]; - [NSGraphicsContext setCurrentContext:gc]; - } - } - NSCopyBits(gs, srcRect, NSMakePoint(dest_x, - dc.portBounds.size.height - dest_y)); - if (gc) { - [NSGraphicsContext restoreGraphicsState]; - } + + if (img) { + DrawCGImage(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)); + CFRelease(img); + + } else { - TkMacOSXDbgMsg("Invalid destination drawable"); + TkMacOSXDbgMsg("Failed to construct CGImage."); } - TkMacOSXRestoreDrawingContext(&dc); + } else { - TkMacOSXDbgMsg("Invalid source drawable"); + TkMacOSXDbgMsg("Invalid destination drawable - no context."); + return; } + + TkMacOSXRestoreDrawingContext(&dc); } /* @@ -240,10 +282,10 @@ XCopyPlane( Display *display, /* Display. */ Drawable src, /* Source drawable. */ Drawable dst, /* Destination drawable. */ - GC gc, /* GC to use. */ + GC gc, /* GC to use. */ int src_x, /* X & Y, width & height */ int src_y, /* define the source rectangle */ - unsigned int width, /* that will be copied. */ + unsigned int width, /* that will be copied. */ unsigned int height, int dest_x, /* Dest X & Y on dest rect. */ int dest_y, @@ -251,10 +293,11 @@ XCopyPlane( { TkMacOSXDrawingContext dc; MacDrawable *srcDraw = (MacDrawable *) src; + MacDrawable *dstDraw = (MacDrawable *) dst; display->request++; if (!width || !height) { - /* TkMacOSXDbgMsg("Drawing of emtpy area requested"); */ + /* TkMacOSXDbgMsg("Drawing of empty area requested"); */ return; } if (plane != 1) { @@ -264,33 +307,47 @@ XCopyPlane( if (!TkMacOSXSetupDrawingContext(dst, gc, 1, &dc)) { return; } - if (dc.context) { + CGContextRef context = dc.context; + if (context) { CGImageRef img = TkMacOSXCreateCGImageWithDrawable(src); - if (img) { TkpClipMask *clipPtr = (TkpClipMask *) gc->clip_mask; unsigned long imageBackground = gc->background; - - if (clipPtr && clipPtr->type == TKP_CLIP_PIXMAP && - clipPtr->value.pixmap == src) { - imageBackground = TRANSPARENT_PIXEL << 24; + if (clipPtr && clipPtr->type == TKP_CLIP_PIXMAP){ + CGImageRef mask = TkMacOSXCreateCGImageWithDrawable(clipPtr->value.pixmap); + CGRect rect = CGRectMake(dest_x, dest_y, width, height); + rect = CGRectOffset(rect, dstDraw->xOff, dstDraw->yOff); + CGContextSaveGState(context); + /* Move the origin of the destination to top left. */ + CGContextTranslateCTM(context, 0, rect.origin.y + CGRectGetMaxY(rect)); + CGContextScaleCTM(context, 1, -1); + /* Fill with the background color, clipping to the mask. */ + CGContextClipToMask(context, rect, mask); + TkMacOSXSetColorInContext(gc, gc->background, dc.context); + CGContextFillRect(dc.context, rect); + /* Fill with the foreground color, clipping to the intersection of img and mask. */ + CGContextClipToMask(context, rect, img); + TkMacOSXSetColorInContext(gc, gc->foreground, context); + CGContextFillRect(context, rect); + CGContextRestoreGState(context); + CGImageRelease(mask); + CGImageRelease(img); + } else { + DrawCGImage(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)); + CGImageRelease(img); } - DrawCGImage(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)); - CFRelease(img); - } else { + } else { /* no image */ TkMacOSXDbgMsg("Invalid source drawable"); } } else { - TkMacOSXDbgMsg("Invalid destination drawable"); + TkMacOSXDbgMsg("Invalid destination drawable - could not get a bitmap context."); } TkMacOSXRestoreDrawingContext(&dc); - } else { - XCopyArea(display, src, dst, gc, src_x, src_y, width, height, dest_x, - dest_y); + } else { /* source drawable is a window, not a Pixmap */ + XCopyArea(display, src, dst, gc, src_x, src_y, width, height, dest_x, dest_y); } } @@ -314,16 +371,16 @@ XCopyPlane( int TkPutImage( unsigned long *colors, /* Unused on Macintosh. */ - int ncolors, /* Unused on Macintosh. */ + int ncolors, /* Unused on Macintosh. */ Display* display, /* Display. */ Drawable d, /* Drawable to place image on. */ - GC gc, /* GC to use. */ + 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 width, /* Same width & height for both */ unsigned int height) /* distination and source. */ { TkMacOSXDrawingContext dc; @@ -384,22 +441,17 @@ CreateCGImageWithXImage( char *data = NULL; CGDataProviderReleaseDataCallback releaseData = ReleaseData; - if (image->obdata) { - /* - * Image from XGetImage - */ - - img = TkMacOSXCreateCGImageWithDrawable((Pixmap) image->obdata); - } else if (image->bits_per_pixel == 1) { + 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; - decode = decodeWB; if (image->bitmap_bit_order != MSBFirst) { char *srcPtr = image->data + image->xoffset; char *endPtr = srcPtr + len; @@ -409,23 +461,21 @@ CreateCGImageWithXImage( *destPtr++ = xBitReverseTable[(unsigned char)(*(srcPtr++))]; } } else { - data = memcpy(ckalloc(len), image->data + image->xoffset, - len); + 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); + bitsPerPixel, image->bytes_per_line, provider, decode, 0); } } else if (image->format == ZPixmap && image->bits_per_pixel == 32) { /* * Color image */ - CGColorSpaceRef colorspace = CGColorSpaceCreateWithName(kCGColorSpaceGenericRGB); + CGColorSpaceRef colorspace = CGColorSpaceCreateWithName(kCGColorSpaceSRGB); bitsPerComponent = 8; bitsPerPixel = 32; @@ -440,6 +490,7 @@ CreateCGImageWithXImage( img = CGImageCreate(image->width, image->height, bitsPerComponent, bitsPerPixel, image->bytes_per_line, colorspace, bitmapInfo, provider, decode, 0, kCGRenderingIntentDefault); + CFRelease(provider); } if (colorspace) { CFRelease(colorspace); @@ -447,10 +498,6 @@ CreateCGImageWithXImage( } else { TkMacOSXDbgMsg("Unsupported image type"); } - if (provider) { - CFRelease(provider); - } - return img; } @@ -619,17 +666,16 @@ GetCGContextForDrawable( CGColorSpaceRef colorspace = NULL; CGBitmapInfo bitmapInfo = #ifdef __LITTLE_ENDIAN__ - kCGBitmapByteOrder32Host; + kCGBitmapByteOrder32Host; #else - kCGBitmapByteOrderDefault; + kCGBitmapByteOrderDefault; #endif char *data; - CGRect bounds = CGRectMake(0, 0, macDraw->size.width, - macDraw->size.height); + CGRect bounds = CGRectMake(0, 0, macDraw->size.width, macDraw->size.height); if (macDraw->flags & TK_IS_BW_PIXMAP) { bitsPerPixel = 8; - bitmapInfo = kCGImageAlphaOnly; + bitmapInfo = (CGBitmapInfo)kCGImageAlphaOnly; } else { colorspace = CGColorSpaceCreateWithName(kCGColorSpaceGenericRGB); bitsPerPixel = 32; @@ -698,9 +744,11 @@ DrawCGImage( } } 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. */ if (imageBackground != TRANSPARENT_PIXEL << 24) { CGContextClearRect(context, dstBounds); } @@ -713,6 +761,7 @@ DrawCGImage( TkMacOSXSetColorInContext(gc, imageForeground, context); } } + #ifdef TK_MAC_DEBUG_IMAGE_DRAWING CGContextSaveGState(context); CGContextSetLineWidth(context, 1.0); @@ -732,8 +781,7 @@ DrawCGImage( dstBounds.size.width, dstBounds.size.height); #else /* TK_MAC_DEBUG_IMAGE_DRAWING */ CGContextSaveGState(context); - CGContextTranslateCTM(context, - 0, dstBounds.origin.y + CGRectGetMaxY(dstBounds)); + CGContextTranslateCTM(context, 0, dstBounds.origin.y + CGRectGetMaxY(dstBounds)); CGContextScaleCTM(context, 1, -1); CGContextDrawImage(context, dstBounds, image); CGContextRestoreGState(context); @@ -1441,43 +1489,94 @@ TkScrollWindow( int dx, int dy, /* Distance rectangle should be moved. */ TkRegion damageRgn) /* Region to accumulate damage in. */ { - MacDrawable *macDraw = (MacDrawable *) Tk_WindowId(tkwin); - NSView *view = TkMacOSXDrawableView(macDraw); - CGRect visRect, srcRect, dstRect; - CGFloat boundsH; - HIShapeRef dmgRgn, dstRgn; - int result; - - if (view && !CGRectIsEmpty(visRect = NSRectToCGRect([view visibleRect]))) { - boundsH = [view bounds].size.height; - srcRect = CGRectMake(macDraw->xOff + x, boundsH - height - - (macDraw->yOff + y), width, height); - dstRect = CGRectIntersection(CGRectOffset(srcRect, dx, -dy), visRect); - srcRect = CGRectIntersection(srcRect, visRect); - if (!CGRectIsEmpty(srcRect) && !CGRectIsEmpty(dstRect)) { - /* - CGRect sRect = CGRectIntersection(CGRectOffset(dstRect, -dx, dy), - srcRect); - NSCopyBits(0, NSRectFromCGRect(sRect), - NSPointFromCGPoint(CGRectOffset(sRect, dx, -dy).origin)); - */ - [view scrollRect:NSRectFromCGRect(srcRect) by:NSMakeSize(dx, -dy)]; - } - srcRect.origin.y = boundsH - srcRect.size.height - srcRect.origin.y; - dstRect.origin.y = boundsH - dstRect.size.height - dstRect.origin.y; - srcRect = CGRectUnion(srcRect, dstRect); - dmgRgn = HIShapeCreateMutableWithRect(&srcRect); - dstRgn = HIShapeCreateWithRect(&dstRect); - ChkErr(HIShapeDifference, dmgRgn, dstRgn, (HIMutableShapeRef) dmgRgn); - CFRelease(dstRgn); - TkMacOSXInvalidateViewRegion(view, dmgRgn); + Drawable drawable = Tk_WindowId(tkwin); + MacDrawable *macDraw = (MacDrawable *) drawable; + TKContentView *view = (TKContentView *)TkMacOSXDrawableView(macDraw); + CGRect srcRect, dstRect; + HIShapeRef dmgRgn = NULL, extraRgn = NULL; + NSRect bounds, visRect, scrollSrc, scrollDst; + int result = 0; + + if ( view ) { + /* Get the scroll area in NSView coordinates (origin at bottom left). */ + bounds = [view bounds]; + scrollSrc = NSMakeRect( + macDraw->xOff + x, + bounds.size.height - height - (macDraw->yOff + y), + width, height); + scrollDst = NSOffsetRect(scrollSrc, dx, -dy); + + /* Limit scrolling to the window content area. */ + visRect = [view visibleRect]; + scrollSrc = NSIntersectionRect(scrollSrc, visRect); + scrollDst = NSIntersectionRect(scrollDst, visRect); + if ( !NSIsEmptyRect(scrollSrc) && !NSIsEmptyRect(scrollDst) ) { + + /* + * Mark the difference between source and destination as damaged. + * This region is described in NSView coordinates (y=0 at the bottom) + * and converted to Tk coordinates later. + */ + + srcRect = CGRectMake(x, y, width, height); + dstRect = CGRectOffset(srcRect, dx, dy); + + /* Expand the rectangles slightly to avoid degeneracies. */ + srcRect.origin.y -= 1; + srcRect.size.height += 2; + dstRect.origin.y += 1; + dstRect.size.height -= 2; + + /* Compute the damage. */ + dmgRgn = HIShapeCreateMutableWithRect(&srcRect); + extraRgn = HIShapeCreateWithRect(&dstRect); + ChkErr(HIShapeDifference, dmgRgn, extraRgn, (HIMutableShapeRef) dmgRgn); + result = HIShapeIsEmpty(dmgRgn) ? 0 : 1; + + /* Convert to Tk coordinates. */ + TkMacOSXSetWithNativeRegion(damageRgn, dmgRgn); + if (extraRgn) { + CFRelease(extraRgn); + } + + /* Scroll the rectangle. */ + [view scrollRect:scrollSrc by:NSMakeSize(dx, -dy)]; + + /* Shift the Tk children which meet the source rectangle. */ + TkWindow *winPtr = (TkWindow *)tkwin; + TkWindow *childPtr; + CGRect childBounds; + for (childPtr = winPtr->childList; childPtr != NULL; childPtr = childPtr->nextPtr) { + if (Tk_IsMapped(childPtr) && !Tk_IsTopLevel(childPtr)) { + TkMacOSXWinCGBounds(childPtr, &childBounds); + if (CGRectIntersectsRect(srcRect, childBounds)) { + MacDrawable *macChild = childPtr->privatePtr; + if (macChild) { + macChild->yOff += dy; + macChild->xOff += dx; + childPtr->changes.y = macChild->yOff; + childPtr->changes.x = macChild->xOff; + } + } + } + } + + /* Queue up Expose events for the damage region. */ + int oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE); + [view generateExposeEvents:dmgRgn childrenOnly:1]; + Tcl_SetServiceMode(oldMode); + + /* Belt and suspenders: make the AppKit request a redraw + when it gets control again. */ + } } else { dmgRgn = HIShapeCreateEmpty(); + TkMacOSXSetWithNativeRegion(damageRgn, dmgRgn); } - TkMacOSXSetWithNativeRegion(damageRgn, dmgRgn); - result = HIShapeIsEmpty(dmgRgn) ? 0 : 1; - CFRelease(dmgRgn); + if (dmgRgn) { + CFRelease(dmgRgn); + } return result; } @@ -1590,13 +1689,13 @@ TkMacOSXSetupDrawingContext( CGContextSetTextDrawingMode(dc.context, kCGTextFill); CGContextConcatCTM(dc.context, t); if (dc.clipRgn) { -#ifdef TK_MAC_DEBUG_DRAWING + #ifdef TK_MAC_DEBUG_DRAWING CGContextSaveGState(dc.context); ChkErr(HIShapeReplacePathInCGContext, dc.clipRgn, dc.context); CGContextSetRGBFillColor(dc.context, 1.0, 0.0, 0.0, 0.1); CGContextEOFillPath(dc.context); CGContextRestoreGState(dc.context); -#endif /* TK_MAC_DEBUG_DRAWING */ + #endif /* TK_MAC_DEBUG_DRAWING */ CGRect r; if (!HIShapeIsRectangular(dc.clipRgn) || !CGRectContainsRect( *HIShapeGetBounds(dc.clipRgn, &r), @@ -1754,7 +1853,6 @@ TkMacOSXGetClipRgn( } else if (macDraw->visRgn) { clipRgn = HIShapeCreateCopy(macDraw->visRgn); } - return clipRgn; } @@ -1812,10 +1910,11 @@ TkpClipDrawableToRect( CFRelease(macDraw->drawRgn); macDraw->drawRgn = NULL; } + if (width >= 0 && height >= 0) { - CGRect drawRect = CGRectMake(x + macDraw->xOff, y + macDraw->yOff, + CGRect clipRect = CGRectMake(x + macDraw->xOff, y + macDraw->yOff, width, height); - HIShapeRef drawRgn = HIShapeCreateWithRect(&drawRect); + HIShapeRef drawRgn = HIShapeCreateWithRect(&clipRect); if (macDraw->winPtr && macDraw->flags & TK_CLIP_INVALID) { TkMacOSXUpdateClipRgn(macDraw->winPtr); @@ -1828,9 +1927,9 @@ TkpClipDrawableToRect( macDraw->drawRgn = drawRgn; } if (view && view != [NSView focusView] && [view lockFocusIfCanDraw]) { - drawRect.origin.y = [view bounds].size.height - - (drawRect.origin.y + drawRect.size.height); - NSRectClip(NSRectFromCGRect(drawRect)); + clipRect.origin.y = [view bounds].size.height - + (clipRect.origin.y + clipRect.size.height); + NSRectClip(NSRectFromCGRect(clipRect)); macDraw->flags |= TK_FOCUSED_VIEW; } } else { @@ -1959,7 +2058,7 @@ TkpDrawHighlightBorder ( * TkpDrawFrame -- * * This procedure draws the rectangular frame area. If the user - * has request themeing, it draws with a the background theme. + * has requested themeing, it draws with the background theme. * * Results: * None. @@ -1989,6 +2088,7 @@ TkpDrawFrame( border = themedBorder; } } + Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), border, highlightWidth, highlightWidth, Tk_Width(tkwin) - 2 * highlightWidth, diff --git a/macosx/tkMacOSXEmbed.c b/macosx/tkMacOSXEmbed.c index e2e05d2..99f7584 100644 --- a/macosx/tkMacOSXEmbed.c +++ b/macosx/tkMacOSXEmbed.c @@ -174,6 +174,50 @@ TkpMakeWindow( /* *---------------------------------------------------------------------- * + * TkpScanWindowId -- + * + * Given a string, produce the corresponding Window Id. + * + * Results: + * The return value is normally TCL_OK; in this case *idPtr will be set + * to the Window value equivalent to string. If string is improperly + * formed then TCL_ERROR is returned and an error message will be left in + * the interp's result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +TkpScanWindowId( + Tcl_Interp *interp, + CONST char * string, + Window *idPtr) +{ + int code; + Tcl_Obj obj; + + obj.refCount = 1; + obj.bytes = (char *) string; /* DANGER?! */ + obj.length = strlen(string); + obj.typePtr = NULL; + + code = Tcl_GetLongFromObj(interp, &obj, (long *)idPtr); + + if (obj.refCount > 1) { + Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); + } + if (obj.typePtr && obj.typePtr->freeIntRepProc) { + obj.typePtr->freeIntRepProc(&obj); + } + return code; +} + +/* + *---------------------------------------------------------------------- + * * TkpUseWindow -- * * This procedure causes a Tk window to use a given X window as its @@ -215,7 +259,7 @@ TkpUseWindow( } /* - * Decode the container pointer, and look for it among the list of + * Decode the container window ID, and look for it among the list of * available containers. * * N.B. For now, we are limiting the containers to be in the same Tk @@ -223,7 +267,7 @@ TkpUseWindow( * containers. */ - if (Tcl_GetInt(interp, string, (int*) &parent) != TCL_OK) { + if (TkpScanWindowId(interp, string, (Window *)&parent) != TCL_OK) { return TCL_ERROR; } @@ -563,15 +607,15 @@ int TkpTestembedCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { int all; Container *containerPtr; Tcl_DString dString; char buffer[50]; - if ((argc > 1) && (strcmp(argv[1], "all") == 0)) { + if ((objc > 1) && (strcmp(Tcl_GetString(objv[1]), "all") == 0)) { all = 1; } else { all = 0; diff --git a/macosx/tkMacOSXEvent.c b/macosx/tkMacOSXEvent.c index ea262ff..7f3357f 100644 --- a/macosx/tkMacOSXEvent.c +++ b/macosx/tkMacOSXEvent.c @@ -31,18 +31,19 @@ enum { NSEvent *processedEvent = theEvent; NSEventType type = [theEvent type]; NSInteger subtype; - NSUInteger flags; switch ((NSInteger)type) { case NSAppKitDefined: subtype = [theEvent subtype]; switch (subtype) { + /* Ignored at the moment. */ case NSApplicationActivatedEventType: break; case NSApplicationDeactivatedEventType: break; case NSWindowExposedEventType: + break; case NSScreenChangedEventType: break; case NSWindowMovedEventType: @@ -53,13 +54,12 @@ enum { default: break; } - break; + break; /* AppkitEvent. Return theEvent */ case NSKeyUp: case NSKeyDown: case NSFlagsChanged: - flags = [theEvent modifierFlags]; processedEvent = [self tkProcessKeyEvent:theEvent]; - break; + break; /* Key event. Return the processed event. */ case NSLeftMouseDown: case NSLeftMouseUp: case NSRightMouseDown: @@ -76,7 +76,7 @@ enum { case NSTabletPoint: case NSTabletProximity: processedEvent = [self tkProcessMouseEvent:theEvent]; - break; + break; /* Mouse event. Return the processed event. */ #if 0 case NSSystemDefined: subtype = [theEvent subtype]; @@ -100,7 +100,7 @@ enum { #endif default: - break; + break; /* return theEvent */ } return processedEvent; } @@ -113,14 +113,14 @@ enum { * * TkMacOSXFlushWindows -- * - * This routine flushes all the windows of the application. It is + * This routine flushes all the visible windows of the application. It is * called by XSync(). * * Results: * None. * * Side effects: - * Flushes all Carbon windows + * Flushes all visible Cocoa windows * *---------------------------------------------------------------------- */ @@ -128,22 +128,15 @@ enum { MODULE_SCOPE void TkMacOSXFlushWindows(void) { - NSInteger windowCount; - NSInteger *windowNumbers; + NSArray *macWindows = [NSApp orderedWindows]; - NSCountWindows(&windowCount); - if(windowCount) { - windowNumbers = ckalloc(windowCount * sizeof(NSInteger)); - NSWindowList(windowCount, windowNumbers); - for (NSInteger index = 0; index < windowCount; index++) { - NSWindow *w = [NSApp windowWithWindowNumber:windowNumbers[index]]; - if (TkMacOSXGetXWindow(w)) { - [w flushWindow]; - } + for (NSWindow *w in macWindows) { + if (TkMacOSXGetXWindow(w)) { + [w flushWindow]; } - ckfree(windowNumbers); } } + /* * Local Variables: diff --git a/macosx/tkMacOSXFont.c b/macosx/tkMacOSXFont.c index d800ae5..c48e56e 100644 --- a/macosx/tkMacOSXFont.c +++ b/macosx/tkMacOSXFont.c @@ -15,6 +15,19 @@ #include "tkMacOSXPrivate.h" #include "tkMacOSXFont.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 #define TK_MAC_DEBUG_FONTS @@ -197,6 +210,7 @@ FindNSFont( nsFont = [fm convertFont:nsFont toSize:size]; nsFont = [fm convertFont:nsFont toHaveTrait:traits]; } + [nsFont retain]; #undef defaultFont return nsFont; } @@ -270,7 +284,7 @@ InitFont( fmPtr->fixed = [nsFont advancementForGlyph:glyphs[0]].width == [nsFont advancementForGlyph:glyphs[1]].width; bounds = NSRectFromCGRect(CTFontGetBoundingRectsForGlyphs((CTFontRef) - nsFont, kCTFontDefaultOrientation, ch, boundingRects, nCh)); + nsFont, defaultOrientation, ch, boundingRects, nCh)); kern = [nsFont advancementForGlyph:glyphs[2]].width - [fontPtr->nsFont advancementForGlyph:glyphs[2]].width; } @@ -293,7 +307,7 @@ InitFont( [NSNumber numberWithInt:fmPtr->fixed ? 0 : 1], NSLigatureAttributeName, [NSNumber numberWithDouble:kern], NSKernAttributeName, nil]; - fontPtr->nsAttributes = TkMacOSXMakeUncollectableAndRetain(nsAttributes); + fontPtr->nsAttributes = [nsAttributes retain]; #undef nCh } @@ -358,6 +372,7 @@ TkpFontPkgInit( NSFont *nsFont; TkFontAttributes fa; NSMutableCharacterSet *cs; + /* Since we called before TkpInit, we need our own autorelease pool. */ NSAutoreleasePool *pool = [NSAutoreleasePool new]; /* force this for now */ @@ -382,8 +397,7 @@ TkpFontPkgInit( systemFont++; } TkInitFontAttributes(&fa); - nsFont = (NSFont*) CTFontCreateUIFontForLanguage( - kCTFontUserFixedPitchFontType, 11, NULL); + nsFont = (NSFont*) CTFontCreateUIFontForLanguage(fixedPitch, 11, NULL); if (nsFont) { GetTkFontAttributesForNSFont(nsFont, &fa); CFRelease(nsFont); @@ -518,7 +532,7 @@ TkpGetFontFromAttributes( nsFont = FindNSFont(faPtr->family, traits, weight, points, 1); } if (!nsFont) { - Tcl_Panic("Could not deternmine NSFont from TkFontAttributes"); + Tcl_Panic("Could not determine NSFont from TkFontAttributes"); } if (tkFontPtr == NULL) { fontPtr = ckalloc(sizeof(MacFont)); @@ -557,7 +571,8 @@ TkpDeleteFont( { MacFont *fontPtr = (MacFont *) tkFontPtr; - TkMacOSXMakeCollectableAndRelease(fontPtr->nsAttributes); + [fontPtr->nsAttributes release]; + fontPtr->nsAttributes = NULL; CFRelease(fontPtr->nsFont); /* Either a CTFontRef or a CFRetained NSFont */ } @@ -662,7 +677,6 @@ TkpGetFontAttrsForChar( { MacFont *fontPtr = (MacFont *) tkfont; NSFont *nsFont = fontPtr->nsFont; - *faPtr = fontPtr->font.fa; if (nsFont && ![[nsFont coveredCharacterSet] characterIsMember:c]) { UTF16Char ch = c; diff --git a/macosx/tkMacOSXHLEvents.c b/macosx/tkMacOSXHLEvents.c index ffbb06d..f5aeff0 100644 --- a/macosx/tkMacOSXHLEvents.c +++ b/macosx/tkMacOSXHLEvents.c @@ -7,12 +7,15 @@ * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright 2001-2009, Apple Inc. * Copyright (c) 2006-2009 Daniel A. Steffen <das@users.sourceforge.net> + * Copyright (c) 2015 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 <sys/param.h> +#define URL_MAX_LENGTH (17 + MAXPATHLEN) /* * This is a Tcl_Event structure that the Quit AppleEvent handler uses to @@ -30,154 +33,32 @@ typedef struct KillEvent { * Static functions used only in this file. */ -static OSErr QuitHandler(const AppleEvent *event, - AppleEvent *reply, SRefCon handlerRefcon); -static OSErr OappHandler(const AppleEvent *event, - AppleEvent *reply, SRefCon handlerRefcon); -static OSErr RappHandler(const AppleEvent *event, - AppleEvent *reply, SRefCon handlerRefcon); -static OSErr OdocHandler(const AppleEvent *event, - AppleEvent *reply, SRefCon handlerRefcon); -static OSErr PrintHandler(const AppleEvent *event, - AppleEvent *reply, SRefCon handlerRefcon); -static OSErr ScriptHandler(const AppleEvent *event, - AppleEvent *reply, SRefCon handlerRefcon); -static OSErr PrefsHandler(const AppleEvent *event, - AppleEvent *reply, SRefCon handlerRefcon); -static int MissedAnyParameters(const AppleEvent *theEvent); -static int ReallyKillMe(Tcl_Event *eventPtr, int flags); -static OSStatus FSRefToDString(const FSRef *fsref, Tcl_DString *ds); +static void tkMacOSXProcessFiles(NSAppleEventDescriptor* event, + NSAppleEventDescriptor* replyEvent, + Tcl_Interp *interp, + char* procedure); +static int MissedAnyParameters(const AppleEvent *theEvent); +static int ReallyKillMe(Tcl_Event *eventPtr, int flags); #pragma mark TKApplication(TKHLEvents) @implementation TKApplication(TKHLEvents) - (void) terminate: (id) sender { - QuitHandler(NULL, NULL, (SRefCon) _eventInterp); + [self handleQuitApplicationEvent:Nil withReplyEvent:Nil]; } - (void) preferences: (id) sender { - PrefsHandler(NULL, NULL, (SRefCon) _eventInterp); + [self handleShowPreferencesEvent:Nil withReplyEvent:Nil]; } -@end - -#pragma mark - - -/* - *---------------------------------------------------------------------- - * - * TkMacOSXInitAppleEvents -- - * - * Initilize the Apple Events on the Macintosh. This registers the core - * event handlers. - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -void -TkMacOSXInitAppleEvents( - Tcl_Interp *interp) /* Interp to handle basic events. */ -{ - AEEventHandlerUPP OappHandlerUPP, RappHandlerUPP, OdocHandlerUPP; - AEEventHandlerUPP PrintHandlerUPP, QuitHandlerUPP, ScriptHandlerUPP; - AEEventHandlerUPP PrefsHandlerUPP; - static Boolean initialized = FALSE; - - if (!initialized) { - initialized = TRUE; - - /* - * Install event handlers for the core apple events. - */ - - QuitHandlerUPP = NewAEEventHandlerUPP(QuitHandler); - ChkErr(AEInstallEventHandler, kCoreEventClass, kAEQuitApplication, - QuitHandlerUPP, (SRefCon) interp, false); - - OappHandlerUPP = NewAEEventHandlerUPP(OappHandler); - ChkErr(AEInstallEventHandler, kCoreEventClass, kAEOpenApplication, - OappHandlerUPP, (SRefCon) interp, false); - - RappHandlerUPP = NewAEEventHandlerUPP(RappHandler); - ChkErr(AEInstallEventHandler, kCoreEventClass, kAEReopenApplication, - RappHandlerUPP, (SRefCon) interp, false); - - OdocHandlerUPP = NewAEEventHandlerUPP(OdocHandler); - ChkErr(AEInstallEventHandler, kCoreEventClass, kAEOpenDocuments, - OdocHandlerUPP, (SRefCon) interp, false); - - PrintHandlerUPP = NewAEEventHandlerUPP(PrintHandler); - ChkErr(AEInstallEventHandler, kCoreEventClass, kAEPrintDocuments, - PrintHandlerUPP, (SRefCon) interp, false); - - PrefsHandlerUPP = NewAEEventHandlerUPP(PrefsHandler); - ChkErr(AEInstallEventHandler, kCoreEventClass, kAEShowPreferences, - PrefsHandlerUPP, (SRefCon) interp, false); - - if (interp) { - ScriptHandlerUPP = NewAEEventHandlerUPP(ScriptHandler); - ChkErr(AEInstallEventHandler, kAEMiscStandards, kAEDoScript, - ScriptHandlerUPP, (SRefCon) interp, false); - } - } -} - -/* - *---------------------------------------------------------------------- - * - * TkMacOSXDoHLEvent -- - * - * Dispatch incomming highlevel events. - * - * Results: - * None. - * - * Side effects: - * Depends on the incoming event. - * - *---------------------------------------------------------------------- - */ - -int -TkMacOSXDoHLEvent( - void *theEvent) -{ - return AEProcessAppleEvent((EventRecord *)theEvent); -} - -/* - *---------------------------------------------------------------------- - * - * QuitHandler -- - * - * This is the 'quit' core Apple event handler. - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ -static OSErr -QuitHandler( - const AppleEvent *event, - AppleEvent *reply, - SRefCon handlerRefcon) +- (void) handleQuitApplicationEvent: (NSAppleEventDescriptor *)event + withReplyEvent: (NSAppleEventDescriptor *)replyEvent { - Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon; KillEvent *eventPtr; - if (interp) { + if (_eventInterp) { /* * Call the exit command from the event loop, since you are not * supposed to call ExitToShell in an Apple Event Handler. We put this @@ -188,287 +69,290 @@ QuitHandler( eventPtr = ckalloc(sizeof(KillEvent)); eventPtr->header.proc = ReallyKillMe; - eventPtr->interp = interp; + eventPtr->interp = _eventInterp; Tcl_QueueEvent((Tcl_Event *) eventPtr, TCL_QUEUE_HEAD); } - return noErr; } - -/* - *---------------------------------------------------------------------- - * - * OappHandler -- - * - * This is the 'oapp' core Apple event handler. - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ -static OSErr -OappHandler( - const AppleEvent *event, - AppleEvent *reply, - SRefCon handlerRefcon) +- (void) handleOpenApplicationEvent: (NSAppleEventDescriptor *)event + withReplyEvent: (NSAppleEventDescriptor *)replyEvent { - Tcl_CmdInfo dummy; - Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon; + Tcl_Interp *interp = _eventInterp; if (interp && - Tcl_GetCommandInfo(interp, "::tk::mac::OpenApplication", &dummy)){ - int code = Tcl_EvalEx(interp, "::tk::mac::OpenApplication", -1, TCL_EVAL_GLOBAL); + Tcl_FindCommand(_eventInterp, "::tk::mac::OpenApplication", NULL, 0)){ + int code = Tcl_EvalEx(_eventInterp, "::tk::mac::OpenApplication", + -1, TCL_EVAL_GLOBAL); if (code != TCL_OK) { - Tcl_BackgroundException(interp, code); + Tcl_BackgroundException(_eventInterp, code); } } - return noErr; } - -/* - *---------------------------------------------------------------------- - * - * RappHandler -- - * - * This is the 'rapp' core Apple event handler. - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ -static OSErr -RappHandler( - const AppleEvent *event, - AppleEvent *reply, - SRefCon handlerRefcon) +- (void) handleReopenApplicationEvent: (NSAppleEventDescriptor *)event + withReplyEvent: (NSAppleEventDescriptor *)replyEvent { - Tcl_CmdInfo dummy; - Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon; +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090 ProcessSerialNumber thePSN = {0, kCurrentProcess}; - OSStatus err = ChkErr(SetFrontProcess, &thePSN); - - if (interp && Tcl_GetCommandInfo(interp, - "::tk::mac::ReopenApplication", &dummy)) { - int code = Tcl_EvalEx(interp, "::tk::mac::ReopenApplication", -1, TCL_EVAL_GLOBAL); + SetFrontProcess(&thePSN); +#else + [[NSApplication sharedApplication] activateIgnoringOtherApps: YES]; +#endif + if (_eventInterp && Tcl_FindCommand(_eventInterp, + "::tk::mac::ReopenApplication", NULL, 0)) { + int code = Tcl_EvalEx(_eventInterp, "::tk::mac::ReopenApplication", + -1, TCL_EVAL_GLOBAL); if (code != TCL_OK){ - Tcl_BackgroundException(interp, code); + Tcl_BackgroundException(_eventInterp, code); } } - return err; } - -/* - *---------------------------------------------------------------------- - * - * PrefsHandler -- - * - * This is the 'pref' core Apple event handler. Called when the user - * selects 'Preferences...' in MacOS X - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ -static OSErr -PrefsHandler( - const AppleEvent *event, - AppleEvent *reply, - SRefCon handlerRefcon) +- (void) handleShowPreferencesEvent: (NSAppleEventDescriptor *)event + withReplyEvent: (NSAppleEventDescriptor *)replyEvent { - Tcl_CmdInfo dummy; - Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon; - - if (interp && - Tcl_GetCommandInfo(interp, "::tk::mac::ShowPreferences", &dummy)){ - int code = Tcl_EvalEx(interp, "::tk::mac::ShowPreferences", -1, TCL_EVAL_GLOBAL); + if (_eventInterp && + Tcl_FindCommand(_eventInterp, "::tk::mac::ShowPreferences", NULL, 0)){ + int code = Tcl_EvalEx(_eventInterp, "::tk::mac::ShowPreferences", + -1, TCL_EVAL_GLOBAL); if (code != TCL_OK) { - Tcl_BackgroundException(interp, code); + Tcl_BackgroundException(_eventInterp, code); } } - return noErr; } - -/* - *---------------------------------------------------------------------- - * - * OdocHandler -- - * - * This is the 'odoc' core Apple event handler. - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ -static OSErr -OdocHandler( - const AppleEvent *event, - AppleEvent *reply, - SRefCon handlerRefcon) +- (void) handleOpenDocumentsEvent: (NSAppleEventDescriptor *)event + withReplyEvent: (NSAppleEventDescriptor *)replyEvent { - Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon; - AEDescList fileSpecList; - FSRef file; - DescType type; - Size actual; - long count, index; - AEKeyword keyword; - Tcl_DString command, pathName; - Tcl_CmdInfo dummy; - int code; + tkMacOSXProcessFiles(event, replyEvent, _eventInterp, "::tk::mac::OpenDocument"); +} - /* - * Don't bother if we don't have an interp or the open document procedure - * doesn't exist. - */ +- (void) handlePrintDocumentsEvent: (NSAppleEventDescriptor *)event + withReplyEvent: (NSAppleEventDescriptor *)replyEvent +{ + tkMacOSXProcessFiles(event, replyEvent, _eventInterp, "::tk::mac::PrintDocument"); +} - if (!interp || - !Tcl_GetCommandInfo(interp, "::tk::mac::OpenDocument", &dummy)) { - return noErr; - } +- (void) handleDoScriptEvent: (NSAppleEventDescriptor *)event + withReplyEvent: (NSAppleEventDescriptor *)replyEvent +{ + OSStatus err; + const AEDesc *theDesc = nil; + DescType type = 0, initialType = 0; + Size actual; + int tclErr = -1; + char URLBuffer[1 + URL_MAX_LENGTH]; + char errString[128]; + char typeString[5]; /* - * If we get any errors while retrieving our parameters we just return with - * no error. + * The DoScript event receives one parameter that should be text data or a + * fileURL. */ - if (ChkErr(AEGetParamDesc, event, keyDirectObject, typeAEList, - &fileSpecList) != noErr) { - return noErr; + theDesc = [event aeDesc]; + if (theDesc == nil) { + return; } - if (MissedAnyParameters(event) != noErr) { - return noErr; - } - if (ChkErr(AECountItems, &fileSpecList, &count) != noErr) { - return noErr; + + err = AEGetParamPtr(theDesc, keyDirectObject, typeWildCard, &initialType, + NULL, 0, NULL); + if (err != noErr) { + sprintf(errString, "AEDoScriptHandler: GetParamDesc error %d", (int)err); + AEPutParamPtr((AppleEvent*)[replyEvent aeDesc], keyErrorString, typeChar, + errString, strlen(errString)); + return; } - /* - * Convert our parameters into a script to evaluate, skipping things that - * we can't handle right. - */ + if (MissedAnyParameters((AppleEvent*)theDesc)) { + sprintf(errString, "AEDoScriptHandler: extra parameters"); + AEPutParamPtr((AppleEvent*)[replyEvent aeDesc], keyErrorString, typeChar, + errString, strlen(errString)); + return; + } - Tcl_DStringInit(&command); - Tcl_DStringAppend(&command, "::tk::mac::OpenDocument", -1); - for (index = 1; index <= count; index++) { - if (ChkErr(AEGetNthPtr, &fileSpecList, index, typeFSRef, &keyword, - &type, (Ptr) &file, sizeof(FSRef), &actual) != noErr) { - continue; + if (initialType == typeFileURL || initialType == typeAlias) { + /* + * The descriptor can be coerced to a file url. Source the file, or + * pass the path as a string argument to ::tk::mac::DoScriptFile if + * that procedure exists. + */ + err = AEGetParamPtr(theDesc, keyDirectObject, typeFileURL, &type, + (Ptr) URLBuffer, URL_MAX_LENGTH, &actual); + if (err == noErr && actual > 0){ + URLBuffer[actual] = '\0'; + NSString *urlString = [NSString stringWithUTF8String:(char*)URLBuffer]; + NSURL *fileURL = [NSURL URLWithString:urlString]; + Tcl_DString command; + Tcl_DStringInit(&command); + if (Tcl_FindCommand(_eventInterp, "::tk::mac::DoScriptFile", NULL, 0)){ + Tcl_DStringAppend(&command, "::tk::mac::DoScriptFile", -1); + } else { + Tcl_DStringAppend(&command, "source", -1); + } + Tcl_DStringAppendElement(&command, [[fileURL path] UTF8String]); + tclErr = Tcl_EvalEx(_eventInterp, Tcl_DStringValue(&command), + Tcl_DStringLength(&command), TCL_EVAL_GLOBAL); } - - if (ChkErr(FSRefToDString, &file, &pathName) == noErr) { - Tcl_DStringAppendElement(&command, Tcl_DStringValue(&pathName)); - Tcl_DStringFree(&pathName); + } else if (noErr == AEGetParamPtr(theDesc, keyDirectObject, typeUTF8Text, &type, + NULL, 0, &actual)) { + if (actual > 0) { + /* + * The descriptor can be coerced to UTF8 text. Evaluate as Tcl, or + * or pass the text as a string argument to ::tk::mac::DoScriptText + * if that procedure exists. + */ + char *data = ckalloc(actual + 1); + if (noErr == AEGetParamPtr(theDesc, keyDirectObject, typeUTF8Text, &type, + data, actual, NULL)) { + if (Tcl_FindCommand(_eventInterp, "::tk::mac::DoScriptText", NULL, 0)){ + Tcl_DString command; + Tcl_DStringInit(&command); + Tcl_DStringAppend(&command, "::tk::mac::DoScriptText", -1); + Tcl_DStringAppendElement(&command, data); + tclErr = Tcl_EvalEx(_eventInterp, Tcl_DStringValue(&command), + Tcl_DStringLength(&command), TCL_EVAL_GLOBAL); + } else { + tclErr = Tcl_EvalEx(_eventInterp, data, actual, TCL_EVAL_GLOBAL); + } + } + ckfree(data); + } + } else { + /* + * The descriptor can not be coerced to a fileURL or UTF8 text. + */ + for (int i = 0; i < 4; i++) { + typeString[i] = ((char*)&initialType)[3-i]; } + typeString[4] = '\0'; + sprintf(errString, "AEDoScriptHandler: invalid script type '%s', " + "must be coercable to 'furl' or 'utf8'", typeString); + AEPutParamPtr((AppleEvent*)[replyEvent aeDesc], keyErrorString, typeChar, errString, + strlen(errString)); } - /* - * Now handle the event by evaluating a script. + * If we ran some Tcl code, put the result in the reply. */ - - code = Tcl_EvalEx(interp, Tcl_DStringValue(&command), - Tcl_DStringLength(&command), TCL_EVAL_GLOBAL); - if (code != TCL_OK) { - Tcl_BackgroundException(interp, code); + if (tclErr >= 0) { + int reslen; + const char *result = + Tcl_GetStringFromObj(Tcl_GetObjResult(_eventInterp), &reslen); + if (tclErr == TCL_OK) { + AEPutParamPtr((AppleEvent*)[replyEvent aeDesc], keyDirectObject, typeChar, + result, reslen); + } else { + AEPutParamPtr((AppleEvent*)[replyEvent aeDesc], keyErrorString, typeChar, + result, reslen); + AEPutParamPtr((AppleEvent*)[replyEvent aeDesc], keyErrorNumber, typeSInt32, + (Ptr) &tclErr,sizeof(int)); + } } - Tcl_DStringFree(&command); - return noErr; + return; } - +@end + +#pragma mark - + /* *---------------------------------------------------------------------- * - * PrintHandler -- + * TkMacOSXProcessFiles -- * - * This is the 'pdoc' core Apple event handler. + * Extract a list of fileURLs from an AppleEvent and call the specified + * procedure with the file paths as arguments. * * Results: * None. * * Side effects: - * None. + * The event is handled by running the procedure. * *---------------------------------------------------------------------- */ -static OSErr -PrintHandler( - const AppleEvent * event, - AppleEvent * reply, - SRefCon handlerRefcon) +static void +tkMacOSXProcessFiles( + NSAppleEventDescriptor* event, + NSAppleEventDescriptor* replyEvent, + Tcl_Interp *interp, + char* procedure) { - Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon; - AEDescList fileSpecList; - FSRef file; + Tcl_Encoding utf8 = Tcl_GetEncoding(NULL, "utf-8"); + const AEDesc *fileSpecDesc = nil; + AEDesc contents; + char URLString[1 + URL_MAX_LENGTH]; + NSURL *fileURL; DescType type; Size actual; long count, index; AEKeyword keyword; Tcl_DString command, pathName; - Tcl_CmdInfo dummy; int code; /* - * Don't bother if we don't have an interp or the print document procedure - * doesn't exist. + * Do nothing if we don't have an interpreter or the procedure doesn't exist. */ - if (!interp || - !Tcl_GetCommandInfo(interp, "::tk::mac::PrintDocument", &dummy)) { - return noErr; + if (!interp || !Tcl_FindCommand(interp, procedure, NULL, 0)) { + return; + } + + fileSpecDesc = [event aeDesc]; + if (fileSpecDesc == nil ) { + return; } /* - * If we get any errors while retrieving our parameters we just return with - * no error. + * The AppleEvent's descriptor should either contain a value of + * typeObjectSpecifier or typeAEList. In the first case, the descriptor + * can be treated as a list of size 1 containing a value which can be + * coerced into a fileURL. In the second case we want to work with the list + * itself. Values in the list will be coerced into fileURL's if possible; + * otherwise they will be ignored. */ - if (ChkErr(AEGetParamDesc, event, keyDirectObject, typeAEList, - &fileSpecList) != noErr) { - return noErr; - } - if (ChkErr(MissedAnyParameters, event) != noErr) { - return noErr; + /* Get a copy of the AppleEvent's descriptor. */ + AEGetParamDesc(fileSpecDesc, keyDirectObject, typeWildCard, &contents); + if (contents.descriptorType == typeAEList) { + fileSpecDesc = &contents; } - if (ChkErr(AECountItems, &fileSpecList, &count) != noErr) { - return noErr; + + if (AECountItems(fileSpecDesc, &count) != noErr) { + AEDisposeDesc(&contents); + return; } + /* + * Construct a Tcl command which calls the procedure, passing the + * paths contained in the AppleEvent as arguments. + */ + Tcl_DStringInit(&command); - Tcl_DStringAppend(&command, "::tk::mac::PrintDocument", -1); + Tcl_DStringAppend(&command, procedure, -1); + for (index = 1; index <= count; index++) { - if (ChkErr(AEGetNthPtr, &fileSpecList, index, typeFSRef, &keyword, - &type, (Ptr) &file, sizeof(FSRef), &actual) != noErr) { + if (noErr != AEGetNthPtr(fileSpecDesc, index, typeFileURL, &keyword, + &type, (Ptr) URLString, URL_MAX_LENGTH, &actual)) { continue; } - - if (ChkErr(FSRefToDString, &file, &pathName) == noErr) { - Tcl_DStringAppendElement(&command, Tcl_DStringValue(&pathName)); - Tcl_DStringFree(&pathName); + if (type != typeFileURL) { + continue; + } + URLString[actual] = '\0'; + fileURL = [NSURL URLWithString:[NSString stringWithUTF8String:(char*)URLString]]; + if (fileURL == nil) { + continue; } + Tcl_ExternalToUtfDString(utf8, [[fileURL path] UTF8String], -1, &pathName); + Tcl_DStringAppendElement(&command, Tcl_DStringValue(&pathName)); + Tcl_DStringFree(&pathName); } + AEDisposeDesc(&contents); /* - * Now handle the event by evaluating a script. + * Handle the event by evaluating the Tcl expression we constructed. */ code = Tcl_EvalEx(interp, Tcl_DStringValue(&command), @@ -477,18 +361,19 @@ PrintHandler( Tcl_BackgroundException(interp, code); } Tcl_DStringFree(&command); - return noErr; + return; } /* *---------------------------------------------------------------------- * - * ScriptHandler -- + * TkMacOSXInitAppleEvents -- * - * This handler process the script event. + * Register AppleEvent handlers with the NSAppleEventManager for + * this NSApplication. * * Results: - * Schedules the given event to be processed. + * None. * * Side effects: * None. @@ -496,108 +381,91 @@ PrintHandler( *---------------------------------------------------------------------- */ -static OSErr -ScriptHandler( - const AppleEvent *event, - AppleEvent *reply, - SRefCon handlerRefcon) +void +TkMacOSXInitAppleEvents( + Tcl_Interp *interp) /* not used */ { - OSStatus theErr; - AEDescList theDesc; - Size size; - int tclErr = -1; - Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon; - char errString[128]; + NSAppleEventManager *aeManager = [NSAppleEventManager sharedAppleEventManager]; + static Boolean initialized = FALSE; - /* - * The do script event receives one parameter that should be data or a - * file. - */ + if (!initialized) { + initialized = TRUE; - theErr = AEGetParamDesc(event, keyDirectObject, typeWildCard, - &theDesc); - if (theErr != noErr) { - sprintf(errString, "AEDoScriptHandler: GetParamDesc error %d", - (int)theErr); - theErr = AEPutParamPtr(reply, keyErrorString, typeChar, errString, - strlen(errString)); - } else if (MissedAnyParameters(event)) { - /* - * Return error if parameter is missing. - */ + [aeManager setEventHandler:NSApp + andSelector:@selector(handleQuitApplicationEvent:withReplyEvent:) + forEventClass:kCoreEventClass andEventID:kAEQuitApplication]; - sprintf(errString, "AEDoScriptHandler: extra parameters"); - AEPutParamPtr(reply, keyErrorString, typeChar, errString, - strlen(errString)); - theErr = -1771; - } else if (theDesc.descriptorType == (DescType) typeAlias && - AEGetParamPtr(event, keyDirectObject, typeFSRef, NULL, NULL, - 0, &size) == noErr && size == sizeof(FSRef)) { - /* - * We've had a file sent to us. Source it. - */ + [aeManager setEventHandler:NSApp + andSelector:@selector(handleOpenApplicationEvent:withReplyEvent:) + forEventClass:kCoreEventClass andEventID:kAEOpenApplication]; - FSRef file; - theErr = AEGetParamPtr(event, keyDirectObject, typeFSRef, NULL, &file, - size, NULL); - if (theErr == noErr) { - Tcl_DString scriptName; + [aeManager setEventHandler:NSApp + andSelector:@selector(handleReopenApplicationEvent:withReplyEvent:) + forEventClass:kCoreEventClass andEventID:kAEReopenApplication]; - theErr = FSRefToDString(&file, &scriptName); - if (theErr == noErr) { - tclErr = Tcl_FSEvalFileEx(interp, Tcl_DStringValue(&scriptName), NULL); - Tcl_DStringFree(&scriptName); - } else { - sprintf(errString, "AEDoScriptHandler: file not found"); - AEPutParamPtr(reply, keyErrorString, typeChar, errString, - strlen(errString)); - } - } - } else if (AEGetParamPtr(event, keyDirectObject, typeUTF8Text, NULL, NULL, - 0, &size) == noErr && size) { - /* - * We've had some data sent to us. Evaluate it. - */ + [aeManager setEventHandler:NSApp + andSelector:@selector(handleShowPreferencesEvent:withReplyEvent:) + forEventClass:kCoreEventClass andEventID:kAEShowPreferences]; - char *data = ckalloc(size + 1); - theErr = AEGetParamPtr(event, keyDirectObject, typeUTF8Text, NULL, data, - size, NULL); - if (theErr == noErr) { - tclErr = Tcl_EvalEx(interp, data, size, TCL_EVAL_GLOBAL); - } - } else { - /* - * Umm, don't recognize what we've got... - */ + [aeManager setEventHandler:NSApp + andSelector:@selector(handleOpenDocumentsEvent:withReplyEvent:) + forEventClass:kCoreEventClass andEventID:kAEOpenDocuments]; + + [aeManager setEventHandler:NSApp + andSelector:@selector(handleOpenDocumentsEvent:withReplyEvent:) + forEventClass:kCoreEventClass andEventID:kAEPrintDocuments]; - sprintf(errString, "AEDoScriptHandler: invalid script type '%-4.4s', " - "must be 'alis' or coercable to 'utf8'", - (char*) &theDesc.descriptorType); - AEPutParamPtr(reply, keyErrorString, typeChar, errString, - strlen(errString)); - theErr = -1770; + [aeManager setEventHandler:NSApp + andSelector:@selector(handleDoScriptEvent:withReplyEvent:) + forEventClass:kAEMiscStandards andEventID:kAEDoScript]; } +} + +/* + *---------------------------------------------------------------------- + * + * TkMacOSXDoHLEvent -- + * + * Dispatch an AppleEvent. + * + * Results: + * None. + * + * Side effects: + * Depend on the AppleEvent. + * + *---------------------------------------------------------------------- + */ - /* - * If we actually go to run Tcl code - put the result in the reply. +int +TkMacOSXDoHLEvent( + void *theEvent) +{ + /* According to the NSAppleEventManager reference: + * "The theReply parameter always specifies a reply Apple event, never + * nil. However, the handler should not fill out the reply if the + * descriptor type for the reply event is typeNull, indicating the sender + * does not want a reply." + * The specified way to build such a non-nil descriptor is used here. But + * on OSX 10.11, the compiler nonetheless generates a warning. I am + * supressing the warning here -- maybe the warnings will stop in a future + * compiler release. */ +#ifdef __clang__ +#pragma clang diagnostic push +#pragma clang diagnostic ignored "-Wnonnull" +#endif - if (tclErr >= 0) { - int reslen; - const char *result = - Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &reslen); + NSAppleEventDescriptor* theReply = [NSAppleEventDescriptor nullDescriptor]; + NSAppleEventManager *aeManager = [NSAppleEventManager sharedAppleEventManager]; - if (tclErr == TCL_OK) { - AEPutParamPtr(reply, keyDirectObject, typeChar, result, reslen); - } else { - AEPutParamPtr(reply, keyErrorString, typeChar, result, reslen); - AEPutParamPtr(reply, keyErrorNumber, typeSInt32, (Ptr) &tclErr, - sizeof(int)); - } - } + return [aeManager dispatchRawAppleEvent:(const AppleEvent*)theEvent + withRawReply: (AppleEvent *)theReply + handlerRefCon: (SRefCon)0]; - AEDisposeDesc(&theDesc); - return theErr; +#ifdef __clang__ +#pragma clang diagnostic pop +#endif } /* @@ -605,8 +473,8 @@ ScriptHandler( * * ReallyKillMe -- * - * This proc tries to kill the shell by running exit, called from an - * event scheduled by the "Quit" AppleEvent handler. + * This procedure tries to kill the shell by running exit, called from + * an event scheduled by the "Quit" AppleEvent handler. * * Results: * Runs the "exit" command which might kill the shell. @@ -623,8 +491,7 @@ ReallyKillMe( int flags) { Tcl_Interp *interp = ((KillEvent *) eventPtr)->interp; - Tcl_CmdInfo dummy; - int quit = Tcl_GetCommandInfo(interp, "::tk::mac::Quit", &dummy); + int quit = Tcl_FindCommand(interp, "::tk::mac::Quit", NULL, 0)!=NULL; int code = Tcl_EvalEx(interp, quit ? "::tk::mac::Quit" : "exit", -1, TCL_EVAL_GLOBAL); if (code != TCL_OK) { @@ -667,37 +534,7 @@ MissedAnyParameters( return (err != errAEDescNotFound); } -/* - *---------------------------------------------------------------------- - * - * FSRefToDString -- - * - * Get a POSIX path from an FSRef. - * - * Results: - * In the parameter ds. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static OSStatus -FSRefToDString( - const FSRef *fsref, - Tcl_DString *ds) -{ - UInt8 fileName[PATH_MAX+1]; - OSStatus err; - err = ChkErr(FSRefMakePath, fsref, fileName, sizeof(fileName)); - if (err == noErr) { - Tcl_ExternalToUtfDString(NULL, (char*) fileName, -1, ds); - } - return err; -} - /* * Local Variables: * mode: objc diff --git a/macosx/tkMacOSXInit.c b/macosx/tkMacOSXInit.c index 1f70149..b965a38 100644 --- a/macosx/tkMacOSXInit.c +++ b/macosx/tkMacOSXInit.c @@ -28,7 +28,6 @@ static char tkLibPath[PATH_MAX + 1] = ""; static char scriptPath[PATH_MAX + 1] = ""; -int tkMacOSXGCEnabled = 0; long tkMacOSXMacOSXVersion = 0; #pragma mark TKApplication(TKInit) @@ -53,18 +52,24 @@ static void keyboardChanged(CFNotificationCenterRef center, void *observer, CFSt - (void) _setupWindowNotifications; @end -@interface TKApplication(TKScrlbr) -- (void) _setupScrollBarNotifications; -@end - @interface TKApplication(TKMenus) - (void) _setupMenus; @end @implementation TKApplication +#ifndef __clang__ +@synthesize poolProtected = _poolProtected; +#endif @end @implementation TKApplication(TKInit) +- (void) _resetAutoreleasePool +{ + if(![self poolProtected]) { + [_mainPool drain]; + _mainPool = [NSAutoreleasePool new]; + } +} #ifdef TK_MAC_DEBUG_NOTIFICATIONS - (void) _postedNotification: (NSNotification *) notification { @@ -91,17 +96,17 @@ static void keyboardChanged(CFNotificationCenterRef center, void *observer, CFSt - (void) _setupEventLoop { - _running = 1; - if (!_appFlags._hasBeenRun) { - _appFlags._hasBeenRun = YES; - [self finishLaunching]; - } + NSAutoreleasePool *pool = [NSAutoreleasePool new]; + [self finishLaunching]; [self setWindowsNeedUpdate:YES]; + [pool drain]; } - (void) _setup: (Tcl_Interp *) interp { _eventInterp = interp; + _mainPool = [NSAutoreleasePool new]; + [NSApp setPoolProtected:NO]; _defaultMainMenu = nil; [self _setupMenus]; [self setDelegate:self]; @@ -110,14 +115,13 @@ static void keyboardChanged(CFNotificationCenterRef center, void *observer, CFSt selector:@selector(_postedNotification:) name:nil object:nil]; #endif [self _setupWindowNotifications]; - [self _setupScrollBarNotifications]; [self _setupApplicationNotifications]; } - (NSString *) tkFrameworkImagePath: (NSString *) image { NSString *path = nil; - + NSAutoreleasePool *pool = [NSAutoreleasePool new]; if (tkLibPath[0] != '\0') { path = [[NSBundle bundleWithPath:[[NSString stringWithUTF8String: tkLibPath] stringByAppendingString:@"/../.."]] @@ -150,6 +154,8 @@ static void keyboardChanged(CFNotificationCenterRef center, void *observer, CFSt } } #endif + [path retain]; + [pool drain]; return path; } @end @@ -176,6 +182,7 @@ static void SetApplicationIcon( ClientData clientData) { + NSAutoreleasePool *pool = [NSAutoreleasePool new]; NSString *path = [NSApp tkFrameworkImagePath:@"Tk.icns"]; if (path) { NSImage *image = [[NSImage alloc] initWithContentsOfFile:path]; @@ -184,6 +191,7 @@ SetApplicationIcon( [image release]; } } + [pool drain]; } /* @@ -236,12 +244,17 @@ TkpInit( if (!uname(&name)) { tkMacOSXMacOSXVersion = (strtod(name.release, NULL) + 96) * 10; } - if (tkMacOSXMacOSXVersion && + /*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 @@ -256,20 +269,19 @@ TkpInit( } #endif - static NSAutoreleasePool *pool = nil; - if (!pool) { - pool = [NSAutoreleasePool new]; + { + NSAutoreleasePool *pool = [NSAutoreleasePool new]; + [[NSUserDefaults standardUserDefaults] registerDefaults: + [NSDictionary dictionaryWithObjectsAndKeys: + [NSNumber numberWithBool:YES], + @"_NSCanWrapButtonTitles", + [NSNumber numberWithInt:-1], + @"NSStringDrawingTypesetterBehavior", + nil]]; + [TKApplication sharedApplication]; + [pool drain]; + [NSApp _setup:interp]; } - tkMacOSXGCEnabled = ([NSGarbageCollector defaultCollector] != nil); - [[NSUserDefaults standardUserDefaults] registerDefaults: - [NSDictionary dictionaryWithObjectsAndKeys: - [NSNumber numberWithBool:YES], - @"_NSCanWrapButtonTitles", - [NSNumber numberWithInt:-1], - @"NSStringDrawingTypesetterBehavior", - nil]]; - [TKApplication sharedApplication]; - [NSApp _setup:interp]; /* Check whether we are a bundled executable: */ bundleRef = CFBundleGetMainBundle(); @@ -326,12 +338,14 @@ TkpInit( Tcl_DoWhenIdle(SetApplicationIcon, NULL); } - [NSApp _setupEventLoop]; - TkMacOSXInitAppleEvents(interp); - TkMacOSXUseAntialiasedText(interp, -1); - TkMacOSXInitCGDrawing(interp, TRUE, 0); - [pool drain]; - pool = [NSAutoreleasePool new]; + { + NSAutoreleasePool *pool = [NSAutoreleasePool new]; + [NSApp _setupEventLoop]; + TkMacOSXInitAppleEvents(interp); + TkMacOSXUseAntialiasedText(interp, -1); + TkMacOSXInitCGDrawing(interp, TRUE, 0); + [pool drain]; + } /* * FIXME: Close stdin & stdout for remote debugging otherwise we will @@ -488,9 +502,8 @@ TkpDisplayWarning( MODULE_SCOPE void TkMacOSXDefaultStartupScript(void) { - CFBundleRef bundleRef; - - bundleRef = CFBundleGetMainBundle(); + NSAutoreleasePool *pool = [NSAutoreleasePool new]; + CFBundleRef bundleRef = CFBundleGetMainBundle(); if (bundleRef != NULL) { CFURLRef appMainURL = CFBundleCopyResourceURL(bundleRef, @@ -514,6 +527,7 @@ TkMacOSXDefaultStartupScript(void) CFRelease(appMainURL); } } + [pool drain]; } /* diff --git a/macosx/tkMacOSXInt.h b/macosx/tkMacOSXInt.h index 813acce..6971e26 100644 --- a/macosx/tkMacOSXInt.h +++ b/macosx/tkMacOSXInt.h @@ -24,6 +24,7 @@ #ifndef _TKMAC #include "tkMacOSX.h" +#import <Cocoa/Cocoa.h> #endif /* @@ -85,7 +86,7 @@ typedef struct TkWindowPrivate MacDrawable; #define TK_FOCUSED_VIEW 0x10 #define TK_IS_PIXMAP 0x20 #define TK_IS_BW_PIXMAP 0x40 - +#define TK_DO_NOT_DRAW 0x80 /* * 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 @@ -196,7 +197,7 @@ MODULE_SCOPE void TkpClipDrawableToRect(Display *display, Drawable d, int x, int y, int width, int height); MODULE_SCOPE void TkpRetainRegion(TkRegion r); MODULE_SCOPE void TkpReleaseRegion(TkRegion r); - +MODULE_SCOPE void TkpShiftButton(NSButton *button, NSPoint delta); /* * Include the stubbed internal platform-specific API. */ diff --git a/macosx/tkMacOSXKeyEvent.c b/macosx/tkMacOSXKeyEvent.c index 1d24960..151b4f2 100644 --- a/macosx/tkMacOSXKeyEvent.c +++ b/macosx/tkMacOSXKeyEvent.c @@ -7,6 +7,7 @@ * Copyright 2001-2009, Apple Inc. * Copyright (c) 2006-2009 Daniel A. Steffen <das@users.sourceforge.net> * Copyright (c) 2012 Adrian Robert. + * Copyright 2015 Marc Culler. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -27,7 +28,9 @@ static Tk_Window grabWinPtr = NULL; /* Current grab window, NULL if no grab. */ static Tk_Window keyboardGrabWinPtr = NULL; /* Current keyboard grab window. */ -static NSModalSession modalSession = NULL; +static NSWindow *keyboardGrabNSWindow = nil; + /* NSWindow for the current keyboard grab window. */ +static NSModalSession modalSession = nil; static BOOL processingCompose = NO; static BOOL finishedCompose = NO; @@ -78,16 +81,18 @@ static unsigned isFunctionKey(unsigned int code); case NSFlagsChanged: modifiers = [theEvent modifierFlags]; keyCode = [theEvent keyCode]; - w = [self windowWithWindowNumber:[theEvent windowNumber]]; + // 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); #endif break; default: - return theEvent; + return theEvent; /* Unrecognized key event. */ } + /* Create an Xevent to add to the Tk queue. */ if (!processingCompose) { unsigned int state = 0; @@ -128,7 +133,7 @@ static unsigned isFunctionKey(unsigned int code); tkwin = (Tk_Window) winPtr->dispPtr->focusPtr; if (!tkwin) { TkMacOSXDbgMsg("tkwin == NULL"); - return theEvent; + return theEvent; /* Give up. No window for this event. */ } /* @@ -222,7 +227,7 @@ static unsigned isFunctionKey(unsigned int code); -@implementation TKContentView(TKKeyEvent) +@implementation TKContentView /* <NSTextInput> implementation (called through interpretKeyEvents:]). */ /* <NSTextInput>: called when done composing; @@ -241,7 +246,7 @@ static unsigned isFunctionKey(unsigned int code); finishedCompose = YES; /* first, clear any working text */ - if (_workingText != nil) + if (privateWorkingText != nil) [self deleteWorkingText]; /* now insert the string as keystrokes */ @@ -272,46 +277,32 @@ static unsigned isFunctionKey(unsigned int code); NSString *str = [aString respondsToSelector: @selector (string)] ? [aString string] : aString; if (NS_KEYLOG) - NSLog (@"setMarkedText '%@' len =%d range %d from %d", str, [str length], - selRange.length, selRange.location); + NSLog (@"setMarkedText '%@' len =%lu range %lu from %lu", str, + (unsigned long) [str length], (unsigned long) selRange.length, + (unsigned long) selRange.location); - if (_workingText != nil) + if (privateWorkingText != nil) [self deleteWorkingText]; if ([str length] == 0) return; processingCompose = YES; - _workingText = [str copy]; + privateWorkingText = [str copy]; //PENDING: insert workingText underlined } -/* delete display of composing characters [not in <NSTextInput>] */ -- (void)deleteWorkingText -{ - if (_workingText == nil) - return; - if (NS_KEYLOG) - NSLog(@"deleteWorkingText len = %d\n", [_workingText length]); - [_workingText release]; - _workingText = nil; - processingCompose = NO; - - //PENDING: delete working text -} - - - (BOOL)hasMarkedText { - return _workingText != nil; + return privateWorkingText != nil; } - (NSRange)markedRange { - NSRange rng = _workingText != nil - ? NSMakeRange (0, [_workingText length]) : NSMakeRange (NSNotFound, 0); + NSRange rng = privateWorkingText != nil + ? NSMakeRange (0, [privateWorkingText length]) : NSMakeRange (NSNotFound, 0); if (NS_KEYLOG) NSLog (@"markedRange request"); return rng; @@ -337,7 +328,7 @@ static unsigned isFunctionKey(unsigned int code); pt.y = caret_y; pt = [self convertPoint: pt toView: nil]; - pt = [[self window] convertBaseToScreen: pt]; + pt = [[self window] convertPointToScreen: pt]; pt.y -= caret_height; rect.origin = pt; @@ -411,6 +402,24 @@ static unsigned isFunctionKey(unsigned int code); @end +@implementation TKContentView(TKKeyEvent) +/* delete display of composing characters [not in <NSTextInput>] */ +- (void)deleteWorkingText +{ + if (privateWorkingText == nil) + return; + if (NS_KEYLOG) + NSLog(@"deleteWorkingText len = %lu\n", + (unsigned long)[privateWorkingText length]); + [privateWorkingText release]; + privateWorkingText = nil; + processingCompose = NO; + + //PENDING: delete working text +} +@end + + /* * Set up basic fields in xevent for keyboard input. @@ -472,7 +481,9 @@ XGrabKeyboard( if (modalSession) { Tcl_Panic("XGrabKeyboard: already grabbed"); } - modalSession = [NSApp beginModalSessionForWindow:[w retain]]; + keyboardGrabNSWindow = w; + [w retain]; + modalSession = [NSApp beginModalSessionForWindow:w]; } } return GrabSuccess; @@ -500,11 +511,12 @@ XUngrabKeyboard( Time time) { if (modalSession) { - NSWindow *w = keyboardGrabWinPtr ? TkMacOSXDrawableWindow( - ((TkWindow *) keyboardGrabWinPtr)->window) : nil; [NSApp endModalSession:modalSession]; - [w release]; - modalSession = NULL; + modalSession = nil; + } + if (keyboardGrabNSWindow) { + [keyboardGrabNSWindow release]; + keyboardGrabNSWindow = nil; } keyboardGrabWinPtr = NULL; } diff --git a/macosx/tkMacOSXKeyboard.c b/macosx/tkMacOSXKeyboard.c index 54f99d3..7ac087d 100644 --- a/macosx/tkMacOSXKeyboard.c +++ b/macosx/tkMacOSXKeyboard.c @@ -734,7 +734,8 @@ TkpGetKeySym( */ if (eventPtr->xany.send_event == -1) { - int modifier = eventPtr->xkey.keycode; + + int modifier = eventPtr->xkey.keycode & NSDeviceIndependentModifierFlagsMask; if (modifier == NSCommandKeyMask) { return XK_Meta_L; diff --git a/macosx/tkMacOSXMenu.c b/macosx/tkMacOSXMenu.c index 83ad47a..c7e3a78 100644 --- a/macosx/tkMacOSXMenu.c +++ b/macosx/tkMacOSXMenu.c @@ -258,9 +258,10 @@ static int ModifierCharWidth(Tk_Font tkfont); if (menuPtr && mePtr) { Tcl_Interp *interp = menuPtr->interp; - /*Add time for errors to fire if necessary. This is sub-optimal but avoids issues with Tcl/Cocoa event loop integration.*/ + /*Add time for errors to fire if necessary. This is sub-optimal + *but avoids issues with Tcl/Cocoa event loop integration. + */ Tcl_Sleep(100); - Tcl_Preserve(interp); Tcl_Preserve(menuPtr); @@ -411,7 +412,7 @@ static int ModifierCharWidth(Tk_Font tkfont); if (!mePtr || !(mePtr->entryFlags & ENTRY_APPLE_MENU)) { applicationMenuItem = [NSMenuItem itemWithSubmenu: - [[_defaultApplicationMenu copy] autorelease]]; + [_defaultApplicationMenu copy]]; [menu insertItem:applicationMenuItem atIndex:0]; } [menu setSpecial:tkMainMenu]; @@ -419,7 +420,7 @@ static int ModifierCharWidth(Tk_Font tkfont); applicationMenu = (TKMenu *)[applicationMenuItem submenu]; if (![applicationMenu isSpecial:tkApplicationMenu]) { for (NSMenuItem *item in _defaultApplicationMenuItems) { - [applicationMenu addItem:[[item copy] autorelease]]; + [applicationMenu addItem:[item copy]]; } [applicationMenu setSpecial:tkApplicationMenu]; } @@ -429,15 +430,13 @@ static int ModifierCharWidth(Tk_Font tkfont); for (NSMenuItem *item in itemArray) { TkMenuEntry *mePtr = (TkMenuEntry *)[item tag]; TKMenu *submenu = (TKMenu *)[item submenu]; - if (mePtr && submenu) { if ((mePtr->entryFlags & ENTRY_WINDOWS_MENU) && ![submenu isSpecial:tkWindowsMenu]) { NSInteger index = 0; for (NSMenuItem *i in _defaultWindowsMenuItems) { - [submenu insertItem:[[i copy] autorelease] atIndex: - index++]; + [submenu insertItem:[i copy] atIndex:index++]; } [self setWindowsMenu:submenu]; [submenu setSpecial:tkWindowsMenu]; @@ -446,8 +445,7 @@ static int ModifierCharWidth(Tk_Font tkfont); NSInteger index = 0; for (NSMenuItem *i in _defaultHelpMenuItems) { - [submenu insertItem:[[i copy] autorelease] atIndex: - index++]; + [submenu insertItem:[i copy] atIndex:index++]; } [submenu setSpecial:tkHelpMenu]; } @@ -496,8 +494,7 @@ TkpNewMenu( * platform structure for. */ { TKMenu *menu = [[TKMenu alloc] initWithTkMenu:menuPtr]; - menuPtr->platformData = (TkMenuPlatformData) - TkMacOSXMakeUncollectable(menu); + menuPtr->platformData = (TkMenuPlatformData) menu; CheckForSpecialMenu(menuPtr); return TCL_OK; } @@ -522,7 +519,10 @@ void TkpDestroyMenu( TkMenu *menuPtr) /* The common menu structure */ { - TkMacOSXMakeCollectableAndRelease(menuPtr->platformData); + NSMenu* nsmenu = (NSMenu*)(menuPtr->platformData); + + [nsmenu release]; + menuPtr->platformData = NULL; } /* @@ -555,8 +555,7 @@ TkpMenuNewEntry( } else { menuItem = [menu newTkMenuItem:mePtr]; } - mePtr->platformEntryData = (TkMenuPlatformEntryData) - TkMacOSXMakeUncollectable(menuItem); + mePtr->platformEntryData = (TkMenuPlatformEntryData) menuItem; /* * Caller TkMenuEntry() already did this same insertion into the generic @@ -684,6 +683,9 @@ TkpConfigureMenuEntry( NSArray *itemArray = [submenu itemArray]; for (NSMenuItem *item in itemArray) { TkMenuEntry *submePtr = menuRefPtr->menuPtr->entries[i]; + /* Work around an apparent bug where itemArray can have + more items than the menu's entries[] array. */ + if (i >= menuRefPtr->menuPtr->numEntries) break; [item setEnabled: !(submePtr->state == ENTRY_DISABLED)]; i++; } @@ -717,16 +719,21 @@ void TkpDestroyMenuEntry( TkMenuEntry *mePtr) { + NSMenuItem *menuItem; + TKMenu *menu; + NSInteger index; + if (mePtr->platformEntryData && mePtr->menuPtr->platformData) { - TKMenu *menu = (TKMenu *) mePtr->menuPtr->platformData; - NSMenuItem *menuItem = (NSMenuItem *) mePtr->platformEntryData; - NSInteger index = [menu indexOfItem:menuItem]; + menu = (TKMenu *) mePtr->menuPtr->platformData; + menuItem = (NSMenuItem *) mePtr->platformEntryData; + index = [menu indexOfItem:menuItem]; if (index > -1) { [menu removeItemAtIndex:index]; } + [menuItem release]; + mePtr->platformEntryData = NULL; } - TkMacOSXMakeCollectableAndRelease(mePtr->platformEntryData); } /* @@ -754,11 +761,19 @@ TkpPostMenu( * to be posted. */ int y) /* The global y-coordinate */ { - NSWindow *win = [NSApp keyWindow]; - if (!win) { + + + /* Get the object that holds this Tk Window.*/ + Tk_Window root; + root = Tk_MainWindow(interp); + if (root == NULL) { return TCL_ERROR; } + Drawable d = Tk_WindowId(root); + NSView *rootview = TkMacOSXGetRootControl(d); + NSWindow *win = [rootview window]; + inPostMenu = 1; int oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE); @@ -766,7 +781,7 @@ TkpPostMenu( NSRect frame = NSMakeRect(x + 9, tkMacOSXZeroScreenHeight - y - 9, 1, 1); frame.origin = [view convertPoint: - [win convertScreenToBase:frame.origin] fromView:nil]; + [win convertPointFromScreen:frame.origin] fromView:nil]; NSMenu *menu = (NSMenu *) menuPtr->platformData; NSPopUpButtonCell *popUpButtonCell = [[NSPopUpButtonCell alloc] @@ -819,11 +834,16 @@ TkpSetWindowMenuBar( * Puts the menu associated with a window into the menubar. Should only * be called when the window is in front. * + * This is a no-op on all other platforms. On OS X it is a no-op when + * passed a NULL menuName or a nonexistent menuName, with an exception + * for the first call in a new interpreter. In that special case, passing a + * NULL menuName installs the default menu. + * * Results: * None. * * Side effects: - * The menubar is changed. + * The menubar may be changed. * *---------------------------------------------------------------------- */ @@ -832,8 +852,7 @@ void TkpSetMainMenubar( Tcl_Interp *interp, /* The interpreter of the application */ Tk_Window tkwin, /* The frame we are setting up */ - const char *menuName) /* The name of the menu to put in front. If - * NULL, use the default menu bar. */ + const char *menuName) /* The name of the menu to put in front. */ { static Tcl_Interp *currentInterp = NULL; TKMenu *menu = nil; diff --git a/macosx/tkMacOSXMenubutton.c b/macosx/tkMacOSXMenubutton.c index d6e635a..a85e572 100644 --- a/macosx/tkMacOSXMenubutton.c +++ b/macosx/tkMacOSXMenubutton.c @@ -5,66 +5,70 @@ * menubutton widget. * * Copyright (c) 1996 by Sun Microsystems, Inc. - * Copyright 2001-2009, Apple Inc. - * Copyright (c) 2006-2009 Daniel A. Steffen <das@users.sourceforge.net> + * Copyright 2001, Apple Computer, Inc. + * Copyright (c) 2006-2007 Daniel A. Steffen <das@users.sourceforge.net> + * Copyright 2007 Revar Desmera. + * Copyright 2015 Kevin Walzer/WordTech Communications LLC. * * 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 "tkMenu.h" #include "tkMenubutton.h" #include "tkMacOSXFont.h" #include "tkMacOSXDebug.h" -/* -#ifdef TK_MAC_DEBUG -#define TK_MAC_DEBUG_MENUBUTTON -#endif -*/ +#define FIRST_DRAW 2 +#define ACTIVE 4 -typedef struct MacMenuButton { - TkMenuButton info; - NSPopUpButton *button; -#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS - int fix; -#endif -} MacMenuButton; -#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS +typedef struct { + Tk_3DBorder border; + int relief; + GC gc; + int hasImageOrBitmap; +} DrawParams; + /* - * Use the following heuristic conversion constants to make NSButton-based - * widget metrics match up with the old Carbon control buttons (for the - * default Lucida Grande 13 font). - * TODO: provide a scriptable way to turn this off and use the raw NSButton - * metrics (will also need dynamic adjustment of the default padding, - * c.f. tkMacOSXDefault.h). + * Declaration of Mac specific button structure. */ -typedef struct { - int trimW, trimH, inset, shrinkW, offsetX, offsetY; -} BoundsFix; - -#define fixForStyle(style) ( \ - style == NSRoundedBezelStyle ? 1 : \ - style == NSRegularSquareBezelStyle ? 2 : \ - style == NSShadowlessSquareBezelStyle ? 3 : \ - INT_MIN) - -static const BoundsFix boundsFixes[] = { - [fixForStyle(NSRoundedBezelStyle)] = { 14, 10, -2, -1}, - [fixForStyle(NSRegularSquareBezelStyle)] = { 6, 13, -2, 1, 1}, - [fixForStyle(NSShadowlessSquareBezelStyle)] = { 15, 0, 2 }, -}; - -#endif +typedef struct MacMenuButton { + TkMenuButton info; /* Generic button info. */ + int flags; + ThemeButtonKind btnkind; + HIThemeButtonDrawInfo drawinfo; + HIThemeButtonDrawInfo lastdrawinfo; + DrawParams drawParams; +} MacMenuButton; /* * Forward declarations for procedures defined later in this file: */ static void MenuButtonEventProc(ClientData clientData, XEvent *eventPtr); +static void MenuButtonBackgroundDrawCB ( MacMenuButton *ptr, SInt16 depth, Boolean isColorDev); +static void MenuButtonContentDrawCB ( ThemeButtonKind kind, const HIThemeButtonDrawInfo * info, MacMenuButton *ptr, SInt16 depth, Boolean isColorDev); +static void MenuButtonEventProc ( ClientData clientData, XEvent *eventPtr); +static void TkMacOSXComputeMenuButtonParams (TkMenuButton * butPtr, ThemeButtonKind* btnkind, HIThemeButtonDrawInfo* drawinfo); +static int TkMacOSXComputeMenuButtonDrawParams (TkMenuButton * butPtr, DrawParams * dpPtr); +static void TkMacOSXDrawMenuButton (MacMenuButton *butPtr, + GC gc, Pixmap pixmap); +static void DrawMenuButtonImageAndText(TkMenuButton* butPtr); + +/* + * The structure below defines menubutton class behavior by means of + * procedures that can be invoked from generic window code. + */ + +Tk_ClassProcs tkpMenubuttonClass = { + sizeof(Tk_ClassProcs), /* size */ + TkMenuButtonWorldChanged, /* worldChangedProc */ +}; /* @@ -87,112 +91,94 @@ TkMenuButton * TkpCreateMenuButton( Tk_Window tkwin) { - MacMenuButton *macButtonPtr = ckalloc(sizeof(MacMenuButton)); + MacMenuButton *mbPtr = (MacMenuButton *) ckalloc(sizeof(MacMenuButton)); - macButtonPtr->button = nil; Tk_CreateEventHandler(tkwin, ActivateMask, - MenuButtonEventProc, (ClientData) macButtonPtr); - return (TkMenuButton *) macButtonPtr; + MenuButtonEventProc, (ClientData) mbPtr); + mbPtr->flags = FIRST_DRAW; + mbPtr->btnkind = kThemePopupButton; + bzero(&mbPtr->drawinfo, sizeof(mbPtr->drawinfo)); + bzero(&mbPtr->lastdrawinfo, sizeof(mbPtr->lastdrawinfo)); + + return (TkMenuButton *) mbPtr; } /* *---------------------------------------------------------------------- * - * TkpDestroyMenuButton -- + * TkpDisplayMenuButton -- * - * Free data structures associated with the menubutton control. + * This procedure is invoked to display a menubutton widget. * * Results: * None. * * Side effects: - * Restores the default control state. + * Commands are output to X to display the menubutton in its + * current mode. * *---------------------------------------------------------------------- */ void -TkpDestroyMenuButton( - TkMenuButton *mbPtr) +TkpDisplayMenuButton( + ClientData clientData) /* Information about widget. */ { - MacMenuButton *macButtonPtr = (MacMenuButton *) mbPtr; + MacMenuButton *mbPtr = (MacMenuButton *)clientData; + TkMenuButton *butPtr = (TkMenuButton *) clientData; + Tk_Window tkwin = butPtr->tkwin; + Pixmap pixmap; + DrawParams* dpPtr = &mbPtr->drawParams; + + butPtr->flags &= ~REDRAW_PENDING; + if ((butPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) { + return; + } + + pixmap = (Pixmap) Tk_WindowId(tkwin); + + TkMacOSXComputeMenuButtonDrawParams(butPtr, dpPtr); - TkMacOSXMakeCollectableAndRelease(macButtonPtr->button); + /* + * set up clipping region. Make sure the we are using the port + * for this button, or we will set the wrong window's clip. + */ + + TkMacOSXSetUpClippingRgn(pixmap); + + /* Draw the native portion of the buttons. */ + TkMacOSXDrawMenuButton(mbPtr, dpPtr->gc, pixmap); + + /* Draw highlight border, if needed. */ + if (butPtr->highlightWidth < 3) { + if ((butPtr->flags & GOT_FOCUS)) { + Tk_Draw3DRectangle(tkwin, pixmap, butPtr->normalBorder, 0, 0, + Tk_Width(tkwin), Tk_Height(tkwin), + butPtr->highlightWidth, TK_RELIEF_SOLID); + } + } } /* *---------------------------------------------------------------------- * - * TkpDisplayMenuButton -- + * TkpDestroyMenuButton -- * - * This function is invoked to display a menubutton widget. + * Free data structures associated with the menubutton control. * * Results: * None. * * Side effects: - * Commands are output to X to display the menubutton in its current - * mode. + * Restores the default control state. * *---------------------------------------------------------------------- */ void -TkpDisplayMenuButton( - ClientData clientData) /* Information about widget. */ +TkpDestroyMenuButton( + TkMenuButton *mbPtr) { - TkMenuButton *mbPtr = (TkMenuButton *) clientData; - MacMenuButton *macButtonPtr = (MacMenuButton *) mbPtr; - NSPopUpButton *button = macButtonPtr->button; - Tk_Window tkwin = mbPtr->tkwin; - TkWindow *winPtr = (TkWindow *) tkwin; - MacDrawable *macWin = (MacDrawable *) winPtr->window; - TkMacOSXDrawingContext dc; - NSView *view = TkMacOSXDrawableView(macWin); - CGFloat viewHeight = [view bounds].size.height; - CGAffineTransform t = { .a = 1, .b = 0, .c = 0, .d = -1, .tx = 0, - .ty = viewHeight}; - NSRect frame; - int enabled; - - mbPtr->flags &= ~REDRAW_PENDING; - if (!tkwin || !Tk_IsMapped(tkwin) || !view || - !TkMacOSXSetupDrawingContext((Drawable) macWin, NULL, 1, &dc)) { - return; - } - CGContextConcatCTM(dc.context, t); - Tk_Fill3DRectangle(tkwin, (Pixmap) macWin, mbPtr->normalBorder, 0, 0, - Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT); - if ([button superview] != view) { - [view addSubview:button]; - } - enabled = !(mbPtr->state == STATE_DISABLED); - [button setEnabled:enabled]; - if (enabled) { - [[button cell] setHighlighted:(mbPtr->state == STATE_ACTIVE)]; - } - frame = NSMakeRect(macWin->xOff, macWin->yOff, Tk_Width(tkwin), - Tk_Height(tkwin)); - frame = NSInsetRect(frame, mbPtr->inset, mbPtr->inset); -#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS - if (tkMacOSXUseCompatibilityMetrics) { - BoundsFix boundsFix = boundsFixes[macButtonPtr->fix]; - frame = NSOffsetRect(frame, boundsFix.offsetX, boundsFix.offsetY); - frame.size.width -= boundsFix.shrinkW; - frame = NSInsetRect(frame, boundsFix.inset, boundsFix.inset); - } -#endif - frame.origin.y = viewHeight - (frame.origin.y + frame.size.height); - if (!NSEqualRects(frame, [button frame])) { - [button setFrame:frame]; - } - [button displayRectIgnoringOpacity:[button bounds]]; - TkMacOSXRestoreDrawingContext(&dc); -#ifdef TK_MAC_DEBUG_MENUBUTTON - TKLog(@"menubutton %s frame %@ width %d height %d", - ((TkWindow *)mbPtr->tkwin)->pathName, NSStringFromRect(frame), - Tk_Width(tkwin), Tk_Height(tkwin)); -#endif } /* @@ -200,7 +186,7 @@ TkpDisplayMenuButton( * * TkpComputeMenuButtonGeometry -- * - * After changes in a menu button's text or bitmap, this function + * After changes in a menu button's text or bitmap, this procedure * recomputes the menu button's geometry and passes this information * along to the geometry manager for the window. * @@ -214,205 +200,504 @@ TkpDisplayMenuButton( */ void -TkpComputeMenuButtonGeometry( - TkMenuButton *mbPtr) /* Widget record for menu button. */ +TkpComputeMenuButtonGeometry(butPtr) + register TkMenuButton *butPtr; /* Widget record for menu button. */ { - MacMenuButton *macButtonPtr = (MacMenuButton *) mbPtr; - NSPopUpButton *button = macButtonPtr->button; - NSPopUpButtonCell *cell; - NSMenuItem *menuItem; - NSBezelStyle style = NSRoundedBezelStyle; - NSFont *font; - NSRect bounds = NSZeroRect, titleRect = NSZeroRect; - int haveImage = (mbPtr->image || mbPtr->bitmap != None), haveText = 0; - int haveCompound = (mbPtr->compound != COMPOUND_NONE); - int width, height; - - if (!button) { - button = [[NSPopUpButton alloc] initWithFrame:NSZeroRect pullsDown:YES]; - macButtonPtr->button = TkMacOSXMakeUncollectable(button); - cell = [button cell]; - [cell setUsesItemFromMenu:NO]; - menuItem = [[[NSMenuItem alloc] initWithTitle:@"" - action:NULL keyEquivalent:@""] autorelease]; - [cell setMenuItem:menuItem]; - } else { - cell = [button cell]; - menuItem = [cell menuItem]; + int width, height, avgWidth, haveImage = 0, haveText = 0; + MacMenuButton *mbPtr = (MacMenuButton*)butPtr; + int txtWidth, txtHeight; + Tk_FontMetrics fm; + DrawParams drawParams; + int paddingx = 0; + int paddingy = 0; + + /* + * First figure out the size of the contents of the button. + */ + + width = 0; + height = 0; + txtWidth = 0; + txtHeight = 0; + avgWidth = 0; + + TkMacOSXComputeMenuButtonParams(butPtr, &mbPtr->btnkind, &mbPtr->drawinfo); + + if (butPtr->image != NULL) { + Tk_SizeOfImage(butPtr->image, &width, &height); + haveImage = 1; + } else if (butPtr->bitmap != None) { + Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height); + haveImage = 1; } - if (haveImage) { - style = NSShadowlessSquareBezelStyle; - } else if (!mbPtr->indicatorOn) { - style = NSRegularSquareBezelStyle; + + if (haveImage == 0 || butPtr->compound != COMPOUND_NONE) { + Tk_FreeTextLayout(butPtr->textLayout); + butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont, + butPtr->text, -1, butPtr->wrapLength, + butPtr->justify, 0, &butPtr->textWidth, &butPtr->textHeight); + + txtWidth = butPtr->textWidth; + txtHeight = butPtr->textHeight; + avgWidth = Tk_TextWidth(butPtr->tkfont, "0", 1); + Tk_GetFontMetrics(butPtr->tkfont, &fm); + haveText = (txtWidth != 0 && txtHeight != 0); } - [button setBezelStyle:style]; - [cell setArrowPosition:(mbPtr->indicatorOn ? NSPopUpArrowAtBottom : - NSPopUpNoArrow)]; -#if 0 - NSControlSize controlSize = NSRegularControlSize; - - if (mbPtr->borderWidth <= 2) { - controlSize = NSMiniControlSize; - } else if (mbPtr->borderWidth == 3) { - controlSize = NSSmallControlSize; + + /* + * If the button is compound (ie, it shows both an image and text), + * the new geometry is a combination of the image and text geometry. + * We only honor the compound bit if the button has both text and an + * image, because otherwise it is not really a compound button. + */ + + if (butPtr->compound != COMPOUND_NONE && haveImage && haveText) { + switch ((enum compound) butPtr->compound) { + case COMPOUND_TOP: + case COMPOUND_BOTTOM: { + /* + * Image is above or below text + */ + + height += txtHeight + butPtr->padY; + width = (width > txtWidth ? width : txtWidth); + break; + } + case COMPOUND_LEFT: + case COMPOUND_RIGHT: { + /* + * Image is left or right of text + */ + + width += txtWidth + butPtr->padX; + height = (height > txtHeight ? height : txtHeight); + break; + } + case COMPOUND_CENTER: { + /* + * Image and text are superimposed + */ + + width = (width > txtWidth ? width : txtWidth); + height = (height > txtHeight ? height : txtHeight); + break; + } + case COMPOUND_NONE: {break;} + } + + if (butPtr->width > 0) { + width = butPtr->width; + } + if (butPtr->height > 0) { + height = butPtr->height; + } + + } else { + if (haveImage) { + if (butPtr->width > 0) { + width = butPtr->width; + } + if (butPtr->height > 0) { + height = butPtr->height; + } + } else { + width = txtWidth; + height = txtHeight; + if (butPtr->width > 0) { + width = butPtr->width * avgWidth; + } + if (butPtr->height > 0) { + height = butPtr->height * fm.linespace; + } + } } - [cell setControlSize:controlSize]; -#endif - - if (mbPtr->text && *(mbPtr->text) && (!haveImage || haveCompound)) { - NSString *title = [[NSString alloc] initWithUTF8String:mbPtr->text]; - [button setTitle:title]; - [title release]; - haveText = 1; + width += 2 * butPtr->padX - 2; + height += 2 * butPtr->padY - 2; + + /*Add padding for button arrows.*/ + width += 22; + + /* + * Now figure out the size of the border decorations for the button. + */ + + if (butPtr->highlightWidth < 0) { + butPtr->highlightWidth = 0; } - haveCompound = (haveCompound && haveImage && haveText); - if (haveText) { - NSTextAlignment alignment = NSNaturalTextAlignment; - - switch (mbPtr->justify) { - case TK_JUSTIFY_LEFT: - alignment = NSLeftTextAlignment; - break; - case TK_JUSTIFY_RIGHT: - alignment = NSRightTextAlignment; - break; - case TK_JUSTIFY_CENTER: - alignment = NSCenterTextAlignment; - break; - } - [button setAlignment:alignment]; - } else { - [button setTitle:@""]; + butPtr->inset = 0; + butPtr->inset += butPtr->highlightWidth; + + TkMacOSXComputeMenuButtonDrawParams(butPtr,&drawParams); + + HIRect tmpRect; + HIRect contBounds; + + tmpRect = CGRectMake(0, 0, width, height); + + HIThemeGetButtonContentBounds(&tmpRect, &mbPtr->drawinfo, &contBounds); + + + + /* If the content region has a minimum height, match it. */ + if (height < contBounds.size.height) { + height = contBounds.size.height; + } + + /* If the content region has a minimum width, match it. */ + if (width < contBounds.size.width) { + width = contBounds.size.width; + } + + /* Pad to fill difference between content bounds and button bounds. */ + paddingx = tmpRect.origin.x - contBounds.origin.x; + paddingy = tmpRect.origin.y - contBounds.origin.y; + + if (paddingx > 0) { + width += paddingx; } - font = TkMacOSXNSFontForFont(mbPtr->tkfont); - if (font) { - [button setFont:font]; + if (paddingy > 0) { + height += paddingy; } - if (haveImage) { - int width, height; - NSImage *image; - NSCellImagePosition pos = NSImageOnly; - - if (mbPtr->image) { - Tk_SizeOfImage(mbPtr->image, &width, &height); - image = TkMacOSXGetNSImageWithTkImage(mbPtr->display, - mbPtr->image, width, height); - } else { - Tk_SizeOfBitmap(mbPtr->display, mbPtr->bitmap, &width, &height); - image = TkMacOSXGetNSImageWithBitmap(mbPtr->display, - mbPtr->bitmap, mbPtr->normalTextGC, width, height); - } - if (haveCompound) { - switch ((enum compound) mbPtr->compound) { - case COMPOUND_TOP: - pos = NSImageAbove; - break; - case COMPOUND_BOTTOM: - pos = NSImageBelow; - break; - case COMPOUND_LEFT: - pos = NSImageLeft; - break; - case COMPOUND_RIGHT: - pos = NSImageRight; - break; - case COMPOUND_CENTER: - pos = NSImageOverlaps; - break; - case COMPOUND_NONE: - pos = NSImageOnly; - break; - } - } - [button setImagePosition:pos]; - [menuItem setImage:image]; - bounds.size = cell ? [cell cellSize] : NSZeroSize; - if (bounds.size.height < height + 8) { /* workaround AppKit sizing bug */ - bounds.size.height = height + 8; - } -#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS - if (!mbPtr->indicatorOn && tkMacOSXUseCompatibilityMetrics) { - bounds.size.width -= 16; - } -#endif - } else { - bounds.size = cell ? [cell cellSize] : NSZeroSize; + + width += butPtr->inset*2; + height += butPtr->inset*2; + + + Tk_GeometryRequest(butPtr->tkwin, width, height); + Tk_SetInternalBorder(butPtr->tkwin, butPtr->inset); +} + +/* + *---------------------------------------------------------------------- + * + * DrawMenuButtonImageAndText -- + * + * Draws the image and text associated witha button or label. + * + * Results: + * None. + * + * Side effects: + * The image and text are drawn. + * + *---------------------------------------------------------------------- + */ +void +DrawMenuButtonImageAndText( + TkMenuButton* butPtr) +{ + MacMenuButton *mbPtr = (MacMenuButton*)butPtr; + Tk_Window tkwin = butPtr->tkwin; + Pixmap pixmap; + int haveImage = 0; + int haveText = 0; + int imageWidth = 0; + int imageHeight = 0; + int imageXOffset = 0; + int imageYOffset = 0; + int textXOffset = 0; + int textYOffset = 0; + int width = 0; + int height = 0; + int fullWidth = 0; + int fullHeight = 0; + int pressed; + + if (tkwin == NULL || !Tk_IsMapped(tkwin)) { + return; } - if (haveText) { - titleRect = cell ? [cell titleRectForBounds:bounds] : NSZeroRect; - if (mbPtr->wrapLength > 0 && - titleRect.size.width > mbPtr->wrapLength) { - if (style == NSRoundedBezelStyle) { - [button setBezelStyle:(style = NSRegularSquareBezelStyle)]; - bounds.size = cell ? [cell cellSize] : NSZeroSize; - titleRect = cell ? [cell titleRectForBounds:bounds] : NSZeroRect; - } - bounds.size.width -= titleRect.size.width - mbPtr->wrapLength; - bounds.size.height = 40000.0; - [cell setWraps:YES]; - bounds.size = cell ? [cell cellSizeForBounds:bounds] : NSZeroSize; -#ifdef TK_MAC_DEBUG_MENUBUTTON - titleRect = cell ? [cell titleRectForBounds:bounds] : NSZeroRect; -#endif -#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS - if (tkMacOSXUseCompatibilityMetrics) { - bounds.size.height += 3; - } -#endif - } + + DrawParams* dpPtr = &mbPtr->drawParams; + pixmap = (Pixmap)Tk_WindowId(tkwin); + + + if (butPtr->image != None) { + Tk_SizeOfImage(butPtr->image, &width, &height); + haveImage = 1; + } else if (butPtr->bitmap != None) { + Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height); + haveImage = 1; } - width = lround(bounds.size.width); - height = lround(bounds.size.height); -#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS - if (tkMacOSXUseCompatibilityMetrics) { - macButtonPtr->fix = fixForStyle(style); - width -= boundsFixes[macButtonPtr->fix].trimW; - height -= boundsFixes[macButtonPtr->fix].trimH; + + imageWidth = width; + imageHeight = height; + + if (mbPtr->drawinfo.state == kThemeStatePressed) { + /* Offset bitmaps by a bit when the button is pressed. */ + pressed = 1; } -#endif - if (haveImage || haveCompound) { - if (mbPtr->width > 0) { - width = mbPtr->width; - } - if (mbPtr->height > 0) { - height = mbPtr->height; + haveText = (butPtr->textWidth != 0 && butPtr->textHeight != 0); + if (butPtr->compound != COMPOUND_NONE && haveImage && haveText) { + int x = 0; + int y = 0; + textXOffset = 0; + textYOffset = 0; + fullWidth = 0; + fullHeight = 0; + + switch ((enum compound) butPtr->compound) { + case COMPOUND_TOP: + case COMPOUND_BOTTOM: { + /* Image is above or below text */ + if (butPtr->compound == COMPOUND_TOP) { + textYOffset = height + butPtr->padY; + } else { + imageYOffset = butPtr->textHeight + butPtr->padY; + } + fullHeight = height + butPtr->textHeight + butPtr->padY; + fullWidth = (width > butPtr->textWidth ? width : + butPtr->textWidth); + textXOffset = (fullWidth - butPtr->textWidth)/2; + imageXOffset = (fullWidth - width)/2; + break; + } + case COMPOUND_LEFT: + case COMPOUND_RIGHT: { + /* + * Image is left or right of text + */ + + if (butPtr->compound == COMPOUND_LEFT) { + textXOffset = width + butPtr->padX - 2; + } else { + imageXOffset = butPtr->textWidth + butPtr->padX; + } + fullWidth = butPtr->textWidth + butPtr->padX + width; + fullHeight = (height > butPtr->textHeight ? height : + butPtr->textHeight); + textYOffset = (fullHeight - butPtr->textHeight)/2; + imageYOffset = (fullHeight - height)/2; + break; + } + case COMPOUND_CENTER: { + /* + * Image and text are superimposed + */ + + fullWidth = (width > butPtr->textWidth ? width : + butPtr->textWidth); + fullHeight = (height > butPtr->textHeight ? height : + butPtr->textHeight); + textXOffset = (fullWidth - butPtr->textWidth)/2; + imageXOffset = (fullWidth - width)/2; + textYOffset = (fullHeight - butPtr->textHeight)/2; + imageYOffset = (fullHeight - height)/2; + break; + } + case COMPOUND_NONE: {break;} } + + TkComputeAnchor(butPtr->anchor, tkwin, + butPtr->padX + butPtr->borderWidth, + butPtr->padY + butPtr->borderWidth, + fullWidth, fullHeight, &x, &y); + imageXOffset += x; + imageYOffset += y; + textYOffset -= 1; + + if (butPtr->image != NULL) { + Tk_RedrawImage(butPtr->image, 0, 0, width, + height, pixmap, imageXOffset, imageYOffset); + } else { + XSetClipOrigin(butPtr->display, dpPtr->gc, + imageXOffset, imageYOffset); + XCopyPlane(butPtr->display, butPtr->bitmap, pixmap, dpPtr->gc, + 0, 0, (unsigned int) width, (unsigned int) height, + imageXOffset, imageYOffset, 1); + XSetClipOrigin(butPtr->display, dpPtr->gc, 0, 0); + } + + Tk_DrawTextLayout(butPtr->display, pixmap, + dpPtr->gc, butPtr->textLayout, + x + textXOffset, y + textYOffset, 0, -1); + Tk_UnderlineTextLayout(butPtr->display, pixmap, dpPtr->gc, + butPtr->textLayout, + x + textXOffset, y + textYOffset, + butPtr->underline); } else { - if (mbPtr->width > 0) { - int avgWidth = Tk_TextWidth(mbPtr->tkfont, "0", 1); - width = mbPtr->width * avgWidth; + if (haveImage) { + int x = 0; + int y; + TkComputeAnchor(butPtr->anchor, tkwin, + butPtr->padX + butPtr->borderWidth, + butPtr->padY + butPtr->borderWidth, + width, height, &x, &y); + imageXOffset += x; + imageYOffset += y; + + if (butPtr->image != NULL) { + Tk_RedrawImage(butPtr->image, 0, 0, width, height, + pixmap, imageXOffset, imageYOffset); + } else { + XSetClipOrigin(butPtr->display, dpPtr->gc, x, y); + XCopyPlane(butPtr->display, butPtr->bitmap, + pixmap, dpPtr->gc, + 0, 0, (unsigned int) width, + (unsigned int) height, + imageXOffset, imageYOffset, 1); + XSetClipOrigin(butPtr->display, dpPtr->gc, 0, 0); + } + } else { + /*Move x back by eight pixels to give the menubutton arrows room.*/ + int x = 0; + int y; + textXOffset = 8; + TkComputeAnchor(butPtr->anchor, tkwin, butPtr->padX, butPtr->padY, + butPtr->textWidth, butPtr->textHeight, &x, &y); + Tk_DrawTextLayout(butPtr->display, pixmap, dpPtr->gc, + butPtr->textLayout, x - textXOffset, y, 0, -1); + y += butPtr->textHeight/2; + } + } +} + + + +/* + *-------------------------------------------------------------- + * + * TkMacOSXDrawMenuButton -- + * + * This function draws the tk menubutton using Mac controls + * In addition, this code may apply custom colors passed + * in the TkMenubutton. + * + * Results: + * None. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ +static void +TkMacOSXDrawMenuButton( + MacMenuButton *mbPtr, /* Mac menubutton. */ + GC gc, /* The GC we are drawing into - needed for + * the bevel button */ + Pixmap pixmap) /* The pixmap we are drawing into - needed + * for the bevel button */ + +{ + TkMenuButton * butPtr = ( TkMenuButton *)mbPtr; + TkWindow * winPtr; + HIRect cntrRect; + TkMacOSXDrawingContext dc; + DrawParams* dpPtr = &mbPtr->drawParams; + int useNewerHITools = 1; + + winPtr = (TkWindow *)butPtr->tkwin; + + TkMacOSXComputeMenuButtonParams(butPtr, &mbPtr->btnkind, &mbPtr->drawinfo); + + cntrRect = CGRectMake(winPtr->privatePtr->xOff, winPtr->privatePtr->yOff, Tk_Width(butPtr->tkwin),Tk_Height(butPtr->tkwin)); + + cntrRect = CGRectInset(cntrRect, butPtr->inset, butPtr->inset); + + + if (useNewerHITools == 1) { + HIRect contHIRec; + static HIThemeButtonDrawInfo hiinfo; + + MenuButtonBackgroundDrawCB((MacMenuButton*) mbPtr, 32, true); + + if (!TkMacOSXSetupDrawingContext(pixmap, dpPtr->gc, 1, &dc)) { + return; } - if (mbPtr->height > 0) { - Tk_FontMetrics fm; - Tk_GetFontMetrics(mbPtr->tkfont, &fm); - height = mbPtr->height * fm.linespace; + + hiinfo.version = 0; + hiinfo.state = mbPtr->drawinfo.state; + hiinfo.kind = mbPtr->btnkind; + hiinfo.value = mbPtr->drawinfo.value; + hiinfo.adornment = mbPtr->drawinfo.adornment; + hiinfo.animation.time.current = CFAbsoluteTimeGetCurrent(); + if (hiinfo.animation.time.start == 0) { + hiinfo.animation.time.start = hiinfo.animation.time.current; + } + + HIThemeDrawButton(&cntrRect, &hiinfo, dc.context, kHIThemeOrientationNormal, &contHIRec); + + TkMacOSXRestoreDrawingContext(&dc); + + MenuButtonContentDrawCB( mbPtr->btnkind, &mbPtr->drawinfo, (MacMenuButton *)mbPtr, 32, true); + } else { + if (!TkMacOSXSetupDrawingContext(pixmap, dpPtr->gc, 1, &dc)) { + return; } + + + TkMacOSXRestoreDrawingContext(&dc); } - if (!haveImage || haveCompound) { - width += 2*mbPtr->padX; - height += 2*mbPtr->padY; - } - if (mbPtr->highlightWidth < 0) { - mbPtr->highlightWidth = 0; + mbPtr->lastdrawinfo = mbPtr->drawinfo; +} + +/* + *-------------------------------------------------------------- + * + * MenuButtonBackgroundDrawCB -- + * + * This function draws the background that + * lies under checkboxes and radiobuttons. + * + * Results: + * None. + * + * Side effects: + * The background gets updated to the current color. + * + *-------------------------------------------------------------- + */ +static void +MenuButtonBackgroundDrawCB ( + MacMenuButton *ptr, + SInt16 depth, + Boolean isColorDev) +{ + TkMenuButton* butPtr = (TkMenuButton*)ptr; + Tk_Window tkwin = butPtr->tkwin; + Pixmap pixmap; + if (tkwin == NULL || !Tk_IsMapped(tkwin)) { + return; } - if (haveImage) { - mbPtr->inset = mbPtr->highlightWidth; - width += 2*mbPtr->borderWidth; - height += 2*mbPtr->borderWidth; - } else { - mbPtr->inset = mbPtr->highlightWidth + mbPtr->borderWidth; + pixmap = (Pixmap)Tk_WindowId(tkwin); + + Tk_Fill3DRectangle(tkwin, pixmap, butPtr->normalBorder, 0, 0, + Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT); +} + +/* + *-------------------------------------------------------------- + * + * MenuButtonContentDrawCB -- + * + * This function draws the label and image for the button. + * + * Results: + * None. + * + * Side effects: + * The content of the button gets updated. + * + *-------------------------------------------------------------- + */ +static void +MenuButtonContentDrawCB ( + ThemeButtonKind kind, + const HIThemeButtonDrawInfo *drawinfo, + MacMenuButton *ptr, + SInt16 depth, + Boolean isColorDev) +{ + TkMenuButton *butPtr = (TkMenuButton *)ptr; + Tk_Window tkwin = butPtr->tkwin; + + if (tkwin == NULL || !Tk_IsMapped(tkwin)) { + return; } - Tk_GeometryRequest(mbPtr->tkwin, width + 2 * mbPtr->inset, - height + 2 * mbPtr->inset); - Tk_SetInternalBorder(mbPtr->tkwin, mbPtr->inset); -#ifdef TK_MAC_DEBUG_MENUBUTTON - TKLog(@"menubutton %s bounds %@ titleRect %@ width %d height %d inset %d borderWidth %d", - ((TkWindow *)mbPtr->tkwin)->pathName, NSStringFromRect(bounds), - NSStringFromRect(titleRect), width, height, mbPtr->inset, - mbPtr->borderWidth); -#endif + + DrawMenuButtonImageAndText( butPtr); } /* @@ -427,7 +712,7 @@ TkpComputeMenuButtonGeometry( * None. * * Side effects: - * When activation state changes, it is redisplayed. + * When it gets exposed, it is redisplayed. * *-------------------------------------------------------------- */ @@ -437,27 +722,124 @@ MenuButtonEventProc( ClientData clientData, /* Information about window. */ XEvent *eventPtr) /* Information about event. */ { - TkMenuButton *mbPtr = (TkMenuButton *) clientData; + TkMenuButton *buttonPtr = (TkMenuButton *) clientData; + MacMenuButton *mbPtr = (MacMenuButton *) clientData; - if (!mbPtr->tkwin || !Tk_IsMapped(mbPtr->tkwin)) { - return; + if (eventPtr->type == ActivateNotify + || eventPtr->type == DeactivateNotify) { + if ((buttonPtr->tkwin == NULL) || (!Tk_IsMapped(buttonPtr->tkwin))) { + return; + } + if (eventPtr->type == ActivateNotify) { + mbPtr->flags |= ACTIVE; + } else { + mbPtr->flags &= ~ACTIVE; + } + if ((buttonPtr->flags & REDRAW_PENDING) == 0) { + Tcl_DoWhenIdle(TkpDisplayMenuButton, (ClientData) buttonPtr); + buttonPtr->flags |= REDRAW_PENDING; + } } - switch (eventPtr->type) { - case ActivateNotify: - case DeactivateNotify: - if (!(mbPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(TkpDisplayMenuButton, (ClientData) mbPtr); - mbPtr->flags |= REDRAW_PENDING; +} + +/* + *---------------------------------------------------------------------- + * + * TkMacOSXComputeMenuButtonParams -- + * + * This procedure computes the various parameters used + * when creating a Carbon Appearance control. + * These are determined by the various tk button parameters + * + * Results: + * None. + * + * Side effects: + * Sets the btnkind and drawinfo parameters + * + *---------------------------------------------------------------------- + */ + +static void +TkMacOSXComputeMenuButtonParams(TkMenuButton * butPtr, ThemeButtonKind* btnkind, HIThemeButtonDrawInfo *drawinfo) +{ + MacMenuButton *mbPtr = (MacMenuButton *)butPtr; + + if (butPtr->image || butPtr->bitmap) { + /* TODO: allow for Small and Mini menubuttons. */ + *btnkind = kThemePopupButton; + } else { + if (!butPtr->text || !*butPtr->text) { + *btnkind = kThemeArrowButton; + } else { + *btnkind = kThemePopupButton; + } + } + + drawinfo->value = kThemeButtonOff; + + if ((mbPtr->flags & FIRST_DRAW) != 0) { + mbPtr->flags &= ~FIRST_DRAW; + if (Tk_MacOSXIsAppInFront()) { + mbPtr->flags |= ACTIVE; } - break; } + + drawinfo->state = kThemeStateInactive; + if ((mbPtr->flags & ACTIVE) == 0) { + if (butPtr->state == STATE_DISABLED) { + drawinfo->state = kThemeStateUnavailableInactive; + } else { + drawinfo->state = kThemeStateInactive; + } + } else if (butPtr->state == STATE_DISABLED) { + drawinfo->state = kThemeStateUnavailable; + } else { + drawinfo->state = kThemeStateActive; + } + + drawinfo->adornment = kThemeAdornmentNone; + if (butPtr->highlightWidth >= 3) { + if ((butPtr->flags & GOT_FOCUS)) { + drawinfo->adornment |= kThemeAdornmentFocus; + } + } + drawinfo->adornment |= kThemeAdornmentArrowDoubleArrow; } /* - * Local Variables: - * mode: objc - * c-basic-offset: 4 - * fill-column: 79 - * coding: utf-8 - * End: + *---------------------------------------------------------------------- + * + * TkMacOSXComputeMenuButtonDrawParams -- + * + * This procedure computes the various parameters used + * when drawing a button + * These are determined by the various tk button parameters + * + * Results: + * 1 if control will be used, 0 otherwise. + * + * Side effects: + * Sets the button draw parameters + * + *---------------------------------------------------------------------- */ + +static int +TkMacOSXComputeMenuButtonDrawParams(TkMenuButton * butPtr, DrawParams * dpPtr) +{ + dpPtr->hasImageOrBitmap = ((butPtr->image != NULL) + || (butPtr->bitmap != None)); + dpPtr->border = butPtr->normalBorder; + if ((butPtr->state == STATE_DISABLED) && (butPtr->disabledFg != NULL)) { + dpPtr->gc = butPtr->disabledGC; + } else if (butPtr->state == STATE_ACTIVE) { + dpPtr->gc = butPtr->activeTextGC; + dpPtr->border = butPtr->activeBorder; + } else { + dpPtr->gc = butPtr->normalTextGC; + } + + return 1; +} + diff --git a/macosx/tkMacOSXMenus.c b/macosx/tkMacOSXMenus.c index 881bf75..68b2c00 100644 --- a/macosx/tkMacOSXMenus.c +++ b/macosx/tkMacOSXMenus.c @@ -145,10 +145,9 @@ static Tcl_Obj * GetWidgetDemoPath(Tcl_Interp *interp); SEL action = [anItem action]; if (sel_isEqual(action, @selector(preferences:))) { - Tcl_CmdInfo dummy; - return (_eventInterp && Tcl_GetCommandInfo(_eventInterp, - "::tk::mac::ShowPreferences", &dummy)); + return (_eventInterp && Tcl_FindCommand(_eventInterp, + "::tk::mac::ShowPreferences", NULL, 0)); } else if (sel_isEqual(action, @selector(tkDemo:))) { BOOL haveDemo = NO; @@ -169,10 +168,8 @@ static Tcl_Obj * GetWidgetDemoPath(Tcl_Interp *interp); - (void) orderFrontStandardAboutPanel: (id) sender { - Tcl_CmdInfo dummy; - - if (!_eventInterp || !Tcl_GetCommandInfo(_eventInterp, "tkAboutDialog", - &dummy) || (GetCurrentEventKeyModifiers() & optionKey)) { + if (!_eventInterp || !Tcl_FindCommand(_eventInterp, "tkAboutDialog", + NULL, 0) || (GetCurrentEventKeyModifiers() & optionKey)) { TkAboutDlg(); } else { int code = Tcl_EvalEx(_eventInterp, "tkAboutDialog", -1, @@ -187,10 +184,8 @@ static Tcl_Obj * GetWidgetDemoPath(Tcl_Interp *interp); - (void) showHelp: (id) sender { - Tcl_CmdInfo dummy; - - if (!_eventInterp || !Tcl_GetCommandInfo(_eventInterp, - "::tk::mac::ShowHelp", &dummy)) { + if (!_eventInterp || !Tcl_FindCommand(_eventInterp, + "::tk::mac::ShowHelp", NULL, 0)) { [super showHelp:sender]; } else { int code = Tcl_EvalEx(_eventInterp, "::tk::mac::ShowHelp", -1, diff --git a/macosx/tkMacOSXMouseEvent.c b/macosx/tkMacOSXMouseEvent.c index 90d2d00..c4197f7 100644 --- a/macosx/tkMacOSXMouseEvent.c +++ b/macosx/tkMacOSXMouseEvent.c @@ -26,13 +26,22 @@ typedef struct { static int GenerateButtonEvent(MouseEventData *medPtr); static unsigned int ButtonModifiers2State(UInt32 buttonState, - UInt32 keyModifiers); + UInt32 keyModifiers); #pragma mark TKApplication(TKMouseEvent) enum { NSWindowWillMoveEventType = 20 }; +/* + * In OS X 10.6 an NSEvent of type NSMouseMoved would always have a non-Nil + * window attribute pointing to the active window. As of 10.8 this behavior + * had changed. The new behavior was that if the mouse were ever moved outside + * of a window, all subsequent NSMouseMoved NSEvents would have a Nil window + * attribute. To work around this the TKApplication remembers the last non-Nil + * window that it received in a mouse event. If it receives an NSEvent with a + * Nil window attribute then the saved window is used. + */ @implementation TKApplication(TKMouseEvent) - (NSEvent *) tkProcessMouseEvent: (NSEvent *) theEvent @@ -40,80 +49,72 @@ enum { #ifdef TK_MAC_DEBUG_EVENTS TKLog(@"-[%@(%p) %s] %@", [self class], self, _cmd, theEvent); #endif - id win; - NSEventType type = [theEvent type]; + NSWindow* eventWindow = [theEvent window]; + NSEventType eventType = [theEvent type]; #if 0 NSTrackingArea *trackingArea = nil; NSInteger eventNumber, clickCount, buttonNumber; #endif - - switch (type) { + switch (eventType) { case NSMouseEntered: case NSMouseExited: case NSCursorUpdate: -#if 0 - trackingArea = [theEvent trackingArea]; -#endif - /* fall through */ case NSLeftMouseDown: case NSLeftMouseUp: case NSRightMouseDown: case NSRightMouseUp: case NSOtherMouseDown: case NSOtherMouseUp: - case NSLeftMouseDragged: case NSRightMouseDragged: case NSOtherMouseDragged: - case NSMouseMoved: -#if 0 - eventNumber = [theEvent eventNumber]; - if (!trackingArea) { - clickCount = [theEvent clickCount]; - buttonNumber = [theEvent buttonNumber]; - } -#endif - case NSTabletPoint: case NSTabletProximity: - case NSScrollWheel: - win = [self windowWithWindowNumber:[theEvent windowNumber]]; break; - - default: + default: /* Unrecognized mouse event. */ return theEvent; - break; } - NSPoint global, local = [theEvent locationInWindow]; + /* Remember the window in case we need it next time. */ + if (eventWindow && eventWindow != _windowWithMouse) { + if (_windowWithMouse) { + [_windowWithMouse release]; + } + _windowWithMouse = eventWindow; + [_windowWithMouse retain]; + } - if (win) { - global = [win convertBaseToScreen:local]; - local.y = [win frame].size.height - local.y; + /* 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]; + local.y = [eventWindow frame].size.height - local.y; global.y = tkMacOSXZeroScreenHeight - global.y; - } else { - local.y = tkMacOSXZeroScreenHeight - local.y; - global = local; + } else { /* local will be in screen coordinates. */ + if (_windowWithMouse ) { + eventWindow = _windowWithMouse; + global = local; + local = [eventWindow convertPointFromScreen: local]; + local.y = [eventWindow frame].size.height - local.y; + global.y = tkMacOSXZeroScreenHeight - global.y; + } else { /* We have no window. Use the screen???*/ + local.y = tkMacOSXZeroScreenHeight - local.y; + global = local; + } } - Window window = TkMacOSXGetXWindow(win); + Window window = TkMacOSXGetXWindow(eventWindow); Tk_Window tkwin = window ? Tk_IdToWindow(TkGetDisplayList()->display, window) : NULL; if (!tkwin) { tkwin = TkMacOSXGetCapture(); } if (!tkwin) { - return theEvent; + return theEvent; /* Give up. No window for this event. */ } - /* - MacDrawable *macWin = (MacDrawable *) window; - NSView *view = TkMacOSXDrawableView(macWin); - local = [view convertPoint:local fromView:nil]; - local.y = NSHeight([view bounds]) - local.y; - */ TkWindow *winPtr = (TkWindow *) tkwin; local.x -= winPtr->wmInfoPtr->xInParent; local.y -= winPtr->wmInfoPtr->yInParent; @@ -127,12 +128,12 @@ enum { EventRef eventRef = (EventRef)[theEvent eventRef]; UInt32 buttons; OSStatus err = GetEventParameter(eventRef, kEventParamMouseChord, - typeUInt32, NULL, sizeof(UInt32), NULL, &buttons); + typeUInt32, NULL, sizeof(UInt32), NULL, &buttons); if (err == noErr) { - state |= (buttons & ((1<<5) - 1)) << 8; + state |= (buttons & ((1<<5) - 1)) << 8; } else if (button < 5) { - switch (type) { + switch (eventType) { case NSLeftMouseDown: case NSRightMouseDown: case NSLeftMouseDragged: @@ -169,12 +170,12 @@ enum { state |= Mod4Mask; } - if (type != NSScrollWheel) { + if (eventType != NSScrollWheel) { #ifdef TK_MAC_DEBUG_EVENTS TKLog(@"UpdatePointer %p x %f.0 y %f.0 %d", tkwin, global.x, global.y, state); #endif Tk_UpdatePointer(tkwin, global.x, global.y, state); - } else { + } else { /* handle scroll wheel event */ CGFloat delta; int coarseDelta; XEvent xEvent; @@ -190,7 +191,8 @@ enum { delta = [theEvent deltaY]; if (delta != 0.0) { - coarseDelta = (delta > -1.0 && delta < 1.0) ? (signbit(delta) ? -1 : 1) : lround(delta); + coarseDelta = (delta > -1.0 && delta < 1.0) ? + (signbit(delta) ? -1 : 1) : lround(delta); xEvent.xbutton.state = state; xEvent.xkey.keycode = coarseDelta; xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); @@ -198,14 +200,14 @@ enum { } delta = [theEvent deltaX]; if (delta != 0.0) { - coarseDelta = (delta > -1.0 && delta < 1.0) ? (signbit(delta) ? -1 : 1) : lround(delta); + coarseDelta = (delta > -1.0 && delta < 1.0) ? + (signbit(delta) ? -1 : 1) : lround(delta); xEvent.xbutton.state = state | ShiftMask; xEvent.xkey.keycode = coarseDelta; xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); } } - return theEvent; } @end @@ -370,7 +372,7 @@ XQueryPointer( if (win) { NSPoint local; - local = [win convertScreenToBase:global]; + local = [win convertPointFromScreen:global]; local.y = [win frame].size.height - local.y; if (macWin->winPtr && macWin->winPtr->wmInfoPtr) { local.x -= macWin->winPtr->wmInfoPtr->xInParent; @@ -468,7 +470,7 @@ TkGenerateButtonEvent( if (win) { NSPoint local = NSMakePoint(x, tkMacOSXZeroScreenHeight - y); - local = [win convertScreenToBase:local]; + local = [win convertPointFromScreen:local]; local.y = [win frame].size.height - local.y; if (macWin->winPtr && macWin->winPtr->wmInfoPtr) { local.x -= macWin->winPtr->wmInfoPtr->xInParent; @@ -554,19 +556,18 @@ TkpWarpPointer( } /* - * Tell the OSX core to generate the events to make it happen. This is - * fairly ugly, but means that under most circumstances we'll register all - * the events that would normally be generated correctly. If we use - * CGWarpMouseCursorPosition instead, strange things happen. + * Tell the OSX core to generate the events to make it happen. */ - buttonState = (GetCurrentEvent() && Tk_MacOSXIsAppInFront()) - ? GetCurrentEventButtonState() : GetCurrentButtonState(); - - CGPostMouseEvent(pt, 1 /* generate motion events */, 5, - buttonState&1 ? 1 : 0, buttonState&2 ? 1 : 0, - buttonState&4 ? 1 : 0, buttonState&8 ? 1 : 0, - buttonState&16 ? 1 : 0); + buttonState = [NSEvent pressedMouseButtons]; + CGEventType type = kCGEventMouseMoved; + CGEventRef theEvent = CGEventCreateMouseEvent(NULL, + type, + pt, + buttonState); + CGWarpMouseCursorPosition(pt); + CGEventPost(kCGHIDEventTap, theEvent); + CFRelease(theEvent); } /* diff --git a/macosx/tkMacOSXNotify.c b/macosx/tkMacOSXNotify.c index 3e0dfde..1455688 100644 --- a/macosx/tkMacOSXNotify.c +++ b/macosx/tkMacOSXNotify.c @@ -7,6 +7,7 @@ * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright 2001-2009, Apple Inc. * Copyright (c) 2005-2009 Daniel A. Steffen <das@users.sourceforge.net> + * Copyright 2015 Marc Culler. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -18,9 +19,9 @@ #include <pthread.h> #import <objc/objc-auto.h> +/* This is not used for anything at the moment. */ typedef struct ThreadSpecificData { - int initialized, sendEventNestingLevel; - NSEvent *currentEvent; + int initialized; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -34,6 +35,7 @@ static void TkMacOSXEventsCheckProc(ClientData clientData, int flags); #pragma mark TKApplication(TKNotify) @interface NSApplication(TKNotify) +/* We need to declare this hidden method. */ - (void) _modalSession: (NSModalSession) session sendEvent: (NSEvent *) event; @end @@ -48,41 +50,27 @@ static void TkMacOSXEventsCheckProc(ClientData clientData, int flags); @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 { - NSAutoreleasePool *pool = [NSAutoreleasePool new]; - + 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]; - - int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); - NSEvent *event = [[super nextEventMatchingMask:mask untilDate:expiration - inMode:mode dequeue:deqFlag] retain]; - - Tcl_SetServiceMode(oldMode); - if (event) { - TSD_INIT(); - if (tsdPtr->sendEventNestingLevel) { - if (![NSApp tkProcessEvent:event]) { - [event release]; - event = nil; - } - } - } - [pool drain]; - return [event autorelease]; + return event; } +/* + * Call super then check the pasteboard. + */ - (void) sendEvent: (NSEvent *) theEvent { - TSD_INIT(); - int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); - - tsdPtr->sendEventNestingLevel++; [super sendEvent:theEvent]; - tsdPtr->sendEventNestingLevel--; - Tcl_SetServiceMode(oldMode); [NSApp tkCheckPasteboard]; } @end @@ -161,7 +149,8 @@ Tk_MacOSXSetupTkNotifier(void) "first [load] of TkAqua has to occur in the main thread!"); } Tcl_CreateEventSource(TkMacOSXEventsSetupProc, - TkMacOSXEventsCheckProc, GetMainEventQueue()); + TkMacOSXEventsCheckProc, + GetMainEventQueue()); TkCreateExitHandler(TkMacOSXNotifyExitHandler, NULL); Tcl_SetServiceMode(TCL_SERVICE_ALL); TclMacOSXNotifierAddRunLoopMode(NSEventTrackingRunLoopMode); @@ -194,7 +183,8 @@ TkMacOSXNotifyExitHandler( TSD_INIT(); Tcl_DeleteEventSource(TkMacOSXEventsSetupProc, - TkMacOSXEventsCheckProc, GetMainEventQueue()); + TkMacOSXEventsCheckProc, + GetMainEventQueue()); tsdPtr->initialized = 0; } @@ -203,16 +193,19 @@ TkMacOSXNotifyExitHandler( * * TkMacOSXEventsSetupProc -- * - * This procedure implements the setup part of the TkAqua Events event - * source. It is invoked by Tcl_DoOneEvent before entering the notifier - * to check for events. + * This procedure implements the setup part of the MacOSX event + * source. It is invoked by Tcl_DoOneEvent before calling + * TkMacOSXEventsProc to process all queued NSEvents. In our + * case, all we need to do is to set the Tcl MaxBlockTime to + * 0 before starting the loop to process all queued NSEvents. * * Results: * None. * * Side effects: - * If TkAqua events are queued, then the maximum block time will be set - * to 0 to ensure that the notifier returns control to Tcl. + * + * If NSEvents are queued, then the maximum block time will be set + * to 0 to ensure that control returns immediately to Tcl. * *---------------------------------------------------------------------- */ @@ -222,24 +215,20 @@ TkMacOSXEventsSetupProc( ClientData clientData, int flags) { - if (flags & TCL_WINDOW_EVENTS && - ![[NSRunLoop currentRunLoop] currentMode]) { + NSString *runloopMode = [[NSRunLoop currentRunLoop] currentMode]; + /* runloopMode will be nil if we are in the Tcl event loop. */ + if (flags & TCL_WINDOW_EVENTS && !runloopMode) { static const Tcl_Time zeroBlockTime = { 0, 0 }; - TSD_INIT(); - - if (!tsdPtr->currentEvent) { - NSEvent *currentEvent = [NSApp nextEventMatchingMask:NSAnyEventMask - untilDate:[NSDate distantPast] - inMode:GetRunLoopMode(TkMacOSXGetModalSession()) - dequeue:YES]; - - if (currentEvent) { - tsdPtr->currentEvent = - TkMacOSXMakeUncollectableAndRetain(currentEvent); + /* Call this with dequeue=NO -- just checking if the queue is empty. */ + NSEvent *currentEvent = [NSApp nextEventMatchingMask:NSAnyEventMask + untilDate:[NSDate distantPast] + inMode:GetRunLoopMode(TkMacOSXGetModalSession()) + dequeue:NO]; + if (currentEvent) { + if (currentEvent.type > 0) { + Tcl_SetMaxBlockTime(&zeroBlockTime); } - } - if (tsdPtr->currentEvent) { - Tcl_SetMaxBlockTime(&zeroBlockTime); + [currentEvent release]; } } } @@ -249,69 +238,69 @@ TkMacOSXEventsSetupProc( * * TkMacOSXEventsCheckProc -- * - * This procedure processes events sitting in the TkAqua event queue. + * This procedure loops through all NSEvents waiting in the + * TKApplication event queue, generating X events from them. * * Results: * None. * * Side effects: - * Moves applicable queued TkAqua events onto the Tcl event queue. + * NSevents are used to generate X events, which are added to the + * Tcl event queue. * *---------------------------------------------------------------------- */ - static void TkMacOSXEventsCheckProc( ClientData clientData, int flags) { - if (flags & TCL_WINDOW_EVENTS && - ![[NSRunLoop currentRunLoop] currentMode]) { + NSString *runloopMode = [[NSRunLoop currentRunLoop] currentMode]; + /* runloopMode will be nil if we are in the Tcl event loop. */ + if (flags & TCL_WINDOW_EVENTS && !runloopMode) { NSEvent *currentEvent = nil; - NSAutoreleasePool *pool = nil; + NSEvent *testEvent = nil; NSModalSession modalSession; - TSD_INIT(); - if (tsdPtr->currentEvent) { - currentEvent = TkMacOSXMakeCollectableAndAutorelease( - tsdPtr->currentEvent); - } do { + [NSApp _resetAutoreleasePool]; modalSession = TkMacOSXGetModalSession(); - if (!currentEvent) { - currentEvent = [NSApp nextEventMatchingMask:NSAnyEventMask - untilDate:[NSDate distantPast] - inMode:GetRunLoopMode(modalSession) dequeue:YES]; - } - if (!currentEvent) { + testEvent = [NSApp nextEventMatchingMask:NSAnyEventMask + untilDate:[NSDate distantPast] + inMode:GetRunLoopMode(modalSession) + dequeue:NO]; + /* We must not steal any events during LiveResize. */ + if (testEvent && [[testEvent window] inLiveResize]) { break; } - [currentEvent retain]; - pool = [NSAutoreleasePool new]; - if (tkMacOSXGCEnabled) { - objc_clear_stack(0); - } - if (![NSApp tkProcessEvent:currentEvent]) { - [currentEvent release]; - currentEvent = nil; - } + + currentEvent = [NSApp nextEventMatchingMask:NSAnyEventMask + untilDate:[NSDate distantPast] + inMode:GetRunLoopMode(modalSession) + dequeue:YES]; if (currentEvent) { + /* Generate Xevents. */ + int oldServiceMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); + NSEvent *processedEvent = [NSApp tkProcessEvent:currentEvent]; + Tcl_SetServiceMode(oldServiceMode); + if (processedEvent) { /* Should always be non-NULL. */ #ifdef TK_MAC_DEBUG_EVENTS - TKLog(@" event: %@", currentEvent); + TKLog(@" event: %@", currentEvent); #endif - if (modalSession) { - [NSApp _modalSession:modalSession sendEvent:currentEvent]; - } else { - [NSApp sendEvent:currentEvent]; + if (modalSession) { + [NSApp _modalSession:modalSession sendEvent:currentEvent]; + } else { + [NSApp sendEvent:currentEvent]; + } } [currentEvent release]; - currentEvent = nil; + } else { + break; } - [pool drain]; - pool = nil; } while (1); } } + /* * Local Variables: diff --git a/macosx/tkMacOSXPort.h b/macosx/tkMacOSXPort.h index 1576ec7..0c3b347 100644 --- a/macosx/tkMacOSXPort.h +++ b/macosx/tkMacOSXPort.h @@ -141,18 +141,10 @@ /* * This macro stores a representation of the window handle in a string. - * This should perhaps use the real size of an XID. */ #define TkpPrintWindowId(buf,w) \ - sprintf((buf), "0x%x", (unsigned int) (w)) - -/* - * TkpScanWindowId is just an alias for Tcl_GetInt on Unix. - */ - -#define TkpScanWindowId(i,s,wp) \ - Tcl_GetInt((i),(s),(int *) (wp)) + sprintf((buf), "0x%lx", (unsigned long) (w)) /* * Turn off Tk double-buffering as Aqua windows are already double-buffered. diff --git a/macosx/tkMacOSXPrivate.h b/macosx/tkMacOSXPrivate.h index 034c450..2a411f6 100644 --- a/macosx/tkMacOSXPrivate.h +++ b/macosx/tkMacOSXPrivate.h @@ -144,23 +144,6 @@ } /* - * Macros for GC - */ - -#define TkMacOSXMakeUncollectable(x) ({ id o = (id)(x); \ - if (o) { if(tkMacOSXGCEnabled) CFRetain(o); } o; }) -#define TkMacOSXMakeUncollectableAndRetain(x) ({ id o = (id)(x); \ - if (o) { if(tkMacOSXGCEnabled) CFRetain(o); else [o retain]; } o; }) -#define TkMacOSXMakeCollectable(x) ({ id o = (id)(x); \ - if (o) { x = nil; if (tkMacOSXGCEnabled) CFRelease(o); } o; }) -#define TkMacOSXMakeCollectableAndRelease(x) ({ id o = (id)(x); \ - if (o) { x = nil; if (tkMacOSXGCEnabled) CFRelease(o); \ - else [o release]; } o; }) -#define TkMacOSXMakeCollectableAndAutorelease(x) ({ id o = (id)(x); \ - if (o) { x = nil; if (tkMacOSXGCEnabled) CFRelease(o); \ - else [o autorelease]; } o; }) - -/* * Structure encapsulating current drawing environment. */ @@ -178,11 +161,7 @@ typedef struct TkMacOSXDrawingContext { MODULE_SCOPE CGFloat tkMacOSXZeroScreenHeight; MODULE_SCOPE CGFloat tkMacOSXZeroScreenTop; -MODULE_SCOPE int tkMacOSXGCEnabled; MODULE_SCOPE long tkMacOSXMacOSXVersion; -#if TK_MAC_BUTTON_USE_COMPATIBILITY_METRICS -MODULE_SCOPE int tkMacOSXUseCompatibilityMetrics; -#endif /* * Prototypes for TkMacOSXRegion.c. @@ -230,6 +209,8 @@ MODULE_SCOPE WindowClass TkMacOSXWindowClass(TkWindow *winPtr); MODULE_SCOPE int TkMacOSXIsWindowZoomed(TkWindow *winPtr); MODULE_SCOPE int TkGenerateButtonEventForXPointer(Window window); MODULE_SCOPE EventModifiers TkMacOSXModifierState(void); +MODULE_SCOPE NSBitmapImageRep* BitmapRepFromDrawableRect(Drawable drawable, + int x, int y, unsigned int width, unsigned int height); MODULE_SCOPE int TkMacOSXSetupDrawingContext(Drawable d, GC gc, int useCG, TkMacOSXDrawingContext *dcPtr); MODULE_SCOPE void TkMacOSXRestoreDrawingContext( @@ -293,10 +274,14 @@ VISIBILITY_HIDDEN TKMenu *_defaultMainMenu, *_defaultApplicationMenu; NSArray *_defaultApplicationMenuItems, *_defaultWindowsMenuItems; NSArray *_defaultHelpMenuItems; + NSWindow *_windowWithMouse; + NSAutoreleasePool *_mainPool; } +@property BOOL poolProtected; @end @interface TKApplication(TKInit) - (NSString *)tkFrameworkImagePath:(NSString*)image; +- (void)_resetAutoreleasePool; @end @interface TKApplication(TKEvent) - (NSEvent *)tkProcessEvent:(NSEvent *)theEvent; @@ -314,13 +299,34 @@ VISIBILITY_HIDDEN - (void)tkProvidePasteboard:(TkDisplay *)dispPtr; - (void)tkCheckPasteboard; @end +@interface TKApplication(TKHLEvents) +- (void) terminate: (id) sender; +- (void) preferences: (id) sender; +- (void) handleQuitApplicationEvent: (NSAppleEventDescriptor *)event + withReplyEvent: (NSAppleEventDescriptor *)replyEvent; +- (void) handleOpenApplicationEvent: (NSAppleEventDescriptor *)event + withReplyEvent: (NSAppleEventDescriptor *)replyEvent; +- (void) handleReopenApplicationEvent: (NSAppleEventDescriptor *)event + withReplyEvent: (NSAppleEventDescriptor *)replyEvent; +- (void) handleShowPreferencesEvent: (NSAppleEventDescriptor *)event + withReplyEvent: (NSAppleEventDescriptor *)replyEvent; +- (void) handleOpenDocumentsEvent: (NSAppleEventDescriptor *)event + withReplyEvent: (NSAppleEventDescriptor *)replyEvent; +- (void) handlePrintDocumentsEvent: (NSAppleEventDescriptor *)event + withReplyEvent: (NSAppleEventDescriptor *)replyEvent; +- (void) handleDoScriptEvent: (NSAppleEventDescriptor *)event + withReplyEvent: (NSAppleEventDescriptor *)replyEvent; +@end VISIBILITY_HIDDEN @interface TKContentView : NSView <NSTextInput> { @private + /*Remove private API calls.*/ +#if 0 id _savedSubviews; BOOL _subviewsSetAside; - NSString *_workingText; +#endif + NSString *privateWorkingText; } @end @@ -328,10 +334,27 @@ VISIBILITY_HIDDEN - (void) deleteWorkingText; @end +@interface TKContentView(TKWindowEvent) +- (void) drawRect: (NSRect) rect; +- (void) generateExposeEvents: (HIShapeRef) shape; +- (void) generateExposeEvents: (HIShapeRef) shape childrenOnly: (int) childrenOnly; +- (void) viewDidEndLiveResize; +- (void) tkToolbarButton: (id) sender; +- (BOOL) isOpaque; +- (BOOL) wantsDefaultClipping; +- (BOOL) acceptsFirstResponder; +- (void) keyDown: (NSEvent *) theEvent; +@end + VISIBILITY_HIDDEN @interface TKWindow : NSWindow @end +@interface NSWindow(TKWm) +- (NSPoint) convertPointToScreen:(NSPoint)point; +- (NSPoint) convertPointFromScreen:(NSPoint)point; +@end + #pragma mark NSMenu & NSMenuItem Utilities @interface NSMenu(TKUtils) @@ -360,9 +383,4 @@ VISIBILITY_HIDDEN keyEquivalentModifierMask:(NSUInteger)keyEquivalentModifierMask; @end -/* From WebKit/WebKit/mac/WebCoreSupport/WebChromeClient.mm: */ -@interface NSWindow(TKGrowBoxRect) -- (NSRect)_growBoxRect; -@end - #endif /* _TKMACPRIV */ diff --git a/macosx/tkMacOSXRegion.c b/macosx/tkMacOSXRegion.c index 8432299..0f2a74a 100644 --- a/macosx/tkMacOSXRegion.c +++ b/macosx/tkMacOSXRegion.c @@ -158,6 +158,29 @@ TkUnionRectWithRegion( /* *---------------------------------------------------------------------- * + * TkMacOSXIsEmptyRegion -- + * + * Return native region for given tk region. + * + * Results: + * 1 if empty, 0 otherwise. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +TkMacOSXIsEmptyRegion( + TkRegion r) +{ + return HIShapeIsEmpty((HIMutableShapeRef) r) ? 1 : 0; +} + +/* + *---------------------------------------------------------------------- + * * TkRectInRegion -- * * Implements the equivelent of the X window function XRectInRegion. See @@ -181,12 +204,14 @@ TkRectInRegion( unsigned int width, unsigned int height) { - int result; - const CGRect r = CGRectMake(x, y, width, height); - - result = HIShapeIntersectsRect((HIShapeRef) region, &r) ? + if ( TkMacOSXIsEmptyRegion(region) ) { + return RectangleOut; + } + else { + const CGRect r = CGRectMake(x, y, width, height); + return HIShapeIntersectsRect((HIShapeRef) region, &r) ? RectanglePart : RectangleOut; - return result; + } } /* @@ -332,12 +357,11 @@ TkpReleaseRegion( { CFRelease(r); } -#if 0 /* *---------------------------------------------------------------------- * - * TkMacOSXEmtpyRegion -- + * TkMacOSXSetEmptyRegion -- * * Set region to emtpy. * @@ -351,7 +375,7 @@ TkpReleaseRegion( */ void -TkMacOSXEmtpyRegion( +TkMacOSXSetEmptyRegion( TkRegion r) { ChkErr(HIShapeSetEmpty, (HIMutableShapeRef) r); @@ -360,30 +384,6 @@ TkMacOSXEmtpyRegion( /* *---------------------------------------------------------------------- * - * TkMacOSXIsEmptyRegion -- - * - * Return native region for given tk region. - * - * Results: - * 1 if empty, 0 otherwise. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -int -TkMacOSXIsEmptyRegion( - TkRegion r) -{ - return HIShapeIsEmpty((HIMutableShapeRef) r) ? 1 : 0; -} -#endif - -/* - *---------------------------------------------------------------------- - * * TkMacOSXGetNativeRegion -- * * Return native region for given tk region. diff --git a/macosx/tkMacOSXScale.c b/macosx/tkMacOSXScale.c index 0bca521..c5a6f76 100644 --- a/macosx/tkMacOSXScale.c +++ b/macosx/tkMacOSXScale.c @@ -145,7 +145,7 @@ TkpDisplayScale( Tk_Window tkwin = scalePtr->tkwin; Tcl_Interp *interp = scalePtr->interp; int result; - char string[PRINT_CHARS]; + char string[TCL_DOUBLE_SPACE]; MacScale *macScalePtr = (MacScale *) clientData; Rect r; WindowRef windowRef; diff --git a/macosx/tkMacOSXScrlbr.c b/macosx/tkMacOSXScrlbr.c index ac71d8e..91cf112 100644 --- a/macosx/tkMacOSXScrlbr.c +++ b/macosx/tkMacOSXScrlbr.c @@ -7,51 +7,41 @@ * Copyright (c) 1996 by Sun Microsystems, Inc. * Copyright 2001-2009, Apple Inc. * Copyright (c) 2006-2009 Daniel A. Steffen <das@users.sourceforge.net> - * + * Copyright (c) 2015 Kevin Walzer/WordTech Commununications LLC. * 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 "tkInt.h" #include "tkScrollbar.h" +#include "tkMacOSXPrivate.h" -/* -#ifdef TK_MAC_DEBUG -#define TK_MAC_DEBUG_SCROLLBAR -#endif -*/ -/* - * Declaration of Mac specific scrollbar structure. - */ +#define MIN_SCROLLBAR_VALUE 0 -typedef struct MacScrollbar { - TkScrollbar info; - NSScroller *scroller; - int variant; -} MacScrollbar; +/*Borrowed from ttkMacOSXTheme.c to provide appropriate scaling of scrollbar values.*/ +#ifdef __LP64__ +#define RangeToFactor(maximum) (((double) (INT_MAX >> 1)) / (maximum)) +#else +#define RangeToFactor(maximum) (((double) (LONG_MAX >> 1)) / (maximum)) +#endif /* __LP64__ */ -typedef struct ScrollbarMetrics { - SInt32 width, minThumbHeight; - int minHeight, topArrowHeight, bottomArrowHeight; - NSControlSize controlSize; -} ScrollbarMetrics; - -static ScrollbarMetrics metrics[2] = { - {15, 54, 26, 14, 14, NSRegularControlSize}, /* kThemeScrollBarMedium */ - {11, 40, 20, 10, 10, NSSmallControlSize}, /* kThemeScrollBarSmall */ -}; +#define MOUNTAIN_LION_STYLE (NSAppKitVersionNumber < 1138) /* - * Declarations for functions defined in this file. + * Declaration of Mac specific scrollbar structure. */ -static void UpdateScrollbarMetrics(void); -static void ScrollbarEventProc(ClientData clientData, - XEvent *eventPtr); +typedef struct MacScrollbar { + TkScrollbar information; /* Generic scrollbar info. */ + GC troughGC; /* For drawing trough. */ + GC copyGC; /* Used for copying from pixmap onto screen. */ +} MacScrollbar; /* - * The class procedure table for the scrollbar widget. + * The class procedure table for the scrollbar widget. All fields except size + * are left initialized to NULL, which should happen automatically since the + * variable is declared at this scope. */ const Tk_ClassProcs tkpScrollbarProcs = { @@ -60,151 +50,37 @@ const Tk_ClassProcs tkpScrollbarProcs = { NULL, /* createProc */ NULL /* modalProc */ }; - -#pragma mark TKApplication(TKScrlbr) -#define NSAppleAquaScrollBarVariantChanged @"AppleAquaScrollBarVariantChanged" -@implementation TKApplication(TKScrlbr) -- (void) tkScroller: (NSScroller *) scroller -{ - NSScrollerPart hitPart = [scroller hitPart]; - TkScrollbar *scrollPtr = (TkScrollbar *)[scroller tag]; - Tcl_DString cmdString; - Tcl_Interp *interp; - int result; - - if (!scrollPtr || !scrollPtr->command || !scrollPtr->commandSize || - hitPart == NSScrollerNoPart) { - return; - } - - Tcl_DStringInit(&cmdString); - Tcl_DStringAppend(&cmdString, scrollPtr->command, - scrollPtr->commandSize); - switch (hitPart) { - case NSScrollerKnob: - case NSScrollerKnobSlot: { - char valueString[TCL_DOUBLE_SPACE]; - - Tcl_PrintDouble(NULL, [scroller doubleValue] * - (1.0 - [scroller knobProportion]), valueString); - Tcl_DStringAppendElement(&cmdString, "moveto"); - Tcl_DStringAppendElement(&cmdString, valueString); - break; - } - case NSScrollerDecrementLine: - case NSScrollerIncrementLine: - Tcl_DStringAppendElement(&cmdString, "scroll"); - Tcl_DStringAppendElement(&cmdString, - (hitPart == NSScrollerDecrementLine) ? "-1" : "1"); - Tcl_DStringAppendElement(&cmdString, "unit"); - break; - case NSScrollerDecrementPage: - case NSScrollerIncrementPage: - Tcl_DStringAppendElement(&cmdString, "scroll"); - Tcl_DStringAppendElement(&cmdString, - (hitPart == NSScrollerDecrementPage) ? "-1" : "1"); - Tcl_DStringAppendElement(&cmdString, "page"); - break; - } - interp = scrollPtr->interp; - Tcl_Preserve(interp); - Tcl_Preserve(scrollPtr); - result = Tcl_EvalEx(interp, Tcl_DStringValue(&cmdString), - Tcl_DStringLength(&cmdString), TCL_EVAL_GLOBAL); - if (result != TCL_OK && result != TCL_CONTINUE && result != TCL_BREAK) { - Tcl_AddErrorInfo(interp, "\n (scrollbar command)"); - Tcl_BackgroundException(interp, result); - } - Tcl_Release(scrollPtr); - Tcl_Release(interp); - Tcl_DStringFree(&cmdString); -#ifdef TK_MAC_DEBUG_SCROLLBAR - TKLog(@"scroller %s value %f knobProportion %f", - ((TkWindow *)scrollPtr->tkwin)->pathName, [scroller doubleValue], - [scroller knobProportion]); -#endif -} - -- (void) scrollBarVariantChanged: (NSNotification *) notification -{ -#ifdef TK_MAC_DEBUG_NOTIFICATIONS - TKLog(@"-[%@(%p) %s] %@", [self class], self, _cmd, notification); -#endif - UpdateScrollbarMetrics(); -} +/*Information on scrollbar layout, metrics, and draw info.*/ +typedef struct ScrollbarMetrics { + SInt32 width, minThumbHeight; + int minHeight, topArrowHeight, bottomArrowHeight; + NSControlSize controlSize; +} ScrollbarMetrics; -- (void) _setupScrollBarNotifications -{ - NSNotificationCenter *nc = [NSNotificationCenter defaultCenter]; +static ScrollbarMetrics metrics[2] = { + {15, 54, 26, 14, 14, NSRegularControlSize}, /* kThemeScrollBarMedium */ + {11, 40, 20, 10, 10, NSSmallControlSize}, /* kThemeScrollBarSmall */ +}; -#define observe(n, s) [nc addObserver:self selector:@selector(s) name:(n) object:nil] - observe(NSAppleAquaScrollBarVariantChanged, scrollBarVariantChanged:); -#undef observe +HIThemeTrackDrawInfo info = { + .version = 0, + .min = 0.0, + .max = 100.0, + .attributes = kThemeTrackShowThumb, + .kind = kThemeScrollBarMedium, +}; - UpdateScrollbarMetrics(); -} -@end -#pragma mark - - /* - *---------------------------------------------------------------------- - * - * UpdateScrollbarMetrics -- - * - * This function retrieves the current system metrics for a scrollbar. - * - * Results: - * None. - * - * Side effects: - * Updates the geometry cache info for all scrollbars. - * - *---------------------------------------------------------------------- + * Forward declarations for procedures defined later in this file: */ -static void -UpdateScrollbarMetrics(void) -{ - const short height = 100, width = 50; - HIThemeTrackDrawInfo info = { - .version = 0, - .bounds = {{0, 0}, {width, height}}, - .min = 0, - .max = 1, - .value = 0, - .attributes = kThemeTrackShowThumb, - .enableState = kThemeTrackActive, - .trackInfo.scrollbar = {.viewsize = 1, .pressState = 0}, - }; - CGRect bounds; - - ChkErr(GetThemeMetric, kThemeMetricScrollBarWidth, &metrics[0].width); - ChkErr(GetThemeMetric, kThemeMetricScrollBarMinThumbHeight, - &metrics[0].minThumbHeight); - info.kind = kThemeScrollBarMedium; - ChkErr(HIThemeGetTrackDragRect, &info, &bounds); - metrics[0].topArrowHeight = bounds.origin.y; - metrics[0].bottomArrowHeight = height - (bounds.origin.y + - bounds.size.height); - metrics[0].minHeight = metrics[0].minThumbHeight + - metrics[0].topArrowHeight + metrics[0].bottomArrowHeight; - ChkErr(GetThemeMetric, kThemeMetricSmallScrollBarWidth, &metrics[1].width); - ChkErr(GetThemeMetric, kThemeMetricSmallScrollBarMinThumbHeight, - &metrics[1].minThumbHeight); - info.kind = kThemeScrollBarSmall; - ChkErr(HIThemeGetTrackDragRect, &info, &bounds); - metrics[1].topArrowHeight = bounds.origin.y; - metrics[1].bottomArrowHeight = height - (bounds.origin.y + - bounds.size.height); - metrics[1].minHeight = metrics[1].minThumbHeight + - metrics[1].topArrowHeight + metrics[1].bottomArrowHeight; - - sprintf(tkDefScrollbarWidth, "%d", (int)(metrics[0].width)); -} - +static void ScrollbarEventProc(ClientData clientData, XEvent *eventPtr); +static int ScrollbarPress(TkScrollbar *scrollPtr, XEvent *eventPtr); +static void UpdateControlValues(TkScrollbar *scrollPtr); + /* *---------------------------------------------------------------------- * @@ -223,41 +99,17 @@ UpdateScrollbarMetrics(void) TkScrollbar * TkpCreateScrollbar( - Tk_Window tkwin) + Tk_Window tkwin) { - MacScrollbar *scrollPtr = ckalloc(sizeof(MacScrollbar)); - scrollPtr->scroller = nil; - Tk_CreateEventHandler(tkwin, StructureNotifyMask|FocusChangeMask| - ActivateMask|ExposureMask, ScrollbarEventProc, scrollPtr); - return (TkScrollbar *) scrollPtr; -} - -/* - *---------------------------------------------------------------------- - * - * TkpDestroyScrollbar -- - * - * Free data structures associated with the scrollbar control. - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ + MacScrollbar *scrollPtr = (MacScrollbar *)ckalloc(sizeof(MacScrollbar)); -void -TkpDestroyScrollbar( - TkScrollbar *scrollPtr) -{ - MacScrollbar *macScrollPtr = (MacScrollbar *) scrollPtr; - NSScroller *scroller = macScrollPtr->scroller; - [scroller setTag:(NSInteger)0]; + scrollPtr->troughGC = None; + scrollPtr->copyGC = None; + + Tk_CreateEventHandler(tkwin,ExposureMask|StructureNotifyMask|FocusChangeMask|ButtonPressMask|VisibilityChangeMask, ScrollbarEventProc, scrollPtr); - TkMacOSXMakeCollectableAndRelease(macScrollPtr->scroller); + return (TkScrollbar *) scrollPtr; } /* @@ -266,8 +118,8 @@ TkpDestroyScrollbar( * TkpDisplayScrollbar -- * * This procedure redraws the contents of a scrollbar window. It is - * invoked as a do-when-idle handler, so it only runs when there's nothing - * else for the application to do. + * invoked as a do-when-idle handler, so it only runs when there's + * nothing else for the application to do. * * Results: * None. @@ -280,91 +132,68 @@ TkpDestroyScrollbar( void TkpDisplayScrollbar( - ClientData clientData) /* Information about window. */ + ClientData clientData) /* Information about window. */ { - TkScrollbar *scrollPtr = clientData; - MacScrollbar *macScrollPtr = clientData; - NSScroller *scroller = macScrollPtr->scroller; - Tk_Window tkwin = scrollPtr->tkwin; + register TkScrollbar *scrollPtr = (TkScrollbar *) clientData; + register Tk_Window tkwin = scrollPtr->tkwin; TkWindow *winPtr = (TkWindow *) tkwin; - MacDrawable *macWin = (MacDrawable *) winPtr->window; TkMacOSXDrawingContext dc; - NSView *view = TkMacOSXDrawableView(macWin); - CGFloat viewHeight = [view bounds].size.height; - CGAffineTransform t = { .a = 1, .b = 0, .c = 0, .d = -1, .tx = 0, - .ty = viewHeight}; - NSRect frame; - double knobProportion = scrollPtr->lastFraction - scrollPtr->firstFraction; scrollPtr->flags &= ~REDRAW_PENDING; - if (!scrollPtr->tkwin || !Tk_IsMapped(tkwin) || !view || - !TkMacOSXSetupDrawingContext((Drawable) macWin, NULL, 1, &dc)) { - return; + + if (tkwin == NULL || !Tk_IsMapped(tkwin)) { + return; + } + + MacDrawable *macWin = (MacDrawable *) winPtr->window; + NSView *view = TkMacOSXDrawableView(macWin); + if (!view || + macWin->flags & TK_DO_NOT_DRAW || + !TkMacOSXSetupDrawingContext((Drawable) macWin, NULL, 1, &dc)) { + return; } + + CGFloat viewHeight = [view bounds].size.height; + CGAffineTransform t = { .a = 1, .b = 0, .c = 0, .d = -1, .tx = 0, + .ty = viewHeight}; CGContextConcatCTM(dc.context, t); + + /*Draw Unix-style scroll trough to provide rect for native scrollbar.*/ if (scrollPtr->highlightWidth != 0) { - GC fgGC, bgGC; - - bgGC = Tk_GCForColor(scrollPtr->highlightBgColorPtr, (Pixmap) macWin); - if (scrollPtr->flags & GOT_FOCUS) { - fgGC = Tk_GCForColor(scrollPtr->highlightColorPtr, (Pixmap) macWin); - } else { - fgGC = bgGC; - } - TkpDrawHighlightBorder(tkwin, fgGC, bgGC, scrollPtr->highlightWidth, - (Pixmap) macWin); + GC fgGC, bgGC; + + bgGC = Tk_GCForColor(scrollPtr->highlightBgColorPtr, (Pixmap) macWin); + if (scrollPtr->flags & GOT_FOCUS) { + fgGC = Tk_GCForColor(scrollPtr->highlightColorPtr, (Pixmap) macWin); + } else { + fgGC = bgGC; + } + TkpDrawHighlightBorder(tkwin, fgGC, bgGC, scrollPtr->highlightWidth, + (Pixmap) macWin); } + Tk_Draw3DRectangle(tkwin, (Pixmap) macWin, scrollPtr->bgBorder, - scrollPtr->highlightWidth, scrollPtr->highlightWidth, - Tk_Width(tkwin) - 2*scrollPtr->highlightWidth, - Tk_Height(tkwin) - 2*scrollPtr->highlightWidth, - scrollPtr->borderWidth, scrollPtr->relief); + scrollPtr->highlightWidth, scrollPtr->highlightWidth, + Tk_Width(tkwin) - 2*scrollPtr->highlightWidth, + Tk_Height(tkwin) - 2*scrollPtr->highlightWidth, + scrollPtr->borderWidth, scrollPtr->relief); Tk_Fill3DRectangle(tkwin, (Pixmap) macWin, scrollPtr->bgBorder, - scrollPtr->inset, scrollPtr->inset, - Tk_Width(tkwin) - 2*scrollPtr->inset, - Tk_Height(tkwin) - 2*scrollPtr->inset, 0, TK_RELIEF_FLAT); - if ([scroller superview] != view) { - [view addSubview:scroller]; - } - frame = NSMakeRect(macWin->xOff, macWin->yOff, Tk_Width(tkwin), - Tk_Height(tkwin)); - frame = NSInsetRect(frame, scrollPtr->inset, scrollPtr->inset); - frame.origin.y = viewHeight - (frame.origin.y + frame.size.height); - - NSWindow *w = [view window]; - - if ([w showsResizeIndicator]) { - NSRect growBox = [view convertRect:[w _growBoxRect] fromView:nil]; - - if (NSIntersectsRect(growBox, frame)) { - if (scrollPtr->vertical) { - CGFloat y = frame.origin.y; - - frame.origin.y = growBox.origin.y + growBox.size.height; - frame.size.height -= frame.origin.y - y; - } else { - frame.size.width = growBox.origin.x - frame.origin.x; - } - TkMacOSXSetScrollbarGrow(winPtr, true); - } - } - if (!NSEqualRects(frame, [scroller frame])) { - [scroller setFrame:frame]; + scrollPtr->inset, scrollPtr->inset, + Tk_Width(tkwin) - 2*scrollPtr->inset, + Tk_Height(tkwin) - 2*scrollPtr->inset, 0, TK_RELIEF_FLAT); + + /*Update values and draw in native rect.*/ + UpdateControlValues(scrollPtr); + if (MOUNTAIN_LION_STYLE) { + HIThemeDrawTrack (&info, 0, dc.context, kHIThemeOrientationInverted); + } else { + HIThemeDrawTrack (&info, 0, dc.context, kHIThemeOrientationNormal); } - [scroller setEnabled:(knobProportion < 1.0 && - (scrollPtr->vertical ? frame.size.height : frame.size.width) > - metrics[macScrollPtr->variant].minHeight)]; - [scroller setDoubleValue:scrollPtr->firstFraction / (1.0 - knobProportion)]; - [scroller setKnobProportion:knobProportion]; - [scroller displayRectIgnoringOpacity:[scroller bounds]]; TkMacOSXRestoreDrawingContext(&dc); -#ifdef TK_MAC_DEBUG_SCROLLBAR - TKLog(@"scroller %s frame %@ width %d height %d", - ((TkWindow *)scrollPtr->tkwin)->pathName, NSStringFromRect(frame), - Tk_Width(tkwin), Tk_Height(tkwin)); -#endif + + scrollPtr->flags &= ~REDRAW_PENDING; } - + /* *---------------------------------------------------------------------- * @@ -383,123 +212,107 @@ TkpDisplayScrollbar( *---------------------------------------------------------------------- */ -void +extern void TkpComputeScrollbarGeometry( - register TkScrollbar *scrollPtr) - /* Scrollbar whose geometry may have - * changed. */ + register TkScrollbar *scrollPtr) +/* Scrollbar whose geometry may have + * changed. */ { - MacScrollbar *macScrollPtr = (MacScrollbar *) scrollPtr; - NSScroller *scroller = macScrollPtr->scroller; - int width, height, variant, fieldLength; + + int variant, fieldLength; if (scrollPtr->highlightWidth < 0) { - scrollPtr->highlightWidth = 0; + scrollPtr->highlightWidth = 0; } scrollPtr->inset = scrollPtr->highlightWidth + scrollPtr->borderWidth; - width = Tk_Width(scrollPtr->tkwin) - 2 * scrollPtr->inset; - height = Tk_Height(scrollPtr->tkwin) - 2 * scrollPtr->inset; - variant = ((scrollPtr->vertical ? width : height) < metrics[0].width) ? - 1 : 0; - macScrollPtr->variant = variant; - if (scroller) { - NSSize size = [scroller frame].size; - - if ((size.width > size.height) ^ !scrollPtr->vertical) { - /* - * Orientation changed, need new scroller. - */ - - if ([scroller superview]) { - [scroller removeFromSuperviewWithoutNeedingDisplay]; - } - TkMacOSXMakeCollectableAndRelease(scroller); - } - } - if (!scroller) { - if ((width > height) ^ !scrollPtr->vertical) { - /* -[NSScroller initWithFrame:] determines horizonalness for the - * lifetime of the scroller via isHoriz = (width > height) */ - if (scrollPtr->vertical) { - width = height; - } else if (width > 1) { - height = width - 1; - } else { - height = 1; - width = 2; - } - } - scroller = [[NSScroller alloc] initWithFrame: - NSMakeRect(0, 0, width, height)]; - macScrollPtr->scroller = TkMacOSXMakeUncollectable(scroller); - [scroller setAction:@selector(tkScroller:)]; - [scroller setTarget:NSApp]; - [scroller setTag:(NSInteger)scrollPtr]; - } - [[scroller cell] setControlSize:metrics[variant].controlSize]; - + 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; + metrics[variant].bottomArrowHeight) / 2; fieldLength = (scrollPtr->vertical ? Tk_Height(scrollPtr->tkwin) - : Tk_Width(scrollPtr->tkwin)) - - 2 * (scrollPtr->arrowLength + scrollPtr->inset); + : Tk_Width(scrollPtr->tkwin)) + - 2 * (scrollPtr->arrowLength + scrollPtr->inset); if (fieldLength < 0) { - 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; + scrollPtr->sliderFirst = fieldLength - 2*scrollPtr->borderWidth; } 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; + metrics[variant].minThumbHeight)) { + scrollPtr->sliderLast = scrollPtr->sliderFirst + + metrics[variant].minThumbHeight; } if (scrollPtr->sliderLast > fieldLength) { - scrollPtr->sliderLast = fieldLength; + scrollPtr->sliderLast = fieldLength; + } + if (!(MOUNTAIN_LION_STYLE)) { + scrollPtr->sliderFirst += scrollPtr->inset + + metrics[variant].topArrowHeight; + scrollPtr->sliderLast += scrollPtr->inset + + metrics[variant].bottomArrowHeight; } - scrollPtr->sliderFirst += scrollPtr->inset + - metrics[variant].topArrowHeight; - scrollPtr->sliderLast += scrollPtr->inset + - metrics[variant].bottomArrowHeight; - /* - * 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 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); + Tk_GeometryRequest(scrollPtr->tkwin, scrollPtr->width + 2 * scrollPtr->inset, 2 * (scrollPtr->arrowLength + scrollPtr->borderWidth + scrollPtr->inset) + metrics[variant].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[variant].minThumbHeight, scrollPtr->width + 2 * scrollPtr->inset); } Tk_SetInternalBorder(scrollPtr->tkwin, scrollPtr->inset); -#ifdef TK_MAC_DEBUG_SCROLLBAR - TKLog(@"scroller %s bounds %@ width %d height %d inset %d borderWidth %d", - ((TkWindow *)scrollPtr->tkwin)->pathName, - NSStringFromRect([scroller bounds]), - width, height, scrollPtr->inset, scrollPtr->borderWidth); -#endif + } - + +/* + *---------------------------------------------------------------------- + * + * TkpDestroyScrollbar -- + * + * Free data structures associated with the scrollbar control. + * + * Results: + * None. + * + * Side effects: + * Frees the GCs associated with the scrollbar. + * + *---------------------------------------------------------------------- + */ + +void +TkpDestroyScrollbar( + TkScrollbar *scrollPtr) +{ + MacScrollbar *macScrollPtr = (MacScrollbar *)scrollPtr; + + if (macScrollPtr->troughGC != None) { + Tk_FreeGC(scrollPtr->display, macScrollPtr->troughGC); + } + if (macScrollPtr->copyGC != None) { + Tk_FreeGC(scrollPtr->display, macScrollPtr->copyGC); + } + + macScrollPtr=NULL; +} + /* *---------------------------------------------------------------------- * @@ -513,19 +326,20 @@ TkpComputeScrollbarGeometry( * None. * * Side effects: - * None. + * Configuration info may get changed. * *---------------------------------------------------------------------- */ void TkpConfigureScrollbar( - register TkScrollbar *scrollPtr) - /* Information about widget; may or may not - * already have values for some fields. */ + register TkScrollbar *scrollPtr) +/* Information about widget; may or may not + * already have values for some fields. */ { + } - + /* *-------------------------------------------------------------- * @@ -550,30 +364,174 @@ TkpScrollbarPosition( /* Scrollbar widget record. */ int x, int y) /* Coordinates within scrollPtr's window. */ { - NSScroller *scroller = ((MacScrollbar *) scrollPtr)->scroller; - MacDrawable *macWin = (MacDrawable *) - ((TkWindow *) scrollPtr->tkwin)->window; - NSView *view = TkMacOSXDrawableView(macWin); - switch ([scroller testPart:NSMakePoint(macWin->xOff + x, - [view bounds].size.height - (macWin->yOff + y))]) { - case NSScrollerDecrementLine: - return TOP_ARROW; - case NSScrollerDecrementPage: + /* + * 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. + */ + + int length, fieldlength, 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<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. + */ + + if (y < scrollPtr->sliderFirst) { return TOP_GAP; - case NSScrollerKnob: + } + if (y < scrollPtr->sliderLast) { return SLIDER; - case NSScrollerIncrementPage: + } + if (y < fieldlength){ return BOTTOM_GAP; - case NSScrollerIncrementLine: - return BOTTOM_ARROW; - case NSScrollerKnobSlot: - case NSScrollerNoPart: - default: - return OUTSIDE; } + if (y < fieldlength + arrowSize) { + return TOP_ARROW; + } + return BOTTOM_ARROW; } - + +/* + *-------------------------------------------------------------- + * + * UpdateControlValues -- + * + * 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 + * drive scrolling in the Tk window and all the Mac scrollbar has + * to do is redraw itself. + * + * Results: + * None. + * + * Side effects: + * The Macintosh control is updated. + * + *-------------------------------------------------------------- + */ + +static void +UpdateControlValues( + TkScrollbar *scrollPtr) /* Scrollbar data struct. */ +{ + 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); + CGFloat viewHeight = [view bounds].size.height; + NSRect frame; + frame = NSMakeRect(macWin->xOff, macWin->yOff, Tk_Width(tkwin), + Tk_Height(tkwin)); + frame = NSInsetRect(frame, scrollPtr->inset, scrollPtr->inset); + frame.origin.y = viewHeight - (frame.origin.y + frame.size.height); + + contrlRect = NSRectToCGRect(frame); + 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; + if (scrollPtr->vertical) { + info.attributes &= ~kThemeTrackHorizontal; + } else { + info.attributes |= kThemeTrackHorizontal; + } + + /* + * Given the Tk parameters for the fractions of the start and end of the + * thumb, the following calculation determines the location for the + * Macintosh thumb. The Aqua scroll control works as follows. The + * scrollbar's value is the position of the left (or top) side of the view + * area in the content area being scrolled. The maximum value of the + * control is therefore the dimension of the content area less the size of + * the view area. + */ + + double maximum = 100, factor; + factor = RangeToFactor(maximum); + dViewSize = (scrollPtr->lastFraction - scrollPtr->firstFraction) + * factor; + info.max = MIN_SCROLLBAR_VALUE + + factor - dViewSize; + info.trackInfo.scrollbar.viewsize = dViewSize; + if (scrollPtr->vertical) { + if (MOUNTAIN_LION_STYLE) { + info.value = factor * scrollPtr->firstFraction; + } else { + info.value = info.max - factor * scrollPtr->firstFraction; + } + } else { + info.value = MIN_SCROLLBAR_VALUE + factor * scrollPtr->firstFraction; + } + + if((scrollPtr->firstFraction <= 0.0 && scrollPtr->lastFraction >= 1.0) + || height <= metrics[variant].minHeight) { + info.enableState = kThemeTrackHideTrack; + } else { + info.enableState = kThemeTrackActive; + info.attributes = kThemeTrackShowThumb | kThemeTrackThumbRgnIsNotGhost; + } + +} + +/* + *-------------------------------------------------------------- + * + * ScrollbarPress -- + * + * This procedure is invoked in response to <ButtonPress> events. + * Enters a modal loop to handle scrollbar interactions. + * + *-------------------------------------------------------------- + */ + +static int +ScrollbarPress(TkScrollbar *scrollPtr, XEvent *eventPtr) +{ + + if (eventPtr->type == ButtonPress) { + UpdateControlValues(scrollPtr); + } + return TCL_OK; +} + + + /* *-------------------------------------------------------------- * @@ -594,8 +552,8 @@ TkpScrollbarPosition( static void ScrollbarEventProc( - ClientData clientData, /* Information about window. */ - XEvent *eventPtr) /* Information about event. */ + ClientData clientData, /* Information about window. */ + XEvent *eventPtr) /* Information about event. */ { TkScrollbar *scrollPtr = clientData; @@ -607,16 +565,10 @@ ScrollbarEventProc( case DeactivateNotify: TkScrollbarEventuallyRedraw(scrollPtr); break; + case ButtonPress: + ScrollbarPress(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 18276fb..f026318 100644 --- a/macosx/tkMacOSXSubwindows.c +++ b/macosx/tkMacOSXSubwindows.c @@ -149,8 +149,11 @@ XMapWindow( if (Tk_IsTopLevel(macWin->winPtr)) { if (!Tk_IsEmbedded(macWin->winPtr)) { NSWindow *win = TkMacOSXDrawableWindow(window); - - [win makeKeyAndOrderFront:NSApp]; + [NSApp activateIgnoringOtherApps:YES]; + if ( [win canBecomeKeyWindow] ) { + [win makeKeyAndOrderFront:NSApp]; + } + /* Why do we need this? (It is used by Carbon)*/ [win windowRef]; TkMacOSXApplyWindowAttributes(macWin->winPtr, win); } @@ -310,7 +313,6 @@ XResizeWindow( unsigned int height) { MacDrawable *macWin = (MacDrawable *) window; - display->request++; if (Tk_IsTopLevel(macWin->winPtr) && !Tk_IsEmbedded(macWin->winPtr)) { NSWindow *w = macWin->winPtr->wmInfoPtr->window; @@ -357,7 +359,6 @@ XMoveResizeWindow( display->request++; if (Tk_IsTopLevel(macWin->winPtr) && !Tk_IsEmbedded(macWin->winPtr)) { NSWindow *w = macWin->winPtr->wmInfoPtr->window; - if (w) { NSRect r = NSMakeRect(x + macWin->winPtr->wmInfoPtr->xInParent, tkMacOSXZeroScreenHeight - (y + @@ -398,7 +399,6 @@ XMoveWindow( display->request++; if (Tk_IsTopLevel(macWin->winPtr) && !Tk_IsEmbedded(macWin->winPtr)) { NSWindow *w = macWin->winPtr->wmInfoPtr->window; - if (w) { [w setFrameTopLeftPoint:NSMakePoint(x, tkMacOSXZeroScreenHeight - y)]; } @@ -649,9 +649,68 @@ XConfigureWindow( /* *---------------------------------------------------------------------- * + * TkMacOSXSetDrawingEnabled -- + * + * This function sets the TK_DO_NOT_DRAW flag for a given window and + * all of its children. + * + * Results: + * None. + * + * Side effects: + * The clipping regions for the window and its children are cleared. + * + *---------------------------------------------------------------------- + */ + +void +TkMacOSXSetDrawingEnabled( + TkWindow *winPtr, + int flag) +{ + TkWindow *childPtr; + MacDrawable *macWin = winPtr->privatePtr; + + if (macWin) { + if (flag ) { + macWin->flags &= ~TK_DO_NOT_DRAW; + } else { + macWin->flags |= TK_DO_NOT_DRAW; + } + } + + /* + * Set the flag for all children & their descendants, excluding + * Toplevels. (??? Do we need to exclude Toplevels?) + */ + + childPtr = winPtr->childList; + while (childPtr) { + if (!Tk_IsTopLevel(childPtr)) { + TkMacOSXSetDrawingEnabled(childPtr, flag); + } + childPtr = childPtr->nextPtr; + } + + /* + * If the window is a container, set the flag for its embedded window. + */ + + if (Tk_IsContainer(winPtr)) { + childPtr = TkpGetOtherWindow(winPtr); + + if (childPtr) { + TkMacOSXSetDrawingEnabled(childPtr, flag); + } + } +} + +/* + *---------------------------------------------------------------------- + * * TkMacOSXUpdateClipRgn -- * - * This function updates the cliping regions for a given window and all of + * This function updates the clipping regions for a given window and all of * its children. Once updated the TK_CLIP_INVALID flag in the subwindow * data structure is unset. The TK_CLIP_INVALID flag should always be * unset before any drawing is attempted. @@ -738,17 +797,6 @@ TkMacOSXUpdateClipRgn( /* * TODO: Here we should handle out of process embedding. */ - } else if (winPtr->wmInfoPtr->attributes & - kWindowResizableAttribute) { - NSWindow *w = TkMacOSXDrawableWindow(winPtr->window); - - if (w) { - bounds = NSRectToCGRect([w _growBoxRect]); - bounds.origin.y = [w contentRectForFrameRect: - [w frame]].size.height - bounds.size.height - - bounds.origin.y; - ChkErr(TkMacOSHIShapeDifferenceWithRect, rgn, &bounds); - } } macWin->aboveVisRgn = HIShapeCreateCopy(rgn); @@ -825,7 +873,7 @@ TkMacOSXUpdateClipRgn( * * TkMacOSXVisableClipRgn -- * - * This function returns the Macintosh cliping region for the given + * This function returns the Macintosh clipping region for the given * window. The caller is responsible for disposing of the returned * region via TkDestroyRegion(). * @@ -920,7 +968,7 @@ TkMacOSXInvalidateWindow( * TK_PARENT_WINDOW */ { #ifdef TK_MAC_DEBUG_CLIP_REGIONS - TkMacOSXDbgMsg("%s", winPtr->pathName); + TkMacOSXDbgMsg("%s", macWin->winPtr->pathName); #endif if (macWin->flags & TK_CLIP_INVALID) { TkMacOSXUpdateClipRgn(macWin->winPtr); @@ -1078,7 +1126,7 @@ TkMacOSXGetRootControl( * None. * * Side effects: - * The cliping regions for the window and its children are mark invalid. + * The clipping regions for the window and its children are marked invalid. * (Make sure they are valid before drawing.) * *---------------------------------------------------------------------- @@ -1097,6 +1145,10 @@ TkMacOSXInvalClipRgns( * be marked. */ +#ifdef TK_MAC_DEBUG_CLIP_REGIONS + TkMacOSXDbgMsg("%s", winPtr->pathName); +#endif + if (!macWin || macWin->flags & TK_CLIP_INVALID) { return; } @@ -1277,7 +1329,7 @@ UpdateOffsets( * Returns a handle to a new pixmap. * * Side effects: - * Allocates a new Macintosh GWorld. + * Allocates a new CGBitmapContext. * *---------------------------------------------------------------------- */ @@ -1323,7 +1375,7 @@ Tk_GetPixmap( * None. * * Side effects: - * Deletes the Macintosh GWorld created by Tk_GetPixmap. + * Deletes the CGBitmapContext created by Tk_GetPixmap. * *---------------------------------------------------------------------- */ diff --git a/macosx/tkMacOSXTest.c b/macosx/tkMacOSXTest.c index 7d2b24e..1882ce6 100644 --- a/macosx/tkMacOSXTest.c +++ b/macosx/tkMacOSXTest.c @@ -18,8 +18,8 @@ * Forward declarations of procedures defined later in this file: */ -static int DebuggerCmd (ClientData dummy, Tcl_Interp *interp, - int argc, const char **argv); +static int DebuggerObjCmd (ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); /* *---------------------------------------------------------------------- @@ -46,7 +46,7 @@ TkplatformtestInit( * Add commands for platform specific tests on MacOS here. */ - Tcl_CreateCommand(interp, "debugger", DebuggerCmd, + Tcl_CreateObjCommand(interp, "debugger", DebuggerObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); return TCL_OK; @@ -55,7 +55,7 @@ TkplatformtestInit( /* *---------------------------------------------------------------------- * - * DebuggerCmd -- + * DebuggerObjCmd -- * * This procedure simply calls the low level debugger. * @@ -69,11 +69,11 @@ TkplatformtestInit( */ static int -DebuggerCmd( +DebuggerObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Not used. */ - int argc, /* Not used. */ - const char **argv) /* Not used. */ + int objc, /* Not used. */ + Tcl_Obj *const objv[]) /* Not used. */ { Debugger(); return TCL_OK; diff --git a/macosx/tkMacOSXWindowEvent.c b/macosx/tkMacOSXWindowEvent.c index 9402cbb..461a94c 100644 --- a/macosx/tkMacOSXWindowEvent.c +++ b/macosx/tkMacOSXWindowEvent.c @@ -6,6 +6,8 @@ * * Copyright 2001-2009, Apple Inc. * Copyright (c) 2005-2009 Daniel A. Steffen <das@users.sourceforge.net> + * Copyright (c) 2015 Kevin Walzer/WordTech Communications LLC. + * Copyright (c) 2015 Marc Culler. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -27,7 +29,7 @@ * Declaration of functions used only in this file */ -static int GenerateUpdates(HIMutableShapeRef updateRgn, +static int GenerateUpdates(HIShapeRef updateRgn, CGRect *updateBounds, TkWindow *winPtr); static int GenerateActivateEvents(TkWindow *winPtr, int activeFlag); @@ -46,7 +48,7 @@ extern NSString *NSWindowDidOrderOffScreenNotification; #endif #endif -extern NSString *opaqueTag; +extern BOOL opaqueTag; @implementation TKApplication(TKWindowEvent) @@ -163,6 +165,10 @@ extern NSString *opaqueTag; if (winPtr) { TkGenWMDestroyEvent((Tk_Window) winPtr); + if (_windowWithMouse == w) { + _windowWithMouse = nil; + [w release]; + } } /* @@ -266,9 +272,8 @@ extern NSString *opaqueTag; const char *cmd = ([[notification name] isEqualToString: NSApplicationDidUnhideNotification] ? "::tk::mac::OnShow" : "::tk::mac::OnHide"); - Tcl_CmdInfo dummy; - if (_eventInterp && Tcl_GetCommandInfo(_eventInterp, cmd, &dummy)) { + if (_eventInterp && Tcl_FindCommand(_eventInterp, cmd, NULL, 0)) { int code = Tcl_EvalEx(_eventInterp, cmd, -1, TCL_EVAL_GLOBAL); if (code != TCL_OK) { @@ -314,7 +319,7 @@ extern NSString *opaqueTag; static int GenerateUpdates( - HIMutableShapeRef updateRgn, + HIShapeRef updateRgn, CGRect *updateBounds, TkWindow *winPtr) { @@ -357,11 +362,12 @@ GenerateUpdates( event.xexpose.width = damageBounds.size.width; event.xexpose.height = damageBounds.size.height; event.xexpose.count = 0; - Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL); -#ifdef TK_MAC_DEBUG_DRAWING - TKLog(@"Expose %p {{%d, %d}, {%d, %d}}", event.xany.window, event.xexpose.x, + Tk_HandleEvent(&event); + + #ifdef TK_MAC_DEBUG_DRAWING + NSLog(@"Expose %p {{%d, %d}, {%d, %d}}", event.xany.window, event.xexpose.x, event.xexpose.y, event.xexpose.width, event.xexpose.height); -#endif + #endif /* * Generate updates for the children of this window @@ -743,15 +749,16 @@ TkWmProtocolEventProc( int Tk_MacOSXIsAppInFront(void) { - OSStatus err; - ProcessSerialNumber frontPsn, ourPsn = {0, kCurrentProcess}; Boolean isFrontProcess = true; +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1060 + ProcessSerialNumber frontPsn, ourPsn = {0, kCurrentProcess}; - err = ChkErr(GetFrontProcess, &frontPsn); - if (err == noErr) { - ChkErr(SameProcess, &frontPsn, &ourPsn, &isFrontProcess); + if (noErr == GetFrontProcess(&frontPsn)){ + SameProcess(&frontPsn, &ourPsn, &isFrontProcess); } - +#else + isFrontProcess = [NSRunningApplication currentApplication].active; +#endif return (isFrontProcess == true); } @@ -760,27 +767,25 @@ Tk_MacOSXIsAppInFront(void) #import <ApplicationServices/ApplicationServices.h> /* - * Custom content view for Tk NSWindows, containing standard NSView subviews. - * The goal is to emulate X11-style drawing in response to Expose events: - * during the normal AppKit drawing cycle, we supress drawing of all subviews - * (using a technique adapted from WebKit's WebHTMLView) and instead send - * Expose events about the subviews that would be redrawn. Tk Expose event - * handling and drawing handlers then draw the subviews manually via their - * -displayRectIgnoringOpacity: + * Custom content view for use in Tk NSWindows. + * + * Since Tk handles all drawing of widgets, we only use the AppKit event loop + * as a source of input events. To do this, we overload the NSView drawRect + * method with a method which generates Expose events for Tk but does no + * drawing. The redrawing operations are then done when Tk processes these + * events. + * + * Earlier versions of Mac Tk used subclasses of NSView, e.g. NSButton, as the + * basis for Tk widgets. These would then appear as subviews of the + * TKContentView. To prevent the AppKit from redrawing and corrupting the Tk + * Widgets it was necessary to use Apple private API calls. In order to avoid + * using private API calls, the NSView-based widgets have been replaced with + * normal Tk widgets which draw themselves as native widgets by using the + * HITheme API. + * */ -@interface TKContentView(TKWindowEvent) -- (void) drawRect: (NSRect) rect; -- (void) generateExposeEvents: (HIMutableShapeRef) shape; -- (BOOL) isOpaque; -- (BOOL) wantsDefaultClipping; -- (BOOL) acceptsFirstResponder; -- (void) keyDown: (NSEvent *) theEvent; -@end - -@implementation TKContentView -@end - +/*Restrict event processing to Expose events.*/ static Tk_RestrictAction ExposeRestrictProc( ClientData arg, @@ -790,6 +795,15 @@ ExposeRestrictProc( ? TK_PROCESS_EVENT : TK_DEFER_EVENT); } +/*Restrict event processing to ConfigureNotify events.*/ +static Tk_RestrictAction +ConfigureRestrictProc( + ClientData arg, + XEvent *eventPtr) +{ + return (eventPtr->type==ConfigureNotify ? TK_PROCESS_EVENT : TK_DEFER_EVENT); +} + @implementation TKContentView(TKWindowEvent) - (void) drawRect: (NSRect) rect @@ -798,6 +812,7 @@ ExposeRestrictProc( 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]; @@ -805,73 +820,135 @@ ExposeRestrictProc( NSCompositeSourceOver); #endif - NSWindow *w = [self window]; - - if ([self isOpaque] && [w showsResizeIndicator]) { - NSRect bounds = [self convertRect:[w _growBoxRect] fromView:nil]; - - if ([self needsToDrawRect:bounds]) { - NSEraseRect(bounds); - } - } - CGFloat height = [self bounds].size.height; HIMutableShapeRef drawShape = HIShapeCreateMutable(); while (rectsBeingDrawnCount--) { CGRect r = NSRectToCGRect(*rectsBeingDrawn++); - r.origin.y = height - (r.origin.y + r.size.height); HIShapeUnionWithRect(drawShape, &r); } if (CFRunLoopGetMain() == CFRunLoopGetCurrent()) { - [self generateExposeEvents:drawShape]; + [self generateExposeEvents:(HIShapeRef)drawShape]; } else { [self performSelectorOnMainThread:@selector(generateExposeEvents:) withObject:(id)drawShape waitUntilDone:NO modes:[NSArray arrayWithObjects:NSRunLoopCommonModes, + NSEventTrackingRunLoopMode, NSModalPanelRunLoopMode, nil]]; } + CFRelease(drawShape); } -- (void) generateExposeEvents: (HIMutableShapeRef) shape +-(void) setFrameSize: (NSSize)newsize +{ + [super setFrameSize: newsize]; + if ([self inLiveResize]) { + NSWindow *w = [self window]; + TkWindow *winPtr = TkMacOSXGetTkWindow(w); + Tk_Window tkwin = (Tk_Window) winPtr; + 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. + * Since it calls Tcl_DoOneEvent, we need to make sure we + * don't clobber the AutoreleasePool set up by the caller. + */ + [NSApp setPoolProtected:YES]; + + /* + * Try to prevent flickers and flashes. + */ + [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.*/ + 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. */ + TkMacOSXSetDrawingEnabled(winPtr, 1); + TkMacOSXInvalClipRgns(tkwin); + TkMacOSXUpdateClipRgn(winPtr); + + /* Finally, 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(); + [NSApp setPoolProtected:NO]; + } +} + +/* + * 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. + */ + +- (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 +{ + [self generateExposeEvents:shape childrenOnly:0]; +} + +- (void) generateExposeEvents: (HIShapeRef) shape + childrenOnly: (int) childrenOnly { TkWindow *winPtr = TkMacOSXGetTkWindow([self window]); unsigned long serial; CGRect updateBounds; + int updatesNeeded; if (!winPtr) { - return; + return; } + + /* Generate Tk Expose events. */ HIShapeGetBounds(shape, &updateBounds); + /* All of these events will share the same serial number. */ serial = LastKnownRequestProcessed(Tk_Display(winPtr)); - if (GenerateUpdates(shape, &updateBounds, winPtr) && - ![[NSRunLoop currentRunLoop] currentMode] && - Tcl_GetServiceMode() != TCL_SERVICE_NONE) { - /* - * Ensure there are no pending idle-time redraws that could prevent the - * just posted Expose events from generating new redraws. - */ - - while (Tcl_DoOneEvent(TCL_IDLE_EVENTS|TCL_DONT_WAIT)) {} - - /* - * For smoother drawing, process Expose events and resulting redraws - * immediately instead of at idle time. - */ + 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)) {} - Tk_RestrictEvents(oldProc, oldArg, &oldArg); - while (Tcl_DoOneEvent(TCL_IDLE_EVENTS|TCL_DONT_WAIT)) {} + Tk_RestrictProc *oldProc = Tk_RestrictEvents(ExposeRestrictProc, + UINT2PTR(serial), &oldArg); + while (Tcl_ServiceEvent(TCL_WINDOW_EVENTS)) {} + Tk_RestrictEvents(oldProc, oldArg, &oldArg); } } +/* + * 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 @@ -881,7 +958,6 @@ ExposeRestrictProc( int x, y; TkWindow *winPtr = TkMacOSXGetTkWindow([self window]); Tk_Window tkwin = (Tk_Window) winPtr; - bzero(&event, sizeof(XVirtualEvent)); event.type = VirtualEvent; event.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); @@ -899,27 +975,11 @@ ExposeRestrictProc( Tk_QueueWindowEvent((XEvent *) &event, TCL_QUEUE_TAIL); } -#ifdef TK_MAC_DEBUG_DRAWING -- (void) setFrameSize: (NSSize) newSize -{ - TKLog(@"-[%@(%p) %s%@]", [self class], self, _cmd, - NSStringFromSize(newSize)); - [super setFrameSize:newSize]; -} - -- (void) setNeedsDisplayInRect: (NSRect) invalidRect -{ - TKLog(@"-[%@(%p) %s%@]", [self class], self, _cmd, - NSStringFromRect(invalidRect)); - [super setNeedsDisplayInRect:invalidRect]; -} -#endif - - (BOOL) isOpaque { NSWindow *w = [self window]; - if (opaqueTag != NULL) { + if (opaqueTag) { return YES; } else { @@ -947,153 +1007,6 @@ ExposeRestrictProc( @end -#pragma mark TKContentViewPrivate - -/* - * Technique adapted from WebKit/WebKit/mac/WebView/WebHTMLView.mm to supress - * normal AppKit subview drawing and make all drawing go through us. - * Overrides NSView internals. - */ - -@interface TKContentView(TKContentViewPrivate) -- (id) initWithFrame: (NSRect) frame; -- (void) _setAsideSubviews; -- (void) _restoreSubviews; -@end - -@interface NSView(TKContentViewPrivate) -- (void) _recursiveDisplayRectIfNeededIgnoringOpacity: (NSRect) rect - isVisibleRect: (BOOL) isVisibleRect - rectIsVisibleRectForView: (NSView *) visibleView - topView: (BOOL) topView; -- (void) _recursiveDisplayAllDirtyWithLockFocus: (BOOL) needsLockFocus - visRect: (NSRect) visRect; -- (void) _recursive: (BOOL) recurse - displayRectIgnoringOpacity: (NSRect) displayRect - inContext: (NSGraphicsContext *) context topView: (BOOL) topView; -- (void) _lightWeightRecursiveDisplayInRect: (NSRect) visRect; -- (BOOL) _drawRectIfEmpty; -- (void) _drawRect: (NSRect) inRect clip: (BOOL) clip; -- (void) _setDrawsOwnDescendants: (BOOL) drawsOwnDescendants; -@end - -@implementation TKContentView(TKContentViewPrivate) - -- (id) initWithFrame: (NSRect) frame -{ - self = [super initWithFrame:frame]; - if (self) { - _savedSubviews = nil; - _subviewsSetAside = NO; - [self _setDrawsOwnDescendants:YES]; - } - return self; -} - -- (void) _setAsideSubviews -{ -#ifdef TK_MAC_DEBUG - if (_subviewsSetAside || _savedSubviews) { - Tcl_Panic("TKContentView _setAsideSubviews called incorrectly"); - } -#endif - _savedSubviews = _subviews; - _subviews = nil; - _subviewsSetAside = YES; -} - -- (void) _restoreSubviews -{ -#ifdef TK_MAC_DEBUG - if (!_subviewsSetAside || _subviews) { - Tcl_Panic("TKContentView _restoreSubviews called incorrectly"); - } -#endif - _subviews = _savedSubviews; - _savedSubviews = nil; - _subviewsSetAside = NO; -} - -- (void) _recursiveDisplayRectIfNeededIgnoringOpacity: (NSRect) rect - isVisibleRect: (BOOL) isVisibleRect - rectIsVisibleRectForView: (NSView *) visibleView - topView: (BOOL) topView -{ - [self _setAsideSubviews]; - [super _recursiveDisplayRectIfNeededIgnoringOpacity:rect - isVisibleRect:isVisibleRect rectIsVisibleRectForView:visibleView - topView:topView]; - [self _restoreSubviews]; -} - -- (void) _recursiveDisplayAllDirtyWithLockFocus: (BOOL) needsLockFocus - visRect: (NSRect) visRect -{ - BOOL needToSetAsideSubviews = !_subviewsSetAside; - - if (needToSetAsideSubviews) { - [self _setAsideSubviews]; - } - [super _recursiveDisplayAllDirtyWithLockFocus:needsLockFocus - visRect:visRect]; - if (needToSetAsideSubviews) { - [self _restoreSubviews]; - } -} - -- (void) _recursive: (BOOL) recurse - displayRectIgnoringOpacity: (NSRect) displayRect - inContext: (NSGraphicsContext *) context topView: (BOOL) topView -{ - [self _setAsideSubviews]; - [super _recursive:recurse - displayRectIgnoringOpacity:displayRect inContext:context - topView:topView]; - [self _restoreSubviews]; -} - -- (void) _lightWeightRecursiveDisplayInRect: (NSRect) visRect -{ - BOOL needToSetAsideSubviews = !_subviewsSetAside; - - if (needToSetAsideSubviews) { - [self _setAsideSubviews]; - } - [super _lightWeightRecursiveDisplayInRect:visRect]; - if (needToSetAsideSubviews) { - [self _restoreSubviews]; - } -} - -- (BOOL) _drawRectIfEmpty -{ - /* - * Our -drawRect manages subview drawing directly, so it needs to be called - * even if the area to be redrawn is completely obscured by subviews. - */ - - return YES; -} - -- (void) _drawRect: (NSRect) inRect clip: (BOOL) clip -{ -#ifdef TK_MAC_DEBUG_DRAWING - TKLog(@"-[%@(%p) %s%@]", [self class], self, _cmd, - NSStringFromRect(inRect)); -#endif - BOOL subviewsWereSetAside = _subviewsSetAside; - - if (subviewsWereSetAside) { - [self _restoreSubviews]; - } - [super _drawRect:inRect clip:clip]; - if (subviewsWereSetAside) { - [self _setAsideSubviews]; - } -} - -@end - /* * Local Variables: * mode: objc diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index 370c86a..3ea2f51 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -21,6 +21,8 @@ #include "tkMacOSXEvent.h" #include "tkMacOSXDebug.h" +#define DEBUG_ZOMBIES 0 + /* #ifdef TK_MAC_DEBUG #define TK_MAC_DEBUG_WINDOWS @@ -53,7 +55,7 @@ /*Objects for use in setting background color and opacity of window.*/ NSColor *colorName = NULL; -NSString *opaqueTag = NULL; +BOOL opaqueTag = FALSE; static const struct { const UInt64 validAttrs, defaultAttrs, forceOnAttrs, forceOffAttrs; @@ -194,6 +196,48 @@ static int tkMacOSXWmAttrNotifyVal = 0; static Tcl_HashTable windowTable; static int windowHashInit = false; + + +#pragma mark NSWindow(TKWm) + +/* + * Conversion of coordinates between window and screen. + */ + +@implementation NSWindow(TKWm) +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 +- (NSPoint) convertPointToScreen: (NSPoint) point +{ + return [self convertBaseToScreen:point]; +} +- (NSPoint) convertPointFromScreen: (NSPoint)point +{ + return [self convertScreenToBase:point]; +} +@end +#else +- (NSPoint) convertPointToScreen: (NSPoint) point +{ + NSRect pointrect; + pointrect.origin = point; + pointrect.size.width = 0; + pointrect.size.height = 0; + return [self convertRectToScreen:pointrect].origin; +} +- (NSPoint) convertPointFromScreen: (NSPoint)point +{ + NSRect pointrect; + pointrect.origin = point; + pointrect.size.width = 0; + pointrect.size.height = 0; + return [self convertRectFromScreen:pointrect].origin; +} +@end +#endif + +#pragma mark - + + /* * Forward declarations for procedures defined in this file: */ @@ -342,6 +386,7 @@ static void RemapWindows(TkWindow *winPtr, @end @implementation TKWindow(TKWm) + - (BOOL) canBecomeKeyWindow { TkWindow *winPtr = TkMacOSXGetTkWindow(self); @@ -350,6 +395,59 @@ static void RemapWindows(TkWindow *winPtr, kHelpWindowClass || winPtr->wmInfoPtr->attributes & kWindowNoActivatesAttribute)) ? NO : YES; } + +#if DEBUG_ZOMBIES +- (id) retain +{ + id result = [super retain]; + const char *title = [[self title] UTF8String]; + if (title == nil) { + title = "unnamed window"; + } + if (DEBUG_ZOMBIES > 1){ + printf("Retained <%s>. Count is: %lu\n", title, [self retainCount]); + } + return result; +} + +- (id) autorelease +{ + static int xcount = 0; + id result = [super autorelease]; + const char *title = [[self title] UTF8String]; + if (title == nil) { + title = "unnamed window"; + } + if (DEBUG_ZOMBIES > 1){ + printf("Autoreleased <%s>. Count is %lu\n", title, [self retainCount]); + } + return result; +} + +- (oneway void) release { + const char *title = [[self title] UTF8String]; + if (title == nil) { + title = "unnamed window"; + } + if (DEBUG_ZOMBIES > 1){ + printf("Releasing <%s>. Count is %lu\n", title, [self retainCount]); + } + [super release]; +} + +- (void) dealloc { + const char *title = [[self title] UTF8String]; + if (title == nil) { + title = "unnamed window"; + } + if (DEBUG_ZOMBIES > 0){ + printf(">>>> Freeing <%s>. Count is %lu\n", title, [self retainCount]); + } + [super dealloc]; +} + + +#endif @end #pragma mark - @@ -463,25 +561,16 @@ FrontWindowAtPoint( int x, int y) { NSPoint p = NSMakePoint(x, tkMacOSXZeroScreenHeight - y); - NSWindow *win = nil; - NSInteger windowCount; - NSInteger *windowNumbers; - - NSCountWindows(&windowCount); - if (windowCount) { - windowNumbers = ckalloc(windowCount * sizeof(NSInteger)); - NSWindowList(windowCount, windowNumbers); - for (NSInteger index = 0; index < windowCount; index++) { - NSWindow *w = [NSApp windowWithWindowNumber:windowNumbers[index]]; + NSArray *windows = [NSApp orderedWindows]; + TkWindow *front = NULL; + for (NSWindow *w in windows) { if (w && NSMouseInRect(p, [w frame], NO)) { - win = w; + front = TkMacOSXGetTkWindow(w); break; } } - ckfree(windowNumbers); - } - return (win ? TkMacOSXGetTkWindow(win) : NULL); + return front; } /* @@ -677,6 +766,7 @@ TkWmMapWindow( */ XMapWindow(winPtr->display, winPtr->window); + } /* @@ -699,7 +789,7 @@ TkWmMapWindow( void TkWmUnmapWindow( TkWindow *winPtr) /* Top-level window that's about to be - * mapped. */ + * unmapped. */ { XUnmapWindow(winPtr->display, winPtr->window); } @@ -783,15 +873,42 @@ TkWmDeadWindow( NSWindow *window = wmPtr->window; if (window && !Tk_IsEmbedded(winPtr) ) { - [[window parentWindow] removeChildWindow:window]; + NSWindow *parent = [window parentWindow]; + if (parent) { + [parent removeChildWindow:window]; + } [window close]; TkMacOSXUnregisterMacWindow(window); - if (winPtr->window) { - ((MacDrawable *) winPtr->window)->view = nil; + if (winPtr->window) { + ((MacDrawable *) winPtr->window)->view = nil; + } +#if DEBUG_ZOMBIES > 0 + { + const char *title = [[window title] UTF8String]; + if (title == nil) { + title = "unnamed window"; + } + printf(">>>> Closing <%s>. Count is: %lu\n", title, [window retainCount]); } - TkMacOSXMakeCollectableAndRelease(wmPtr->window); - } +#endif + [window release]; + wmPtr->window = NULL; + + /* Activate the highest window left on the screen. */ + NSArray *windows = [NSApp orderedWindows]; + if ( [windows count] > 0 ) { + NSWindow *front = [windows objectAtIndex:0]; + if ( front && [front canBecomeKeyWindow] ) { + [front makeKeyAndOrderFront:NSApp]; + } + } + [NSApp _resetAutoreleasePool]; +#if DEBUG_ZOMBIES > 0 + fprintf(stderr, "================= Pool dump ===================\n"); + [NSAutoreleasePool showPools]; +#endif + } ckfree(wmPtr); winPtr->wmInfoPtr = NULL; } @@ -1655,8 +1772,8 @@ WmForgetCmd( if (Tk_IsTopLevel(frameWin)) { MacDrawable *macWin; - Tk_MakeWindowExist(winPtr); - Tk_MakeWindowExist(winPtr->parentPtr); + Tk_MakeWindowExist(frameWin); + Tk_MakeWindowExist((Tk_Window)winPtr->parentPtr); macWin = (MacDrawable *) winPtr->window; @@ -5116,7 +5233,7 @@ TkUnsupported1ObjCmd( colorName = [NSColor clearColor]; //use systemTransparent in Tk scripts to match } if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*opacity*")) { - opaqueTag = @"YES"; + opaqueTag = YES; } } @@ -5444,7 +5561,6 @@ TkMacOSXMakeRealWindowExist( * TODO: Here we should handle out of process embedding. */ } - WindowClass macClass = wmPtr->macClass; wmPtr->attributes &= (tkAlwaysValidAttributes | macClassAttrs[macClass].validAttrs); @@ -5478,11 +5594,10 @@ TkMacOSXMakeRealWindowExist( NSWindow *window = [[winClass alloc] initWithContentRect:contentRect styleMask:styleMask backing:NSBackingStoreBuffered defer:YES]; if (!window) { - Tcl_Panic("couldn't allocate new Mac window"); + Tcl_Panic("couldn't allocate new Mac window"); } - TkMacOSXMakeUncollectable(window); TKContentView *contentView = [[TKContentView alloc] - initWithFrame:NSZeroRect]; + initWithFrame:NSZeroRect]; [window setContentView:contentView]; [contentView release]; [window setDelegate:NSApp]; @@ -5507,7 +5622,7 @@ TkMacOSXMakeRealWindowExist( [window setBackgroundColor: colorName]; } - if (opaqueTag != NULL) { + if (opaqueTag) { #ifdef TK_GOT_AT_LEAST_SNOW_LEOPARD [window setOpaque: opaqueTag]; #else @@ -5517,7 +5632,7 @@ TkMacOSXMakeRealWindowExist( [window setDocumentEdited:NO]; wmPtr->window = window; - macWin->view = contentView; + macWin->view = window.contentView; TkMacOSXApplyWindowAttributes(winPtr, window); NSRect geometry = InitialWindowBounds(winPtr, window); @@ -5526,7 +5641,6 @@ TkMacOSXMakeRealWindowExist( geometry.origin.y = tkMacOSXZeroScreenHeight - (geometry.origin.y + geometry.size.height); [window setFrame:geometry display:NO]; - TkMacOSXRegisterOffScreenWindow((Window) macWin, window); macWin->flags |= TK_HOST_EXISTS; } @@ -5915,15 +6029,21 @@ TkpChangeFocus( * didn't originally belong to topLevelPtr's * application. */ { - /* - * We don't really need to do anything on the Mac. Tk will keep all this - * state for us. - */ - if (winPtr->atts.override_redirect) { return 0; } + if (Tk_IsTopLevel(winPtr) && !Tk_IsEmbedded(winPtr) ){ + NSWindow *win = TkMacOSXDrawableWindow(winPtr->window); + TkWmRestackToplevel(winPtr, Above, NULL); + if (force ) { + [NSApp activateIgnoringOtherApps:YES]; + } + if ( win && [win canBecomeKeyWindow] ) { + [win makeKeyAndOrderFront:NSApp]; + } + } + /* * Remember the current serial number for the X server and issue a dummy * server request. This marks the position at which we changed the focus, @@ -5940,7 +6060,7 @@ TkpChangeFocus( * WmStackorderToplevelWrapperMap -- * * This procedure will create a table that maps the reparent wrapper X id - * for a toplevel to the TkWindow structure that is wraps. Tk keeps track + * for a toplevel to the TkWindow structure that it wraps. Tk keeps track * of a mapping from the window X id to the TkWindow structure but that * does us no good here since we only get the X id of the wrapper window. * Only those toplevel windows that are mapped have a position in the @@ -6003,8 +6123,6 @@ TkWmStackorderToplevel( Tcl_HashTable table; Tcl_HashEntry *hPtr; Tcl_HashSearch search; - NSInteger windowCount; - NSInteger *windowNumbers; /* * Map mac windows to a TkWindow of the wrapped toplevel. @@ -6031,31 +6149,26 @@ TkWmStackorderToplevel( goto done; } - NSCountWindows(&windowCount); + NSArray *macWindows = [NSApp orderedWindows]; + NSInteger windowCount = [macWindows count]; + if (!windowCount) { ckfree(windows); windows = NULL; } else { windowPtr = windows + table.numEntries; *windowPtr-- = NULL; - windowNumbers = ckalloc(windowCount * sizeof(NSInteger)); - NSWindowList(windowCount, windowNumbers); - for (NSInteger index = 0; index < windowCount; index++) { - NSWindow *w = [NSApp windowWithWindowNumber:windowNumbers[index]]; - - if (w) { - hPtr = Tcl_FindHashEntry(&table, (char*) w); - if (hPtr != NULL) { - childWinPtr = Tcl_GetHashValue(hPtr); - *windowPtr-- = childWinPtr; - } + for (NSWindow *w in macWindows) { + hPtr = Tcl_FindHashEntry(&table, (char*) w); + if (hPtr != NULL) { + childWinPtr = Tcl_GetHashValue(hPtr); + *windowPtr-- = childWinPtr; } } if (windowPtr != windows-1) { Tcl_Panic("num matched toplevel windows does not equal num " - "children"); + "children"); } - ckfree(windowNumbers); } done: @@ -6614,7 +6727,6 @@ RemapWindows( MacDrawable *parentWin) { TkWindow *childPtr; - /* * Remove the OS specific window. It will get rebuilt when the window gets * Mapped. diff --git a/macosx/tkMacOSXXStubs.c b/macosx/tkMacOSXXStubs.c index 848b49c..5d6ffb9 100644 --- a/macosx/tkMacOSXXStubs.c +++ b/macosx/tkMacOSXXStubs.c @@ -9,6 +9,7 @@ * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright 2001-2009, Apple Inc. * Copyright (c) 2005-2009 Daniel A. Steffen <das@users.sourceforge.net> + * Copyright 2014 Marc Culler. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -141,7 +142,7 @@ TkpOpenDisplay( static NSRect maxBounds = {{0, 0}, {0, 0}}; static char vendor[25] = ""; NSArray *cgVers; - NSAutoreleasePool *pool; + NSAutoreleasePool *pool = [NSAutoreleasePool new]; if (gMacDisplay != NULL) { if (strcmp(gMacDisplay->display->display_name, display_name) == 0) { @@ -165,7 +166,6 @@ TkpOpenDisplay( display->default_screen = 0; display->display_name = (char *) macScreenName; - pool = [NSAutoreleasePool new]; cgVers = [[[NSBundle bundleWithIdentifier:@"com.apple.CoreGraphics"] objectForInfoDictionaryKey:@"CFBundleShortVersionString"] componentsSeparatedByString:@"."]; @@ -176,12 +176,25 @@ TkpOpenDisplay( display->proto_minor_version = [[cgVers objectAtIndex:2] integerValue]; } if (!vendor[0]) { - snprintf(vendor, sizeof(vendor), "Apple AppKit %s %g", - ([NSGarbageCollector defaultCollector] ? "GC" : "RR"), + snprintf(vendor, sizeof(vendor), "Apple AppKit %g", NSAppKitVersionNumber); } display->vendor = vendor; - Gestalt(gestaltSystemVersion, (SInt32 *) &display->release); + { + int major, minor, patch; + +#if MAC_OS_X_VERSION_MIN_REQUIRED < 10100 + Gestalt(gestaltSystemVersionMajor, (SInt32*)&major); + Gestalt(gestaltSystemVersionMinor, (SInt32*)&minor); + Gestalt(gestaltSystemVersionBugFix, (SInt32*)&patch); +#else + NSOperatingSystemVersion systemVersion = [[NSProcessInfo processInfo] operatingSystemVersion]; + major = systemVersion.majorVersion; + minor = systemVersion.minorVersion; + patch = systemVersion.patchVersion; +#endif + display->release = major << 16 | minor << 8 | patch; + } /* * These screen bits never change @@ -782,7 +795,6 @@ XCreateImage( int bytes_per_line) { XImage *ximage; - display->request++; ximage = ckalloc(sizeof(XImage)); @@ -792,6 +804,7 @@ XCreateImage( ximage->xoffset = offset; ximage->format = format; ximage->data = data; + ximage->obdata = NULL; if (format == ZPixmap) { ximage->bits_per_pixel = 32; @@ -823,7 +836,6 @@ XCreateImage( ximage->red_mask = 0x00FF0000; ximage->green_mask = 0x0000FF00; ximage->blue_mask = 0x000000FF; - ximage->obdata = NULL; ximage->f.create_image = NULL; ximage->f.destroy_image = DestroyImage; ximage->f.get_pixel = ImageGetPixel; @@ -842,8 +854,9 @@ XCreateImage( * This function copies data from a pixmap or window into an XImage. * * Results: - * Returns a newly allocated image containing the data from the given - * rectangle of the given drawable. + * 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. * * Side effects: * None. @@ -862,60 +875,84 @@ XGetImage( unsigned long plane_mask, int format) { - MacDrawable *macDraw = (MacDrawable *) d; - XImage * imagePtr = NULL; - Pixmap pixmap = (Pixmap) NULL; - Tk_Window win = (Tk_Window) macDraw->winPtr; - GC gc; - char * data = NULL; - int depth = 32; - int offset = 0; - int bitmap_pad = 0; - int bytes_per_line = 0; - + NSBitmapImageRep *bitmap_rep; + NSUInteger bitmap_fmt; + XImage * imagePtr = NULL; + char * bitmap = NULL; + char * image_data=NULL; + int depth = 32; + int offset = 0; + int bitmap_pad = 0; + int bytes_per_row = 4*width; + int size; + TkMacOSXDbgMsg("XGetImage"); if (format == ZPixmap) { - if (width > 0 && height > 0) { - /* - * Tk_GetPixmap fails for zero width or height. - */ - - pixmap = Tk_GetPixmap(display, d, width, height, depth); + if (width == 0 || height == 0) { + /* This happens all the time. + TkMacOSXDbgMsg("XGetImage: empty image requested"); + */ + return NULL; } - if (win) { - XGCValues values; - gc = Tk_GetGC(win, 0, &values); - } else { - gc = XCreateGC(display, pixmap, 0, NULL); + bitmap_rep = BitmapRepFromDrawableRect(d, x, y,width, height); + bitmap_fmt = [bitmap_rep bitmapFormat]; + + if ( bitmap_rep == Nil || + (bitmap_fmt != 0 && bitmap_fmt != 1) || + [bitmap_rep samplesPerPixel] != 4 || + [bitmap_rep isPlanar] != 0 ) { + TkMacOSXDbgMsg("XGetImage: Failed to construct NSBitmapRep"); + return NULL; } - if (pixmap) { - CGContextRef context; - - XCopyArea(display, d, pixmap, gc, x, y, width, height, 0, 0); - context = ((MacDrawable *) pixmap)->context; - if (context) { - data = CGBitmapContextGetData(context); - bytes_per_line = CGBitmapContextGetBytesPerRow(context); + + NSSize image_size = NSMakeSize(width, height); + NSImage* ns_image = [[NSImage alloc]initWithSize:image_size]; + [ns_image addRepresentation:bitmap_rep]; + + /* Assume premultiplied nonplanar data with 4 bytes per pixel.*/ + if ( [bitmap_rep isPlanar ] == 0 && + [bitmap_rep samplesPerPixel] == 4 ) { + bytes_per_row = [bitmap_rep bytesPerRow]; + size = bytes_per_row*height; + image_data = (char*)[bitmap_rep bitmapData]; + if ( image_data ) { + int row, n, m; + bitmap = ckalloc(size); + /* + Oddly enough, the bitmap has the top row at the beginning, + and the pixels are in BGRA or ABGR format. + */ + if (bitmap_fmt == 0) { + /* BGRA */ + for (row=0, n=0; row<height; row++, n+=bytes_per_row) { + for (m=n; m<n+bytes_per_row; m+=4) { + *(bitmap+m) = *(image_data+m+2); + *(bitmap+m+1) = *(image_data+m+1); + *(bitmap+m+2) = *(image_data+m); + *(bitmap+m+3) = *(image_data+m+3); + } + } + } else { + /* ABGR */ + for (row=0, n=0; row<height; row++, n+=bytes_per_row) { + for (m=n; m<n+bytes_per_row; m+=4) { + *(bitmap+m) = *(image_data+m+3); + *(bitmap+m+1) = *(image_data+m+2); + *(bitmap+m+2) = *(image_data+m+1); + *(bitmap+m+3) = *(image_data+m); + } + } + } } } - if (data) { + if (bitmap) { imagePtr = XCreateImage(display, NULL, depth, format, offset, - data, width, height, bitmap_pad, bytes_per_line); - - /* - * Track Pixmap underlying the XImage in the unused obdata field - * so that we can treat XImages coming from XGetImage specially. - */ - - imagePtr->obdata = (XPointer) pixmap; - } else if (pixmap) { - Tk_FreePixmap(display, pixmap); - } - if (!win) { - XFreeGC(display, gc); + (char*)bitmap, width, height, bitmap_pad, bytes_per_row); + [ns_image removeRepresentation:bitmap_rep]; /*releases the rep*/ + [ns_image release]; } } else { - TkMacOSXDbgMsg("Invalid image format"); + TkMacOSXDbgMsg("Could not extract image from drawable."); } return imagePtr; } @@ -941,9 +978,7 @@ DestroyImage( XImage *image) { if (image) { - if (image->obdata) { - Tk_FreePixmap((Display*) gMacDisplay, (Pixmap) image->obdata); - } else if (image->data) { + if (image->data) { ckfree(image->data); } ckfree(image); diff --git a/macosx/ttkMacOSXTheme.c b/macosx/ttkMacOSXTheme.c index 5752fb1..4753a40 100644 --- a/macosx/ttkMacOSXTheme.c +++ b/macosx/ttkMacOSXTheme.c @@ -294,14 +294,13 @@ static Ttk_StateTable TabPositionTable[] = { * TP30000359-TPXREF116> */ -static const int TAB_HEIGHT = 10; -static const int TAB_OVERLAP = 10; - static void TabElementSize( void *clientData, void *elementRecord, Tk_Window tkwin, int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr) { - *heightPtr = TAB_HEIGHT + TAB_OVERLAP - 1; + *heightPtr = GetThemeMetric(kThemeMetricLargeTabHeight, heightPtr); + *paddingPtr = Ttk_MakePadding(0, 0, 0, 2); + } static void TabElementDraw( @@ -319,7 +318,6 @@ static void TabElementDraw( .position = Ttk_StateTableLookup(TabPositionTable, state), }; - bounds.size.height += TAB_OVERLAP; BEGIN_DRAWING(d) ChkErr(HIThemeDrawTab, &bounds, &info, dc.context, HIOrientation, NULL); END_DRAWING @@ -357,8 +355,8 @@ static void PaneElementDraw( .adornment = kHIThemeTabPaneAdornmentNormal, }; - bounds.origin.y -= TAB_OVERLAP; - bounds.size.height += TAB_OVERLAP; + bounds.origin.y -= kThemeMetricTabFrameOverlap; + bounds.size.height += kThemeMetricTabFrameOverlap; BEGIN_DRAWING(d) ChkErr(HIThemeDrawTabPane, &bounds, &info, dc.context, HIOrientation); END_DRAWING @@ -520,6 +518,10 @@ static Ttk_ElementSpec ComboboxElementSpec = { ComboboxElementDraw }; + + + + /*---------------------------------------------------------------------- * +++ Spinbuttons. * @@ -592,6 +594,7 @@ static TrackElementData ScaleData = { kThemeSlider, kThemeMetricHSliderHeight }; + typedef struct { Tcl_Obj *fromObj; /* minimum value */ Tcl_Obj *toObj; /* maximum value */ @@ -653,6 +656,7 @@ static void TrackElementDraw( info.trackInfo.slider.thumbDir = kThemeThumbPlain; } + BEGIN_DRAWING(d) ChkErr(HIThemeDrawTrack, &info, NULL, dc.context, HIOrientation); END_DRAWING diff --git a/tests/bevel.tcl b/tests/bevel.tcl index 950b714..531def0 100644 --- a/tests/bevel.tcl +++ b/tests/bevel.tcl @@ -42,6 +42,7 @@ significance: r - should appear raised u - should appear raised and also slightly offset vertically s - should appear sunken +S - should appear solid n - preceding relief should extend right to end of line. * - should appear "normal" x - extra long lines to allow horizontal scrolling. @@ -125,15 +126,35 @@ foreach i {1 2 3} { .t.t insert end ***** .t.t insert end rrr r1 +font configure TkFixedFont -size 20 +.t.t tag configure sol100 -relief solid -borderwidth 100 \ + -foreground red -font TkFixedFont +.t.t tag configure sol12 -relief solid -borderwidth 12 \ + -foreground red -font TkFixedFont +.t.t tag configure big -font TkFixedFont +set ind [.t.t index end] + +.t.t insert end "\n\nBorders do not leak on the neighbour chars" +.t.t insert end "\nOnly \"S\" is on dark background" +.t.t insert end { + xxx + x} {} S sol100 {x + xxx} + +.t.t insert end "\n\nA very thick border grows toward the inside of the tagged area only" +.t.t insert end "\nOnly \"S\" is on dark background" +.t.t insert end { + xxxx} {} SSSSS sol100 {xxxx + x} {} SSSSSSSSSSSSSSSSSS sol100 {x + xxx} {} SSSSSSSSS sol100 xxxx {} +} +.t.t insert end "\n\nA thinner border is continuous" +.t.t insert end { + xxxx} {} SSSSS sol12 {xxxx + x} {} SSSSSSSSSSSSSSSSSS sol12 {x + xxx} {} SSSSSSSSS sol12 xxxx {} +} - - - - - - - - - +.t.t tag add big $ind end diff --git a/tests/bind.test b/tests/bind.test index c777d66..474771d 100644 --- a/tests/bind.test +++ b/tests/bind.test @@ -25,7 +25,6 @@ foreach event [bind all] { bind all $event {} } - proc unsetBindings {} { bind all <Enter> {} bind Test <Enter> {} @@ -2172,6 +2171,48 @@ test bind-16.44 {ExpandPercents procedure} -setup { destroy .t.f } -result {?? ??} +test bind-16.45 {ExpandPercents procedure} -setup { + set savedBind(Entry) [bind Entry <Key>] + set savedBind(All) [bind all <Key>] + entry .t.e + pack .t.e + focus -force .t.e + foreach p [event info] {event delete $p} + update +} -body { + bind .t.e <Key> {set x "%M"} + bind Entry <Key> {set y "%M"} + bind all <Key> {set z "%M"} + set x none; set y none; set z none + event gen .t.e <Key-a> + list $x $y $z +} -cleanup { + destroy .t.e + bind all <Key> $savedBind(All) + bind Entry <Key> $savedBind(Entry) + unset savedBind +} -result {0 1 2} +test bind-16.46 {ExpandPercents procedure} -setup { + set savedBind(All) [bind all <Key>] + set savedBind(Entry) [bind Entry <Key>] + entry .t.e + pack .t.e + focus -force .t.e + foreach p [event info] {event delete $p} + update +} -body { + bind all <Key> {set z "%M"} + bind Entry <Key> {set y "%M"} + bind .t.e <Key> {set x "%M"} + set x none; set y none; set z none + event gen .t.e <Key-a> + list $x $y $z +} -cleanup { + destroy .t.e + bind Entry <Key> $savedBind(Entry) + bind all <Key> $savedBind(All) + unset savedBind +} -result {0 1 2} test bind-17.1 {event command} -body { event diff --git a/tests/bugs.tcl b/tests/bugs.tcl index 83d9519..55e5f84 100644 --- a/tests/bugs.tcl +++ b/tests/bugs.tcl @@ -1,6 +1,6 @@ # This file is a Tcl script to test out various known bugs that will # cause Tk to crash. This file ends with .tcl instead of .test to make -# sure it isn't run when you type "source all". We currently are not +# sure it isn't run when you type "source all". We currently are not # shipping this file with the rest of the source release. # # Copyright (c) 1996 Sun Microsystems, Inc. diff --git a/tests/butGeom2.tcl b/tests/butGeom2.tcl index 96ff209..096225c 100644 --- a/tests/butGeom2.tcl +++ b/tests/butGeom2.tcl @@ -35,7 +35,7 @@ pack .t.anchorLabel .t.control.left.f -in .t.control.left -side top -anchor w foreach opt {activebackground activeforeground background disabledforeground foreground highlightbackground highlightcolor } { #button .t.color-$opt -text $opt -command "config -$opt \[tk_chooseColor]" menubutton .t.color-$opt -text $opt -menu .t.color-$opt.m -indicatoron 1 \ - -relief raised -bd 2 + -relief raised -bd 2 menu .t.color-$opt.m -tearoff 0 .t.color-$opt.m add command -label Red -command "config -$opt red" .t.color-$opt.m add command -label Green -command "config -$opt green" diff --git a/tests/canvPsGrph.tcl b/tests/canvPsGrph.tcl index 343979f..08ccd74 100644 --- a/tests/canvPsGrph.tcl +++ b/tests/canvPsGrph.tcl @@ -50,13 +50,13 @@ proc mkObjs c { $c create rect 380 200 420 240 -fill black $c create rect 200 330 240 370 -fill black } - + if {$what == "oval"} { $c create oval 50 10 150 80 -fill black -stipple gray25 -outline {} $c create oval 100 100 200 150 -outline {} -fill black -stipple gray50 $c create oval 250 100 400 300 -width .5c } - + if {$what == "poly"} { $c create poly 100 200 200 50 300 200 -smooth yes -stipple gray25 \ -outline black -width 4 @@ -68,7 +68,7 @@ proc mkObjs c { $c create poly 20 200 100 220 90 100 40 250 \ -fill {} -outline brown -width 3 } - + if {$what == "line"} { $c create line 20 20 120 20 -arrow both -width 5 $c create line 20 80 150 80 20 200 150 200 -smooth yes diff --git a/tests/canvPsImg.tcl b/tests/canvPsImg.tcl index c06aeaa..1f46eca 100644 --- a/tests/canvPsImg.tcl +++ b/tests/canvPsImg.tcl @@ -35,7 +35,7 @@ toplevel .t wm title .t "Postscript Tests for Canvases: Images" wm iconname .t "Postscript" -message .t.m -text {This screen exercises the Postscript-generation abilities of Tk canvas widgets for images. Click the buttons below to select a Visual type for the canvas and colormode for the Postscript output. Then click "Print" to send the results to the default printer, or "Print to file" to put the Postscript output in a file called "/tmp/test.ps". You can also click on items in the canvas to delete them. +message .t.m -text {This screen exercises the Postscript-generation abilities of Tk canvas widgets for images. Click the buttons below to select a Visual type for the canvas and colormode for the Postscript output. Then click "Print" to send the results to the default printer, or "Print to file" to put the Postscript output in a file called "/tmp/test.ps". You can also click on items in the canvas to delete them. NOTE: Some Postscript printers may not be able to handle Postscript generated in color mode.} -width 6i pack .t.m -side top -fill both diff --git a/tests/canvText.test b/tests/canvText.test index f0c677f..ff5e4b9 100644 --- a/tests/canvText.test +++ b/tests/canvText.test @@ -832,7 +832,7 @@ test canvText-16.1 {GetSelText procedure} -setup { test canvText-17.1 {TextToPostscript procedure} -setup { .c delete all - set result {/Courier-Oblique findfont [font actual $font -size] scalefont ISOEncode setfont + set result {findfont [font actual $font -size] scalefont ISOEncode setfont 0.000 0.000 0.000 setrgbcolor AdjustColor 0 100 200 \[ \[(000)\] @@ -856,7 +856,7 @@ end .c itemconfig test -font $font -text "00000000" -width [expr 3*$ax] .c itemconfig test -anchor n -fill black set x [.c postscript] - set x [string range $x [string first "/Courier-Oblique" $x] end] + set x [string range $x [string first "findfont " $x] end] expr {$x eq [subst $result] ? "ok" : $x} } -result ok @@ -873,6 +873,7 @@ test canvText-18.1 {bug fix 2525, find enclosed on text with newlines} -setup { .c find enclosed 99 99 [expr $x2 + 1] [expr $y2 + 1] } -cleanup { destroy .c + unset -nocomplain bbox x2 y2 } -result 1 test canvText-19.1 {patch 1006286, leading space caused wrap under Win32} -setup { diff --git a/tests/constraints.tcl b/tests/constraints.tcl index e28b159..6402753 100644 --- a/tests/constraints.tcl +++ b/tests/constraints.tcl @@ -38,7 +38,7 @@ namespace eval tk { } namespace eval bg { - # Manage a background process. + # Manage a background process. # Replace with slave interp or thread? namespace import ::tcltest::interpreter namespace import ::tk::test::loadTkCommand @@ -126,7 +126,7 @@ namespace eval tk { eval destroy [winfo children .] } - namespace export fixfocus + namespace export fixfocus proc fixfocus {} { catch {destroy .focus} toplevel .focus @@ -185,7 +185,7 @@ testConstraint aqua [expr {[tk windowingsystem] eq "aqua"}] testConstraint nonwin [expr {[tk windowingsystem] ne "win32"}] testConstraint userInteraction 0 testConstraint nonUnixUserInteraction [expr { - [testConstraint userInteraction] || + [testConstraint userInteraction] || ([testConstraint unix] && [testConstraint notAqua]) }] testConstraint haveDISPLAY [info exists env(DISPLAY)] @@ -207,7 +207,6 @@ testConstraint testembed [llength [info commands testembed]] testConstraint testfont [llength [info commands testfont]] testConstraint testmakeexist [llength [info commands testmakeexist]] testConstraint testmenubar [llength [info commands testmenubar]] -testConstraint testmenubar [llength [info commands testmenubar]] testConstraint testmetrics [llength [info commands testmetrics]] testConstraint testobjconfig [llength [info commands testobjconfig]] testConstraint testsend [llength [info commands testsend]] diff --git a/tests/entry.test b/tests/entry.test index 11408ac..9c30b00 100644 --- a/tests/entry.test +++ b/tests/entry.test @@ -1892,6 +1892,19 @@ test entry-6.11 {EntryComputeGeometry procedure} -constraints { } -cleanup { destroy .e } -result {1 1 1} +test entry-6.12 {EntryComputeGeometry procedure} -constraints { + fonts +} -setup { + catch {destroy .e} + entry .e -font $fixed -bd 2 -relief raised -width 20 + pack .e +} -body { + .e insert end "012\t456\t" + update + list [.e index @81] [.e index @82] [.e index @116] [.e index @117] +} -cleanup { + destroy .e +} -result {6 7 7 8} test entry-7.1 {InsertChars procedure} -setup { @@ -3447,8 +3460,6 @@ test entry-22.1 {lost namespaced textvar} -body { namespace eval test { variable foo {a b} } entry .e -textvariable ::test::foo namespace delete test - .e insert end "more stuff" - .e delete 5 end set ::test::foo } -cleanup { destroy .e @@ -3457,13 +3468,39 @@ test entry-22.2 {lost namespaced textvar} -body { namespace eval test { variable foo {a b} } entry .e -textvariable ::test::foo namespace delete test - .e insert end "more stuff" - .e delete 5 end - catch {set ::test::foo} - list [.e get] [.e cget -textvar] + catch {.e insert end "more stuff"} result1 + catch {.e delete 5 end } result2 + catch {set ::test::foo} result3 + list [.e get] [.e cget -textvar] $result1 $result2 $result3 +} -cleanup { + destroy .e +} -result [list "a bmo" ::test::foo \ + {can't set "::test::foo": parent namespace doesn't exist} \ + {can't set "::test::foo": parent namespace doesn't exist} \ + {can't read "::test::foo": no such variable}] + +test entry-23.1 {error in trace proc attached to the textvariable} -setup { + destroy .e +} -body { + trace variable myvar w traceit + proc traceit args {error "Intentional error here!"} + entry .e -textvariable myvar + catch {.e insert end mystring} result1 + catch {.e delete 0} result2 + list $result1 $result2 } -cleanup { destroy .e -} -result [list "a bmo" ::test::foo] +} -result [list {can't set "myvar": Intentional error here!} \ + {can't set "myvar": Intentional error here!}] + +test entry-24.1 {textvariable lives in a non-existing namespace} -setup { + destroy .e +} -body { + catch {entry .e -textvariable thisnsdoesntexist::myvar} result1 + set result1 +} -cleanup { + destroy .e +} -result {can't trace "thisnsdoesntexist::myvar": parent namespace doesn't exist} # Gathered comments about lacks # XXX Still need to write tests for EntryBlinkProc, EntryFocusProc, diff --git a/tests/event.test b/tests/event.test index 1548467..756dbe5 100644 --- a/tests/event.test +++ b/tests/event.test @@ -756,9 +756,7 @@ test event-7.1(double-click) {A double click on a lone character deleteWindows } -result {1.3 A 1.3 A} test event-7.2(double-click) {A double click on a lone character - in an entry widget should select that character} -constraints { - knownBug -} -setup { + in an entry widget should select that character} -setup { deleteWindows } -body { set t [toplevel .t] @@ -822,7 +820,7 @@ test event-7.2(double-click) {A double click on a lone character return $result } -cleanup { deleteWindows -} -result {3 A 4 A} +} -result {4 A 4 A} # cleanup unset -nocomplain keypress_lookup diff --git a/tests/font.test b/tests/font.test index a07e391..9e44a93 100644 --- a/tests/font.test +++ b/tests/font.test @@ -12,7 +12,25 @@ eval tcltest::configure $argv tcltest::loadTestedCommands -catch {eval font delete [font names]} +set defaultfontlist [font names] + +proc getnondefaultfonts {} { + global defaultfontlist + set nondeffonts [list ] + foreach afont [font names] { + if {$afont ni $defaultfontlist} { + lappend nondeffonts $afont + } + } + set nondeffonts +} + +proc clearnondefaultfonts {} { + foreach afont [getnondefaultfonts] { + font delete $afont + } +} + deleteWindows # Toplevel used (in some tests) of the whole file toplevel .t @@ -161,12 +179,12 @@ test font-5.4 {font command: configure: get all options} -setup { font delete xyz } -result xyz test font-5.5 {font command: configure: get one option} -setup { - catch {eval font delete [font names]} + clearnondefaultfonts } -body { # (objc == 4) so objPtr = objv[3] font create xyz -family xyz font configure xyz -family - font names + getnondefaultfonts } -cleanup { font delete xyz } -result xyz @@ -192,34 +210,33 @@ test font-5.7 {font command: configure: bad option} -setup { test font-6.1 {font command: create: make up name} -setup { - catch {eval font delete [font names]} + clearnondefaultfonts } -body { # (objc < 3) so name = NULL font create - font names + getnondefaultfonts } -cleanup { font delete font1 } -result {font1} test font-6.2 {font command: create: name specified} -setup { - catch {eval font delete [font names]} + clearnondefaultfonts } -body { # not (objc < 3) font create xyz - font names + getnondefaultfonts } -cleanup { font delete xyz } -result {xyz} test font-6.3 {font command: create: name not really specified} -setup { - catch {eval font delete [font names]} + clearnondefaultfonts } -body { # (name[0] == '-') so name = NULL font create -family xyz - font names + getnondefaultfonts } -cleanup { font delete font1 } -result {font1} test font-6.4 {font command: create: generate name} -setup { - catch {eval font delete [font names]} } -body { # (name == NULL) font create -family one @@ -229,7 +246,7 @@ test font-6.4 {font command: create: generate name} -setup { font create -family four font configure font2 -family } -cleanup { - catch {eval font delete [font names]} + font delete font1 font2 font3 } -result {four} test font-6.5 {font command: create: bad option creating new font} -setup { catch {font delete xyz} @@ -238,7 +255,7 @@ test font-6.5 {font command: create: bad option creating new font} -setup { font create xyz -xyz times } -returnCodes error -result {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike} test font-6.6 {font command: create: bad option creating new font} -setup { - catch {eval font delete [font names]} + clearnondefaultfonts } -body { # name was not specified so skip = 2 font create -xyz times @@ -258,7 +275,7 @@ test font-7.1 {font command: delete: arguments} -body { font delete } -returnCodes error -result {wrong # args: should be "font delete fontname ?fontname ...?"} test font-7.2 {font command: delete: loop test} -setup { - catch {eval font delete [font names]} + clearnondefaultfonts set x {} } -body { # for (i = 2; i < objc; i++) @@ -267,14 +284,14 @@ test font-7.2 {font command: delete: loop test} -setup { font create c -underline 1 font create d -underline 1 font create e -underline 1 - lappend x [lsort [font names]] + lappend x [lsort [getnondefaultfonts]] font delete a e c b - lappend x [lsort [font names]] + lappend x [lsort [getnondefaultfonts]] } -cleanup { - catch {eval font delete [font names]} + getnondefaultfonts } -result {{a b c d e} d} test font-7.3 {font command: delete: loop test} -setup { - catch {eval font delete [font names]} + clearnondefaultfonts set x {} } -body { # (namedHashPtr == NULL) in middle of loop @@ -283,11 +300,11 @@ test font-7.3 {font command: delete: loop test} -setup { font create c -underline 1 font create d -underline 1 font create e -underline 1 - lappend x [lsort [font names]] + lappend x [lsort [getnondefaultfonts]] catch {font delete a d q c e b} - lappend x [lsort [font names]] + lappend x [lsort [getnondefaultfonts]] } -cleanup { - catch {eval font delete [font names]} + clearnondefaultfonts } -result {{a b c d e} {b c e}} test font-7.4 {font command: delete: non-existent} -setup { catch {font delete xyz} @@ -434,29 +451,29 @@ test font-11.1 {font command: names: arguments} -body { font names xyz } -returnCodes error -result {wrong # args: should be "font names"} test font-11.2 {font command: names: loop test: no passes} -setup { - catch {eval font delete [font names]} + clearnondefaultfonts } -body { - font names + getnondefaultfonts } -result {} test font-11.3 {font command: names: loop test: one pass} -setup { - catch {eval font delete [font names]} + clearnondefaultfonts } -body { font create - font names + getnondefaultfonts } -result {font1} test font-11.4 {font command: names: loop test: multiple passes} -setup { - catch {eval font delete [font names]} + clearnondefaultfonts } -body { font create xyz font create abc font create def - lsort [font names] + lsort [getnondefaultfonts] } -cleanup { - catch {eval font delete [font names]} + clearnondefaultfonts } -result {abc def xyz} test font-11.5 {font command: names: skip deletePending fonts} -setup { destroy .t.f - catch {eval font delete [font names]} + clearnondefaultfonts pack [label .t.f] update set x {} @@ -464,12 +481,12 @@ test font-11.5 {font command: names: skip deletePending fonts} -setup { # (nfPtr->deletePending == 0) font create xyz font create abc - lappend x [lsort [font names]] + lappend x [lsort [getnondefaultfonts]] .t.f config -font xyz font delete xyz - lappend x [font names] + lappend x [getnondefaultfonts] } -cleanup { - catch {eval font delete [font names]} + clearnondefaultfonts } -result {{abc xyz} abc} @@ -509,9 +526,9 @@ test font-13.1 {CreateNamedFont: new named font} -setup { set x {} } -body { # not (new == 0) - lappend x [font names] + lappend x [getnondefaultfonts] font create xyz - lappend x [font names] + lappend x [getnondefaultfonts] } -cleanup { font delete xyz } -result {{} xyz} @@ -646,7 +663,7 @@ test font-15.8 {Tk_AllocFontFromObj procedure: get native font} -constraints { win } -setup { destroy .t.f - catch {eval font delete [font names]} + clearnondefaultfonts pack [label .t.f] update } -body { @@ -752,7 +769,7 @@ test font-17.3 {Tk_FreeFont procedure: multiple ref} -setup { } -result {-family fixed} test font-17.4 {Tk_FreeFont procedure: named font} -setup { destroy .t.f - catch {eval font delete [font names]} + clearnondefaultfonts pack [label .t.f] update } -body { @@ -760,7 +777,7 @@ test font-17.4 {Tk_FreeFont procedure: named font} -setup { font create xyz .t.f config -font xyz destroy .t.f - font names + getnondefaultfonts } -result {xyz} test font-17.5 {Tk_FreeFont procedure: named font} -setup { destroy .t.f @@ -1509,11 +1526,11 @@ test font-24.10 {Tk_ComputeTextLayout: tab caused break} -body { set x {} .t.l config -text "000\t" update - lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 8}]}] lappend x [expr {[winfo reqheight .t.l] eq $ay}] .t.l config -text "000\t00" -wrap [expr $ax * 6] update - lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 8}]}] lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] return $x } -cleanup { diff --git a/tests/listbox.test b/tests/listbox.test index 72b1cdf..0519e93 100644 --- a/tests/listbox.test +++ b/tests/listbox.test @@ -3068,6 +3068,45 @@ test listbox-30.1 {Bug 3607326} -setup { unset -nocomplain a } -result * -match glob -returnCodes error +test listbox-31.1 {<<ListboxSelect>> event} -setup { + destroy .l + unset -nocomplain res +} -body { + pack [listbox .l -state normal] + update + bind .l <<ListboxSelect>> {lappend res [%W curselection]} + .l insert end a b c + focus -force .l + event generate .l <1> -x 5 -y 5 ; # <<ListboxSelect>> fires + .l configure -state disabled + focus -force .l + event generate .l <Control-Home> ; # <<ListboxSelect>> does NOT fire + .l configure -state normal + focus -force .l + event generate .l <Control-End> ; # <<ListboxSelect>> fires + .l selection clear 0 end ; # <<ListboxSelect>> does NOT fire + .l selection set 1 1 ; # <<ListboxSelect>> does NOT fire + lappend res [.l curselection] +} -cleanup { + destroy .l + unset -nocomplain res +} -result {0 2 1} + +test listbox-31.2 {<<ListboxSelect>> event on lost selection} -setup { + destroy .l +} -body { + pack [listbox .l -exportselection true] + update + bind .l <<ListboxSelect>> {lappend res [list [selection own] [%W curselection]]} + .l insert end a b c + focus -force .l + event generate .l <1> -x 5 -y 5 ; # <<ListboxSelect>> fires + selection clear ; # <<ListboxSelect>> fires again + set res +} -cleanup { + destroy .l +} -result {{.l 0} {{} {}}} + resetGridInfo deleteWindows option clear diff --git a/tests/menu.test b/tests/menu.test index 595a21b..aaadc86 100644 --- a/tests/menu.test +++ b/tests/menu.test @@ -1548,10 +1548,15 @@ test menu-3.41 {MenuWidgetCmd procedure, "index" option} -setup { } -body { menu .m1 .m1 add command -label "test" - .m1 index "test" + .m1 add command -label "3" + .m1 add command -label "another label" + .m1 add command -label "end" + .m1 add command -label "3a" + .m1 add command -label "final entry" + list [.m1 index "test"] [.m1 index "3"] [.m1 index "3a"] [.m1 index "end"] } -cleanup { destroy .m1 -} -result {1} +} -result {1 3 5 6} test menu-3.42 {MenuWidgetCmd procedure, "insert" option} -setup { destroy .m1 } -body { @@ -3862,6 +3867,18 @@ test menu-35.1 {menu -underline string overruns Bug 1599877} -setup { deleteWindows } -result {} +test menu-37.1 {menubar menues cannot be posted - bug 2160206} -setup { + catch {destroy .m} +} -body { + # On Linux the following used to panic + # It now returns an error (on all platforms) + menu .m -type menubar + list [catch ".m post 1 1" msg] $msg +} -cleanup { + destroy .m +} -result {1 {a menubar menu cannot be posted}} + + # cleanup imageFinish deleteWindows diff --git a/tests/option.file3 b/tests/option.file3 new file mode 100755 index 0000000..87f41ae --- /dev/null +++ b/tests/option.file3 @@ -0,0 +1,18 @@ +! This file is a sample option (resource) database used to test +! Tk's option-handling capabilities. + +! Comment line \ + with a backslash-newline sequence embedded in it. + +*x1: blue + tktest.x2 : green +*\ +x3 \ + : pur\ +ple +*x 4: brówn +# More comments, this time delimited by hash-marks. + # Comment-line with space. +*x6: +*x9: \ \ \\\101\n +# comment line as last line of file. diff --git a/tests/option.test b/tests/option.test index 23866d7..ea5b5d1 100644 --- a/tests/option.test +++ b/tests/option.test @@ -399,18 +399,20 @@ test option-15.10 {database files} -body { set option2 [file join [testsDirectory] option.file2] option read $option2 } -returnCodes error -result {missing colon on line 2} - +set option3 [file join [testsDirectory] option.file3] +option read $option3 +test option-15.11 {database files} {option get . {x 4} color} br\xf3wn test option-16.1 {ReadOptionFile} -body { - set option3 [makeFile {} option.file3] - set file [open $option3 w] + set option4 [makeFile {} option.file3] + set file [open $option4 w] fconfigure $file -translation crlf puts $file "*x7: true\n*x8: false" close $file - option read $option3 userDefault + option read $option4 userDefault list [option get . x7 color] [option get . x8 color] } -cleanup { - removeFile $option3 + removeFile $option4 } -result {true false} deleteWindows diff --git a/tests/panedwindow.test b/tests/panedwindow.test index f2e01e8..666ed9c 100644 --- a/tests/panedwindow.test +++ b/tests/panedwindow.test @@ -98,168 +98,195 @@ test panedwindow-1.17 {configuration options: -orient (good)} -body { test panedwindow-1.18 {configuration options: -orient (bad)} -body { .p configure -orient badValue } -returnCodes error -result {bad orient "badValue": must be horizontal or vertical} -test panedwindow-1.19 {configuration options: -relief (good)} -body { +test panedwindow-1.19 {configuration options: -proxybackground (good)} -body { + .p configure -proxybackground "#f0a0a0" + list [lindex [.p configure -proxybackground] 4] [.p cget -proxybackground] +} -cleanup { + .p configure -proxybackground [lindex [.p configure -proxybackground] 3] +} -result {{#f0a0a0} #f0a0a0} +test panedwindow-1.20 {configuration options: -proxybackground (bad)} -body { + .p configure -proxybackground badValue +} -returnCodes error -result {unknown color name "badValue"} +test panedwindow-1.21 {configuration options: -proxyborderwidth (good)} -body { + .p configure -proxyborderwidth 1.3 + list [lindex [.p configure -proxyborderwidth] 4] [.p cget -proxyborderwidth] +} -cleanup { + .p configure -proxyborderwidth [lindex [.p configure -proxyborderwidth] 3] +} -result {1.3 1.3} +test panedwindow-1.22 {configuration options: -proxyborderwidth (bad)} -body { + .p configure -proxyborderwidth badValue +} -returnCodes error -result {bad screen distance "badValue"} +test panedwindow-1.23 {configuration options: -proxyrelief (good)} -body { + .p configure -proxyrelief groove + list [lindex [.p configure -proxyrelief] 4] [.p cget -proxyrelief] +} -cleanup { + .p configure -proxyrelief [lindex [.p configure -proxyrelief] 3] +} -result {groove groove} +test panedwindow-1.24 {configuration options: -proxyrelief (bad)} -body { + .p configure -proxyrelief 1.5 +} -returnCodes error -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} +test panedwindow-1.25 {configuration options: -relief (good)} -body { .p configure -relief groove list [lindex [.p configure -relief] 4] [.p cget -relief] } -cleanup { .p configure -relief [lindex [.p configure -relief] 3] } -result {groove groove} -test panedwindow-1.20 {configuration options: -relief (bad)} -body { +test panedwindow-1.26 {configuration options: -relief (bad)} -body { .p configure -relief 1.5 } -returnCodes error -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} -test panedwindow-1.21 {configuration options: -sashcursor (good)} -body { +test panedwindow-1.27 {configuration options: -sashcursor (good)} -body { .p configure -sashcursor arrow list [lindex [.p configure -sashcursor] 4] [.p cget -sashcursor] } -cleanup { .p configure -sashcursor [lindex [.p configure -sashcursor] 3] } -result {arrow arrow} -test panedwindow-1.22 {configuration options: -sashcursor (bad)} -body { +test panedwindow-1.28 {configuration options: -sashcursor (bad)} -body { .p configure -sashcursor badValue } -returnCodes error -result {bad cursor spec "badValue"} -test panedwindow-1.23 {configuration options: -sashpad (good)} -body { +test panedwindow-1.29 {configuration options: -sashpad (good)} -body { .p configure -sashpad 1.3 list [lindex [.p configure -sashpad] 4] [.p cget -sashpad] } -cleanup { .p configure -sashpad [lindex [.p configure -sashpad] 3] } -result {1 1} -test panedwindow-1.24 {configuration options: -sashpad (bad)} -body { +test panedwindow-1.30 {configuration options: -sashpad (bad)} -body { .p configure -sashpad badValue } -returnCodes error -result {bad screen distance "badValue"} -test panedwindow-1.25 {configuration options: -sashrelief (good)} -body { +test panedwindow-1.31 {configuration options: -sashrelief (good)} -body { .p configure -sashrelief groove list [lindex [.p configure -sashrelief] 4] [.p cget -sashrelief] } -cleanup { .p configure -sashrelief [lindex [.p configure -sashrelief] 3] } -result {groove groove} -test panedwindow-1.26 {configuration options: -sashrelief (bad)} -body { +test panedwindow-1.32 {configuration options: -sashrelief (bad)} -body { .p configure -sashrelief 1.5 } -returnCodes error -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} -test panedwindow-1.27 {configuration options: -sashwidth (good)} -body { +test panedwindow-1.33 {configuration options: -sashwidth (good)} -body { .p configure -sashwidth 10 list [lindex [.p configure -sashwidth] 4] [.p cget -sashwidth] } -cleanup { .p configure -sashwidth [lindex [.p configure -sashwidth] 3] } -result {10 10} -test panedwindow-1.28 {configuration options: -sashwidth (bad)} -body { +test panedwindow-1.34 {configuration options: -sashwidth (bad)} -body { .p configure -sashwidth badValue } -returnCodes error -result {bad screen distance "badValue"} -test panedwindow-1.29 {configuration options: -showhandle (good)} -body { +test panedwindow-1.35 {configuration options: -showhandle (good)} -body { .p configure -showhandle true list [lindex [.p configure -showhandle] 4] [.p cget -showhandle] } -cleanup { .p configure -showhandle [lindex [.p configure -showhandle] 3] } -result {1 1} -test panedwindow-1.30 {configuration options: -showhandle (bad)} -body { +test panedwindow-1.36 {configuration options: -showhandle (bad)} -body { .p configure -showhandle foo } -returnCodes error -result {expected boolean value but got "foo"} -test panedwindow-1.31 {configuration options: -width (good)} -body { +test panedwindow-1.37 {configuration options: -width (good)} -body { .p configure -width 402 list [lindex [.p configure -width] 4] [.p cget -width] } -cleanup { .p configure -width [lindex [.p configure -width] 3] } -result {402 402} -test panedwindow-1.32 {configuration options: -width (bad)} -body { +test panedwindow-1.38 {configuration options: -width (bad)} -body { .p configure -width badValue } -returnCodes error -result {bad screen distance "badValue"} -test panedwindow-1.33 {configuration options: -after (good)} -body { +test panedwindow-1.39 {configuration options: -after (good)} -body { .p paneconfigure .b -after .c list [lindex [.p paneconfigure .b -after] 4] \ [.p panecget .b -after] } -cleanup { .p paneconfig .b -after [lindex [.p paneconfig .b -after] 3] } -result {.c .c} -test panedwindow-1.34 {configuration options: -after (bad)} -body { +test panedwindow-1.40 {configuration options: -after (bad)} -body { .p paneconfigure .b -after badValue } -returnCodes error -result {bad window path name "badValue"} -test panedwindow-1.35 {configuration options: -before (good)} -body { +test panedwindow-1.41 {configuration options: -before (good)} -body { .p paneconfigure .b -before .c list [lindex [.p paneconfigure .b -before] 4] \ [.p panecget .b -before] } -cleanup { .p paneconfig .b -before [lindex [.p paneconfig .b -before] 3] } -result {.c .c} -test panedwindow-1.36 {configuration options: -before (bad)} -body { +test panedwindow-1.42 {configuration options: -before (bad)} -body { .p paneconfigure .b -before badValue } -returnCodes error -result {bad window path name "badValue"} -test panedwindow-1.37 {configuration options: -height (good)} -body { +test panedwindow-1.43 {configuration options: -height (good)} -body { .p paneconfigure .b -height 10 list [lindex [.p paneconfigure .b -height] 4] \ [.p panecget .b -height] } -cleanup { .p paneconfig .b -height [lindex [.p paneconfig .b -height] 3] } -result {10 10} -test panedwindow-1.38 {configuration options: -height (bad)} -body { +test panedwindow-1.44 {configuration options: -height (bad)} -body { .p paneconfigure .b -height badValue } -returnCodes error -result {bad screen distance "badValue"} -test panedwindow-1.39 {configuration options: -hide (good)} -body { +test panedwindow-1.45 {configuration options: -hide (good)} -body { .p paneconfigure .b -hide false list [lindex [.p paneconfigure .b -hide] 4] \ [.p panecget .b -hide] } -cleanup { .p paneconfig .b -hide [lindex [.p paneconfig .b -hide] 3] } -result {0 0} -test panedwindow-1.40 {configuration options: -hide (bad)} -body { +test panedwindow-1.46 {configuration options: -hide (bad)} -body { .p paneconfigure .b -hide foo } -returnCodes error -result {expected boolean value but got "foo"} -test panedwindow-1.41 {configuration options: -minsize (good)} -body { +test panedwindow-1.47 {configuration options: -minsize (good)} -body { .p paneconfigure .b -minsize 10 list [lindex [.p paneconfigure .b -minsize] 4] \ [.p panecget .b -minsize] } -cleanup { .p paneconfig .b -minsize [lindex [.p paneconfig .b -minsize] 3] } -result {10 10} -test panedwindow-1.42 {configuration options: -minsize (bad)} -body { +test panedwindow-1.48 {configuration options: -minsize (bad)} -body { .p paneconfigure .b -minsize badValue } -returnCodes error -result {bad screen distance "badValue"} -test panedwindow-1.43 {configuration options: -padx (good)} -body { +test panedwindow-1.49 {configuration options: -padx (good)} -body { .p paneconfigure .b -padx 1.3 list [lindex [.p paneconfigure .b -padx] 4] \ [.p panecget .b -padx] } -cleanup { .p paneconfig .b -padx [lindex [.p paneconfig .b -padx] 3] } -result {1 1} -test panedwindow-1.44 {configuration options: -padx (bad)} -body { +test panedwindow-1.50 {configuration options: -padx (bad)} -body { .p paneconfigure .b -padx badValue } -returnCodes error -result {bad screen distance "badValue"} -test panedwindow-1.45 {configuration options: -pady (good)} -body { +test panedwindow-1.51 {configuration options: -pady (good)} -body { .p paneconfigure .b -pady 1.3 list [lindex [.p paneconfigure .b -pady] 4] \ [.p panecget .b -pady] } -cleanup { .p paneconfig .b -pady [lindex [.p paneconfig .b -pady] 3] } -result {1 1} -test panedwindow-1.46 {configuration options: -pady (bad)} -body { +test panedwindow-1.52 {configuration options: -pady (bad)} -body { .p paneconfigure .b -pady badValue } -returnCodes error -result {bad screen distance "badValue"} -test panedwindow-1.47 {configuration options: -sticky (good)} -body { +test panedwindow-1.53 {configuration options: -sticky (good)} -body { .p paneconfigure .b -sticky nsew list [lindex [.p paneconfigure .b -sticky] 4] \ [.p panecget .b -sticky] } -cleanup { .p paneconfig .b -sticky [lindex [.p paneconfig .b -sticky] 3] } -result {nesw nesw} -test panedwindow-1.48 {configuration options: -sticky (bad)} -body { +test panedwindow-1.54 {configuration options: -sticky (bad)} -body { .p paneconfigure .b -sticky abcd } -returnCodes error -result {bad stickyness value "abcd": must be a string containing zero or more of n, e, s, and w} -test panedwindow-1.49 {configuration options: -stretch (good)} -body { +test panedwindow-1.55 {configuration options: -stretch (good)} -body { .p paneconfigure .b -stretch alw list [lindex [.p paneconfigure .b -stretch] 4] \ [.p panecget .b -stretch] } -cleanup { .p paneconfig .b -stretch [lindex [.p paneconfig .b -stretch] 3] } -result {always always} -test panedwindow-1.50 {configuration options: -stretch (bad)} -body { +test panedwindow-1.56 {configuration options: -stretch (bad)} -body { .p paneconfigure .b -stretch foo } -returnCodes error -result {bad stretch "foo": must be always, first, last, middle, or never} -test panedwindow-1.51 {configuration options: -width (good)} -body { +test panedwindow-1.57 {configuration options: -width (good)} -body { .p paneconfigure .b -width 10 list [lindex [.p paneconfigure .b -width] 4] \ [.p panecget .b -width] } -cleanup { .p paneconfig .b -width [lindex [.p paneconfig .b -width] 3] } -result {10 10} -test panedwindow-1.52 {configuration options: -width (bad)} -body { +test panedwindow-1.58 {configuration options: -width (bad)} -body { .p paneconfigure .b -width badValue } -returnCodes error -result {bad screen distance "badValue"} deleteWindows @@ -5087,6 +5114,27 @@ test panedwindow-25.1 {DestroyPanedWindow} -setup { } set result {} } -result {} +test panedwindow-25.2 {UnmapNotify and MapNotify events are propagated to slaves} -setup { + deleteWindows +} -body { + panedwindow .pw + .pw add [button .pw.b] + pack .pw + update + set result [winfo ismapped .pw.b] + pack forget .pw + update + lappend result [winfo ismapped .pw.b] + lappend result [winfo ismapped .pw] + pack .pw + update + lappend result [winfo ismapped .pw] + lappend result [winfo ismapped .pw.b] + destroy .pw .pw.b + set result +} -cleanup { + deleteWindows +} -result {1 0 0 1 1} test panedwindow-26.1 {PanedWindowIdentifyCoords} -setup { diff --git a/tests/scale.test b/tests/scale.test index 13ccb4d..a8d08a8 100644 --- a/tests/scale.test +++ b/tests/scale.test @@ -688,6 +688,11 @@ test scale-6.20 {ComputeFormat procedure} -body { .s set 1001.23456789 .s get } -result {1001.235} +test scale-6.21 {ComputeFormat procedure} -body { + .s configure -length 200 -from 1000 -to 1001.8 -resolution 0 -digits 200 + .s set 1001.23456789 + .s get +} -result {1001.235} destroy .s @@ -1357,6 +1362,40 @@ test scale-18.3 {Scale button 2 events [Bug 787065]} -setup { } -result {0 {}} +test scale-19 {Bug [3529885fff] - Click in through goes in wrong direction} \ + -setup { + catch {destroy .s} + catch {destroy .s1 .s2 .s3 .s4} + unset -nocomplain x1 x2 x3 x4 x y + scale .s1 -from 0 -to 100 -resolution 1 -variable x1 -digits 4 -orient horizontal -length 100 + scale .s2 -from 0 -to 100 -resolution -1 -variable x2 -digits 4 -orient horizontal -length 100 + scale .s3 -from 100 -to 0 -resolution 1 -variable x3 -digits 4 -orient horizontal -length 100 + scale .s4 -from 100 -to 0 -resolution -1 -variable x4 -digits 4 -orient horizontal -length 100 + pack .s1 .s2 .s3 .s4 -side left + update + } \ + -body { + foreach {x y} [.s1 coord 50] {} + event generate .s1 <1> -x $x -y $y + event generate .s1 <ButtonRelease-1> -x $x -y $y + foreach {x y} [.s2 coord 50] {} + event generate .s2 <1> -x $x -y $y + event generate .s2 <ButtonRelease-1> -x $x -y $y + foreach {x y} [.s3 coord 50] {} + event generate .s3 <1> -x $x -y $y + event generate .s3 <ButtonRelease-1> -x $x -y $y + foreach {x y} [.s4 coord 50] {} + event generate .s4 <1> -x $x -y $y + event generate .s4 <ButtonRelease-1> -x $x -y $y + update + list $x1 $x2 $x3 $x4 + } \ + -cleanup { + unset x1 x2 x3 x4 x y + destroy .s1 .s2 .s3 .s4 + } \ + -result {1.0 1.0 1.0 1.0} + option clear # cleanup diff --git a/tests/scrollbar.test b/tests/scrollbar.test index 3addd28..3b16821 100644 --- a/tests/scrollbar.test +++ b/tests/scrollbar.test @@ -405,7 +405,7 @@ test scrollbar-3.73 {ScrollbarWidgetCmd procedure} { } {1 {bad option "bogus": must be activate, cget, configure, delta, fraction, get, identify, or set}} test scrollbar-3.74 {ScrollbarWidgetCmd procedure} { list [catch {.s c} msg] $msg -} {1 {bad option "c": must be activate, cget, configure, delta, fraction, get, identify, or set}} +} {1 {ambiguous option "c": must be activate, cget, configure, delta, fraction, get, identify, or set}} test scrollbar-4.1 {ScrollbarEventProc procedure} { catch {destroy .s1} @@ -632,6 +632,36 @@ test scrollbar-9.1 {scrollbar widget vs hidden commands} { list [winfo children .] [interp hidden] } [list {} $l] +test scrollbar-10.1 {<MouseWheel> event on scrollbar} -constraints {win|unix} -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 <MouseWheel> -delta -120 + after 200 {set eventprocessed 1} ; vwait eventprocessed + .t index @0,0 +} -cleanup { + destroy .t .s +} -result {5.0} + +test scrollbar-10.2 {<MouseWheel> event on scrollbar} -constraints {win|unix} -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 <Shift-MouseWheel> -delta -120 + after 200 {set eventprocessed 1} ; vwait eventprocessed + .t index @0,0 +} -cleanup { + destroy .t .s +} -result {1.4} + catch {destroy .s} catch {destroy .t} diff --git a/tests/send.test b/tests/send.test index e3156a1..945d4d0 100644 --- a/tests/send.test +++ b/tests/send.test @@ -227,7 +227,7 @@ test send-8.3 {Tk_SendCmd procedure, options} {secureserver} { } {1 {no application named "-async"}} test send-8.4 {Tk_SendCmd procedure, options} {secureserver} { list [catch {send -gorp foo bar baz} msg] $msg -} {1 {bad option "-gorp": must be -async, -displayof, or --}} +} {1 {no application named "-gorp"}} test send-8.5 {Tk_SendCmd procedure, options} {secureserver} { list [catch {send -async foo} msg] $msg } {1 {wrong # args: should be "send ?-option value ...? interpName arg ?arg ...?"}} diff --git a/tests/spinbox.test b/tests/spinbox.test index b8170c5..594cc90 100644 --- a/tests/spinbox.test +++ b/tests/spinbox.test @@ -3790,6 +3790,32 @@ test spinbox-23.1 {selection present while disabled, bug 637828} -body { destroy .e } -result {1 1 345} +test spinbox-24.1 {error in trace proc attached to the textvariable} -setup { + destroy .s +} -body { + trace variable myvar w traceit + proc traceit args {error "Intentional error here!"} + spinbox .s -textvariable myvar -from 1 -to 10 + catch {.s set mystring} result1 + catch {.s insert 0 mystring} result2 + catch {.s delete 0} result3 + catch {.s invoke buttonup} result4 + list $result1 $result2 $result3 $result4 +} -cleanup { + destroy .s +} -result [list {can't set "myvar": Intentional error here!} \ + {can't set "myvar": Intentional error here!} \ + {can't set "myvar": Intentional error here!} \ + {can't set "myvar": Intentional error here!}] + +test spinbox-25.1 {textvariable lives in a non-existing namespace} -setup { + destroy .s +} -body { + catch {spinbox .s -textvariable thisnsdoesntexist::myvar} result1 + set result1 +} -cleanup { + destroy .s +} -result {can't trace "thisnsdoesntexist::myvar": parent namespace doesn't exist} # Collected comments about lacks from the test # XXX Still need to write tests for SpinboxBlinkProc, SpinboxFocusProc, diff --git a/tests/text.test b/tests/text.test index 5089bb1..7ade29a 100644 --- a/tests/text.test +++ b/tests/text.test @@ -2632,7 +2632,70 @@ test text-10.39 {TextWidgetCmd procedure, "count" option} -setup { lappend res [.t count -displaylines 1.19 3.24] [.t count -displaylines 1.0 end] } -cleanup { destroy .t -} -result {2 6 2 5} +} -result {2 6 1 5} +test text-9.2.45 {TextWidgetCmd procedure, "count" option} -setup { + text .t + pack .t + update + set res {} +} -body { + for {set i 1} {$i < 5} {incr i} { + .t insert end "Line $i+++Line $i---Line $i///Line $i - This is Line [format %c [expr 64+$i]]\n" + } + .t tag configure hidden -elide true + .t tag add hidden 2.15 3.10 + .t configure -wrap none + set res [.t count -displaylines 2.0 3.0] +} -cleanup { + destroy .t +} -result {0} +test text-9.2.46 {TextWidgetCmd procedure, "count" option} -setup { + toplevel .mytop + pack [text .mytop.t -font TkFixedFont -bd 0 -padx 0 -wrap char] + set spec [font measure TkFixedFont "Line 1+++Line 1---Li"] ; # 20 chars + append spec x300+0+0 + wm geometry .mytop $spec + .mytop.t delete 1.0 end + update + set res {} +} -body { + for {set i 1} {$i < 5} {incr i} { + # 0 1 2 3 4 + # 012345 678901234 567890123 456789012 34567890123456789 + .mytop.t insert end "Line $i+++Line $i---Line $i///Line $i - This is Line [format %c [expr 64+$i]]\n" + } + .mytop.t tag configure hidden -elide true + .mytop.t tag add hidden 2.30 3.10 + lappend res [.mytop.t count -displaylines 2.0 3.0] + lappend res [.mytop.t count -displaylines 2.0 3.50] +} -cleanup { + destroy .mytop +} -result {1 3} +test text-9.2.47 {TextWidgetCmd procedure, "count" option} -setup { + text .t + pack .t + update + set res {} +} -body { + for {set i 1} {$i < 25} {incr i} { + .t insert end "Line $i\n" + } + .t tag configure hidden -elide true + .t tag add hidden 5.7 11.0 + update + # next line to be fully sure that asynchronous line heights calculation is + # up-to-date otherwise this test may fail (depending on the computer + # performance), especially when the . toplevel has small height + .t count -update -ypixels 1.0 end + set y1 [lindex [.t yview] 1] + .t count -displaylines 5.0 11.0 + set y2 [lindex [.t yview] 1] + .t count -displaylines 5.0 12.0 + set y3 [lindex [.t yview] 1] + list [expr {$y1 == $y2}] [expr {$y1 == $y3}] +} -cleanup { + destroy .t +} -result {1 1} test text-11.1 {counting with tag priority eliding} -setup { @@ -3440,9 +3503,10 @@ Line 4" list [.t tag ranges sel] [.t get 1.0 end] } -cleanup { destroy .t -} -result {{1.0 3.5} {Line 1 +} -result {{1.0 4.0} {Line 1 abcde 12345 + }} test text-19.9 {DeleteChars procedure} -body { text .t @@ -5498,6 +5562,27 @@ test text-22.217 {TextSearchCmd, elide up to match} -setup { } -cleanup { destroy .t } -result {{} {} 1.0 2.1 2.0 3.1 2.0 3.0} +test text-22.217.1 {elide up to match, with UTF-8 chars before the match} -setup { + pack [text .t] + set res {} +} -body { + .t tag configure e -elide 0 + .t insert end A {} xyz e bb\n + .t insert end \u00c4 {} xyz e bb + set res {} + lappend res [.t search bb 1.0 "1.0 lineend"] + lappend res [.t search bb 2.0 "2.0 lineend"] + lappend res [.t search -regexp bb 1.0 "1.0 lineend"] + lappend res [.t search -regexp bb 2.0 "2.0 lineend"] + .t tag configure e -elide 1 + lappend res [.t search bb 1.0 "1.0 lineend"] + lappend res [.t search bb 2.0 "2.0 lineend"] + lappend res [.t search -regexp bb 1.0 "1.0 lineend"] + lappend res [.t search -regexp -elide bb 2.0 "2.0 lineend"] + lappend res [.t search -regexp bb 2.0 "2.0 lineend"] +} -cleanup { + destroy .t +} -result {1.4 2.4 1.4 2.4 1.4 2.4 1.4 2.4 2.4} test text-22.218 {TextSearchCmd, strict limits} -body { pack [text .t] .t insert 1.0 "Hello world!\nThis is a test\n" @@ -6113,6 +6198,95 @@ test text-27.18 {patch 1469210 - inserting after undo} -setup { } -cleanup { destroy .t } -result 1 +test text-25.19 {patch 1669632 (i) - undo after <Control-1>} -setup { + destroy .t +} -body { + text .t -undo 1 + .t insert end foo\nbar + .t edit reset + .t insert 2.2 WORLD + event generate .t <Control-1> -x 1 -y 1 + .t insert insert HELLO + .t edit undo + .t get 2.2 2.7 +} -cleanup { + destroy .t +} -result WORLD +test text-25.20 {patch 1669632 (iv) - undo after <<SelectNone>>} -setup { + destroy .top .top.t +} -body { + toplevel .top + pack [text .top.t -undo 1] + .top.t insert end "This is an example text" + .top.t edit reset + .top.t mark set insert 1.5 + .top.t insert 1.5 HELLO + .top.t tag add sel 1.10 1.12 + update + focus -force .top.t + event generate .top.t <<SelectNone>> + .top.t insert insert " WORLD " + .top.t edit undo + .top.t get 1.5 1.10 +} -cleanup { + destroy .top.t .top +} -result HELLO +test text-25.21 {patch 1669632 (vii) - <<Undo>> shall not remove separators} -setup { + destroy .t +} -body { + text .t -undo 1 + .t insert end "This is an example text" + .t edit reset + .t insert 1.5 "WORLD " + event generate .t <Control-1> -x 1 -y 1 + .t insert insert HELLO + event generate .t <<Undo>> + .t insert insert E + event generate .t <<Undo>> + .t get 1.0 "1.0 lineend" +} -cleanup { + destroy .t +} -result "This WORLD is an example text" +test text-25.22 {patch 1669632 (v) - <<Clear>> is atomic} -setup { + destroy .t +} -body { + toplevel .top + pack [text .top.t -undo 1] + .top.t insert end "This is an example text" + .top.t edit reset + .top.t mark set insert 1.5 + .top.t insert 1.5 "A" + update + focus -force .top.t + event generate .top.t <Delete> + event generate .top.t <<SelectNextChar>> + event generate .top.t <<Clear>> + event generate .top.t <Delete> + event generate .top.t <<Undo>> + .top.t get 1.0 "1.0 lineend" +} -cleanup { + destroy .top.t .top +} -result "This A an example text" + test text-25.23 {patch 1669632 (v) - <<Cut>> is atomic} -setup { + destroy .t +} -body { + toplevel .top + pack [text .top.t -undo 1] + .top.t insert end "This is an example text" + .top.t edit reset + .top.t mark set insert 1.5 + .top.t insert 1.5 "A" + update + focus -force .top.t + event generate .top.t <Delete> + event generate .top.t <<SelectNextChar>> + event generate .top.t <<Cut>> + event generate .top.t <Delete> + event generate .top.t <<Undo>> + .top.t get 1.0 "1.0 lineend" +} -cleanup { + destroy .top.t .top +} -result "This A an example text" test text-28.1 {bug fix - 624372, ControlUtfProc long lines} -body { pack [text .t -wrap none] diff --git a/tests/textBTree.test b/tests/textBTree.test index 41b3d98..ebd6c50 100644 --- a/tests/textBTree.test +++ b/tests/textBTree.test @@ -872,7 +872,21 @@ test btree-14.1 {check tag presence} -setup { } -cleanup { destroy .t } -result {x y z} - +test btree-14.2 {TkTextIsElided} -setup { + destroy .t + text .t +} -body { + .t delete 1.0 end + .t tag config hidden -elide 1 + .t insert end "Line1\nLine2\nLine3\n" + .t tag add hidden 2.0 3.0 + .t tag add sel 1.2 3.2 + # next line used to panic because of "Bad tag priority being toggled on" + # (see bug [382da038c9]) + .t index "2.0 - 1 display line linestart" +} -cleanup { + destroy .t +} -result {1.0} test btree-15.1 {rebalance with empty node} -setup { destroy .t diff --git a/tests/textDisp.test b/tests/textDisp.test index 8e99eff..ac3aee0 100644 --- a/tests/textDisp.test +++ b/tests/textDisp.test @@ -27,9 +27,10 @@ proc scrollError args { # 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 +set twbw 2 +set twht 2 +option add *Text.borderWidth $twbw +option add *Text.highlightThickness $twht # The frame .f is needed to make sure that the overall window is always # fairly wide, even if the text window is very narrow. This is needed @@ -536,20 +537,24 @@ test textDisp-4.1 {UpdateDisplayInfo, basic} {textfonts} { .t insert end "Line 1\nLine 2\nLine 3\n" update .t delete 2.0 2.end + update + set res $tk_textRelayout .t insert 2.0 "New Line 2" update - list [.t bbox 1.0] [.t bbox 2.0] [.t bbox 3.0] $tk_textRelayout -} [list [list 5 5 7 $fixedHeight] [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 5 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] 2.0] + lappend res [.t bbox 1.0] [.t bbox 2.0] [.t bbox 3.0] $tk_textRelayout +} [list 2.0 [list 5 5 7 $fixedHeight] [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 5 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] 2.0] test textDisp-4.2 {UpdateDisplayInfo, re-use tail of text line} {textfonts} { .t delete 1.0 end .t insert end "Line 1\nLine 2 is so long that it wraps around\nLine 3" update .t mark set x 2.21 .t delete 2.2 + update + set res $tk_textRelayout .t insert 2.0 X update - list [.t bbox 2.0] [.t bbox x] [.t bbox 3.0] $tk_textRelayout -} [list [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 12 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] [list 5 [expr {3*$fixedDiff + 44}] 7 $fixedHeight] {2.0 2.20}] + lappend res [.t bbox 2.0] [.t bbox x] [.t bbox 3.0] $tk_textRelayout +} [list 2.0 2.20 [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 12 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] [list 5 [expr {3*$fixedDiff + 44}] 7 $fixedHeight] {2.0 2.20}] test textDisp-4.3 {UpdateDisplayInfo, tail of text line shifts} {textfonts} { .t delete 1.0 end .t insert end "Line 1\nLine 2 is so long that it wraps around\nLine 3" @@ -610,6 +615,10 @@ catch {destroy .f2} .t configure -borderwidth 0 -wrap char wm geom . {} update +set bw [.t cget -borderwidth] +set px [.t cget -padx] +set py [.t cget -pady] +set hlth [.t cget -highlightthickness] test textDisp-4.7 {UpdateDisplayInfo, filling in extra vertical space} { # This test was failing on Windows because the title bar on . # was a certain minimum size and it was interfering with the size @@ -648,7 +657,7 @@ test textDisp-4.9 {UpdateDisplayInfo, filling in extra vertical space} {textfont update .t delete 15.0 end list [.t bbox 7.0] [.t bbox 12.0] -} [list [list 3 [expr {2*$fixedDiff + 29}] 7 $fixedHeight] [list 3 [expr {7*$fixedDiff + 94}] 7 $fixedHeight]] +} [list [list [expr {$hlth + $px + $bw}] [expr {$hlth + $py + $bw + $fixedHeight}] $fixedWidth $fixedHeight] [list [expr {$hlth + $px + $bw}] [expr {$hlth + $py + $bw + 6 * $fixedHeight}] $fixedWidth $fixedHeight]] test textDisp-4.10 {UpdateDisplayInfo, filling in extra vertical space} { .t delete 1.0 end .t insert end "1\n2\n3\n4\n5\nLine 6 is such a long line that it wraps around.\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16\n17" @@ -657,7 +666,7 @@ test textDisp-4.10 {UpdateDisplayInfo, filling in extra vertical space} { .t delete 13.0 end update list [.t index @0,0] $tk_textRelayout $tk_textRedraw -} {5.0 {12.0 7.0 6.40 6.20 6.0 5.0} {5.0 6.0 6.20 6.40 7.0 12.0}} +} {6.0 {13.0 7.0 6.40 6.20 6.0} {6.0 6.20 6.40 7.0 13.0}} test textDisp-4.11 {UpdateDisplayInfo, filling in extra vertical space} { .t delete 1.0 end .t insert end "1\n2\n3\n4\n5\nLine 6 is such a long line that it wraps around, not once but really quite a few times.\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16\n17" @@ -666,7 +675,7 @@ test textDisp-4.11 {UpdateDisplayInfo, filling in extra vertical space} { .t delete 14.0 end update list [.t index @0,0] $tk_textRelayout $tk_textRedraw -} {6.40 {13.0 7.0 6.80 6.60 6.40} {6.40 6.60 6.80 7.0 13.0}} +} {6.60 {14.0 7.0 6.80 6.60} {6.60 6.80 7.0 14.0}} test textDisp-4.12 {UpdateDisplayInfo, filling in extra vertical space} { .t delete 1.0 end .t insert end "1\n2\n3\n4\n5\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16" @@ -1147,6 +1156,41 @@ test textDisp-8.11 {TkTextChanged, scrollbar notification when changes are off-s .t configure -yscrollcommand "" set scrollInfo } {0.0 0.625} +test textDisp-8.12 {TkTextChanged, moving the insert cursor redraws only past and new lines} { + .t delete 1.0 end + .t configure -wrap none + for {set i 1} {$i < 25} {incr i} { + .t insert end "Line $i Line $i\n" + } + .t tag add hidden 5.0 8.0 + .t tag configure hidden -elide true + .t mark set insert 9.0 + update + .t mark set insert 8.0 ; # up one line + update + set res [list $tk_textRedraw] + .t mark set insert 12.2 ; # in the visible text + update + lappend res $tk_textRedraw + .t mark set insert 6.5 ; # in the hidden text + update + lappend res $tk_textRedraw + .t mark set insert 3.5 ; # in the visible text again + update + lappend res $tk_textRedraw + .t mark set insert 3.8 ; # within the same line + update + lappend res $tk_textRedraw + # This last one is tricky: correct result really is {2.0 3.0} when + # calling .t mark set insert, two calls to TkTextChanged are done: + # (a) to redraw the line of the past position of the cursor + # (b) to redraw the line of the new position of the cursor + # During (a) the display line showing the cursor gets unlinked, + # which leads TkTextChanged in (b) to schedule a redraw starting + # one line _before_ the line containing the insert cursor. This is + # because during (b) findDLine cannot return the display line the + # cursor is in since this display line was just unlinked in (a). +} {{8.0 9.0} {8.0 12.0} {8.0 12.0} {3.0 8.0} {2.0 3.0}} test textDisp-9.1 {TkTextRedrawTag} { .t configure -wrap char @@ -1172,40 +1216,44 @@ test textDisp-9.3 {TkTextRedrawTag} { .t insert 1.0 "Line 1\nLine 2 is long enough to wrap around\nLine 3\nLine 4" update .t tag add big 2.2 2.4 + update .t tag remove big 1.0 end update list $tk_textRelayout $tk_textRedraw -} {2.0 2.0} +} {{2.0 2.20} {2.0 2.20 eof}} test textDisp-9.4 {TkTextRedrawTag} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1\nLine 2 is long enough to wrap around\nLine 3\nLine 4" update .t tag add big 2.2 2.20 + update .t tag remove big 1.0 end update list $tk_textRelayout $tk_textRedraw -} {2.0 2.0} +} {{2.0 2.20} {2.0 2.20 eof}} test textDisp-9.5 {TkTextRedrawTag} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1\nLine 2 is long enough to wrap around\nLine 3\nLine 4" update .t tag add big 2.2 2.end + update .t tag remove big 1.0 end update list $tk_textRelayout $tk_textRedraw -} {{2.0 2.20} {2.0 2.20}} +} {{2.0 2.20} {2.0 2.20 eof}} test textDisp-9.6 {TkTextRedrawTag} { .t configure -wrap char .t delete 1.0 end - .t insert 1.0 "Line 1\nLine 2 is long enough to wrap\nLine 3 is also long enough to wrap\nLine 4" + .t insert 1.0 "Line 1\nLine 2 is long enough to wrap\nLine 3 is also long enough to wrap" update .t tag add big 2.2 3.5 + update .t tag remove big 1.0 end update list $tk_textRelayout $tk_textRedraw -} {{2.0 2.20 3.0} {2.0 2.20 3.0}} +} {{2.0 2.20 3.0 3.20} {2.0 2.20 3.0 3.20 eof}} test textDisp-9.7 {TkTextRedrawTag} { .t configure -wrap char .t delete 1.0 end @@ -1257,6 +1305,58 @@ test textDisp-9.11 {TkTextRedrawTag} { update set tk_textRedraw } {} +test textDisp-9.12 {TkTextRedrawTag} { + .t configure -wrap char + .t delete 1.0 end + for {set i 1} {$i < 5} {incr i} { + .t insert end "Line $i+++Line $i\n" + } + .t tag configure hidden -elide true + .t tag add hidden 2.6 3.6 + update + .t tag add hidden 3.11 4.6 + update + list $tk_textRelayout $tk_textRedraw +} {2.0 {2.0 eof}} +test textDisp-9.13 {TkTextRedrawTag} { + .t configure -wrap none + .t delete 1.0 end + for {set i 1} {$i < 10} {incr i} { + .t insert end "Line $i - This is Line [format %c [expr 64+$i]]\n" + } + .t tag add hidden 2.8 2.17 + .t tag add hidden 6.8 7.17 + .t tag configure hidden -background red + .t tag configure hidden -elide true + update + .t tag configure hidden -elide false + update + list $tk_textRelayout $tk_textRedraw +} {{2.0 6.0 7.0} {2.0 6.0 7.0}} +test textDisp-9.14 {TkTextRedrawTag} { + pack [text .tnocrash] + for {set i 1} {$i < 6} {incr i} { + .tnocrash insert end \nfoo$i + } + .tnocrash tag configure mytag1 -relief raised + .tnocrash tag configure mytag2 -relief solid + update + proc doit {} { + .tnocrash tag add mytag1 4.0 5.0 + .tnocrash tag add mytag2 4.0 5.0 + after idle { + .tnocrash tag remove mytag1 1.0 end + .tnocrash tag remove mytag2 1.0 end + } + .tnocrash delete 1.0 2.0 + } + doit ; # must not crash + after 500 { + destroy .tnocrash + set done 1 + } + vwait done +} {} test textDisp-10.1 {TkTextRelayoutWindow} { .t configure -wrap char @@ -1425,7 +1525,7 @@ test textDisp-11.15 {TkTextSetYView, only a few lines visible} { update .top.t see 11.0 .top.t index @0,0 - # Thie index 9.0 should be just visible by a couple of pixels + # The index 9.0 should be just visible by a couple of pixels } {9.0} test textDisp-11.16 {TkTextSetYView, only a few lines visible} { .top.t yview 8.0 @@ -1438,9 +1538,77 @@ test textDisp-11.17 {TkTextSetYView, only a few lines visible} { update .top.t see 4.0 .top.t index @0,0 - # Thie index 2.0 should be just visible by a couple of pixels + # The index 2.0 should be just visible by a couple of pixels } {2.0} -destroy .top +test textDisp-11.18 {TkTextSetYView, see in elided lines} { + .top.t delete 1.0 end + for {set i 1} {$i < 20} {incr i} { + .top.t insert end [string repeat "Line $i" 10] + .top.t insert end "\n" + } + .top.t yview 4.0 + .top.t tag add hidden 4.10 "4.10 lineend" + .top.t tag add hidden 5.15 10.3 + .top.t tag configure hidden -elide true + update + .top.t see "8.0 lineend" + # The index "8.0 lineend" is on screen despite elided -> no scroll + .top.t index @0,0 +} {4.0} +test textDisp-11.19 {TkTextSetYView, see in elided lines} { + .top.t delete 1.0 end + for {set i 1} {$i < 50} {incr i} { + .top.t insert end "Line $i\n" + } + # button just for having a line with a larger height + button .top.t.b -text "Test" -bd 2 -highlightthickness 2 + .top.t window create 21.0 -window .top.t.b + .top.t tag add hidden 15.36 21.0 + .top.t tag configure hidden -elide true + .top.t configure -height 15 + wm geometry .top 300x200+0+0 + # Indices 21.0, 17.0 and 15.0 are all on the same display line + # therefore index @0,0 shall be the same for all of them + .top.t see end + update + .top.t see 21.0 + update + set ind1 [.top.t index @0,0] + .top.t see end + update + .top.t see 17.0 + update + set ind2 [.top.t index @0,0] + .top.t see end + update + .top.t see 15.0 + update + set ind3 [.top.t index @0,0] + list [expr {$ind1 == $ind2}] [expr {$ind1 == $ind3}] +} {1 1} +test textDisp-11.20 {TkTextSetYView, see in elided lines} { + .top.t delete 1.0 end + .top.t configure -wrap none + for {set i 1} {$i < 5} {incr i} { + .top.t insert end [string repeat "Line $i " 50] + .top.t insert end "\n" + } + .top.t delete 3.11 3.14 + .top.t tag add hidden 3.0 4.0 + # this shall not crash (null chunkPtr in TkTextSeeCmd is tested) + .top.t see 3.0 +} {} +test textDisp-11.21 {TkTextSetYView, window height smaller than the line height} { + .top.t delete 1.0 end + for {set i 1} {$i <= 10} {incr i} { + .top.t insert end "Line $i\n" + } + set lineheight [font metrics [.top.t cget -font] -linespace] + wm geometry .top 200x[expr {$lineheight / 2}] + update + .top.t see 1.0 + .top.t index @0,[expr {$lineheight - 2}] +} {1.0} .t configure -wrap word .t delete 50.0 51.0 @@ -1582,6 +1750,29 @@ test textDisp-13.10 {TkTextSeeCmd procedure} {} { destroy $w set res } {} +test textDisp-13.11 {TkTextSeeCmd procedure} {} { + # insertion of a character at end of a line containing multi-byte + # characters and calling see at the line end shall actually show + # this character + toplevel .top2 + pack [text .top2.t2 -wrap none] + for {set i 1} {$i < 5} {incr i} { + .top2.t2 insert end [string repeat "Line $i: éèà çù" 5]\n + + } + wm geometry .top2 300x200+0+0 + update + .top2.t2 see "1.0 lineend" + update + set ref [.top2.t2 index @0,0] + .top2.t2 insert "1.0 lineend" ç + .top2.t2 see "1.0 lineend" + update + set new [.top2.t2 index @0,0] + set res [.top2.t2 compare $ref == $new] + destroy .top2 + set res +} {0} wm geom . {} .t configure -wrap none @@ -1854,9 +2045,9 @@ test textDisp-16.18 {TkTextYviewCmd procedure, "moveto" roundoff} {textfonts} { wm geometry .top1 +0+0 text .top1.t -height 3 -width 4 -wrap none -setgrid 1 -padx 6 \ -spacing3 6 - .top1.t insert end "1\n2\n3\n4\n5\n6" pack .top1.t update + .top1.t insert end "1\n2\n3\n4\n5\n6" .top1.t yview moveto 0.3333 set result [.top1.t yview] destroy .top1 @@ -2018,6 +2209,70 @@ test textDisp-16.40 {text count -xpixels} { [.t count -xpixels 1.0 "1.0 displaylineend"] \ [.t count -xpixels 1.0 end] } {35 -35 0 42 42 42 0} +test textDisp-16.41 {text count -xpixels with indices in elided lines} { + set res {} + .t delete 1.0 end + for {set i 1} {$i < 40} {incr i} { + .t insert end [string repeat "Line $i" 20] + .t insert end "\n" + } + .t configure -wrap none + .t tag add hidden 5.15 20.15 + .t tag configure hidden -elide true + lappend res [.t count -xpixels 5.15 6.0] \ + [.t count -xpixels 5.15 6.1] \ + [.t count -xpixels 6.0 6.1] \ + [.t count -xpixels 6.1 6.2] \ + [.t count -xpixels 6.1 6.0] \ + [.t count -xpixels 6.0 7.0] \ + [.t count -xpixels 6.1 7.1] \ + [.t count -xpixels 15.0 20.15] \ + [.t count -xpixels 20.15 20.16] \ + [.t count -xpixels 20.16 20.15] + .t tag remove hidden 20.0 20.15 + lappend res [expr {[.t count -xpixels 5.0 20.0] != 0}] +} [list 0 0 0 0 0 0 0 0 $fixedWidth -$fixedWidth 1] +test textDisp-16.42 {TkTextYviewCmd procedure with indices in elided lines} { + .t configure -wrap none + .t delete 1.0 end + for {set i 1} {$i < 100} {incr i} { + .t insert end [string repeat "Line $i" 20] + .t insert end "\n" + } + .t tag add hidden 5.15 20.15 + .t tag configure hidden -elide true + .t yview 35.0 + .t yview scroll [expr {- 15 * $fixedHeight}] pixels + update + .t index @0,0 +} {5.0} +test textDisp-16.43 {TkTextYviewCmd procedure with indices in elided lines} { + .t configure -wrap none + .t delete 1.0 end + for {set i 1} {$i < 100} {incr i} { + .t insert end [string repeat "Line $i" 20] + .t insert end "\n" + } + .t tag add hidden 5.15 20.15 + .t tag configure hidden -elide true + .t yview 35.0 + .t yview scroll -15 units + update + .t index @0,0 +} {5.0} +test textDisp-16.44 {TkTextYviewCmd procedure, scroll down, with elided lines} { + .t configure -wrap none + .t delete 1.0 end + foreach x [list 0 1 2 3 4 5 6 7 8 9 0] { + .t insert end "$x aaa1\n$x bbb2\n$x ccc3\n$x ddd4\n$x eee5\n$x fff6" + .t insert end "$x 1111\n$x 2222\n$x 3333\n$x 4444\n$x 5555\n$x 6666" hidden + } + .t tag configure hidden -elide true ; # 5 hidden lines + update + .t see [expr {5 + [winfo height .t] / $fixedHeight} + 1].0 + update + .t index @0,0 +} {2.0} .t delete 1.0 end foreach i {a b c d e f g h i j k l m n o p q r s t u v w x y z} { @@ -2443,7 +2698,7 @@ test textDisp-19.11.23 {TextWidgetCmd procedure, "index +displaylines"} { [.t index "12.0 +2d lines"] [.t index "11.0 +2d lines"] \ [.t index "13.0 +2d lines"] [.t index "13.0 +3d lines"] \ [.t index "13.0 +4d lines"] -} {16.17 16.33 16.28 16.46 16.28 16.49 16.65 17.0} +} {16.17 16.33 16.28 16.46 16.28 16.49 16.65 16.72} .t tag remove elide 1.0 end test textDisp-19.11.24 {TextWidgetCmd procedure, "index +/-displaylines"} { list [.t index "11.5 + -1 display lines"] \ @@ -2552,6 +2807,63 @@ test textDisp-19.16 {count -ypixels} { [.t count -ypixels 16.0 "16.0 displaylineend +1c"] \ [.t count -ypixels "16.0 +1 displaylines" "16.0 +4 displaylines +3c"] } [list [expr {260 + 20 * $fixedDiff}] [expr {260 + 20 * $fixedDiff}] $fixedHeight [expr {2*$fixedHeight}] $fixedHeight [expr {3*$fixedHeight}]] +test textDisp-19.17 {count -ypixels with indices in elided lines} { + .t configure -wrap none + .t delete 1.0 end + for {set i 1} {$i < 100} {incr i} { + .t insert end [string repeat "Line $i" 20] + .t insert end "\n" + } + .t tag add hidden 5.15 20.15 + .t tag configure hidden -elide true + set res {} + update + lappend res \ + [.t count -ypixels 1.0 6.0] \ + [.t count -ypixels 2.0 7.5] \ + [.t count -ypixels 5.0 8.5] \ + [.t count -ypixels 6.1 6.2] \ + [.t count -ypixels 6.1 18.8] \ + [.t count -ypixels 18.0 20.50] \ + [.t count -ypixels 5.2 20.60] \ + [.t count -ypixels 20.60 20.70] \ + [.t count -ypixels 5.0 25.0] \ + [.t count -ypixels 25.0 5.0] \ + [.t count -ypixels 25.4 27.50] \ + [.t count -ypixels 35.0 38.0] + .t yview 35.0 + lappend res [.t count -ypixels 5.0 25.0] +} [list [expr {4 * $fixedHeight}] [expr {3 * $fixedHeight}] 0 0 0 0 0 0 [expr {5 * $fixedHeight}] [expr {- 5 * $fixedHeight}] [expr {2 * $fixedHeight}] [expr {3 * $fixedHeight}] [expr {5 * $fixedHeight}]] +test textDisp-19.18 {count -ypixels with indices in elided lines} { + .t configure -wrap none + .t delete 1.0 end + for {set i 1} {$i < 100} {incr i} { + .t insert end [string repeat "Line $i" 20] + .t insert end "\n" + } + .t tag add hidden 5.15 20.15 + .t tag configure hidden -elide true + .t yview 35.0 + set res {} + update + lappend res [.t count -ypixels 5.0 25.0] + .t yview scroll [expr {- 15 * $fixedHeight}] pixels + update + lappend res [.t count -ypixels 5.0 25.0] +} [list [expr {5 * $fixedHeight}] [expr {5 * $fixedHeight}]] +test textDisp-19.19 {count -ypixels with indices in elided lines} { + .t configure -wrap char + .t delete 1.0 end + for {set i 1} {$i < 25} {incr i} { + .t insert end [string repeat "Line $i -" 6] + .t insert end "\n" + } + .t tag add hidden 5.27 11.0 + .t tag configure hidden -elide true + .t yview 5.0 + update + set res [list [.t count -ypixels 5.0 11.0] [.t count -ypixels 5.0 11.20]] +} [list [expr {1 * $fixedHeight}] [expr {2 * $fixedHeight}]] .t delete 1.0 end .t insert end "Line 1" for {set i 2} {$i <= 200} {incr i} { @@ -2721,6 +3033,42 @@ test textDisp-22.9 {TkTextCharBbox, handling of spacing} {textfonts} { [.t bbox 1.1] [.t bbox 2.9] } [list [list 24 11 10 4] [list 55 [expr {$fixedDiff/2 + 15}] 10 4] [list 10 [expr {2*$fixedDiff + 43}] 10 4] [list 76 [expr {2*$fixedDiff + 40}] 10 4] [list 10 11 7 $fixedHeight] [list 69 [expr {$fixedDiff + 34}] 7 $fixedHeight]] .t tag delete spacing +test textDisp-22.10 {TkTextCharBbox, handling of elided lines} {textfonts} { + .t configure -wrap char + .t delete 1.0 end + for {set i 1} {$i < 10} {incr i} { + .t insert end "Line $i - Line [format %c [expr 64+$i]]\n" + } + .t tag add hidden 2.8 2.13 + .t tag add hidden 6.8 7.13 + .t tag configure hidden -elide true + update + list \ + [expr {[lindex [.t bbox 2.9] 0] - [lindex [.t bbox 2.8] 0]}] \ + [expr {[lindex [.t bbox 2.10] 0] - [lindex [.t bbox 2.8] 0]}] \ + [expr {[lindex [.t bbox 2.13] 0] - [lindex [.t bbox 2.8] 0]}] \ + [expr {[lindex [.t bbox 6.9] 0] - [lindex [.t bbox 6.8] 0]}] \ + [expr {[lindex [.t bbox 6.10] 0] - [lindex [.t bbox 6.8] 0]}] \ + [expr {[lindex [.t bbox 6.13] 0] - [lindex [.t bbox 6.8] 0]}] \ + [expr {[lindex [.t bbox 6.14] 0] - [lindex [.t bbox 6.8] 0]}] \ + [expr {[lindex [.t bbox 6.15] 0] - [lindex [.t bbox 6.8] 0]}] \ + [expr {[lindex [.t bbox 7.0] 0] - [lindex [.t bbox 6.8] 0]}] \ + [expr {[lindex [.t bbox 7.1] 0] - [lindex [.t bbox 6.8] 0]}] \ + [expr {[lindex [.t bbox 7.12] 0] - [lindex [.t bbox 6.8] 0]}] +} [list 0 0 0 0 0 0 0 0 0 0 0] +test textDisp-22.11 {TkTextCharBbox, handling of wrapped elided lines} {textfonts} { + .t configure -wrap char + .t delete 1.0 end + for {set i 1} {$i < 10} {incr i} { + .t insert end "Line $i - Line _$i - Lines .$i - Line [format %c [expr 64+$i]]\n" + } + .t tag add hidden 1.30 2.5 + .t tag configure hidden -elide true + update + list \ + [expr {[lindex [.t bbox 1.30] 0] - [lindex [.t bbox 2.4] 0]}] \ + [expr {[lindex [.t bbox 1.30] 0] - [lindex [.t bbox 2.5] 0]}] +} [list 0 0] .t delete 1.0 end .t insert end "Line 1" @@ -3350,7 +3698,7 @@ test textDisp-28.1 {"yview" option with bizarre scroll command} { set result [.t2.t index @0,0] update lappend result [.t2.t index @0,0] -} {6.0 1.0} +} {6.0 2.0} test textDisp-29.1 {miscellaneous: lines wrap but are still too long} {textfonts} { catch {destroy .t2} @@ -3366,7 +3714,7 @@ test textDisp-29.1 {miscellaneous: lines wrap but are still too long} {textfonts .t2.t window create 1.1 -window .t2.t.f update list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3] -} [list [list 0.0 [expr {14.0/30}]] 300x50+5+[expr {$fixedDiff + 18}] [list 12 [expr {$fixedDiff + 68}] 7 $fixedHeight]] +} [list [list 0.0 [expr {20.0*$fixedWidth/300}]] 300x50+[expr {$twbw + $twht + 1}]+[expr {$twbw + $twht + $fixedHeight + 1}] [list [expr {$twbw + $twht + $fixedWidth + 1}] [expr {$twbw + $twht + $fixedHeight + 50 + 1}] $fixedWidth $fixedHeight]] test textDisp-29.2 {miscellaneous: lines wrap but are still too long} {textfonts} { catch {destroy .t2} toplevel .t2 @@ -3379,10 +3727,11 @@ test textDisp-29.2 {miscellaneous: lines wrap but are still too long} {textfonts .t2.t insert end 123 frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised .t2.t window create 1.1 -window .t2.t.f + update .t2.t xview scroll 1 unit update list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3] -} [list [list [expr {7.0/300}] 0.49] 300x50+-2+[expr {$fixedDiff + 18}] [list 5 [expr {$fixedDiff + 68}] 7 $fixedHeight]] +} [list [list [expr {1.0*$fixedWidth/300}] [expr {21.0*$fixedWidth/300}]] 300x50+[expr {$twbw + $twht + 1 - $fixedWidth}]+[expr {$twbw + $twht + $fixedHeight + 1}] [list [expr {$twbw + $twht + $fixedWidth + 1 - $fixedWidth}] [expr {$twbw + $twht + $fixedHeight + 50 + 1}] $fixedWidth $fixedHeight]] test textDisp-29.2.1 {miscellaneous: lines wrap but are still too long} {textfonts} { catch {destroy .t2} toplevel .t2 @@ -3394,6 +3743,7 @@ test textDisp-29.2.1 {miscellaneous: lines wrap but are still too long} {textfon pack .t2.s -side bottom -fill x .t2.t insert end 1\n .t2.t insert end [string repeat "abc" 30] + update .t2.t xview scroll 5 unit update .t2.t xview @@ -3410,10 +3760,11 @@ test textDisp-29.2.2 {miscellaneous: lines wrap but are still too long} {textfon .t2.t insert end 123 frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised .t2.t window create 1.1 -window .t2.t.f + update .t2.t xview scroll 2 unit update list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3] -} [list [list [expr {14.0/300}] [expr {154.0/300}]] 300x50+-9+[expr {$fixedDiff + 18}] {}] +} [list [list [expr {2.0*$fixedWidth/300}] [expr {22.0*$fixedWidth/300}]] 300x50+[expr {$twbw + $twht + 1 - 2*$fixedWidth}]+[expr {$twbw + $twht + $fixedHeight + 1}] {}] test textDisp-29.2.3 {miscellaneous: lines wrap but are still too long} {textfonts} { catch {destroy .t2} toplevel .t2 @@ -3426,10 +3777,11 @@ test textDisp-29.2.3 {miscellaneous: lines wrap but are still too long} {textfon .t2.t insert end 123 frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised .t2.t window create 1.1 -window .t2.t.f + update .t2.t xview scroll 7 pixels update list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3] -} [list [list [expr {7.0/300}] 0.49] 300x50+-2+[expr {$fixedDiff + 18}] [list 5 [expr {$fixedDiff + 68}] 7 $fixedHeight]] +} [list [list [expr {7.0/300}] [expr {(20.0*$fixedWidth + 7)/300}]] 300x50+[expr {$twbw + $twht + 1 - 7}]+[expr {$twbw + $twht + $fixedHeight + 1}] [list [expr {$twbw + $twht + $fixedWidth + 1 - 7}] [expr {$twbw + $twht + $fixedHeight + 50 + 1}] $fixedWidth $fixedHeight]] test textDisp-29.2.4 {miscellaneous: lines wrap but are still too long} {textfonts} { catch {destroy .t2} toplevel .t2 @@ -3442,10 +3794,11 @@ test textDisp-29.2.4 {miscellaneous: lines wrap but are still too long} {textfon .t2.t insert end 123 frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised .t2.t window create 1.1 -window .t2.t.f + update .t2.t xview scroll 17 pixels update list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3] -} [list [list [expr {17.0/300}] [expr {157.0/300}]] 300x50+-12+[expr {$fixedDiff + 18}] {}] +} [list [list [expr {17.0/300}] [expr {(20.0*$fixedWidth + 17)/300}]] 300x50+[expr {$twbw + $twht + 1 - 17}]+[expr {$twbw + $twht + $fixedHeight + 1}] {}] test textDisp-29.2.5 {miscellaneous: can show last character} { catch {destroy .t2} toplevel .t2 @@ -3786,7 +4139,7 @@ test textDisp-33.2 {one line longer than fits in the widget} { .tt debug 1 set tk_textHeightCalc "" .tt insert 1.0 [string repeat "more wrap + " 1] - after 100 ; update + after 100 ; update idletasks # Nothing should have been recalculated. set tk_textHeightCalc } {} @@ -3866,7 +4219,23 @@ test textDisp-34.1 {Text widgets multi-scrolling problem: Bug 2677890} -setup { return $result } -cleanup { destroy .t1 .sy -} -result {{0.0 1.0} {0.0 1.0} {0.0 1.0} {0.0 0.24}} +} -result {{0.0 0.24} {0.0 0.24} {0.0 0.24} {0.0 0.24}} + +test textDisp-35.1 {Init value of charHeight - Dancing scrollbar bug 1499165} -setup { + pack [text .t1] -fill both -expand y -side left + .t insert end "[string repeat a\nb\nc\n 500000]THE END\n" + set res {} +} -body { + .t see 10000.0 + after 300 {set fr1 [.t yview] ; set done 1} + vwait done + after 300 {set fr2 [.t yview] ; set done 1} + vwait done + lappend res [expr {[lindex $fr1 0] == [lindex $fr2 0]}] + lappend res [expr {[lindex $fr1 1] == [lindex $fr2 1]}] +} -cleanup { + destroy .t1 +} -result {1 1} deleteWindows option clear diff --git a/tests/textImage.test b/tests/textImage.test index 24246cc..4bb190c 100644 --- a/tests/textImage.test +++ b/tests/textImage.test @@ -316,8 +316,7 @@ test textImage-3.1 {image change propagation} -setup { image delete vary } -result {{base:0 0 5 5} {10:0 0 10 10} {20:0 0 20 20} {40:0 0 40 40}} -# Fails in some environments (both in Linux and winXP) -test textImage-3.2 {delayed image management} -setup { +test textImage-3.2 {delayed image management, see also bug 1591493} -setup { destroy .t set result "" } -body { @@ -329,14 +328,16 @@ test textImage-3.2 {delayed image management} -setup { pack .t .t image create end -name test update - lappend result [.t bbox test] + foreach {x1 y1 w1 h1} [.t bbox test] {} + lappend result [list $x1 $w1 $h1] .t image configure test -image small -align top update - lappend result [.t bbox test] + foreach {x2 y2 w2 h2} [.t bbox test] {} + lappend result [list [expr {$x1==$x2}] [expr {$w2>0}] [expr {$h2>0}]] } -cleanup { destroy .t image delete small -} -result {{} {0 0 5 5}} +} -result {{0 0 0} {1 1 1}} # some temporary random tests diff --git a/tests/textIndex.test b/tests/textIndex.test index c949b1f..83a249e 100644 --- a/tests/textIndex.test +++ b/tests/textIndex.test @@ -905,6 +905,21 @@ test textIndex-22.12 {text index wordstart, unicode} { test textIndex-22.13 {text index wordstart, unicode} { text_test_word wordstart "\uc700\uc700 abc" 8 } 3 +test textIndex-22.14 {text index wordstart, unicode, start index at internal segment start} { + catch {destroy .t} + text .t + .t insert end "C'est du texte en fran\u00e7ais\n" + .t insert end "\u042D\u0442\u043E\u0020\u0442\u0435\u043A\u0441\u0442\u0020\u043D\u0430\u0020\u0440\u0443\u0441\u0441\u043A\u043E\u043C" + .t mark set insert 1.23 + set res [.t index "1.23 wordstart"] + .t mark set insert 2.16 + lappend res [.t index "2.16 wordstart"] [.t index "2.15 wordstart"] +} {1.18 2.13 2.13} +test textIndex-22.15 {text index display wordstart} { + catch {destroy .t} + text .t + .t index "1.0 display wordstart" ; # used to crash +} 1.0 test textIndex-23.1 {text paragraph start} { pack [text .t2] @@ -928,6 +943,19 @@ test textIndex-24.1 {text mark prev} { set res } {1.0} +test textIndex-25.1 {IndexCountBytesOrdered, bug [3f1f79abcf]} { + pack [text .t2] + .t2 tag configure elided -elide 1 + .t2 insert end "01\n02\n03\n04\n05\n06\n07\n08\n09\n10\n" + .t2 insert end "11\n12\n13\n14\n15\n16\n17\n18\n19\n20\n" + .t2 insert end "21\n22\n23\n25\n26\n27\n28\n29\n30\n31" + .t2 insert end "32\n33\n34\n36\n37\n38\n39" elided + # then this used to crash Tk: + .t2 see end + focus -force .t2 ; # to see the cursor blink + destroy .t2 +} {} + # cleanup rename textimage {} catch {destroy .t} diff --git a/tests/textWind.test b/tests/textWind.test index c3483e6..27b7309 100644 --- a/tests/textWind.test +++ b/tests/textWind.test @@ -1458,6 +1458,23 @@ test textWind-17.10 {peer widget window configuration} -setup { destroy .tt .t } -result {{-window {} {} {} {}} {-window {} {} {} {}} {-window {} {} {} .t.f} {-window {} {} {} .tt.t.f}} +test textWind-18.1 {embedded window deletion triggered by a script bound to <Map>} -setup { + catch {destroy .t .f .f2} +} -body { + pack [text .t] + for {set i 1} {$i < 100} {incr i} {.t insert end "Line $i\n"} + .t window create end -window [frame .f -background red -width 80 -height 80] + .t window create end -window [frame .f2 -background blue -width 80 -height 80] + bind .f <Map> {.t delete .f} + update + # this shall not crash (bug 1501749) + after 100 {.t yview end} + tkwait visibility .f2 + update +} -cleanup { + destroy .t .f .f2 +} -result {} + option clear # cleanup diff --git a/tests/ttk/spinbox.test b/tests/ttk/spinbox.test index 3397e37..32b77af 100644 --- a/tests/ttk/spinbox.test +++ b/tests/ttk/spinbox.test @@ -143,8 +143,8 @@ test spinbox-1.8.4 "-validate option: " -setup { .sb configure -validate all -validatecommand {lappend ::spinbox_test %P} pack .sb .sb set 50 - focus .sb - after 100 {set ::spinbox_wait 1} ; vwait ::spinbox_wait + focus -force .sb + after 500 {set ::spinbox_wait 1} ; vwait ::spinbox_wait set ::spinbox_test } -cleanup { destroy .sb diff --git a/tests/winButton.test b/tests/winButton.test index 8bf1d01..88b4345 100644 --- a/tests/winButton.test +++ b/tests/winButton.test @@ -22,8 +22,10 @@ option clear # ---------------------------------------------------------------------- test winbutton-1.1 {TkpComputeButtonGeometry procedure} -constraints { - testImageType win + testImageType win nonPortable } -setup { + # nonPortable because of [3e3e25f483]: on Win7 first started with a high DPI screen + # the smallest size (i.e. 8) is not available for "MS Sans Serif" font deleteWindows } -body { image create test image1 @@ -47,7 +49,11 @@ test winbutton-1.1 {TkpComputeButtonGeometry procedure} -constraints { image delete image1 } -result {68 48 70 50 90 52 90 52} -test winbutton-1.2 {TkpComputeButtonGeometry procedure} -constraints win -setup { +test winbutton-1.2 {TkpComputeButtonGeometry procedure} -constraints { + win nonPortable +} -setup { + # nonPortable because of [3e3e25f483]: on Win7 first started with a high DPI screen + # the smallest size (i.e. 8) is not available for "MS Sans Serif" font deleteWindows } -body { label .b1 -bitmap question -bd 3 -padx 0 -pady 2 diff --git a/tests/winDialog.test b/tests/winDialog.test index 8aa9ac3..c8c36bf 100644 --- a/tests/winDialog.test +++ b/tests/winDialog.test @@ -22,9 +22,26 @@ testConstraint english [expr { && (([testwinlocale] & 0xff) == 9) }] +proc vista? {{prevista 0} {postvista 1}} { + lassign [split $::tcl_platform(osVersion) .] major + return [expr {$major >= 6 ? $postvista : $prevista}] +} + +# What directory to use in initialdir tests. Old code used to use +# c:/. However, on Vista/later that is a protected directory if you +# are not running privileged. Moreover, not everyone has a drive c: +# but not having a TEMP would break a lot Windows programs +proc initialdir {} { + # file join to return in Tcl canonical format (/ separator, not \) + #return [file join $::env(TEMP)] + return [tcltest::temporaryDirectory] +} + + proc start {arg} { set ::tk_dialog 0 set ::iter_after 0 + set ::dialogclass "#32770" after 1 $arg } @@ -34,19 +51,35 @@ proc then {cmd} { set ::dialogresult {} set ::testfont {} - afterbody + # Do not make the delay too short. The newer Vista dialogs take + # time to come up. Even if the testforwindow returns true, the + # controls are not ready to accept messages + after 500 afterbody vwait ::dialogresult return $::dialogresult } proc afterbody {} { - if {$::tk_dialog == 0} { - if {[incr ::iter_after] > 30} { - set ::dialogresult ">30 iterations waiting on tk_dialog" + # On Vista and later, using the new file dialogs we have to find + # the window using its title as tk_dialog will not be set at the C level + if {[vista?]} { + if {[catch {testfindwindow "" $::dialogclass} ::tk_dialog]} { + if {[incr ::iter_after] > 30} { + set ::dialogresult ">30 iterations waiting on tk_dialog" + return + } + after 150 {afterbody} + return + } + } else { + if {$::tk_dialog == 0} { + if {[incr ::iter_after] > 30} { + set ::dialogresult ">30 iterations waiting on tk_dialog" + return + } + after 150 {afterbody} return } - after 150 {afterbody} - return } uplevel #0 {set dialogresult [eval $command]} } @@ -205,7 +238,7 @@ test winDialog-5.2 {GetFileName: one argument} -constraints { test winDialog-5.3 {GetFileName: many arguments} -constraints { nt testwinevent } -body { - start {tk_getOpenFile -initialdir c:/ -parent . -title test -initialfile foo} + start {tk_getOpenFile -initialdir [initialdir] -parent . -title test -initialfile foo} then { Click cancel } @@ -218,64 +251,214 @@ test winDialog-5.4 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} -constraints { test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} -constraints { nt testwinevent } -body { - start {tk_getOpenFile -title bar} - then { + start {set x [tk_getOpenFile -title bar]} + set y [then { Click cancel - } + }] + # Note this also tests fix for + # http://core.tcl.tk/tk/tktview/4a0451f5291b3c9168cc560747dae9264e1d2ef6 + # $x is expected to be empty + append x $y } -result {0} test winDialog-5.6 {GetFileName: valid option, but missing value} -constraints { nt } -body { tk_getOpenFile -initialdir bar -title } -returnCodes error -result {value for "-title" missing} + test winDialog-5.7 {GetFileName: extension begins with .} -constraints { nt testwinevent } -body { -# if (string[0] == '.') { -# string++; -# } - start {set x [tk_getSaveFile -defaultextension .foo -title Save]} set msg {} then { - if {[catch {SetText 0x47C bar} msg]} { + if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { + Click cancel + } else { + Click ok + } + } + set x "[file tail $x]$msg" +} -cleanup { + unset msg +} -result bar.foo + +test winDialog-5.7.1 {GetFileName: extension {} } -constraints { + nt testwinevent +} -body { + start {set x [tk_getSaveFile -defaultextension {} -title Save]} + set msg {} + then { + if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { + Click cancel + } else { + Click ok + } + } + set x "[file tail $x]$msg" +} -cleanup { + unset msg +} -result bar + +test winDialog-5.7.2 {GetFileName: extension {} Bug 47af31bd3ac6fbbb33cde1a5bab1e756ff2a6e00 } -constraints { + nt testwinevent +} -body { + start {set x [tk_getSaveFile -filetypes {{All *}} -defaultextension {} -title Save]} + set msg {} + then { + if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { + Click cancel + } else { + Click ok + } + } + set x "[file tail $x]$msg" +} -cleanup { + unset msg +} -result bar + +test winDialog-5.7.3 {GetFileName: extension {} Bug 47af31bd3ac6fbbb33cde1a5bab1e756ff2a6e00 } -constraints { + nt testwinevent +} -body { + start {set x [tk_getSaveFile -filetypes {{All *}} -defaultextension {} -title Save]} + set msg {} + then { + if {[catch {SetText [vista? 0x47C 0x3e9] bar.c} msg]} { + Click cancel + } else { + Click ok + } + } + set x "[file tail $x]$msg" +} -cleanup { + unset msg +} -result bar.c + +test winDialog-5.7.4 {GetFileName: extension {} } -constraints { + nt testwinevent +} -body { + # Although the docs do not explicitly mention, -filetypes seems to + # override -defaultextension + start {set x [tk_getSaveFile -filetypes {{C .c} {Tcl .tcl}} -defaultextension {foo} -title Save]} + set msg {} + then { + if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { + Click cancel + } else { + Click ok + } + } + set x "[file tail $x]$msg" +} -cleanup { + unset msg +} -result bar.c + +test winDialog-5.7.5 {GetFileName: extension {} } -constraints { + nt testwinevent +} -body { + # Although the docs do not explicitly mention, -filetypes seems to + # override -defaultextension + start {set x [tk_getSaveFile -filetypes {{C .c} {Tcl .tcl}} -defaultextension {} -title Save]} + set msg {} + then { + if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { Click cancel } else { Click ok } } - string totitle $x$msg + set x "[file tail $x]$msg" } -cleanup { unset msg -} -result [string totitle [file join [pwd] bar.foo]] +} -result bar.c + + +test winDialog-5.7.6 {GetFileName: All/extension } -constraints { + nt testwinevent +} -body { + # In 8.6.4 this combination resulted in bar.ext.ext which is bad + start {set x [tk_getSaveFile -filetypes {{All *}} -defaultextension {ext} -title Save]} + set msg {} + then { + if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { + Click cancel + } else { + Click ok + } + } + set x "[file tail $x]$msg" +} -cleanup { + unset msg +} -result bar.ext + +test winDialog-5.7.7 {tk_getOpenFile: -defaultextension} -constraints { + nt testwinevent +} -body { + unset -nocomplain x + tcltest::makeFile "" "5 7 7.ext" [initialdir] + start {set x [tk_getOpenFile \ + -defaultextension ext \ + -initialdir [file nativename [initialdir]] \ + -initialfile "5 7 7" -title Foo]} + then { + Click ok + } + return $x +} -result [file join [initialdir] "5 7 7.ext"] + +test winDialog-5.7.8 {tk_getOpenFile: -defaultextension} -constraints { + nt testwinevent +} -body { + unset -nocomplain x + tcltest::makeFile "" "5 7 8.ext" [initialdir] + start {set x [tk_getOpenFile \ + -defaultextension ext \ + -initialdir [file nativename [initialdir]] \ + -initialfile "5 7 8.ext" -title Foo]} + then { + Click ok + } + return $x +} -result [file join [initialdir] "5 7 8.ext"] + test winDialog-5.8 {GetFileName: extension doesn't begin with .} -constraints { nt testwinevent } -body { start {set x [tk_getSaveFile -defaultextension foo -title Save]} set msg {} then { - if {[catch {SetText 0x47C bar} msg]} { + if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { Click cancel } else { Click ok } } - string totitle $x$msg + set x "[file tail $x]$msg" } -cleanup { unset msg -} -result [string totitle [file join [pwd] bar.foo]] +} -result bar.foo test winDialog-5.9 {GetFileName: file types} -constraints { nt testwinevent } -body { -# case FILE_TYPES: - + # case FILE_TYPES: + start {tk_getSaveFile -filetypes {{"foo files" .foo FOOF}} -title Foo} - then { - set x [GetText 0x470] - Click cancel + # XXX - currently disabled for vista style dialogs because the file + # types control has no control ID and we don't have a mechanism to + # locate it. + if {[vista?]} { + then { + Click cancel + } + return 1 + } else { + then { + set x [GetText 0x470] + Click cancel + } + return [string equal $x {foo files (*.foo)}] } - return $x -} -result {foo files (*.foo)} +} -result 1 test winDialog-5.10 {GetFileName: file types: MakeFilter() fails} -constraints { nt } -body { @@ -283,21 +466,20 @@ test winDialog-5.10 {GetFileName: file types: MakeFilter() fails} -constraints { tk_getSaveFile -filetypes {{"foo" .foo FOO}} } -returnCodes error -result {bad Macintosh file type "FOO"} -if {[info exists ::env(TEMP)]} { test winDialog-5.11 {GetFileName: initial directory} -constraints { nt testwinevent } -body { # case FILE_INITDIR: - + unset -nocomplain x start {set x [tk_getSaveFile \ - -initialdir [file normalize $::env(TEMP)] \ + -initialdir [initialdir] \ -initialfile "12x 455" -title Foo]} then { Click ok } return $x -} -result [file join [file normalize $::env(TEMP)] "12x 455"] -} +} -result [file join [initialdir] "12x 455"] + test winDialog-5.12 {GetFileName: initial directory: Tcl_TranslateFilename()} -constraints { nt } -body { @@ -305,6 +487,199 @@ test winDialog-5.12 {GetFileName: initial directory: Tcl_TranslateFilename()} -c tk_getOpenFile -initialdir ~12x/455 } -returnCodes error -result {user "12x" doesn't exist} + +test winDialog-5.12.1 {tk_getSaveFile: initial directory: ~} -constraints { + nt testwinevent +} -body { + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir ~ \ + -initialfile "5 12 1" -title Foo]} + then { + Click ok + } + return $x +} -result [file normalize [file join ~ "5 12 1"]] + +test winDialog-5.12.2 {tk_getSaveFile: initial directory: ~user} -constraints { + nt testwinevent +} -body { + + # Note: this test will fail on Tcl versions 8.6.4 and earlier due + # to a bug in file normalize for names of the form ~xxx that + # returns the wrong dir on Windows. In particular (in Win8 at + # least) it returned /users/Default instead of /users/USERNAME... + + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir ~$::tcl_platform(user) \ + -initialfile "5 12 2" -title Foo]} + then { + Click ok + } + return $x +} -result [file normalize [file join ~$::tcl_platform(user) "5 12 2"]] + +test winDialog-5.12.3 {tk_getSaveFile: initial directory: .} -constraints { + nt testwinevent +} -body { + # Windows remembers dirs from previous selections so use + # a subdir for this test, not [initialdir] itself + set newdir [tcltest::makeDirectory "5 12 3"] + set cur [pwd] + try { + cd $newdir + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir . \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + } finally { + cd $cur + } + string equal $x [file join $newdir testfile] +} -result 1 + +test winDialog-5.12.4 {tk_getSaveFile: initial directory: unicode} -constraints { + nt testwinevent +} -body { + set dir [tcltest::makeDirectory "\u0167\u00e9\u015d\u0167"] + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir $dir \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + string equal $x [file join $dir testfile] +} -result 1 + +test winDialog-5.12.5 {tk_getSaveFile: initial directory: nativename} -constraints { + nt testwinevent +} -body { + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir [file nativename [initialdir]] \ + -initialfile "5 12 5" -title Foo]} + then { + Click ok + } + return $x +} -result [file join [initialdir] "5 12 5"] + +test winDialog-5.12.6 {tk_getSaveFile: initial directory: relative} -constraints { + nt testwinevent +} -body { + # Windows remembers dirs from previous selections so use + # a subdir for this test, not [initialdir] itself + set dir [tcltest::makeDirectory "5 12 6"] + set cur [pwd] + try { + cd [file dirname $dir] + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir "5 12 6" \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + } finally { + cd $cur + } + string equal $x [file join $dir testfile] +} -result 1 + +test winDialog-5.12.7 {tk_getOpenFile: initial directory: ~} -constraints { + nt testwinevent +} -body { + set fn [file tail [lindex [glob -types f ~/*] 0]] + unset -nocomplain x + start {set x [tk_getOpenFile \ + -initialdir ~ \ + -initialfile $fn -title Foo]} + then { + Click ok + } + string equal $x [file normalize [file join ~ $fn]] +} -result 1 + +test winDialog-5.12.8 {tk_getOpenFile: initial directory: .} -constraints { + nt testwinevent +} -body { + # Windows remembers dirs from previous selections so use + # a subdir for this test, not [initialdir] itself + set newdir [tcltest::makeDirectory "5 12 8"] + set path [tcltest::makeFile "" "testfile" $newdir] + set cur [pwd] + try { + cd $newdir + unset -nocomplain x + start {set x [tk_getOpenFile \ + -initialdir . \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + } finally { + cd $cur + } + string equal $x $path +} -result 1 + +test winDialog-5.12.9 {tk_getOpenFile: initial directory: unicode} -constraints { + nt testwinevent +} -body { + set dir [tcltest::makeDirectory "\u0167\u00e9\u015d\u0167"] + set path [tcltest::makeFile "" testfile $dir] + unset -nocomplain x + start {set x [tk_getOpenFile \ + -initialdir $dir \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + string equal $x $path +} -result 1 + +test winDialog-5.12.10 {tk_getOpenFile: initial directory: nativename} -constraints { + nt testwinevent +} -body { + unset -nocomplain x + tcltest::makeFile "" "5 12 10" [initialdir] + start {set x [tk_getOpenFile \ + -initialdir [file nativename [initialdir]] \ + -initialfile "5 12 10" -title Foo]} + then { + Click ok + } + return $x +} -result [file join [initialdir] "5 12 10"] + +test winDialog-5.12.11 {tk_getOpenFile: initial directory: relative} -constraints { + nt testwinevent +} -body { + # Windows remembers dirs from previous selections so use + # a subdir for this test, not [initialdir] itself + set dir [tcltest::makeDirectory "5 12 11"] + set path [tcltest::makeFile "" testfile $dir] + set cur [pwd] + try { + cd [file dirname $dir] + unset -nocomplain x + start {set x [tk_getOpenFile \ + -initialdir [file tail $dir] \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + } finally { + cd $cur + } + string equal $x $path +} -result 1 + test winDialog-5.13 {GetFileName: initial file} -constraints { nt testwinevent } -body { @@ -314,27 +689,31 @@ test winDialog-5.13 {GetFileName: initial file} -constraints { then { Click ok } - string totitle $x -} -result [string totitle [file join [pwd] "12x 456"]] + file tail $x +} -result "12x 456" test winDialog-5.14 {GetFileName: initial file: Tcl_TranslateFileName()} -constraints { nt } -body { # if (Tcl_TranslateFileName(interp, string, &ds) == NULL) tk_getOpenFile -initialfile ~12x/455 } -returnCodes error -result {user "12x" doesn't exist} -test winDialog-5.15 {GetFileName: initial file: long name} -constraints { - nt testwinevent -} -body { - start { - set dialogresult [catch { - tk_getSaveFile -initialfile [string repeat a 1024] -title Long - } x] - } - then { - Click ok - } - list $dialogresult [string match "invalid filename *" $x] -} -result {1 1} +if {![vista?]} { + # XXX - disabled for Vista because the new dialogs allow long file + # names to be specified but force the user to change it. + test winDialog-5.15 {GetFileName: initial file: long name} -constraints { + nt testwinevent + } -body { + start { + set dialogresult [catch { + tk_getSaveFile -initialfile [string repeat a 1024] -title Long + } x] + } + then { + Click ok + } + list $dialogresult [string match "invalid filename *" $x] + } -result {1 1} +} test winDialog-5.16 {GetFileName: parent} -constraints { nt } -body { @@ -358,18 +737,34 @@ test winDialog-5.17 {GetFileName: title} -constraints { Click cancel } } -result {0} -test winDialog-5.18 {GetFileName: no filter specified} -constraints { - nt testwinevent -} -body { -# if (ofn.lpstrFilter == NULL) +if {[vista?]} { + # In the newer file dialogs, the file type widget does not even exist + # if no file types specified + test winDialog-5.18 {GetFileName: no filter specified} -constraints { + nt testwinevent + } -body { + # if (ofn.lpstrFilter == NULL) + start {tk_getOpenFile -title Filter} + then { + catch {set x [GetText 0x470]} y + Click cancel + } + return $y + } -result {Could not find control with id 1136} +} else { + test winDialog-5.18 {GetFileName: no filter specified} -constraints { + nt testwinevent + } -body { + # if (ofn.lpstrFilter == NULL) - start {tk_getOpenFile -title Filter} - then { - set x [GetText 0x470] - Click cancel - } - return $x -} -result {All Files (*.*)} + start {tk_getOpenFile -title Filter} + then { + set x [GetText 0x470] + Click cancel + } + return $x + } -result {All Files (*.*)} +} test winDialog-5.19 {GetFileName: parent HWND doesn't yet exist} -constraints { nt } -setup { @@ -419,15 +814,14 @@ test winDialog-5.22 {GetFileName: call GetSaveFileName} -constraints { } return $x } -result {&Save} -if {[info exists ::env(TEMP)]} { test winDialog-5.23 {GetFileName: convert \ to /} -constraints { nt testwinevent } -body { set msg {} start {set x [tk_getSaveFile -title Back]} then { - if {[catch {SetText 0x47C [file nativename \ - [file join [file normalize $::env(TEMP)] "12x 457"]]} msg]} { + if {[catch {SetText [vista? 0x47C 0x3e9] [file nativename \ + [file join [initialdir] "12x 457"]]} msg]} { Click cancel } else { Click ok @@ -436,8 +830,7 @@ test winDialog-5.23 {GetFileName: convert \ to /} -constraints { return $x$msg } -cleanup { unset msg -} -result [file join [file normalize $::env(TEMP)] "12x 457"] -} +} -result [file join [initialdir] "12x 457"] test winDialog-5.24 {GetFileName: file types: MakeFilter() succeeds} -constraints { nt } -body { @@ -478,10 +871,12 @@ test winDialog-8.1 {OFNHookProc} -constraints {emptyTest nt} -body {} test winDialog-9.1 {Tk_ChooseDirectoryObjCmd: no arguments} -constraints { nt testwinevent } -body { - start {tk_chooseDirectory} - then { + start {set x [tk_chooseDirectory]} + set y [then { Click cancel - } + }] + # $x should be "" on a Cancel + append x $y } -result {0} test winDialog-9.2 {Tk_ChooseDirectoryObjCmd: one argument} -constraints { nt @@ -492,7 +887,7 @@ test winDialog-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} -constraints { nt testwinevent } -body { start { - tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test + tk_chooseDirectory -initialdir [initialdir] -mustexist 1 -parent . -title test } then { Click cancel @@ -521,12 +916,12 @@ test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} -constraints { } -body { # case DIR_INITIAL: - start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]} + start {set x [tk_chooseDirectory -initialdir [initialdir] -title Foo]} then { Click ok } string tolower [set x] -} -result {c:/} +} -result [string tolower [initialdir]] test winDialog-9.8 {Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFilename()} -constraints { nt } -body { diff --git a/unix/Makefile.in b/unix/Makefile.in index f21fdbb..96f1408 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -709,10 +709,6 @@ install-strip: INSTALL_PROGRAM="$(INSTALL_PROGRAM) ${INSTALL_STRIP_PROGRAM}" \ INSTALL_LIBRARY="$(INSTALL_LIBRARY) ${INSTALL_STRIP_LIBRARY}" -# Note: before running ranlib below, must cd to target directory because -# some ranlibs write to current directory, and this might not always be -# possible (e.g. if installing as root). - install-binaries: $(TK_STUB_LIB_FILE) $(TK_LIB_FILE) ${WISH_EXE} @for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" \ "$(PKG_INSTALL_DIR)" "$(CONFIG_INSTALL_DIR)" ; \ @@ -1578,18 +1574,13 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tkConfig.h.in $(UNIX_DIR)/tk.pc.in $(M $(TOP_DIR)/win/aclocal.m4 $(TOP_DIR)/win/tcl.m4 \ $(DISTDIR)/win cp -p $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.bat $(DISTDIR)/win - $(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/*.bat cp -p $(TOP_DIR)/win/makefile.* $(DISTDIR)/win - $(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/makefile.* cp -p $(TOP_DIR)/win/rules.vc $(DISTDIR)/win - $(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/rules.vc cp -p $(TOP_DIR)/win/README $(DISTDIR)/win cp -p $(TOP_DIR)/license.terms $(DISTDIR)/win mkdir $(DISTDIR)/win/rc cp -p $(TOP_DIR)/win/wish.exe.manifest.in $(DISTDIR)/win/ cp -p $(TOP_DIR)/win/rc/*.{rc,cur,ico,bmp} $(DISTDIR)/win/rc - $(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/rc/*.rc - $(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/wish.exe.manifest.in mkdir $(DISTDIR)/macosx cp -p $(MAC_OSX_DIR)/GNUmakefile $(MAC_OSX_DIR)/README \ $(MAC_OSX_DIR)/*.icns $(MAC_OSX_DIR)/*.tiff \ @@ -1608,7 +1599,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tkConfig.h.in $(UNIX_DIR)/tk.pc.in $(M $(DISTDIR)/macosx/Tk.xcodeproj mkdir $(DISTDIR)/compat cp -p $(TOP_DIR)/license.terms $(TCLDIR)/compat/unistd.h \ - $(TCLDIR)/compat/stdlib.h $(TCLDIR)/compat/limits.h \ + $(TCLDIR)/compat/stdlib.h \ $(DISTDIR)/compat mkdir $(DISTDIR)/xlib cp -p $(XLIB_DIR)/*.[ch] $(DISTDIR)/xlib diff --git a/unix/configure b/unix/configure index ab4f9f6..8f9a4ac 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=".1" +TK_PATCH_LEVEL=".4" VERSION=${TK_VERSION} LOCALES="cs da de el en en_gb eo es fr hu it nl pl pt ru sv" @@ -2692,8 +2692,11 @@ _ACEOF esac -# limits header checks must come early to prevent -# an autoconf bug that throws errors on configure +#-------------------------------------------------------------------- +# Supply a substitute for stdlib.h if it doesn't define strtol, +# strtoul, or strtod (which it doesn't in some versions of SunOS). +#-------------------------------------------------------------------- + ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' @@ -3182,164 +3185,6 @@ fi done -if test "${ac_cv_header_limits_h+set}" = set; then - echo "$as_me:$LINENO: checking for limits.h" >&5 -echo $ECHO_N "checking for limits.h... $ECHO_C" >&6 -if test "${ac_cv_header_limits_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -fi -echo "$as_me:$LINENO: result: $ac_cv_header_limits_h" >&5 -echo "${ECHO_T}$ac_cv_header_limits_h" >&6 -else - # Is the header compilable? -echo "$as_me:$LINENO: checking limits.h usability" >&5 -echo $ECHO_N "checking limits.h usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -#include <limits.h> -_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 - ac_header_compiler=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_header_compiler=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 - -# Is the header present? -echo "$as_me:$LINENO: checking limits.h presence" >&5 -echo $ECHO_N "checking limits.h presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include <limits.h> -_ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes -fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_header_preproc=no -fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 - -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: limits.h: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: limits.h: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: limits.h: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: limits.h: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: limits.h: present but cannot be compiled" >&5 -echo "$as_me: WARNING: limits.h: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: limits.h: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: limits.h: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: limits.h: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: limits.h: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: limits.h: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: limits.h: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: limits.h: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: limits.h: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: limits.h: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: limits.h: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ----------------------------- ## -## Report this to the tk lists. ## -## ----------------------------- ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for limits.h" >&5 -echo $ECHO_N "checking for limits.h... $ECHO_C" >&6 -if test "${ac_cv_header_limits_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - ac_cv_header_limits_h=$ac_header_preproc -fi -echo "$as_me:$LINENO: result: $ac_cv_header_limits_h" >&5 -echo "${ECHO_T}$ac_cv_header_limits_h" >&6 - -fi -if test $ac_cv_header_limits_h = yes; then - -cat >>confdefs.h <<\_ACEOF -#define HAVE_LIMITS_H 1 -_ACEOF - -else - -cat >>confdefs.h <<\_ACEOF -#define NO_LIMITS_H 1 -_ACEOF - -fi - - - -#-------------------------------------------------------------------- -# Supply a substitute for stdlib.h if it doesn't define strtol, -# strtoul, or strtod (which it doesn't in some versions of SunOS). -#-------------------------------------------------------------------- - if test "${ac_cv_header_stdlib_h+set}" = set; then echo "$as_me:$LINENO: checking for stdlib.h" >&5 echo $ECHO_N "checking for stdlib.h... $ECHO_C" >&6 @@ -4852,8 +4697,7 @@ fi LD_SEARCH_FLAGS="" TCL_NEEDS_EXP_FILE=1 TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.dll.a' - TCL_SHLIB_LD_EXTRAS='-Wl,--out-implib,$@.a' - TK_SHLIB_LD_EXTRAS='-Wl,--out-implib,$@.a' + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$@.a" echo "$as_me:$LINENO: checking for Cygwin version of gcc" >&5 echo $ECHO_N "checking for Cygwin version of gcc... $ECHO_C" >&6 if test "${ac_cv_cygwin+set}" = set; then @@ -5519,7 +5363,14 @@ fi LDFLAGS="" ;; *) - SHLIB_CFLAGS="-fPIC" + case "$arch" in + alpha|sparc|sparc64) + SHLIB_CFLAGS="-fPIC" + ;; + *) + SHLIB_CFLAGS="-fpic" + ;; + esac SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" @@ -5586,8 +5437,7 @@ fi # This configuration from FreeBSD Ports. SHLIB_CFLAGS="-fPIC" SHLIB_LD="${CC} -shared" - TCL_SHLIB_LD_EXTRAS="-Wl,-soname=\$@" - TK_SHLIB_LD_EXTRAS="-Wl,-soname,\$@" + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$@" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" @@ -5606,11 +5456,15 @@ fi LDFLAGS="$LDFLAGS $PTHREAD_LIBS" fi - # Version numbers are dot-stripped by system policy. - TCL_TRIM_DOTS=`echo ${VERSION} | tr -d .` - UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' - SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so.1' - TCL_LIB_VERSIONS_OK=nodots + case $system in + FreeBSD-3.*) + # Version numbers are dot-stripped by system policy. + TCL_TRIM_DOTS=`echo ${VERSION} | tr -d .` + UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' + SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so' + TCL_LIB_VERSIONS_OK=nodots + ;; + esac ;; Darwin-*) CFLAGS_OPTIMIZE="-Os" @@ -6821,10 +6675,10 @@ fi if test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""; then LIB_SUFFIX=${SHARED_LIB_SUFFIX} - MAKE_LIB='${SHLIB_LD} -o $@ ${OBJS} ${TCL_SHLIB_LD_EXTRAS} ${SHLIB_LD_LIBS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}' + MAKE_LIB='${SHLIB_LD} -o $@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}' if test "${SHLIB_SUFFIX}" = ".dll"; then - INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)"' + INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)";if test -f $(LIB_FILE).a; then $(INSTALL_DATA) $(LIB_FILE).a "$(LIB_INSTALL_DIR)"; fi;' DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)" else @@ -6841,15 +6695,14 @@ else if test "$RANLIB" = ""; then MAKE_LIB='$(STLIB_LD) $@ ${OBJS}' - INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' else MAKE_LIB='${STLIB_LD} $@ ${OBJS} ; ${RANLIB} $@' - INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(LIB_FILE))' fi + INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' fi @@ -6858,15 +6711,14 @@ fi if test "$RANLIB" = ""; then MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS}' - INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)"' else MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS} ; ${RANLIB} $@' - INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(STUB_LIB_FILE))' fi + INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)"' # Define TCL_LIBS now that we know what DL_LIBS is. # The trick here is that we don't want to change the value of TCL_LIBS if @@ -9631,7 +9483,7 @@ cat >>confdefs.h <<\_ACEOF _ACEOF LIBS="$LIBS -framework Cocoa -framework Carbon -framework IOKit" - EXTRA_CC_SWITCHES='-std=gnu99 -x objective-c -fobjc-gc' + EXTRA_CC_SWITCHES='-std=gnu99 -x objective-c' TK_WINDOWINGSYSTEM=AQUA if test -n "${enable_symbols}" -a "${enable_symbols}" != no; then diff --git a/unix/configure.in b/unix/configure.in index 948eae2..5a18d46 100644 --- 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=".1" +TK_PATCH_LEVEL=".4" VERSION=${TK_VERSION} LOCALES="cs da de el en en_gb eo es fr hu it nl pl pt ru sv" @@ -81,12 +81,6 @@ fi AC_PROG_CC AC_C_INLINE -# limits header checks must come early to prevent -# an autoconf bug that throws errors on configure -AC_CHECK_HEADER(limits.h, - [AC_DEFINE(HAVE_LIMITS_H, 1, [Do we have <limits.h>?])], - [AC_DEFINE(NO_LIMITS_H, 1, [Do we have <limits.h>?])]) - #-------------------------------------------------------------------- # Supply a substitute for stdlib.h if it doesn't define strtol, # strtoul, or strtod (which it doesn't in some versions of SunOS). @@ -369,7 +363,7 @@ fi if test $tk_aqua = yes; then AC_DEFINE(MAC_OSX_TK, 1, [Are we building TkAqua?]) LIBS="$LIBS -framework Cocoa -framework Carbon -framework IOKit" - EXTRA_CC_SWITCHES='-std=gnu99 -x objective-c -fobjc-gc' + EXTRA_CC_SWITCHES='-std=gnu99 -x objective-c' TK_WINDOWINGSYSTEM=AQUA if test -n "${enable_symbols}" -a "${enable_symbols}" != no; then AC_DEFINE(TK_MAC_DEBUG, 1, [Are TkAqua debug messages enabled?]) diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 25137d0..41b94ef 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -1217,8 +1217,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ LD_SEARCH_FLAGS="" TCL_NEEDS_EXP_FILE=1 TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.dll.a' - SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,$[@].a" - TK_SHLIB_LD_EXTRAS='-Wl,--out-implib,$[@].a' + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$[@].a" AC_CACHE_CHECK(for Cygwin version of gcc, ac_cv_cygwin, AC_TRY_COMPILE([ @@ -1476,7 +1475,14 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ LDFLAGS="" ;; *) - SHLIB_CFLAGS="-fPIC" + case "$arch" in + alpha|sparc|sparc64) + SHLIB_CFLAGS="-fPIC" + ;; + *) + SHLIB_CFLAGS="-fpic" + ;; + esac SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" @@ -1531,8 +1537,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ # This configuration from FreeBSD Ports. SHLIB_CFLAGS="-fPIC" SHLIB_LD="${CC} -shared" - SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname=\$[@]" - TK_SHLIB_LD_EXTRAS="-Wl,-soname,\$[@]" + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$[@]" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" @@ -1545,11 +1550,15 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ LIBS=`echo $LIBS | sed s/-pthread//` CFLAGS="$CFLAGS $PTHREAD_CFLAGS" LDFLAGS="$LDFLAGS $PTHREAD_LIBS"]) - # Version numbers are dot-stripped by system policy. - TCL_TRIM_DOTS=`echo ${VERSION} | tr -d .` - UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' - SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so.1' - TCL_LIB_VERSIONS_OK=nodots + case $system in + FreeBSD-3.*) + # Version numbers are dot-stripped by system policy. + TCL_TRIM_DOTS=`echo ${VERSION} | tr -d .` + UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' + SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so' + TCL_LIB_VERSIONS_OK=nodots + ;; + esac ;; Darwin-*) CFLAGS_OPTIMIZE="-Os" @@ -2039,9 +2048,9 @@ dnl # preprocessing tests use only CPPFLAGS. AS_IF([test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""], [ LIB_SUFFIX=${SHARED_LIB_SUFFIX} - MAKE_LIB='${SHLIB_LD} -o [$]@ ${OBJS} ${TCL_SHLIB_LD_EXTRAS} ${SHLIB_LD_LIBS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}' + MAKE_LIB='${SHLIB_LD} -o [$]@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}' AS_IF([test "${SHLIB_SUFFIX}" = ".dll"], [ - INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)"' + INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)";if test -f $(LIB_FILE).a; then $(INSTALL_DATA) $(LIB_FILE).a "$(LIB_INSTALL_DIR)"; fi;' DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)" ], [ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' @@ -2051,21 +2060,19 @@ dnl # preprocessing tests use only CPPFLAGS. AS_IF([test "$RANLIB" = ""], [ MAKE_LIB='$(STLIB_LD) [$]@ ${OBJS}' - INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' ], [ MAKE_LIB='${STLIB_LD} [$]@ ${OBJS} ; ${RANLIB} [$]@' - INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(LIB_FILE))' ]) + INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' ]) # Stub lib does not depend on shared/static configuration AS_IF([test "$RANLIB" = ""], [ MAKE_STUB_LIB='${STLIB_LD} [$]@ ${STUB_LIB_OBJS}' - INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)"' ], [ MAKE_STUB_LIB='${STLIB_LD} [$]@ ${STUB_LIB_OBJS} ; ${RANLIB} [$]@' - INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(STUB_LIB_FILE))' ]) + INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)"' # Define TCL_LIBS now that we know what DL_LIBS is. # The trick here is that we don't want to change the value of TCL_LIBS if @@ -2149,7 +2156,6 @@ dnl # preprocessing tests use only CPPFLAGS. # Defines some of the following vars: # NO_DIRENT_H # NO_VALUES_H -# HAVE_LIMITS_H or NO_LIMITS_H # NO_STDLIB_H # NO_STRING_H # NO_SYS_WAIT_H @@ -2189,9 +2195,6 @@ closedir(d); AC_CHECK_HEADER(float.h, , [AC_DEFINE(NO_FLOAT_H, 1, [Do we have <float.h>?])]) AC_CHECK_HEADER(values.h, , [AC_DEFINE(NO_VALUES_H, 1, [Do we have <values.h>?])]) - AC_CHECK_HEADER(limits.h, - [AC_DEFINE(HAVE_LIMITS_H, 1, [Do we have <limits.h>?])], - [AC_DEFINE(NO_LIMITS_H, 1, [Do we have <limits.h>?])]) AC_CHECK_HEADER(stdlib.h, tcl_ok=1, tcl_ok=0) AC_EGREP_HEADER(strtol, stdlib.h, , tcl_ok=0) AC_EGREP_HEADER(strtoul, stdlib.h, , tcl_ok=0) diff --git a/unix/tk.pc.in b/unix/tk.pc.in index d84a1cf..68f2130 100644 --- a/unix/tk.pc.in +++ b/unix/tk.pc.in @@ -8,8 +8,8 @@ includedir=@includedir@ Name: The Tk Toolkit Description: Tk is a cross-platform graphical user interface toolkit, the standard GUI not only for Tcl, but for many other dynamic languages as well. URL: http://www.tcl.tk/ -Version: @TK_VERSION@ -Requires: -Conflicts: -Libs: -L${libdir} @TK_LIBS@ +Version: @TK_VERSION@@TK_PATCH_LEVEL@ +Requires: tcl >= 8.6 +Libs: -L${libdir} @TK_LIB_FLAG@ @TK_STUB_LIB_FLAG@ +Libs.private: @XFT_LIBS@ @XLIBSW@ Cflags: -I${includedir} diff --git a/unix/tk.spec b/unix/tk.spec index cafad27..af982f7 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.1 +Version: 8.6.4 Release: 2 License: BSD Group: Development/Languages diff --git a/unix/tkAppInit.c b/unix/tkAppInit.c index 9a0b053..13bcdde 100644 --- a/unix/tkAppInit.c +++ b/unix/tkAppInit.c @@ -131,7 +131,7 @@ Tcl_AppInit( */ /* - * Call Tcl_CreateCommand for application-specific commands, if they + * Call Tcl_CreateObjCommand for application-specific commands, if they * weren't already created by the init procedures called above. */ diff --git a/unix/tkConfig.h.in b/unix/tkConfig.h.in index 392566b..4fd7726 100644 --- a/unix/tkConfig.h.in +++ b/unix/tkConfig.h.in @@ -4,9 +4,6 @@ #ifndef _TKCONFIG #define _TKCONFIG -/* Define if building universal (internal helper macro) */ -#undef AC_APPLE_UNIVERSAL_BUILD - /* Define to 1 if you have the <AvailabilityMacros.h> header file. */ #undef HAVE_AVAILABILITYMACROS_H @@ -28,9 +25,6 @@ /* Define to 1 if you have the `Xft' library (-lXft). */ #undef HAVE_LIBXFT -/* Do we have <limits.h>? */ -#undef HAVE_LIMITS_H - /* Define to 1 if you have the `lseek64' function. */ #undef HAVE_LSEEK64 @@ -118,9 +112,6 @@ /* Do we have fd_set? */ #undef NO_FD_SET -/* Do we have <limits.h>? */ -#undef NO_LIMITS_H - /* Do we have <stdlib.h>? */ #undef NO_STDLIB_H @@ -136,9 +127,6 @@ /* Define to the one symbol short name of this package. */ #undef PACKAGE_TARNAME -/* Define to the home page for this package. */ -#undef PACKAGE_URL - /* Define to the version of this package. */ #undef PACKAGE_VERSION @@ -187,17 +175,9 @@ /* Do we want to use the threaded memory allocator? */ #undef USE_THREAD_ALLOC -/* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most - significant byte first (like Motorola and SPARC, unlike Intel). */ -#if defined AC_APPLE_UNIVERSAL_BUILD -# if defined __BIG_ENDIAN__ -# define WORDS_BIGENDIAN 1 -# endif -#else -# ifndef WORDS_BIGENDIAN -# undef WORDS_BIGENDIAN -# endif -#endif +/* Define to 1 if your processor stores words with the most significant byte + first (like Motorola and SPARC, unlike Intel and VAX). */ +#undef WORDS_BIGENDIAN /* Is XKeycodeToKeysym deprecated? */ #undef XKEYCODETOKEYSYM_IS_DEPRECATED @@ -255,7 +235,7 @@ /* Define to `int' if <sys/types.h> does not define. */ #undef pid_t -/* Define to `unsigned int' if <sys/types.h> does not define. */ +/* Define to `unsigned' if <sys/types.h> does not define. */ #undef size_t /* Do we want to use the strtod() in compat? */ diff --git a/unix/tkUnixButton.c b/unix/tkUnixButton.c index e45812e..1aeefac 100644 --- a/unix/tkUnixButton.c +++ b/unix/tkUnixButton.c @@ -363,7 +363,7 @@ TkpDisplayButton( * warning. */ int y, relief; Tk_Window tkwin = butPtr->tkwin; - int width, height, fullWidth, fullHeight; + int width = 0, height = 0, fullWidth, fullHeight; int textXOffset, textYOffset; int haveImage = 0, haveText = 0; int offset; /* 1 means this is a button widget, so we diff --git a/unix/tkUnixDefault.h b/unix/tkUnixDefault.h index 8768a2e..ac7bc4d 100644 --- a/unix/tkUnixDefault.h +++ b/unix/tkUnixDefault.h @@ -368,6 +368,7 @@ #define DEF_PANEDWINDOW_HEIGHT "" #define DEF_PANEDWINDOW_OPAQUERESIZE "1" #define DEF_PANEDWINDOW_ORIENT "horizontal" +#define DEF_PANEDWINDOW_PROXYBORDER "2" #define DEF_PANEDWINDOW_RELIEF "flat" #define DEF_PANEDWINDOW_SASHCURSOR "" #define DEF_PANEDWINDOW_SASHPAD "0" diff --git a/unix/tkUnixEmbed.c b/unix/tkUnixEmbed.c index 8a4c368..b170ad0 100644 --- a/unix/tkUnixEmbed.c +++ b/unix/tkUnixEmbed.c @@ -101,7 +101,7 @@ TkpUseWindow( { TkWindow *winPtr = (TkWindow *) tkwin; TkWindow *usePtr; - int id, anyError; + int anyError; Window parent; Tk_ErrorHandler handler; Container *containerPtr; @@ -115,10 +115,9 @@ TkpUseWindow( Tcl_SetErrorCode(interp, "TK", "EMBED", "POST_CREATE", NULL); return TCL_ERROR; } - if (Tcl_GetInt(interp, string, &id) != TCL_OK) { + if (TkpScanWindowId(interp, string, &parent) != TCL_OK) { return TCL_ERROR; } - parent = (Window) id; usePtr = (TkWindow *) Tk_IdToWindow(winPtr->display, parent); if (usePtr != NULL && !(usePtr->flags & TK_CONTAINER)) { @@ -867,8 +866,8 @@ int TkpTestembedCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { int all; Container *containerPtr; @@ -877,7 +876,7 @@ TkpTestembedCmd( ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - if ((argc > 1) && (strcmp(argv[1], "all") == 0)) { + if ((objc > 1) && (strcmp(Tcl_GetString(objv[1]), "all") == 0)) { all = 1; } else { all = 0; diff --git a/unix/tkUnixPort.h b/unix/tkUnixPort.h index 9051c63..dbd5e09 100644 --- a/unix/tkUnixPort.h +++ b/unix/tkUnixPort.h @@ -20,11 +20,7 @@ #include <stdio.h> #include <ctype.h> #include <fcntl.h> -#ifndef NO_LIMITS_H -# include <limits.h> -#else -# include "../compat/limits.h" -#endif +#include <limits.h> #include <math.h> #include <pwd.h> #ifdef NO_STDLIB_H diff --git a/unix/tkUnixScale.c b/unix/tkUnixScale.c index cc33a27..c348037 100644 --- a/unix/tkUnixScale.c +++ b/unix/tkUnixScale.c @@ -262,7 +262,7 @@ DisplayVerticalValue( { register Tk_Window tkwin = scalePtr->tkwin; int y, width, length; - char valueString[PRINT_CHARS]; + char valueString[TCL_DOUBLE_SPACE]; Tk_FontMetrics fm; Tk_GetFontMetrics(scalePtr->tkfont, &fm); @@ -341,7 +341,7 @@ DisplayHorizontalScale( */ if (tickInterval != 0) { - char valueString[PRINT_CHARS]; + char valueString[TCL_DOUBLE_SPACE]; double ticks, maxTicks; /* @@ -478,7 +478,7 @@ DisplayHorizontalValue( { register Tk_Window tkwin = scalePtr->tkwin; int x, y, length, width; - char valueString[PRINT_CHARS]; + char valueString[TCL_DOUBLE_SPACE]; Tk_FontMetrics fm; x = TkScaleValueToPixel(scalePtr, value); @@ -535,7 +535,7 @@ TkpDisplayScale( Tcl_Interp *interp = scalePtr->interp; Pixmap pixmap; int result; - char string[PRINT_CHARS]; + char string[TCL_DOUBLE_SPACE]; XRectangle drawnArea; Tcl_DString buf; diff --git a/unix/tkUnixSend.c b/unix/tkUnixSend.c index 53a2196..bbbdd77 100644 --- a/unix/tkUnixSend.c +++ b/unix/tkUnixSend.c @@ -823,7 +823,7 @@ Tk_SetAppName( riPtr->nextPtr = tsdPtr->interpListPtr; tsdPtr->interpListPtr = riPtr; riPtr->name = NULL; - Tcl_CreateCommand(interp, "send", Tk_SendCmd, riPtr, DeleteProc); + Tcl_CreateObjCommand(interp, "send", Tk_SendObjCmd, riPtr, DeleteProc); if (Tcl_IsSafe(interp)) { Tcl_HideCommand(interp, "send", "send"); } @@ -914,7 +914,7 @@ Tk_SetAppName( /* *-------------------------------------------------------------- * - * Tk_SendCmd -- + * Tk_SendObjCmd -- * * This function is invoked to process the "send" Tcl command. See the * user documentation for details on what it does. @@ -929,20 +929,25 @@ Tk_SetAppName( */ int -Tk_SendCmd( +Tk_SendObjCmd( ClientData clientData, /* Information about sender (only dispPtr * field is used). */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { + enum { + SEND_ASYNC, SEND_DISPLAYOF, SEND_LAST + }; + static const char *const sendOptions[] = { + "-async", "-displayof", "--", NULL + }; TkWindow *winPtr; Window commWindow; PendingCommand pending; register RegisteredInterp *riPtr; const char *destName; - int result, c, async, i, firstArg; - size_t length; + int result, index, async, i, firstArg; Tk_RestrictProc *prevProc; ClientData prevArg; TkDisplay *dispPtr; @@ -963,43 +968,31 @@ Tk_SendCmd( if (winPtr == NULL) { return TCL_ERROR; } - for (i = 1; i < (argc-1); ) { - if (argv[i][0] != '-') { + for (i = 1; i < objc; i++) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], sendOptions, + sizeof(char *), "option", 0, &index) != TCL_OK) { break; } - c = argv[i][1]; - length = strlen(argv[i]); - if ((c == 'a') && (strncmp(argv[i], "-async", length) == 0)) { - async = 1; - i++; - } else if ((c == 'd') && (strncmp(argv[i], "-displayof", - length) == 0)) { - winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[i+1], + if (index == SEND_ASYNC) { + ++async; + } else if (index == SEND_DISPLAYOF) { + winPtr = (TkWindow *) Tk_NameToWindow(interp, Tcl_GetString(objv[++i]), (Tk_Window) winPtr); if (winPtr == NULL) { return TCL_ERROR; } - i += 2; - } else if (strcmp(argv[i], "--") == 0) { + } else if (index == SEND_LAST) { i++; break; - } else { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad option \"%s\": must be -async, -displayof, or --", - argv[i])); - Tcl_SetErrorCode(interp, "TK", "SEND", "OPTION", NULL); - return TCL_ERROR; } } - if (argc < (i+2)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf("wrong # args: should be " - "\"%s ?-option value ...? interpName arg ?arg ...?\"", - argv[0])); - Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); + if (objc < (i+2)) { + Tcl_WrongNumArgs(interp, 1, objv, + "?-option value ...? interpName arg ?arg ...?"); return TCL_ERROR; } - destName = argv[i]; + destName = Tcl_GetString(objv[i]); firstArg = i+1; dispPtr = winPtr->dispPtr; @@ -1023,14 +1016,14 @@ Tk_SendCmd( Tcl_Preserve(riPtr); localInterp = riPtr->interp; Tcl_Preserve(localInterp); - if (firstArg == (argc-1)) { - result = Tcl_EvalEx(localInterp, argv[firstArg], -1, TCL_EVAL_GLOBAL); + if (firstArg == (objc-1)) { + result = Tcl_EvalEx(localInterp, Tcl_GetString(objv[firstArg]), -1, TCL_EVAL_GLOBAL); } else { Tcl_DStringInit(&request); - Tcl_DStringAppend(&request, argv[firstArg], -1); - for (i = firstArg+1; i < argc; i++) { + Tcl_DStringAppend(&request, Tcl_GetString(objv[firstArg]), -1); + for (i = firstArg+1; i < objc; i++) { Tcl_DStringAppend(&request, " ", 1); - Tcl_DStringAppend(&request, argv[i], -1); + Tcl_DStringAppend(&request, Tcl_GetString(objv[i]), -1); } result = Tcl_EvalEx(localInterp, Tcl_DStringValue(&request), -1, TCL_EVAL_GLOBAL); Tcl_DStringFree(&request); @@ -1097,10 +1090,10 @@ Tk_SendCmd( Tcl_DStringAppend(&request, buffer, -1); } Tcl_DStringAppend(&request, "\0-s ", 4); - Tcl_DStringAppend(&request, argv[firstArg], -1); - for (i = firstArg+1; i < argc; i++) { + Tcl_DStringAppend(&request, Tcl_GetString(objv[firstArg]), -1); + for (i = firstArg+1; i < objc; i++) { Tcl_DStringAppend(&request, " ", 1); - Tcl_DStringAppend(&request, argv[i], -1); + Tcl_DStringAppend(&request, Tcl_GetString(objv[i]), -1); } (void) AppendPropCarefully(dispPtr->display, commWindow, dispPtr->commProperty, Tcl_DStringValue(&request), @@ -1948,44 +1941,55 @@ int TkpTestsendCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { + enum { + TESTSEND_BOGUS, TESTSEND_PROP, TESTSEND_SERIAL + }; + static const char *const testsendOptions[] = { + "bogus", "prop", "serial", NULL + }; TkWindow *winPtr = clientData; + int index; - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - " option ?arg ...?\"", NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, + "option ?arg ...?"); return TCL_ERROR; } - if (strcmp(argv[1], "bogus") == 0) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], testsendOptions, + sizeof(char *), "option", 0, &index) != TCL_OK) { + return TCL_ERROR; + } + if (index == TESTSEND_BOGUS) { XChangeProperty(winPtr->dispPtr->display, RootWindow(winPtr->dispPtr->display, 0), winPtr->dispPtr->registryProperty, XA_INTEGER, 32, PropModeReplace, (unsigned char *) "This is bogus information", 6); - } else if (strcmp(argv[1], "prop") == 0) { + } else if (index == TESTSEND_PROP) { int result, actualFormat; unsigned long length, bytesAfter; Atom actualType, propName; char *property, **propertyPtr = &property, *p, *end; Window w; - if ((argc != 4) && (argc != 5)) { - Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - " prop window name ?value ?\"", NULL); + if ((objc != 4) && (objc != 5)) { + Tcl_WrongNumArgs(interp, 1, objv, + "prop window name ?value ?"); return TCL_ERROR; } - if (strcmp(argv[2], "root") == 0) { + if (strcmp(Tcl_GetString(objv[2]), "root") == 0) { w = RootWindow(winPtr->dispPtr->display, 0); - } else if (strcmp(argv[2], "comm") == 0) { + } else if (strcmp(Tcl_GetString(objv[2]), "comm") == 0) { w = Tk_WindowId(winPtr->dispPtr->commTkwin); } else { - w = strtoul(argv[2], &end, 0); + w = strtoul(Tcl_GetString(objv[2]), &end, 0); } - propName = Tk_InternAtom((Tk_Window) winPtr, argv[3]); - if (argc == 4) { + propName = Tk_InternAtom((Tk_Window) winPtr, Tcl_GetString(objv[3])); + if (objc == 4) { property = NULL; result = XGetWindowProperty(winPtr->dispPtr->display, w, propName, 0, 100000, False, XA_STRING, &actualType, &actualFormat, @@ -2002,14 +2006,14 @@ TkpTestsendCmd( if (property != NULL) { XFree(property); } - } else if (argv[4][0] == 0) { + } else if (Tcl_GetString(objv[4])[0] == 0) { XDeleteProperty(winPtr->dispPtr->display, w, propName); } else { Tcl_DString tmp; Tcl_DStringInit(&tmp); - for (p = Tcl_DStringAppend(&tmp, argv[4], - (int) strlen(argv[4])); *p != 0; p++) { + for (p = Tcl_DStringAppend(&tmp, Tcl_GetString(objv[4]), + (int) strlen(Tcl_GetString(objv[4]))); *p != 0; p++) { if (*p == '\n') { *p = 0; } @@ -2020,12 +2024,8 @@ TkpTestsendCmd( p-Tcl_DStringValue(&tmp)); Tcl_DStringFree(&tmp); } - } else if (strcmp(argv[1], "serial") == 0) { + } else if (index == TESTSEND_SERIAL) { Tcl_SetObjResult(interp, Tcl_NewIntObj(localData.sendSerial+1)); - } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be bogus, prop, or serial", NULL); - return TCL_ERROR; } return TCL_OK; } diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index 8a7ec3c..612270c 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -3734,7 +3734,7 @@ WmWaitMapProc( * This function is invoked by a widget when it wishes to set a grid * coordinate system that controls the size of a top-level window. It * provides a C interface equivalent to the "wm grid" command and is - * usually asscoiated with the -setgrid option. + * usually associated with the -setgrid option. * * Results: * None. diff --git a/unix/tkUnixXId.c b/unix/tkUnixXId.c index 819b7aa..668f228 100644 --- a/unix/tkUnixXId.c +++ b/unix/tkUnixXId.c @@ -125,13 +125,23 @@ TkpScanWindowId( const char *string, Window *idPtr) { - int value; + int code; + Tcl_Obj obj; - if (Tcl_GetInt(interp, string, &value) != TCL_OK) { - return TCL_ERROR; + obj.refCount = 1; + obj.bytes = (char *) string; /* DANGER?! */ + obj.length = strlen(string); + obj.typePtr = NULL; + + code = Tcl_GetLongFromObj(interp, &obj, (long *)idPtr); + + if (obj.refCount > 1) { + Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); + } + if (obj.typePtr && obj.typePtr->freeIntRepProc) { + obj.typePtr->freeIntRepProc(&obj); } - *idPtr = (Window) value; - return TCL_OK; + return code; } /* diff --git a/win/buildall.vc.bat b/win/buildall.vc.bat index 162490e..8f6803b 100755 --- a/win/buildall.vc.bat +++ b/win/buildall.vc.bat @@ -1,107 +1,107 @@ -@echo off - -:: This is an example batchfile for building everything. Please -:: edit this (or make your own) for your needs and wants using -:: the instructions for calling makefile.vc found in makefile.vc - -set SYMBOLS= - -:OPTIONS -if "%1" == "/?" goto help -if /i "%1" == "/help" goto help -if %1.==symbols. goto SYMBOLS -if %1.==debug. goto SYMBOLS -goto OPTIONS_DONE - -:SYMBOLS - set SYMBOLS=symbols - shift - goto OPTIONS - -:OPTIONS_DONE - -:: reset errorlevel -cd > nul - -:: You might have installed your developer studio to add itself to the -:: path or have already run vcvars32.bat. Testing these envars proves -:: cl.exe and friends are in your path. -:: -if defined VCINSTALLDIR (goto :startBuilding) -if defined MSDEVDIR (goto :startBuilding) -if defined MSVCDIR (goto :startBuilding) -if defined MSSDK (goto :startBuilding) -if defined WINDOWSSDKDIR (goto :startBuilding) - -:: We need to run the development environment batch script that comes -:: with developer studio (v4,5,6,7,etc...) All have it. This path -:: might not be correct. You should call it yourself prior to running -:: this batchfile. -:: -call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat" -if errorlevel 1 (goto no_vcvars) - -:startBuilding - -echo. -echo Sit back and have a cup of coffee while this grinds through ;) -echo You asked for *everything*, remember? -echo. -title Building Tk, please wait... - - -:: makefile.vc uses this for its default anyways, but show its use here -:: just to be explicit and convey understanding to the user. Setting -:: the INSTALLDIR envar prior to running this batchfile affects all builds. -:: -if "%INSTALLDIR%" == "" set INSTALLDIR=C:\Program Files\Tcl - - -:: Where is the Tcl source directory? -:: You can set the TCLDIR environment variable to your Tcl HEAD checkout -if "%TCLDIR%" == "" set TCLDIR=..\..\tcl - -:: Build the normal stuff along with the help file. -:: -set OPTS=none -if not %SYMBOLS%.==. set OPTS=symbols -nmake -nologo -f makefile.vc release htmlhelp OPTS=%OPTS% %1 -if errorlevel 1 goto error - -:: Build the static core and shell. -:: -set OPTS=static,msvcrt -if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt -nmake -nologo -f makefile.vc shell OPTS=%OPTS% %1 -if errorlevel 1 goto error - -set OPTS= -set SYMBOLS= -goto end - -:error -echo *** BOOM! *** -goto end - -:no_vcvars -echo vcvars32.bat was not run prior to this batchfile, nor are the MS tools in your path. -goto out - -:help -title buildall.vc.bat help message -echo usage: -echo %0 : builds Tk for all build types (do this first) -echo %0 install : installs all the release builds (do this second) -echo %0 symbols : builds Tk for all debugging build types -echo %0 symbols install : install all the debug builds. -echo. -goto out - -:end -title Building Tk, please wait... DONE! -echo DONE! -goto out - -:out -pause -title Command Prompt +@echo off
+
+:: This is an example batchfile for building everything. Please
+:: edit this (or make your own) for your needs and wants using
+:: the instructions for calling makefile.vc found in makefile.vc
+
+set SYMBOLS=
+
+:OPTIONS
+if "%1" == "/?" goto help
+if /i "%1" == "/help" goto help
+if %1.==symbols. goto SYMBOLS
+if %1.==debug. goto SYMBOLS
+goto OPTIONS_DONE
+
+:SYMBOLS
+ set SYMBOLS=symbols
+ shift
+ goto OPTIONS
+
+:OPTIONS_DONE
+
+:: reset errorlevel
+cd > nul
+
+:: You might have installed your developer studio to add itself to the
+:: path or have already run vcvars32.bat. Testing these envars proves
+:: cl.exe and friends are in your path.
+::
+if defined VCINSTALLDIR (goto :startBuilding)
+if defined MSDEVDIR (goto :startBuilding)
+if defined MSVCDIR (goto :startBuilding)
+if defined MSSDK (goto :startBuilding)
+if defined WINDOWSSDKDIR (goto :startBuilding)
+
+:: We need to run the development environment batch script that comes
+:: with developer studio (v4,5,6,7,etc...) All have it. This path
+:: might not be correct. You should call it yourself prior to running
+:: this batchfile.
+::
+call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat"
+if errorlevel 1 (goto no_vcvars)
+
+:startBuilding
+
+echo.
+echo Sit back and have a cup of coffee while this grinds through ;)
+echo You asked for *everything*, remember?
+echo.
+title Building Tk, please wait...
+
+
+:: makefile.vc uses this for its default anyways, but show its use here
+:: just to be explicit and convey understanding to the user. Setting
+:: the INSTALLDIR envar prior to running this batchfile affects all builds.
+::
+if "%INSTALLDIR%" == "" set INSTALLDIR=C:\Program Files\Tcl
+
+
+:: Where is the Tcl source directory?
+:: You can set the TCLDIR environment variable to your Tcl HEAD checkout
+if "%TCLDIR%" == "" set TCLDIR=..\..\tcl
+
+:: Build the normal stuff along with the help file.
+::
+set OPTS=none
+if not %SYMBOLS%.==. set OPTS=symbols
+nmake -nologo -f makefile.vc release htmlhelp OPTS=%OPTS% %1
+if errorlevel 1 goto error
+
+:: Build the static core and shell.
+::
+set OPTS=static,msvcrt
+if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt
+nmake -nologo -f makefile.vc shell OPTS=%OPTS% %1
+if errorlevel 1 goto error
+
+set OPTS=
+set SYMBOLS=
+goto end
+
+:error
+echo *** BOOM! ***
+goto end
+
+:no_vcvars
+echo vcvars32.bat was not run prior to this batchfile, nor are the MS tools in your path.
+goto out
+
+:help
+title buildall.vc.bat help message
+echo usage:
+echo %0 : builds Tk for all build types (do this first)
+echo %0 install : installs all the release builds (do this second)
+echo %0 symbols : builds Tk for all debugging build types
+echo %0 symbols install : install all the debug builds.
+echo.
+goto out
+
+:end
+title Building Tk, please wait... DONE!
+echo DONE!
+goto out
+
+:out
+pause
+title Command Prompt
diff --git a/win/configure b/win/configure index 299be69..18efa23 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=".1" +TK_PATCH_LEVEL=".4" VER=$TK_MAJOR_VERSION$TK_MINOR_VERSION #------------------------------------------------------------------------ @@ -3449,7 +3449,7 @@ do test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_CYGPATH="cygpath -w" + ac_cv_prog_CYGPATH="cygpath -m" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi @@ -3736,7 +3736,7 @@ echo $ECHO_N "checking compiler flags... $ECHO_C" >&6 if test "${GCC}" = "yes" ; then SHLIB_LD="" SHLIB_LD_LIBS='${LIBS}' - LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -lws2_32" + LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32" # mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32" STLIB_LD='${AR} cr' @@ -3906,6 +3906,13 @@ echo "${ECHO_T}using shared flags" >&6 # Add SHLIB_LD_LIBS to the Make rule, not here. LIBRARIES="\${SHARED_LIBRARIES}" EXESUFFIX="\${DBGX}.exe" + case "x`echo \${VisualStudioVersion}`" in + x1[4-9]*) + lflags="${lflags} -nodefaultlib:libucrt.lib" + ;; + *) + ;; + esac fi MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@" # DLLSUFFIX is separate because it is the building block for @@ -3934,18 +3941,23 @@ echo "${ECHO_T}using shared flags" >&6 ;; esac if test ! -d "${PATH64}" ; then - { echo "$as_me:$LINENO: WARNING: Could not find 64-bit $MACHINE SDK to enable 64bit mode" >&5 -echo "$as_me: WARNING: Could not find 64-bit $MACHINE SDK to enable 64bit mode" >&2;} - { echo "$as_me:$LINENO: WARNING: Ensure latest Platform SDK is installed" >&5 -echo "$as_me: WARNING: Ensure latest Platform SDK is installed" >&2;} - do64bit="no" - else - echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5 -echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 + { echo "$as_me:$LINENO: WARNING: Could not find 64-bit $MACHINE SDK" >&5 +echo "$as_me: WARNING: Could not find 64-bit $MACHINE SDK" >&2;} fi + echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5 +echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 fi - LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib ws2_32.lib" + LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib" + + case "x`echo \${VisualStudioVersion}`" in + x1[4-9]*) + LIBS="$LIBS ucrt.lib" + ;; + *) + ;; + esac + if test "$do64bit" != "no" ; then # The space-based-path will work for the Makefile, but will # not work if AC_TRY_COMPILE is called. TEA has the @@ -4020,7 +4032,7 @@ fi CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d" # Do not use -O2 for Win64 - this has proved buggy in code gen. CFLAGS_OPTIMIZE="-nologo -O1 ${runtime}" - lflags="-nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\"" + lflags="${lflags} -nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\"" LINKBIN="\"${PATH64}/link.exe\"" # Avoid 'unresolved external symbol __security_cookie' errors. # c.f. http://support.microsoft.com/?id=894573 @@ -4032,7 +4044,7 @@ fi CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d" # -O2 - create fast code (/Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy) CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}" - lflags="-nologo" + lflags="${lflags} -nologo" LINKBIN="link" fi diff --git a/win/configure.in b/win/configure.in index 50efa8d..709b97f 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=".1" +TK_PATCH_LEVEL=".4" VER=$TK_MAJOR_VERSION$TK_MINOR_VERSION #------------------------------------------------------------------------ diff --git a/win/makefile.bc b/win/makefile.bc index 934599c..d98dfd7 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -1,537 +1,537 @@ -# -# Makefile for Borland C++ 5.5 (or C++ Builder 5), adapted from the makefile -# for Visual C++ that came with tk 8.3.3 -# -# Some "not so obvious" details in this makefile are preceded by a comment -# "maintenance hint", which tries to explain what's going on. Better to -# leave those in place. -# Helmut Giese, July 2002 -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# Copyright (c) 1995-1997 Sun Microsystems, Inc. -# Copyright (c) 1998-2000 Ajuba Solutions. - -# Does not depend on the presence of any environment variables in -# order to compile tcl; all needed information is derived from -# location of the compiler directories. - -# -# Project directories -# -# ROOT = top of source tree -# -# TMPDIR = location where .obj files should be stored during build -# -# TOOLS32 = location of Borland development tools. -# -# TCLDIR = location of top of Tcl source hierarchy -# - -ROOT = .. -TCLDIR = ..\..\tcl8.4 -INSTALLDIR = D:\tmp\tcl - -# If you have C++ Builder 5 or the free Borland C++ 5.5 compiler -# adapt the following paths as appropriate for your system -TOOLS32 = d:\cbld5 -TOOLS32_rc = d:\cbld5 -#TOOLS32 = c:\bc55 -#TOOLS32_rc = c:\bc55 - -cc32 = "$(TOOLS32)\bin\bcc32.exe" -link32 = "$(TOOLS32)\bin\ilink32.exe" -lib32 = "$(TOOLS32)\bin\tlib.exe" -rc32 = "$(TOOLS32_rc)\bin\brcc32.exe" -include32 = -I"$(TOOLS32)\include;$(TOOLS32)\include\mfc" -libpath32 = -L"$(TOOLS32)\lib" - -# Uncomment the following line to compile with thread support -#THREADDEFINES = -DTCL_THREADS=1 - -# Allow definition of NDEBUG via command line -# Set NODEBUG to 0 to compile with symbols -!if !defined(NODEBUG) -NODEBUG = 1 -!endif - -# uncomment the following two lines to compile with TCL_MEM_DEBUG -#DEBUGDEFINES =-DTCL_MEM_DEBUG - -###################################################################### -# Do not modify below this line -###################################################################### - -TCLNAMEPREFIX = tcl -TKNAMEPREFIX = tk -WISHNAMEPREFIX = wish -VERSION = 84 -DOTVERSION = 8.4 - -TCLSTUBPREFIX = $(TCLNAMEPREFIX)stub -TKSTUBPREFIX = $(TKNAMEPREFIX)stub - - -BINROOT = . -!IF "$(NODEBUG)" == "1" -TMPDIRNAME = Release -DBGX = -!ELSE -TMPDIRNAME = Debug -DBGX = -#DBGX = d -!ENDIF -TMPDIR = $(BINROOT)\$(TMPDIRNAME) -OUTDIRNAME = $(TMPDIRNAME) -OUTDIR = $(TMPDIR) - -TCLLIB = $(TCLNAMEPREFIX)$(VERSION)$(DBGX).lib -TCLPLUGINLIB = $(TCLNAMEPREFIX)$(VERSION)p.lib -TCLSTUBLIB = $(TCLSTUBPREFIX)$(VERSION)$(DBGX).lib -TKDLLNAME = $(TKNAMEPREFIX)$(VERSION)$(DBGX).dll -TKDLL = $(OUTDIR)\$(TKDLLNAME) -TKLIB = $(OUTDIR)\$(TKNAMEPREFIX)$(VERSION)$(DBGX).lib -TKSTUBLIBNAME = $(TKSTUBPREFIX)$(VERSION)$(DBGX).lib -TKSTUBLIB = $(OUTDIR)\$(TKSTUBLIBNAME) -TKPLUGINDLLNAME = $(TKNAMEPREFIX)$(VERSION)p$(DBG).dll -TKPLUGINDLL = $(OUTDIR)\$(TKPLUGINDLLNAME) -TKPLUGINLIB = $(OUTDIR)\$(TKNAMEPREFIX)$(VERSION)p$(DBGX).lib - -WISH = $(OUTDIR)\$(WISHNAMEPREFIX)$(VERSION)$(DBGX).exe -WISHC = $(OUTDIR)\$(WISHNAMEPREFIX)c$(VERSION)$(DBGX).exe -WISHP = $(OUTDIR)\$(WISHNAMEPREFIX)p$(VERSION)$(DBGX).exe -TKTEST = $(OUTDIR)\$(TKNAMEPREFIX)test.exe -CAT32 = $(TMPDIR)\cat32.exe - -BIN_INSTALL_DIR = $(INSTALLDIR)\bin -INCLUDE_INSTALL_DIR = $(INSTALLDIR)\include -LIB_INSTALL_DIR = $(INSTALLDIR)\lib -SCRIPT_INSTALL_DIR = $(LIB_INSTALL_DIR)\tk$(DOTVERSION) - -WISHOBJS = \ - $(TMPDIR)\winMain.obj - -TKTESTOBJS = \ - $(TMPDIR)\tkTest.obj \ - $(TMPDIR)\tkSquare.obj \ - $(TMPDIR)\testMain.obj \ - $(TMPDIR)\tkOldTest.obj \ - $(TMPDIR)\tkWinTest.obj \ - $(TCLLIBDIR)\tclThreadTest.obj - -XLIBOBJS = \ - $(TMPDIR)\xcolors.obj \ - $(TMPDIR)\xdraw.obj \ - $(TMPDIR)\xgc.obj \ - $(TMPDIR)\ximage.obj \ - $(TMPDIR)\xutil.obj - -TKOBJS = \ - $(TMPDIR)\tkConsole.obj \ - $(TMPDIR)\tkUnixMenubu.obj \ - $(TMPDIR)\tkUnixScale.obj \ - $(XLIBOBJS) \ - $(TMPDIR)\tkWin3d.obj \ - $(TMPDIR)\tkWin32Dll.obj \ - $(TMPDIR)\tkWinButton.obj \ - $(TMPDIR)\tkWinClipboard.obj \ - $(TMPDIR)\tkWinColor.obj \ - $(TMPDIR)\tkWinConfig.obj \ - $(TMPDIR)\tkWinCursor.obj \ - $(TMPDIR)\tkWinDialog.obj \ - $(TMPDIR)\tkWinDraw.obj \ - $(TMPDIR)\tkWinEmbed.obj \ - $(TMPDIR)\tkWinFont.obj \ - $(TMPDIR)\tkWinImage.obj \ - $(TMPDIR)\tkWinInit.obj \ - $(TMPDIR)\tkWinKey.obj \ - $(TMPDIR)\tkWinMenu.obj \ - $(TMPDIR)\tkWinPixmap.obj \ - $(TMPDIR)\tkWinPointer.obj \ - $(TMPDIR)\tkWinRegion.obj \ - $(TMPDIR)\tkWinScrlbr.obj \ - $(TMPDIR)\tkWinSend.obj \ - $(TMPDIR)\tkWinWindow.obj \ - $(TMPDIR)\tkWinWm.obj \ - $(TMPDIR)\tkWinX.obj \ - $(TMPDIR)\stubs.obj \ - $(TMPDIR)\tk3d.obj \ - $(TMPDIR)\tkArgv.obj \ - $(TMPDIR)\tkAtom.obj \ - $(TMPDIR)\tkBind.obj \ - $(TMPDIR)\tkBitmap.obj \ - $(TMPDIR)\tkBusy.obj \ - $(TMPDIR)\tkButton.obj \ - $(TMPDIR)\tkCanvArc.obj \ - $(TMPDIR)\tkCanvBmap.obj \ - $(TMPDIR)\tkCanvImg.obj \ - $(TMPDIR)\tkCanvLine.obj \ - $(TMPDIR)\tkCanvPoly.obj \ - $(TMPDIR)\tkCanvPs.obj \ - $(TMPDIR)\tkCanvText.obj \ - $(TMPDIR)\tkCanvUtil.obj \ - $(TMPDIR)\tkCanvWind.obj \ - $(TMPDIR)\tkCanvas.obj \ - $(TMPDIR)\tkClipboard.obj \ - $(TMPDIR)\tkCmds.obj \ - $(TMPDIR)\tkColor.obj \ - $(TMPDIR)\tkConfig.obj \ - $(TMPDIR)\tkCursor.obj \ - $(TMPDIR)\tkEntry.obj \ - $(TMPDIR)\tkError.obj \ - $(TMPDIR)\tkEvent.obj \ - $(TMPDIR)\tkFileFilter.obj \ - $(TMPDIR)\tkFocus.obj \ - $(TMPDIR)\tkFont.obj \ - $(TMPDIR)\tkFrame.obj \ - $(TMPDIR)\tkGC.obj \ - $(TMPDIR)\tkGeometry.obj \ - $(TMPDIR)\tkGet.obj \ - $(TMPDIR)\tkGrab.obj \ - $(TMPDIR)\tkGrid.obj \ - $(TMPDIR)\tkImage.obj \ - $(TMPDIR)\tkImgBmap.obj \ - $(TMPDIR)\tkImgGIF.obj \ - $(TMPDIR)\tkImgPPM.obj \ - $(TMPDIR)\tkImgPhoto.obj \ - $(TMPDIR)\tkImgPhInstance.obj \ - $(TMPDIR)\tkImgUtil.obj \ - $(TMPDIR)\tkListbox.obj \ - $(TMPDIR)\tkMacWinMenu.obj \ - $(TMPDIR)\tkMain.obj \ - $(TMPDIR)\tkMenu.obj \ - $(TMPDIR)\tkMenubutton.obj \ - $(TMPDIR)\tkMenuDraw.obj \ - $(TMPDIR)\tkMessage.obj \ - $(TMP_DIR)\tkPanedWindow.obj \ - $(TMPDIR)\tkObj.obj \ - $(TMPDIR)\tkOldConfig.obj \ - $(TMPDIR)\tkOption.obj \ - $(TMPDIR)\tkPack.obj \ - $(TMPDIR)\tkPlace.obj \ - $(TMPDIR)\tkPointer.obj \ - $(TMPDIR)\tkRectOval.obj \ - $(TMPDIR)\tkScale.obj \ - $(TMPDIR)\tkScrollbar.obj \ - $(TMPDIR)\tkSelect.obj \ - $(TMPDIR)\tkText.obj \ - $(TMPDIR)\tkTextBTree.obj \ - $(TMPDIR)\tkTextDisp.obj \ - $(TMPDIR)\tkTextImage.obj \ - $(TMPDIR)\tkTextIndex.obj \ - $(TMPDIR)\tkTextMark.obj \ - $(TMPDIR)\tkTextTag.obj \ - $(TMPDIR)\tkTextWind.obj \ - $(TMPDIR)\tkTrig.obj \ - $(TMPDIR)\tkUtil.obj \ - $(TMPDIR)\tkVisual.obj \ - $(TMPDIR)\tkStubInit.obj \ - $(TMPDIR)\tkWindow.obj - -# Maintenance hint: Please have multiple members of TKSTUBOBJS be separated -# by exactly one ' ' (see below the rule for making TKSTUBLIB) -TKSTUBOBJS = $(TMPDIR)\tkStubLib.obj - -WINDIR = $(ROOT)\win -GENERICDIR = $(ROOT)\generic -XLIBDIR = $(ROOT)\xlib -BITMAPDIR = $(ROOT)\bitmaps -TCLLIBDIR = $(TCLDIR)\win\$(OUTDIRNAME) -RCDIR = $(WINDIR)\rc - -TK_INCLUDES = -I$(WINDIR) -I$(GENERICDIR) -I$(BITMAPDIR) -I$(XLIBDIR) \ - -I$(TCLDIR)\generic -I$(TCLDIR)\win - -TK_DEFINES = -D_WIN32 $(DEBUGDEFINES) $(THREADDEFINES) SUPPORT_CONFIG_EMBEDDED - -###################################################################### -# Compile flags -###################################################################### - -!IF "$(NODEBUG)" == "1" -# these macros cause maximum optimization and no symbols -cdebug = -v- -vi- -O2 -D_DEBUG -!ELSE -# these macros enable debugging -cdebug = -k -Od -r- -v -vi- -y -!ENDIF - -SYSDEFINES = _MT;NO_STRICT;_NO_VCL - -# declarations common to all compiler options -cbase = -3 -a4 -c -g0 -tWM -Ve -Vx -X- -WARNINGS = -w-rch -w-pch -w-par -w-dup -w-pro -w-dpu - -ccons = -tWC - -CFLAGS = $(cdebug) $(cbase) $(WARNINGS) -D$(SYSDEFINES) - -CON_CFLAGS = $(CFLAGS) $(TK_DEFINES) $(include32) $(ccons) -WISH_CFLAGS = $(CFLAGS) $(include32) $(TK_INCLUDES) $(TK_DEFINES) -TK_CFLAGS = $(CFLAGS) $(include32) $(TK_INCLUDES) $(TK_DEFINES) \ - -DUSE_TCL_STUBS - -###################################################################### -# Link flags -###################################################################### - -!IF "$(NODEBUG)" == "1" -ldebug = -!ELSE -ldebug = -v -!ENDIF - -# declarations common to all linker options -LNFLAGS = -D"" -Gn -I$(TMPDIR) -x $(ldebug) $(libpath32) -# -Gi: create lib file (is -Gl in doc) -# -aa: Windows app, -ap: Windows console app -LNFLAGS_DLL = -ap -Gi -Tpd -LNFLAGS_CONS = -ap -Tpe -LNFLAGS_GUI = -aa -Tpe - -LNLIBS = import32 cw32mt - - -###################################################################### -# Project specific targets -###################################################################### - -all: setup $(WISH) $(CAT32) -install: install-binaries install-libraries -plugin: setup $(TKPLUGINDLL) $(WISHP) -tktest: setup $(TKTEST) $(CAT32) - -# Maintenance hint: We want to set environment variables before calling tktest. -# If we do this in the form of normal commands, they will not persist up to -# the call of tktest. Therfore we put all commands wanted into a batch file. -# The normal way of using 'echo >x.bat' and 'echo >>x.bat' does not work here -# because we cannot write '... > tktest.txt' this way. Hence this advanced -# form of loop hopping: -# - Have MAKE produce a temporary file with the content we want. -# - Use it as input to the COPY command to produce a batch file. -# - Run the batch file and be happy. -# -test: setup $(TKTEST) $(TKLIB) $(CAT32) - copy &&! - set TCL_LIBRARY=$(TCLDIR)/library - set PATH=$(TCLDIR)\win\$(TMPDIRNAME);$(PATH) - $(TKTEST) $(ROOT)/tests/all.tcl > tktest.txt -! _test.bat - _test.bat -# del _test.bat - -runtest: setup $(TKTEST) $(TKLIB) $(CAT32) - echo set TCL_LIBRARY=$(TCLDIR)/library > _test2.bat - echo set PATH=$(TCLDIR)\win\$(TMPDIRNAME);$(PATH) >> _test2.bat - echo $(TKTEST) >> _test2.bat - _test2.bat -# del _test2.bat - -console-wish : all $(WISHC) - -stubs: - $(TCLDIR)\win\$(TMPDIRNAME)\tclsh$(VERSION)$(DBGX) \ - $(TCLDIR)\tools\genStubs.tcl $(GENERICDIR) \ - $(GENERICDIR)\tk.decls $(GENERICDIR)\tkInt.decls - -setup: - @mkd $(TMPDIR) - @mkd $(OUTDIR) - -install-binaries: - @mkd "$(BIN_INSTALL_DIR)" - copy $(TKDLL) "$(BIN_INSTALL_DIR)" - copy $(WISH) "$(BIN_INSTALL_DIR)" - @mkd "$(LIB_INSTALL_DIR)" - copy $(TKLIB) "$(LIB_INSTALL_DIR)" - -install-libraries: - @mkd "$(INCLUDE_INSTALL_DIR)" - @mkd "$(INCLUDE_INSTALL_DIR)\X11" - copy "$(GENERICDIR)\tk.h" "$(INCLUDE_INSTALL_DIR)" - copy "$(GENERICDIR)\tkDecls.h" "$(INCLUDE_INSTALL_DIR)" - copy "$(GENERICDIR)\tkPlatDecls.h" "$(INCLUDE_INSTALL_DIR)" - copy "$(GENERICDIR)\tkIntXlibDecls.h" "$(INCLUDE_INSTALL_DIR)" - xcopy "$(XLIBDIR)\X11\*.h" "$(INCLUDE_INSTALL_DIR)\X11" - @mkd "$(SCRIPT_INSTALL_DIR)" - @mkd "$(SCRIPT_INSTALL_DIR)\images" - @mkd "$(SCRIPT_INSTALL_DIR)\demos" - @mkd "$(SCRIPT_INSTALL_DIR)\demos\images" - @mkd "$(SCRIPT_INSTALL_DIR)\msgs" - xcopy "$(ROOT)\library" "$(SCRIPT_INSTALL_DIR)" - xcopy "$(ROOT)\library\images" "$(SCRIPT_INSTALL_DIR)\images" - xcopy "$(ROOT)\library\demos" "$(SCRIPT_INSTALL_DIR)\demos" - xcopy "$(ROOT)\library\demos\images" "$(SCRIPT_INSTALL_DIR)\demos\images" - xcopy "$(ROOT)\library\msgs" "$(SCRIPT_INSTALL_DIR)\msgs" - -$(TKLIB): $(TKDLL) $(TKSTUBLIB) - -# Maintenance hint: The macro puts a '+-' before the first member of -# TKSTUBOBJS, than replaces any ' ' with ' +-' - together putting '+-' in -# front of any member of TKSTUBOBJS (provided, they are separated in their -# defintion by just one space). -# -# The first time you *make* this target, you will get a warning -# tkStubLib not found in library -# This is (probably) because of the '-' option, telling TLIB to remove -# 'tkStubLib' when it does not yet exist. Forcing a re-make when it already -# exists avoids this warning. -# -$(TKSTUBLIB): $(TKSTUBOBJS) - $(lib32) $@ +-$(TKSTUBOBJS: = +-) - -# $(lib32) $@ @&&! -#+-$(TKSTUBOBJS: = &^ -#+-) -#! - -$(TKDLL): $(TKOBJS) $(TMPDIR)\tk.res - $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 @&&! - $(TKOBJS), $@, -x, $(LNLIBS) $(TCLLIBDIR)\$(TCLSTUBLIB),, $(TMPDIR)\tk.res -! - -$(TKPLUGINLIB): $(TKPLUGINDLL) - -#$(TKPLUGINDLL): $(TKOBJS) $(TMPDIR)\tk.res -# $(link32) $(ldebug) $(dlllflags) \ -# -out:$@ $(TMPDIR)\tk.res $(TCLLIBDIR)\$(TCLPLUGINLIB) \ -# $(guilibsdll) @<< -# $(TKOBJS) -#<< - -$(WISH): $(WISHOBJS) $(TKLIB) $(TMPDIR)\wish.res - $(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_GUI) $(TOOLS32)\lib\c0x32 @&&! - $(WISHOBJS), $@, -x, $(LNLIBS) $(TCLLIBDIR)\$(TCLLIB) $(TKLIB),, $(TMPDIR)\wish.res -! - -$(WISHC): $(WISHOBJS) $(TKLIB) $(TMPDIR)\wish.res - $(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 @&&! - $(WISHOBJS), $@, -x, $(LNLIBS) $(TCLLIBDIR)\$(TCLLIB) $(TKLIB),, $(TMPDIR)\wish.res -! - -$(WISHP): $(WISHOBJS) $(TKPLUGINLIB) $(TMPDIR)\wish.res - $(link32) $(ldebug) $(guilflags) $(TMPDIR)\wish.res -out:$@ \ - $(guilibsdll) $(TCLLIBDIR)\$(TCLPLUGINLIB) \ - $(TKPLUGINLIB) $(WISHOBJS) - -$(TKTEST): $(TKTESTOBJS) $(TKLIB) $(TMPDIR)\wish.res - $(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_GUI) $(TOOLS32)\lib\c0x32 @&&! - $(TKTESTOBJS), $@, -x, $(LNLIBS) $(TCLLIBDIR)\$(TCLLIB) $(TKLIB),, $(TMPDIR)\wish.res -! -# $(link32) $(ldebug) $(guilflags) $(TMPDIR)\wish.res -out:$@ \ -# $(guilibsdll) $(TCLLIBDIR)\$(TCLLIB) $(TKLIB) $(TKTESTOBJS) - -#$(CAT32): $(TCLDIR)\win\cat.c -# $(cc32) $(CON_CFLAGS) -o$(TMPDIR)\cat.obj $? -# $(link32) $(conlflags) -out:$@ -stack:16384 $(TMPDIR)\cat.obj $(conlibs) - -$(CAT32): $(TCLDIR)\win\cat.c - $(cc32) $(CONS_CFLAGS) -o$(TMPDIR)\cat.obj $? - $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 \ - $(TMPDIR)\cat.obj, $@, -x, $(LNLIBS),, - -# -# Regenerate the stubs files. -# - -genstubs: - tclsh$(VERSION) $(TCLDIR)\tools\genStubs.tcl $(GENERICDIR) \ - $(GENERICDIR)\tk.decls $(GENERICDIR)\tkInt.decls - -# -# Special case object file targets -# - -$(TMPDIR)\testMain.obj: $(WINDIR)\winMain.c - $(cc32) $(WISH_CFLAGS) -DTK_TEST -o$@ $? - -$(TMPDIR)\tkTest.obj: $(GENERICDIR)\tkTest.c - $(cc32) $(WISH_CFLAGS) -o$@ $? - -$(TMPDIR)\tkOldTest.obj: $(GENERICDIR)\tkOldTest.c - $(cc32) $(WISH_CFLAGS) -o$@ $? - -$(TMPDIR)\tkWinTest.obj: $(WINDIR)\tkWinTest.c - $(cc32) $(WISH_CFLAGS) -o$@ $? - -$(TMPDIR)\tkSquare.obj: $(GENERICDIR)\tkSquare.c - $(cc32) $(WISH_CFLAGS) -o$@ $? - -$(TMPDIR)\winMain.obj: $(WINDIR)\winMain.c - $(cc32) $(WISH_CFLAGS) -o$@ $? - -$(TMPDIR)\tkStubLib.obj : $(GENERICDIR)\tkStubLib.c - $(cc32) $(TK_CFLAGS) -DSTATIC_BUILD -o$@ $? - -# -# Implicit rules -# - -{$(XLIBDIR)}.c{$(TMPDIR)}.obj: - $(cc32) -DDLL_BUILD -DBUILD_tk $(TK_CFLAGS) -o$@ $< - -{$(GENERICDIR)}.c{$(TMPDIR)}.obj: - $(cc32) -DDLL_BUILD -DBUILD_tk $(TK_CFLAGS) -o$@ $< - -{$(WINDIR)}.c{$(TMPDIR)}.obj: - $(cc32) -DDLL_BUILD -DBUILD_tk $(TK_CFLAGS) -o$@ $< - -{$(ROOT)\unix}.c{$(TMPDIR)}.obj: - $(cc32) -DDLL_BUILD -DBUILD_tk $(TK_CFLAGS) -o$@ $< - -{$(RCDIR)}.rc{$(TMPDIR)}.res: - $(rc32) -I"$(GENERICDIR)" -I"$(TOOLS32)\include" -I"$(TCLDIR)\generic" \ - -D$(USERDEFINES);$(SYSDEFINES) -fo$@ $< - -clean: - -@del $(OUTDIR)\*.exp - -@del $(OUTDIR)\*.lib - -@del $(OUTDIR)\*.dll - -@del $(OUTDIR)\*.exe - -@del $(OUTDIR)\*.pdb - -@del $(TMPDIR)\*.pch - -@del $(TMPDIR)\*.obj - -@del $(TMPDIR)\*.res - -@del $(TMPDIR)\*.exe - -@rmd $(OUTDIR) - -@rmd $(TMPDIR) - -# dependencies - -$(TMPDIR)\tk.res: \ - $(RCDIR)\buttons.bmp \ - $(RCDIR)\cursor*.cur \ - $(RCDIR)\tk.ico - -$(GENERICDIR)/default.h: $(WINDIR)/tkWinDefault.h -$(GENERICDIR)/tkButton.c: $(GENERICDIR)/default.h -$(GENERICDIR)/tkCanvas.c: $(GENERICDIR)/default.h -$(GENERICDIR)/tkEntry.c: $(GENERICDIR)/default.h -$(GENERICDIR)/tkFrame.c: $(GENERICDIR)/default.h -$(GENERICDIR)/tkListbox.c: $(GENERICDIR)/default.h -$(GENERICDIR)/tkMenu.c: $(GENERICDIR)/default.h -$(GENERICDIR)/tkMenubutton.c: $(GENERICDIR)/default.h -$(GENERICDIR)/tkMessage.c: $(GENERICDIR)/default.h -$(GENERICDIR)/tkScale.c: $(GENERICDIR)/default.h -$(GENERICDIR)/tkScrollbar.c: $(GENERICDIR)/default.h -$(GENERICDIR)/tkText.c: $(GENERICDIR)/default.h -$(GENERICDIR)/tkTextIndex.c: $(GENERICDIR)/default.h -$(GENERICDIR)/tkTextTag.c: $(GENERICDIR)/default.h - -$(GENERICDIR)/tkText.c: $(GENERICDIR)/tkText.h -$(GENERICDIR)/tkTextBTree.c: $(GENERICDIR)/tkText.h -$(GENERICDIR)/tkTextDisp.c: $(GENERICDIR)/tkText.h -$(GENERICDIR)/tkTextDisp.c: $(GENERICDIR)/tkText.h -$(GENERICDIR)/tkTextImage.c: $(GENERICDIR)/tkText.h -$(GENERICDIR)/tkTextIndex.c: $(GENERICDIR)/tkText.h -$(GENERICDIR)/tkTextMark.c: $(GENERICDIR)/tkText.h -$(GENERICDIR)/tkTextTag.c: $(GENERICDIR)/tkText.h -$(GENERICDIR)/tkTextWind.c: $(GENERICDIR)/tkText.h - -$(GENERICDIR)/tkMacWinMenu.c: $(GENERICDIR)/tkMenu.h -$(GENERICDIR)/tkMenu.c: $(GENERICDIR)/tkMenu.h -$(GENERICDIR)/tkMenuDraw.c: $(GENERICDIR)/tkMenu.h -$(WINDIR)/tkWinMenu.c: $(GENERICDIR)/tkMenu.h - - +#
+# Makefile for Borland C++ 5.5 (or C++ Builder 5), adapted from the makefile
+# for Visual C++ that came with tk 8.3.3
+#
+# Some "not so obvious" details in this makefile are preceded by a comment
+# "maintenance hint", which tries to explain what's going on. Better to
+# leave those in place.
+# Helmut Giese, July 2002
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# Copyright (c) 1995-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-2000 Ajuba Solutions.
+
+# Does not depend on the presence of any environment variables in
+# order to compile tcl; all needed information is derived from
+# location of the compiler directories.
+
+#
+# Project directories
+#
+# ROOT = top of source tree
+#
+# TMPDIR = location where .obj files should be stored during build
+#
+# TOOLS32 = location of Borland development tools.
+#
+# TCLDIR = location of top of Tcl source hierarchy
+#
+
+ROOT = ..
+TCLDIR = ..\..\tcl8.4
+INSTALLDIR = D:\tmp\tcl
+
+# If you have C++ Builder 5 or the free Borland C++ 5.5 compiler
+# adapt the following paths as appropriate for your system
+TOOLS32 = d:\cbld5
+TOOLS32_rc = d:\cbld5
+#TOOLS32 = c:\bc55
+#TOOLS32_rc = c:\bc55
+
+cc32 = "$(TOOLS32)\bin\bcc32.exe"
+link32 = "$(TOOLS32)\bin\ilink32.exe"
+lib32 = "$(TOOLS32)\bin\tlib.exe"
+rc32 = "$(TOOLS32_rc)\bin\brcc32.exe"
+include32 = -I"$(TOOLS32)\include;$(TOOLS32)\include\mfc"
+libpath32 = -L"$(TOOLS32)\lib"
+
+# Uncomment the following line to compile with thread support
+#THREADDEFINES = -DTCL_THREADS=1
+
+# Allow definition of NDEBUG via command line
+# Set NODEBUG to 0 to compile with symbols
+!if !defined(NODEBUG)
+NODEBUG = 1
+!endif
+
+# uncomment the following two lines to compile with TCL_MEM_DEBUG
+#DEBUGDEFINES =-DTCL_MEM_DEBUG
+
+######################################################################
+# Do not modify below this line
+######################################################################
+
+TCLNAMEPREFIX = tcl
+TKNAMEPREFIX = tk
+WISHNAMEPREFIX = wish
+VERSION = 84
+DOTVERSION = 8.4
+
+TCLSTUBPREFIX = $(TCLNAMEPREFIX)stub
+TKSTUBPREFIX = $(TKNAMEPREFIX)stub
+
+
+BINROOT = .
+!IF "$(NODEBUG)" == "1"
+TMPDIRNAME = Release
+DBGX =
+!ELSE
+TMPDIRNAME = Debug
+DBGX =
+#DBGX = d
+!ENDIF
+TMPDIR = $(BINROOT)\$(TMPDIRNAME)
+OUTDIRNAME = $(TMPDIRNAME)
+OUTDIR = $(TMPDIR)
+
+TCLLIB = $(TCLNAMEPREFIX)$(VERSION)$(DBGX).lib
+TCLPLUGINLIB = $(TCLNAMEPREFIX)$(VERSION)p.lib
+TCLSTUBLIB = $(TCLSTUBPREFIX)$(VERSION)$(DBGX).lib
+TKDLLNAME = $(TKNAMEPREFIX)$(VERSION)$(DBGX).dll
+TKDLL = $(OUTDIR)\$(TKDLLNAME)
+TKLIB = $(OUTDIR)\$(TKNAMEPREFIX)$(VERSION)$(DBGX).lib
+TKSTUBLIBNAME = $(TKSTUBPREFIX)$(VERSION)$(DBGX).lib
+TKSTUBLIB = $(OUTDIR)\$(TKSTUBLIBNAME)
+TKPLUGINDLLNAME = $(TKNAMEPREFIX)$(VERSION)p$(DBG).dll
+TKPLUGINDLL = $(OUTDIR)\$(TKPLUGINDLLNAME)
+TKPLUGINLIB = $(OUTDIR)\$(TKNAMEPREFIX)$(VERSION)p$(DBGX).lib
+
+WISH = $(OUTDIR)\$(WISHNAMEPREFIX)$(VERSION)$(DBGX).exe
+WISHC = $(OUTDIR)\$(WISHNAMEPREFIX)c$(VERSION)$(DBGX).exe
+WISHP = $(OUTDIR)\$(WISHNAMEPREFIX)p$(VERSION)$(DBGX).exe
+TKTEST = $(OUTDIR)\$(TKNAMEPREFIX)test.exe
+CAT32 = $(TMPDIR)\cat32.exe
+
+BIN_INSTALL_DIR = $(INSTALLDIR)\bin
+INCLUDE_INSTALL_DIR = $(INSTALLDIR)\include
+LIB_INSTALL_DIR = $(INSTALLDIR)\lib
+SCRIPT_INSTALL_DIR = $(LIB_INSTALL_DIR)\tk$(DOTVERSION)
+
+WISHOBJS = \
+ $(TMPDIR)\winMain.obj
+
+TKTESTOBJS = \
+ $(TMPDIR)\tkTest.obj \
+ $(TMPDIR)\tkSquare.obj \
+ $(TMPDIR)\testMain.obj \
+ $(TMPDIR)\tkOldTest.obj \
+ $(TMPDIR)\tkWinTest.obj \
+ $(TCLLIBDIR)\tclThreadTest.obj
+
+XLIBOBJS = \
+ $(TMPDIR)\xcolors.obj \
+ $(TMPDIR)\xdraw.obj \
+ $(TMPDIR)\xgc.obj \
+ $(TMPDIR)\ximage.obj \
+ $(TMPDIR)\xutil.obj
+
+TKOBJS = \
+ $(TMPDIR)\tkConsole.obj \
+ $(TMPDIR)\tkUnixMenubu.obj \
+ $(TMPDIR)\tkUnixScale.obj \
+ $(XLIBOBJS) \
+ $(TMPDIR)\tkWin3d.obj \
+ $(TMPDIR)\tkWin32Dll.obj \
+ $(TMPDIR)\tkWinButton.obj \
+ $(TMPDIR)\tkWinClipboard.obj \
+ $(TMPDIR)\tkWinColor.obj \
+ $(TMPDIR)\tkWinConfig.obj \
+ $(TMPDIR)\tkWinCursor.obj \
+ $(TMPDIR)\tkWinDialog.obj \
+ $(TMPDIR)\tkWinDraw.obj \
+ $(TMPDIR)\tkWinEmbed.obj \
+ $(TMPDIR)\tkWinFont.obj \
+ $(TMPDIR)\tkWinImage.obj \
+ $(TMPDIR)\tkWinInit.obj \
+ $(TMPDIR)\tkWinKey.obj \
+ $(TMPDIR)\tkWinMenu.obj \
+ $(TMPDIR)\tkWinPixmap.obj \
+ $(TMPDIR)\tkWinPointer.obj \
+ $(TMPDIR)\tkWinRegion.obj \
+ $(TMPDIR)\tkWinScrlbr.obj \
+ $(TMPDIR)\tkWinSend.obj \
+ $(TMPDIR)\tkWinWindow.obj \
+ $(TMPDIR)\tkWinWm.obj \
+ $(TMPDIR)\tkWinX.obj \
+ $(TMPDIR)\stubs.obj \
+ $(TMPDIR)\tk3d.obj \
+ $(TMPDIR)\tkArgv.obj \
+ $(TMPDIR)\tkAtom.obj \
+ $(TMPDIR)\tkBind.obj \
+ $(TMPDIR)\tkBitmap.obj \
+ $(TMPDIR)\tkBusy.obj \
+ $(TMPDIR)\tkButton.obj \
+ $(TMPDIR)\tkCanvArc.obj \
+ $(TMPDIR)\tkCanvBmap.obj \
+ $(TMPDIR)\tkCanvImg.obj \
+ $(TMPDIR)\tkCanvLine.obj \
+ $(TMPDIR)\tkCanvPoly.obj \
+ $(TMPDIR)\tkCanvPs.obj \
+ $(TMPDIR)\tkCanvText.obj \
+ $(TMPDIR)\tkCanvUtil.obj \
+ $(TMPDIR)\tkCanvWind.obj \
+ $(TMPDIR)\tkCanvas.obj \
+ $(TMPDIR)\tkClipboard.obj \
+ $(TMPDIR)\tkCmds.obj \
+ $(TMPDIR)\tkColor.obj \
+ $(TMPDIR)\tkConfig.obj \
+ $(TMPDIR)\tkCursor.obj \
+ $(TMPDIR)\tkEntry.obj \
+ $(TMPDIR)\tkError.obj \
+ $(TMPDIR)\tkEvent.obj \
+ $(TMPDIR)\tkFileFilter.obj \
+ $(TMPDIR)\tkFocus.obj \
+ $(TMPDIR)\tkFont.obj \
+ $(TMPDIR)\tkFrame.obj \
+ $(TMPDIR)\tkGC.obj \
+ $(TMPDIR)\tkGeometry.obj \
+ $(TMPDIR)\tkGet.obj \
+ $(TMPDIR)\tkGrab.obj \
+ $(TMPDIR)\tkGrid.obj \
+ $(TMPDIR)\tkImage.obj \
+ $(TMPDIR)\tkImgBmap.obj \
+ $(TMPDIR)\tkImgGIF.obj \
+ $(TMPDIR)\tkImgPPM.obj \
+ $(TMPDIR)\tkImgPhoto.obj \
+ $(TMPDIR)\tkImgPhInstance.obj \
+ $(TMPDIR)\tkImgUtil.obj \
+ $(TMPDIR)\tkListbox.obj \
+ $(TMPDIR)\tkMacWinMenu.obj \
+ $(TMPDIR)\tkMain.obj \
+ $(TMPDIR)\tkMenu.obj \
+ $(TMPDIR)\tkMenubutton.obj \
+ $(TMPDIR)\tkMenuDraw.obj \
+ $(TMPDIR)\tkMessage.obj \
+ $(TMP_DIR)\tkPanedWindow.obj \
+ $(TMPDIR)\tkObj.obj \
+ $(TMPDIR)\tkOldConfig.obj \
+ $(TMPDIR)\tkOption.obj \
+ $(TMPDIR)\tkPack.obj \
+ $(TMPDIR)\tkPlace.obj \
+ $(TMPDIR)\tkPointer.obj \
+ $(TMPDIR)\tkRectOval.obj \
+ $(TMPDIR)\tkScale.obj \
+ $(TMPDIR)\tkScrollbar.obj \
+ $(TMPDIR)\tkSelect.obj \
+ $(TMPDIR)\tkText.obj \
+ $(TMPDIR)\tkTextBTree.obj \
+ $(TMPDIR)\tkTextDisp.obj \
+ $(TMPDIR)\tkTextImage.obj \
+ $(TMPDIR)\tkTextIndex.obj \
+ $(TMPDIR)\tkTextMark.obj \
+ $(TMPDIR)\tkTextTag.obj \
+ $(TMPDIR)\tkTextWind.obj \
+ $(TMPDIR)\tkTrig.obj \
+ $(TMPDIR)\tkUtil.obj \
+ $(TMPDIR)\tkVisual.obj \
+ $(TMPDIR)\tkStubInit.obj \
+ $(TMPDIR)\tkWindow.obj
+
+# Maintenance hint: Please have multiple members of TKSTUBOBJS be separated
+# by exactly one ' ' (see below the rule for making TKSTUBLIB)
+TKSTUBOBJS = $(TMPDIR)\tkStubLib.obj
+
+WINDIR = $(ROOT)\win
+GENERICDIR = $(ROOT)\generic
+XLIBDIR = $(ROOT)\xlib
+BITMAPDIR = $(ROOT)\bitmaps
+TCLLIBDIR = $(TCLDIR)\win\$(OUTDIRNAME)
+RCDIR = $(WINDIR)\rc
+
+TK_INCLUDES = -I$(WINDIR) -I$(GENERICDIR) -I$(BITMAPDIR) -I$(XLIBDIR) \
+ -I$(TCLDIR)\generic -I$(TCLDIR)\win
+
+TK_DEFINES = -D_WIN32 $(DEBUGDEFINES) $(THREADDEFINES) SUPPORT_CONFIG_EMBEDDED
+
+######################################################################
+# Compile flags
+######################################################################
+
+!IF "$(NODEBUG)" == "1"
+# these macros cause maximum optimization and no symbols
+cdebug = -v- -vi- -O2 -D_DEBUG
+!ELSE
+# these macros enable debugging
+cdebug = -k -Od -r- -v -vi- -y
+!ENDIF
+
+SYSDEFINES = _MT;NO_STRICT;_NO_VCL
+
+# declarations common to all compiler options
+cbase = -3 -a4 -c -g0 -tWM -Ve -Vx -X-
+WARNINGS = -w-rch -w-pch -w-par -w-dup -w-pro -w-dpu
+
+ccons = -tWC
+
+CFLAGS = $(cdebug) $(cbase) $(WARNINGS) -D$(SYSDEFINES)
+
+CON_CFLAGS = $(CFLAGS) $(TK_DEFINES) $(include32) $(ccons)
+WISH_CFLAGS = $(CFLAGS) $(include32) $(TK_INCLUDES) $(TK_DEFINES)
+TK_CFLAGS = $(CFLAGS) $(include32) $(TK_INCLUDES) $(TK_DEFINES) \
+ -DUSE_TCL_STUBS
+
+######################################################################
+# Link flags
+######################################################################
+
+!IF "$(NODEBUG)" == "1"
+ldebug =
+!ELSE
+ldebug = -v
+!ENDIF
+
+# declarations common to all linker options
+LNFLAGS = -D"" -Gn -I$(TMPDIR) -x $(ldebug) $(libpath32)
+# -Gi: create lib file (is -Gl in doc)
+# -aa: Windows app, -ap: Windows console app
+LNFLAGS_DLL = -ap -Gi -Tpd
+LNFLAGS_CONS = -ap -Tpe
+LNFLAGS_GUI = -aa -Tpe
+
+LNLIBS = import32 cw32mt
+
+
+######################################################################
+# Project specific targets
+######################################################################
+
+all: setup $(WISH) $(CAT32)
+install: install-binaries install-libraries
+plugin: setup $(TKPLUGINDLL) $(WISHP)
+tktest: setup $(TKTEST) $(CAT32)
+
+# Maintenance hint: We want to set environment variables before calling tktest.
+# If we do this in the form of normal commands, they will not persist up to
+# the call of tktest. Therfore we put all commands wanted into a batch file.
+# The normal way of using 'echo >x.bat' and 'echo >>x.bat' does not work here
+# because we cannot write '... > tktest.txt' this way. Hence this advanced
+# form of loop hopping:
+# - Have MAKE produce a temporary file with the content we want.
+# - Use it as input to the COPY command to produce a batch file.
+# - Run the batch file and be happy.
+#
+test: setup $(TKTEST) $(TKLIB) $(CAT32)
+ copy &&!
+ set TCL_LIBRARY=$(TCLDIR)/library
+ set PATH=$(TCLDIR)\win\$(TMPDIRNAME);$(PATH)
+ $(TKTEST) $(ROOT)/tests/all.tcl > tktest.txt
+! _test.bat
+ _test.bat
+# del _test.bat
+
+runtest: setup $(TKTEST) $(TKLIB) $(CAT32)
+ echo set TCL_LIBRARY=$(TCLDIR)/library > _test2.bat
+ echo set PATH=$(TCLDIR)\win\$(TMPDIRNAME);$(PATH) >> _test2.bat
+ echo $(TKTEST) >> _test2.bat
+ _test2.bat
+# del _test2.bat
+
+console-wish : all $(WISHC)
+
+stubs:
+ $(TCLDIR)\win\$(TMPDIRNAME)\tclsh$(VERSION)$(DBGX) \
+ $(TCLDIR)\tools\genStubs.tcl $(GENERICDIR) \
+ $(GENERICDIR)\tk.decls $(GENERICDIR)\tkInt.decls
+
+setup:
+ @mkd $(TMPDIR)
+ @mkd $(OUTDIR)
+
+install-binaries:
+ @mkd "$(BIN_INSTALL_DIR)"
+ copy $(TKDLL) "$(BIN_INSTALL_DIR)"
+ copy $(WISH) "$(BIN_INSTALL_DIR)"
+ @mkd "$(LIB_INSTALL_DIR)"
+ copy $(TKLIB) "$(LIB_INSTALL_DIR)"
+
+install-libraries:
+ @mkd "$(INCLUDE_INSTALL_DIR)"
+ @mkd "$(INCLUDE_INSTALL_DIR)\X11"
+ copy "$(GENERICDIR)\tk.h" "$(INCLUDE_INSTALL_DIR)"
+ copy "$(GENERICDIR)\tkDecls.h" "$(INCLUDE_INSTALL_DIR)"
+ copy "$(GENERICDIR)\tkPlatDecls.h" "$(INCLUDE_INSTALL_DIR)"
+ copy "$(GENERICDIR)\tkIntXlibDecls.h" "$(INCLUDE_INSTALL_DIR)"
+ xcopy "$(XLIBDIR)\X11\*.h" "$(INCLUDE_INSTALL_DIR)\X11"
+ @mkd "$(SCRIPT_INSTALL_DIR)"
+ @mkd "$(SCRIPT_INSTALL_DIR)\images"
+ @mkd "$(SCRIPT_INSTALL_DIR)\demos"
+ @mkd "$(SCRIPT_INSTALL_DIR)\demos\images"
+ @mkd "$(SCRIPT_INSTALL_DIR)\msgs"
+ xcopy "$(ROOT)\library" "$(SCRIPT_INSTALL_DIR)"
+ xcopy "$(ROOT)\library\images" "$(SCRIPT_INSTALL_DIR)\images"
+ xcopy "$(ROOT)\library\demos" "$(SCRIPT_INSTALL_DIR)\demos"
+ xcopy "$(ROOT)\library\demos\images" "$(SCRIPT_INSTALL_DIR)\demos\images"
+ xcopy "$(ROOT)\library\msgs" "$(SCRIPT_INSTALL_DIR)\msgs"
+
+$(TKLIB): $(TKDLL) $(TKSTUBLIB)
+
+# Maintenance hint: The macro puts a '+-' before the first member of
+# TKSTUBOBJS, than replaces any ' ' with ' +-' - together putting '+-' in
+# front of any member of TKSTUBOBJS (provided, they are separated in their
+# defintion by just one space).
+#
+# The first time you *make* this target, you will get a warning
+# tkStubLib not found in library
+# This is (probably) because of the '-' option, telling TLIB to remove
+# 'tkStubLib' when it does not yet exist. Forcing a re-make when it already
+# exists avoids this warning.
+#
+$(TKSTUBLIB): $(TKSTUBOBJS)
+ $(lib32) $@ +-$(TKSTUBOBJS: = +-)
+
+# $(lib32) $@ @&&!
+#+-$(TKSTUBOBJS: = &^
+#+-)
+#!
+
+$(TKDLL): $(TKOBJS) $(TMPDIR)\tk.res
+ $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 @&&!
+ $(TKOBJS), $@, -x, $(LNLIBS) $(TCLLIBDIR)\$(TCLSTUBLIB),, $(TMPDIR)\tk.res
+!
+
+$(TKPLUGINLIB): $(TKPLUGINDLL)
+
+#$(TKPLUGINDLL): $(TKOBJS) $(TMPDIR)\tk.res
+# $(link32) $(ldebug) $(dlllflags) \
+# -out:$@ $(TMPDIR)\tk.res $(TCLLIBDIR)\$(TCLPLUGINLIB) \
+# $(guilibsdll) @<<
+# $(TKOBJS)
+#<<
+
+$(WISH): $(WISHOBJS) $(TKLIB) $(TMPDIR)\wish.res
+ $(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_GUI) $(TOOLS32)\lib\c0x32 @&&!
+ $(WISHOBJS), $@, -x, $(LNLIBS) $(TCLLIBDIR)\$(TCLLIB) $(TKLIB),, $(TMPDIR)\wish.res
+!
+
+$(WISHC): $(WISHOBJS) $(TKLIB) $(TMPDIR)\wish.res
+ $(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 @&&!
+ $(WISHOBJS), $@, -x, $(LNLIBS) $(TCLLIBDIR)\$(TCLLIB) $(TKLIB),, $(TMPDIR)\wish.res
+!
+
+$(WISHP): $(WISHOBJS) $(TKPLUGINLIB) $(TMPDIR)\wish.res
+ $(link32) $(ldebug) $(guilflags) $(TMPDIR)\wish.res -out:$@ \
+ $(guilibsdll) $(TCLLIBDIR)\$(TCLPLUGINLIB) \
+ $(TKPLUGINLIB) $(WISHOBJS)
+
+$(TKTEST): $(TKTESTOBJS) $(TKLIB) $(TMPDIR)\wish.res
+ $(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_GUI) $(TOOLS32)\lib\c0x32 @&&!
+ $(TKTESTOBJS), $@, -x, $(LNLIBS) $(TCLLIBDIR)\$(TCLLIB) $(TKLIB),, $(TMPDIR)\wish.res
+!
+# $(link32) $(ldebug) $(guilflags) $(TMPDIR)\wish.res -out:$@ \
+# $(guilibsdll) $(TCLLIBDIR)\$(TCLLIB) $(TKLIB) $(TKTESTOBJS)
+
+#$(CAT32): $(TCLDIR)\win\cat.c
+# $(cc32) $(CON_CFLAGS) -o$(TMPDIR)\cat.obj $?
+# $(link32) $(conlflags) -out:$@ -stack:16384 $(TMPDIR)\cat.obj $(conlibs)
+
+$(CAT32): $(TCLDIR)\win\cat.c
+ $(cc32) $(CONS_CFLAGS) -o$(TMPDIR)\cat.obj $?
+ $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 \
+ $(TMPDIR)\cat.obj, $@, -x, $(LNLIBS),,
+
+#
+# Regenerate the stubs files.
+#
+
+genstubs:
+ tclsh$(VERSION) $(TCLDIR)\tools\genStubs.tcl $(GENERICDIR) \
+ $(GENERICDIR)\tk.decls $(GENERICDIR)\tkInt.decls
+
+#
+# Special case object file targets
+#
+
+$(TMPDIR)\testMain.obj: $(WINDIR)\winMain.c
+ $(cc32) $(WISH_CFLAGS) -DTK_TEST -o$@ $?
+
+$(TMPDIR)\tkTest.obj: $(GENERICDIR)\tkTest.c
+ $(cc32) $(WISH_CFLAGS) -o$@ $?
+
+$(TMPDIR)\tkOldTest.obj: $(GENERICDIR)\tkOldTest.c
+ $(cc32) $(WISH_CFLAGS) -o$@ $?
+
+$(TMPDIR)\tkWinTest.obj: $(WINDIR)\tkWinTest.c
+ $(cc32) $(WISH_CFLAGS) -o$@ $?
+
+$(TMPDIR)\tkSquare.obj: $(GENERICDIR)\tkSquare.c
+ $(cc32) $(WISH_CFLAGS) -o$@ $?
+
+$(TMPDIR)\winMain.obj: $(WINDIR)\winMain.c
+ $(cc32) $(WISH_CFLAGS) -o$@ $?
+
+$(TMPDIR)\tkStubLib.obj : $(GENERICDIR)\tkStubLib.c
+ $(cc32) $(TK_CFLAGS) -DSTATIC_BUILD -o$@ $?
+
+#
+# Implicit rules
+#
+
+{$(XLIBDIR)}.c{$(TMPDIR)}.obj:
+ $(cc32) -DDLL_BUILD -DBUILD_tk $(TK_CFLAGS) -o$@ $<
+
+{$(GENERICDIR)}.c{$(TMPDIR)}.obj:
+ $(cc32) -DDLL_BUILD -DBUILD_tk $(TK_CFLAGS) -o$@ $<
+
+{$(WINDIR)}.c{$(TMPDIR)}.obj:
+ $(cc32) -DDLL_BUILD -DBUILD_tk $(TK_CFLAGS) -o$@ $<
+
+{$(ROOT)\unix}.c{$(TMPDIR)}.obj:
+ $(cc32) -DDLL_BUILD -DBUILD_tk $(TK_CFLAGS) -o$@ $<
+
+{$(RCDIR)}.rc{$(TMPDIR)}.res:
+ $(rc32) -I"$(GENERICDIR)" -I"$(TOOLS32)\include" -I"$(TCLDIR)\generic" \
+ -D$(USERDEFINES);$(SYSDEFINES) -fo$@ $<
+
+clean:
+ -@del $(OUTDIR)\*.exp
+ -@del $(OUTDIR)\*.lib
+ -@del $(OUTDIR)\*.dll
+ -@del $(OUTDIR)\*.exe
+ -@del $(OUTDIR)\*.pdb
+ -@del $(TMPDIR)\*.pch
+ -@del $(TMPDIR)\*.obj
+ -@del $(TMPDIR)\*.res
+ -@del $(TMPDIR)\*.exe
+ -@rmd $(OUTDIR)
+ -@rmd $(TMPDIR)
+
+# dependencies
+
+$(TMPDIR)\tk.res: \
+ $(RCDIR)\buttons.bmp \
+ $(RCDIR)\cursor*.cur \
+ $(RCDIR)\tk.ico
+
+$(GENERICDIR)/default.h: $(WINDIR)/tkWinDefault.h
+$(GENERICDIR)/tkButton.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkCanvas.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkEntry.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkFrame.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkListbox.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkMenu.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkMenubutton.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkMessage.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkScale.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkScrollbar.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkText.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkTextIndex.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkTextTag.c: $(GENERICDIR)/default.h
+
+$(GENERICDIR)/tkText.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextBTree.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextDisp.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextDisp.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextImage.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextIndex.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextMark.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextTag.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextWind.c: $(GENERICDIR)/tkText.h
+
+$(GENERICDIR)/tkMacWinMenu.c: $(GENERICDIR)/tkMenu.h
+$(GENERICDIR)/tkMenu.c: $(GENERICDIR)/tkMenu.h
+$(GENERICDIR)/tkMenuDraw.c: $(GENERICDIR)/tkMenu.h
+$(WINDIR)/tkWinMenu.c: $(GENERICDIR)/tkMenu.h
+
+
diff --git a/win/makefile.vc b/win/makefile.vc index 6be320e..ae43eb6 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -1,1027 +1,1036 @@ -#------------------------------------------------------------- -*- makefile -*- -# makefile.vc -- -# -# Microsoft Visual C++ makefile for use with nmake.exe v1.62+ (VC++ 5.0+) -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# Copyright (c) 1995-1996 Sun Microsystems, Inc. -# Copyright (c) 1998-2000 Ajuba Solutions. -# Copyright (c) 2001-2005 ActiveState Corporation. -# Copyright (c) 2001-2004 David Gravereaux. -# Copyright (c) 2003-2008 Pat Thoyts. -#------------------------------------------------------------------------------ - -# Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or -# VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir) -!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WINDOWSSDKDIR) -MSG = ^ -You need to run vcvars32.bat from Developer Studio or setenv.bat from the^ -Platform SDK first to setup the environment. Jump to this line to read^ -the build instructions. -!error $(MSG) -!endif - -#------------------------------------------------------------------------------ -# HOW TO USE this makefile: -# -# 1) It is now necessary to have MSVCDir, MSDevDir or MSSDK set in the -# environment. This is used as a check to see if vcvars32.bat had been -# run prior to running nmake or during the installation of Microsoft -# Visual C++, MSVCDir had been set globally and the PATH adjusted. -# Either way is valid. -# -# You'll need to run vcvars32.bat contained in the MsDev's vc(98)/bin -# directory to setup the proper environment, if needed, for your -# current setup. This is a needed bootstrap requirement and allows the -# swapping of different environments to be easier. -# -# 2) To use the Platform SDK (not expressly needed), run setenv.bat after -# vcvars32.bat according to the instructions for it. This can also -# turn on the 64-bit compiler, if your SDK has it. -# -# 3) Targets are: -# release -- Builds the core, the shell. (default) -# dlls -- Just builds the windows extensions. -# shell -- Just builds the shell and the core. -# core -- Only builds the core [tkXX.(dll|lib)]. -# all -- Builds everything. -# test -- Builds and runs the test suite. -# tktest -- Just builds the binaries for the test suite. -# install -- Installs the built binaries and libraries to $(INSTALLDIR) -# as the root of the install tree. -# cwish -- Builds a console version of wish. -# tidy/clean/hose -- varying levels of cleaning. -# genstubs -- Rebuilds the Stubs table and support files (dev only). -# depend -- Generates an accurate set of source dependancies for this -# makefile. Helpful to avoid problems when the sources are -# refreshed and you rebuild, but can "overbuild" when common -# headers like tkInt.h just get small changes. -# htmlhelp -- Builds a Windows .chm help file for Tcl and Tk from the -# troff manual pages found in $(ROOT)\doc. You need to -# have installed the HTML Help Compiler package from Microsoft -# to produce the .chm file. -# winhelp -- Builds the windows .hlp file for Tcl from the troff man -# files found in $(ROOT)\doc. -# -# 4) Macros usable on the commandline: -# TCLDIR=<path> -# Sets the location for where to find the Tcl headers and -# libraries. The install point is assumed when not specified. -# Tk does need the source directory, though. Tk comes very close -# to not needing the sources, but does, in fact, require them. -# -# INSTALLDIR=<path> -# Sets where to install Tcl from the built binaries. -# C:\Progra~1\Tcl is assumed when not specified. -# -# OPTS=loimpact,msvcrt,nothreads,noxp,pdbs,profile,square,static,staticpkg,symbols,unchecked,none -# Sets special options for the core. The default is for none. -# Any combination of the above may be used (comma separated). -# 'none' will over-ride everything to nothing. -# -# loimpact = Adds a flag for how NT treats the heap to keep memory -# in use, low. This is said to impact alloc performance. -# msvcrt = Affects the static option only to switch it from -# using libcmt(d) as the C runtime [by default] to -# msvcrt(d). This is useful for static embedding -# support. -# nothreads= Turns off full multithreading support. -# noxp = If you do not have the uxtheme.h header then you -# cannot include support for XP themeing. -# square = Include the demo square widget. -# static = Builds a static library of the core instead of a -# dll. The shell will be static (and large), as well. -# staticpkg= Affects the static option only to switch wishXX.exe -# to have the dde and reg extension linked inside it. -# pdbs = Build detached symbols for release builds. -# profile = Adds profiling hooks. Map file is assumed. -# thrdalloc = Use the thread allocator (shared global free pool) -# This is the default on threaded builds. -# tclalloc = Use the old non-thread allocator -# symbols = Debug build. Links to the debug C runtime, disables -# optimizations and creates pdb symbols files. -# unchecked = Allows a symbols build to not use the debug -# enabled runtime (msvcrt.dll not msvcrtd.dll -# or libcmt.lib not libcmtd.lib). -# -# STATS=compdbg,memdbg,none -# Sets optional memory and bytecode compiler debugging code added -# to the core. The default is for none. Any combination of the -# above may be used (comma separated). 'none' will over-ride -# everything to nothing. -# -# compdbg = Enables byte compilation logging. -# memdbg = Enables the debugging memory allocator. -# -# CHECKS=64bit,fullwarn,nodep,none -# Sets special macros for checking compatability. -# -# 64bit = Enable 64bit portability warnings (if available) -# fullwarn = Builds with full compiler and link warnings enabled. -# Very verbose. -# nodep = Turns off compatability macros to ensure the core -# isn't being built with deprecated functions. -# -# MACHINE=(ALPHA|AMD64|IA64|IX86) -# Set the machine type used for the compiler, linker, and -# resource compiler. This hook is needed to tell the tools -# when alternate platforms are requested. IX86 is the default -# when not specified. If the CPU environment variable has been -# set (ie: recent Platform SDK) then MACHINE is set from CPU. -# -# TMP_DIR=<path> -# OUT_DIR=<path> -# Hooks to allow the intermediate and output directories to be -# changed. $(OUT_DIR) is assumed to be -# $(BINROOT)\(Release|Debug) based on if symbols are requested. -# $(TMP_DIR) will de $(OUT_DIR)\<buildtype> by default. -# -# TESTPAT=<file> -# Reads the tests requested to be run from this file. -# -# 5) Examples: -# -# Basic syntax of calling nmake looks like this: -# nmake [-nologo] -f makefile.vc [target|macrodef [target|macrodef] [...]] -# -# Standard (no frills) -# c:\tk_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat -# Setting environment for using Microsoft Visual C++ tools. -# c:\tk_src\win\>nmake -f makefile.vc release -# c:\tk_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl -# -# Building for Win64 -# c:\tk_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat -# Setting environment for using Microsoft Visual C++ tools. -# c:\tk_src\win\>c:\progra~1\platfo~1\setenv.bat /pre64 /RETAIL -# Targeting Windows pre64 RETAIL -# c:\tk_src\win\>nmake -f makefile.vc MACHINE=IA64 -# -#------------------------------------------------------------------------------ -#============================================================================== -############################################################################### - - -# //==================================================================\\ -# >>[ -> Do not modify below this line. <- ]<< -# >>[ Please, use the commandline macros to modify how Tcl is built. ]<< -# >>[ If you need more features, send us a patch for more macros. ]<< -# \\==================================================================// - - -############################################################################### -#============================================================================== -#------------------------------------------------------------------------------ - -!if !exist("makefile.vc") -MSG = ^ -You must run this makefile only from the directory it is in.^ -Please `cd` to its location first. -!error $(MSG) -!endif - -PROJECT = tk -!include "rules.vc" - -!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 -!message *** Tcl sources. -!endif - -# Extra makefile options processing... -!if "$(OPTS)" == "" || [nmakehlp -f "$(OPTS)" "none"] -HAVE_UXTHEME_H = 1 -TTK_SQUARE_WIDGET = 0 -!else -!if [nmakehlp -f $(OPTS) "noxp"] -!message *** Exclude support for XP theme -HAVE_UXTHEME_H = 0 -!else -HAVE_UXTHEME_H = 1 -!endif -!if [nmakehlp -f "$(OPTS)" "square"] -!message *** Include ttk square demo widget -TTK_SQUARE_WIDGET = 1 -!else -TTK_SQUARE_WIDGET = 0 -!endif -!endif - -STUBPREFIX = $(PROJECT)stub -WISHNAMEPREFIX = wish - -BINROOT = $(MAKEDIR) # originally . -ROOT = $(MAKEDIR)\.. # originally .. - -TK_LIBRARY = $(ROOT)\library - -TKIMPLIB = "$(OUT_DIR)\$(PROJECT)$(TK_VERSION)$(SUFX).lib" -TKLIBNAME = $(PROJECT)$(TK_VERSION)$(SUFX).$(EXT) -TKLIB = "$(OUT_DIR)\$(TKLIBNAME)" - -TKSTUBLIBNAME = $(STUBPREFIX)$(TK_VERSION).lib -TKSTUBLIB = "$(OUT_DIR)\$(TKSTUBLIBNAME)" - -WISH = "$(OUT_DIR)\$(WISHNAMEPREFIX)$(TK_VERSION)$(SUFX).exe" -WISHC = "$(OUT_DIR)\$(WISHNAMEPREFIX)c$(TK_VERSION)$(SUFX).exe" - -TKTEST = "$(OUT_DIR)\$(PROJECT)test.exe" -CAT32 = "$(OUT_DIR)\cat32.exe" - -LIB_INSTALL_DIR = $(_INSTALLDIR)\lib -BIN_INSTALL_DIR = $(_INSTALLDIR)\bin -DOC_INSTALL_DIR = $(_INSTALLDIR)\doc -SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\$(PROJECT)$(TK_DOTVERSION) -INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include - -WISHOBJS = \ - $(TMP_DIR)\winMain.obj \ -!if $(TCL_USE_STATIC_PACKAGES) - $(TCLDDELIB) \ - $(TCLREGLIB) \ -!endif - $(TMP_DIR)\wish.res - -TKTESTOBJS = \ - $(TMP_DIR)\testMain.obj \ - $(TMP_DIR)\tkSquare.obj \ - $(TMP_DIR)\tkTest.obj \ - $(TMP_DIR)\tkOldTest.obj \ - $(TMP_DIR)\tkWinTest.obj - -XLIBOBJS = \ - $(TMP_DIR)\xcolors.obj \ - $(TMP_DIR)\xdraw.obj \ - $(TMP_DIR)\xgc.obj \ - $(TMP_DIR)\ximage.obj \ - $(TMP_DIR)\xutil.obj - -TKOBJS = \ - $(TMP_DIR)\tkConsole.obj \ - $(TMP_DIR)\tkUnixMenubu.obj \ - $(TMP_DIR)\tkUnixScale.obj \ - $(XLIBOBJS) \ - $(TMP_DIR)\tkWin3d.obj \ - $(TMP_DIR)\tkWin32Dll.obj \ - $(TMP_DIR)\tkWinButton.obj \ - $(TMP_DIR)\tkWinClipboard.obj \ - $(TMP_DIR)\tkWinColor.obj \ - $(TMP_DIR)\tkWinConfig.obj \ - $(TMP_DIR)\tkWinCursor.obj \ - $(TMP_DIR)\tkWinDialog.obj \ - $(TMP_DIR)\tkWinDraw.obj \ - $(TMP_DIR)\tkWinEmbed.obj \ - $(TMP_DIR)\tkWinFont.obj \ - $(TMP_DIR)\tkWinImage.obj \ - $(TMP_DIR)\tkWinInit.obj \ - $(TMP_DIR)\tkWinKey.obj \ - $(TMP_DIR)\tkWinMenu.obj \ - $(TMP_DIR)\tkWinPixmap.obj \ - $(TMP_DIR)\tkWinPointer.obj \ - $(TMP_DIR)\tkWinRegion.obj \ - $(TMP_DIR)\tkWinScrlbr.obj \ - $(TMP_DIR)\tkWinSend.obj \ - $(TMP_DIR)\tkWinSendCom.obj \ - $(TMP_DIR)\tkWinWindow.obj \ - $(TMP_DIR)\tkWinWm.obj \ - $(TMP_DIR)\tkWinX.obj \ - $(TMP_DIR)\stubs.obj \ - $(TMP_DIR)\tk3d.obj \ - $(TMP_DIR)\tkArgv.obj \ - $(TMP_DIR)\tkAtom.obj \ - $(TMP_DIR)\tkBind.obj \ - $(TMP_DIR)\tkBitmap.obj \ - $(TMP_DIR)\tkBusy.obj \ - $(TMP_DIR)\tkButton.obj \ - $(TMP_DIR)\tkCanvArc.obj \ - $(TMP_DIR)\tkCanvBmap.obj \ - $(TMP_DIR)\tkCanvImg.obj \ - $(TMP_DIR)\tkCanvLine.obj \ - $(TMP_DIR)\tkCanvPoly.obj \ - $(TMP_DIR)\tkCanvPs.obj \ - $(TMP_DIR)\tkCanvText.obj \ - $(TMP_DIR)\tkCanvUtil.obj \ - $(TMP_DIR)\tkCanvWind.obj \ - $(TMP_DIR)\tkCanvas.obj \ - $(TMP_DIR)\tkClipboard.obj \ - $(TMP_DIR)\tkCmds.obj \ - $(TMP_DIR)\tkColor.obj \ - $(TMP_DIR)\tkConfig.obj \ - $(TMP_DIR)\tkCursor.obj \ - $(TMP_DIR)\tkEntry.obj \ - $(TMP_DIR)\tkError.obj \ - $(TMP_DIR)\tkEvent.obj \ - $(TMP_DIR)\tkFileFilter.obj \ - $(TMP_DIR)\tkFocus.obj \ - $(TMP_DIR)\tkFont.obj \ - $(TMP_DIR)\tkFrame.obj \ - $(TMP_DIR)\tkGC.obj \ - $(TMP_DIR)\tkGeometry.obj \ - $(TMP_DIR)\tkGet.obj \ - $(TMP_DIR)\tkGrab.obj \ - $(TMP_DIR)\tkGrid.obj \ - $(TMP_DIR)\tkImage.obj \ - $(TMP_DIR)\tkImgBmap.obj \ - $(TMP_DIR)\tkImgGIF.obj \ - $(TMP_DIR)\tkImgPNG.obj \ - $(TMP_DIR)\tkImgPPM.obj \ - $(TMP_DIR)\tkImgPhoto.obj \ - $(TMP_DIR)\tkImgPhInstance.obj \ - $(TMP_DIR)\tkImgUtil.obj \ - $(TMP_DIR)\tkListbox.obj \ - $(TMP_DIR)\tkMacWinMenu.obj \ - $(TMP_DIR)\tkMain.obj \ - $(TMP_DIR)\tkMain2.obj \ - $(TMP_DIR)\tkMenu.obj \ - $(TMP_DIR)\tkMenubutton.obj \ - $(TMP_DIR)\tkMenuDraw.obj \ - $(TMP_DIR)\tkMessage.obj \ - $(TMP_DIR)\tkPanedWindow.obj \ - $(TMP_DIR)\tkObj.obj \ - $(TMP_DIR)\tkOldConfig.obj \ - $(TMP_DIR)\tkOption.obj \ - $(TMP_DIR)\tkPack.obj \ - $(TMP_DIR)\tkPlace.obj \ - $(TMP_DIR)\tkPointer.obj \ - $(TMP_DIR)\tkRectOval.obj \ - $(TMP_DIR)\tkScale.obj \ - $(TMP_DIR)\tkScrollbar.obj \ - $(TMP_DIR)\tkSelect.obj \ - $(TMP_DIR)\tkStyle.obj \ - $(TMP_DIR)\tkText.obj \ - $(TMP_DIR)\tkTextBTree.obj \ - $(TMP_DIR)\tkTextDisp.obj \ - $(TMP_DIR)\tkTextImage.obj \ - $(TMP_DIR)\tkTextIndex.obj \ - $(TMP_DIR)\tkTextMark.obj \ - $(TMP_DIR)\tkTextTag.obj \ - $(TMP_DIR)\tkTextWind.obj \ - $(TMP_DIR)\tkTrig.obj \ - $(TMP_DIR)\tkUndo.obj \ - $(TMP_DIR)\tkUtil.obj \ - $(TMP_DIR)\tkVisual.obj \ - $(TMP_DIR)\tkStubInit.obj \ - $(TMP_DIR)\tkWindow.obj \ - $(TTK_OBJS) \ -!if !$(STATIC_BUILD) - $(TMP_DIR)\tk.res -!endif - -TTK_OBJS = \ - $(TMP_DIR)\ttkWinMonitor.obj \ - $(TMP_DIR)\ttkWinTheme.obj \ - $(TMP_DIR)\ttkWinXPTheme.obj \ - $(TMP_DIR)\ttkBlink.obj \ - $(TMP_DIR)\ttkButton.obj \ - $(TMP_DIR)\ttkCache.obj \ - $(TMP_DIR)\ttkClamTheme.obj \ - $(TMP_DIR)\ttkClassicTheme.obj \ - $(TMP_DIR)\ttkDefaultTheme.obj \ - $(TMP_DIR)\ttkElements.obj \ - $(TMP_DIR)\ttkEntry.obj \ - $(TMP_DIR)\ttkFrame.obj \ - $(TMP_DIR)\ttkImage.obj \ - $(TMP_DIR)\ttkInit.obj \ - $(TMP_DIR)\ttkLabel.obj \ - $(TMP_DIR)\ttkLayout.obj \ - $(TMP_DIR)\ttkManager.obj \ - $(TMP_DIR)\ttkNotebook.obj \ - $(TMP_DIR)\ttkPanedwindow.obj \ - $(TMP_DIR)\ttkProgress.obj \ - $(TMP_DIR)\ttkScale.obj \ - $(TMP_DIR)\ttkScrollbar.obj \ - $(TMP_DIR)\ttkScroll.obj \ - $(TMP_DIR)\ttkSeparator.obj \ - $(TMP_DIR)\ttkSquare.obj \ - $(TMP_DIR)\ttkState.obj \ - $(TMP_DIR)\ttkTagSet.obj \ - $(TMP_DIR)\ttkTheme.obj \ - $(TMP_DIR)\ttkTrace.obj \ - $(TMP_DIR)\ttkTrack.obj \ - $(TMP_DIR)\ttkTreeview.obj \ - $(TMP_DIR)\ttkWidget.obj \ - $(TMP_DIR)\ttkStubInit.obj - -TKSTUBOBJS = \ - $(TMP_DIR)\tkStubLib.obj \ - $(TMP_DIR)\ttkStubLib.obj - - -WINDIR = $(ROOT)\win -GENERICDIR = $(ROOT)\generic -XLIBDIR = $(ROOT)\xlib -TTKDIR = $(ROOT)\generic\ttk -BITMAPDIR = $(ROOT)\bitmaps -DOCDIR = $(ROOT)\doc -RCDIR = $(WINDIR)\rc - -TK_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" -I"$(BITMAPDIR)" -I"$(XLIBDIR)" \ - $(TCL_INCLUDES) - -CONFIG_DEFS =-DSTDC_HEADERS=1 -DHAVE_SYS_TYPES_H=1 -DHAVE_SYS_STAT_H=1 \ - -DHAVE_STDLIB_H=1 -DHAVE_STRING_H=1 -DHAVE_MEMORY_H=1 \ - -DHAVE_STRINGS_H=1 -DHAVE_INTTYPES_H=1 -DHAVE_STDINT_H=1 \ - -DSUPPORT_CONFIG_EMBEDDED \ -!if $(HAVE_UXTHEME_H) - -DHAVE_UXTHEME_H=1 \ -!endif -!if $(TTK_SQUARE_WIDGET) - -DTTK_SQUARE_WIDGET=1 \ -!endif - -TK_DEFINES =-DBUILD_ttk $(OPTDEFINES) $(CONFIG_DEFS) -Dinline=__inline - -#--------------------------------------------------------------------- -# Compile flags -#--------------------------------------------------------------------- - -!if !$(DEBUG) -!if $(OPTIMIZING) -### This cranks the optimization level to maximize speed -### We can't use -O2 because sometimes it causes problems. -cdebug = $(OPTIMIZATIONS) -!else -cdebug = -!endif -!if $(SYMBOLS) -cdebug = $(cdebug) -Zi -!endif -!else if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64" -### Warnings are too many, can't support warnings into errors. -cdebug = -Zi -Od $(DEBUGFLAGS) -!else -cdebug = -Zi -WX $(DEBUGFLAGS) -!endif - -### Declarations common to all compiler options -cwarn = $(WARNINGS) -D _CRT_SECURE_NO_DEPRECATE -D _CRT_NONSTDC_NO_DEPRECATE -cflags = -nologo -c $(COMPILERFLAGS) $(cwarn) -Fp$(TMP_DIR)^\ - -!if $(MSVCRT) -!if $(DEBUG) && !$(UNCHECKED) -crt = -MDd -!else -crt = -MD -!endif -!else -!if $(DEBUG) && !$(UNCHECKED) -crt = -MTd -!else -crt = -MT -!endif -!endif - -BASE_CFLAGS = $(cdebug) $(cflags) $(crt) $(TK_INCLUDES) -TK_CFLAGS = $(BASE_CFLAGS) $(TK_DEFINES) -DUSE_TCL_STUBS -CON_CFLAGS = $(cdebug) $(cflags) $(crt) -DCONSOLE -WISH_CFLAGS = $(BASE_CFLAGS) $(TK_DEFINES) -STUB_CFLAGS = $(cflags) $(cdebug) $(TK_DEFINES) - -#--------------------------------------------------------------------- -# Link flags -#--------------------------------------------------------------------- - -!if $(DEBUG) -ldebug = -debug -debugtype:cv -!else -ldebug = -release -opt:ref -opt:icf,3 -!if $(SYMBOLS) -ldebug = $(ldebug) -debug -debugtype:cv -!endif -!endif - -### Declarations common to all linker options -lflags = -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug) - -!if $(PROFILE) -lflags = $(lflags) -profile -!endif - -!if $(ALIGN98_HACK) && !$(STATIC_BUILD) -### Align sections for PE size savings. -lflags = $(lflags) -opt:nowin98 -!else if !$(ALIGN98_HACK) && $(STATIC_BUILD) -### Align sections for speed in loading by choosing the virtual page size. -lflags = $(lflags) -align:4096 -!endif - -!if $(LOIMPACT) -lflags = $(lflags) -ws:aggressive -!endif - -dlllflags = $(lflags) -dll -conlflags = $(lflags) -subsystem:console -guilflags = $(lflags) -subsystem:windows - -tcllibs = $(TCLSTUBLIB) $(TCLIMPLIB) - -baselibs = netapi32.lib kernel32.lib user32.lib advapi32.lib ws2_32.lib -# Avoid 'unresolved external symbol __security_cookie' errors. -# c.f. http://support.microsoft.com/?id=894573 -!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64" -!if $(VCVERSION) > 1399 && $(VCVERSION) < 1500 -baselibs = $(baselibs) bufferoverflowU.lib -!endif -!endif -guilibs = $(baselibs) gdi32.lib - - -#--------------------------------------------------------------------- -# TkTest flags -#--------------------------------------------------------------------- - -!if "$(TESTPAT)" != "" -TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT) -!endif - - -#--------------------------------------------------------------------- -# Project specific targets -#--------------------------------------------------------------------- - -release: setup $(TKSTUBLIB) $(WISH) -all: release $(CAT32) -core: setup $(TKSTUBLIB) $(TKLIB) -cwish: $(WISHC) -install: install-binaries install-libraries install-docs -tktest: setup $(TKTEST) $(CAT32) - - -test: test-classic test-ttk - -test-classic: setup $(TKTEST) $(TKLIB) $(CAT32) - @set TCL_LIBRARY=$(TCL_LIBRARY:\=/) - @set TK_LIBRARY=$(TK_LIBRARY:\=/) - @set TCLLIBPATH= -!if $(TCLINSTALL) - @set PATH=$(_TCLDIR)\bin;$(PATH) -!else - @set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH) -!endif - $(DEBUGGER) $(TKTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) | $(CAT32) - -test-ttk: setup $(TKTEST) $(TKLIB) $(CAT32) - @set TCL_LIBRARY=$(TCL_LIBRARY:\=/) - @set TK_LIBRARY=$(TK_LIBRARY:\=/) - @set TCLLIBPATH= -!if $(TCLINSTALL) - @set PATH=$(_TCLDIR)\bin;$(PATH) -!else - @set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH) -!endif - $(DEBUGGER) $(TKTEST) "$(ROOT:\=/)/tests/ttk/all.tcl" $(TESTFLAGS) | $(CAT32) - -runtest: setup $(TKTEST) $(TKLIB) $(CAT32) - @set TCL_LIBRARY=$(TCL_LIBRARY:\=/) - @set TK_LIBRARY=$(TK_LIBRARY:\=/) - @set TCLLIBPATH= -!if $(TCLINSTALL) - @set PATH=$(_TCLDIR)\bin;$(PATH) -!else - @set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH) -!endif - $(DEBUGGER) $(TKTEST) - -rundemo: setup $(TKTEST) $(TKLIB) $(CAT32) - @set TCL_LIBRARY=$(TCL_LIBRARY:\=/) - @set TK_LIBRARY=$(TK_LIBRARY:\=/) - @set TCLLIBPATH= -!if $(TCLINSTALL) - @set PATH=$(_TCLDIR)\bin;$(PATH) -!else - @set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH) -!endif - $(TKTEST) $(ROOT:\=/)\library\demos\widget - -shell: setup $(WISH) - @set TCL_LIBRARY=$(TCL_LIBRARY:\=/) - @set TK_LIBRARY=$(TK_LIBRARY:\=/) - @set TCLLIBPATH= -!if $(TCLINSTALL) - @set PATH=$(_TCLDIR)\bin;$(PATH) -!else - @set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH) -!endif - $(DEBUGGER) $(WISH) << - console show -<< - -dbgshell: setup $(WISH) - @set TCL_LIBRARY=$(TCL_LIBRARY:\=/) - @set TK_LIBRARY=$(TK_LIBRARY:\=/) - @set TCLLIBPATH= -!if $(TCLINSTALL) - @set PATH=$(_TCLDIR)\bin;$(PATH) -!else - @set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH) -!endif - windbg $(WISH) - -setup: - @if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR) - @if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR) - -!if !$(STATIC_BUILD) -$(TKIMPLIB): $(TKLIB) -!endif - -$(TKLIB): $(TKOBJS) -!if $(STATIC_BUILD) - $(lib32) -nologo -out:$@ @<< -$** -<< -!else - $(link32) $(dlllflags) -base:@$(COFFBASE),tk -out:$@ $(guilibs) \ - $(TCLSTUBLIB) @<< -$** -<< - $(_VC_MANIFEST_EMBED_DLL) - -@del $*.exp -!endif - - -$(TKSTUBLIB): $(TKSTUBOBJS) - $(lib32) -nologo -nodefaultlib -out:$@ $** - - -$(WISH): $(WISHOBJS) $(TKSTUBLIB) $(TKIMPLIB) - $(link32) $(guilflags) -stack:2300000 -out:$@ $(guilibs) $(tcllibs) $** - $(_VC_MANIFEST_EMBED_EXE) - - -$(WISHC): $(WISHOBJS) $(TKSTUBLIB) $(TKIMPLIB) - $(link32) $(conlflags) -stack:2300000 -out:$@ $(guilibs) $(tcllibs) $** - $(_VC_MANIFEST_EMBED_EXE) - - -$(TKTEST): $(TKTESTOBJS) $(TKSTUBLIB) $(TKIMPLIB) - $(link32) $(guilflags) -stack:2300000 -out:$@ $(guilibs) $(tcllibs) $** - $(_VC_MANIFEST_EMBED_EXE) - - -$(CAT32): $(_TCLDIR)\win\cat.c - $(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $? - $(link32) $(conlflags) -out:$@ -stack:16384 $(TMP_DIR)\cat.obj $(baselibs) - $(_VC_MANIFEST_EMBED_EXE) - -#--------------------------------------------------------------------- -# Regenerate the stubs files. [Development use only] -#--------------------------------------------------------------------- - -genstubs: -!if !exist($(TCLSH)) - @echo Build tclsh first! -!else - set TCL_LIBRARY=$(TCL_LIBRARY) - $(TCLSH) $(_TCLDIR)\tools\genStubs.tcl $(GENERICDIR) \ - $(GENERICDIR)\$(PROJECT).decls $(GENERICDIR)\$(PROJECT)Int.decls -!endif - - -#--------------------------------------------------------------------- -# Build the Windows HTML help file. -#--------------------------------------------------------------------- - -# NOTE: you can define HHC on the command-line to override this -!ifndef HHC -HHC=""%ProgramFiles%\HTML Help Workshop\hhc.exe"" -!endif -HTMLDIR=$(ROOT)\html -HTMLBASE=TclTk$(VERSION) -HHPFILE=$(HTMLDIR)\$(HTMLBASE).hhp -CHMFILE=$(HTMLDIR)\$(HTMLBASE).chm - -htmlhelp: chmsetup $(CHMFILE) - -$(CHMFILE): $(DOCDIR)\* - @$(TCLSH) $(TCLTOOLSDIR)\tcltk-man2html.tcl - @echo Compiling HTML help project - @$(HHC) <<$(HHPFILE) >NUL -[OPTIONS] -Compatibility=1.1 or later -Compiled file=$(HTMLBASE).chm -Display compile progress=no -Error log file=$(HTMLBASE).log -Language=0x409 English (United States) -Title=Tcl/Tk $(DOT_VERSION) Help -[FILES] -contents.htm -docs.css -Keywords -TclCmd -TclLib -TkCmd -TkLib -UserCmd -<< - -chmsetup: - @if not exist $(HTMLDIR)\nul mkdir $(HTMLDIR) - -#------------------------------------------------------------------------- -# Build the old-style Windows .hlp file -#------------------------------------------------------------------------- - -HLPBASE = $(PROJECT)$(TK_VERSION) -HELPFILE = $(OUT_DIR)\$(HLPBASE).hlp -HELPCNT = $(OUT_DIR)\$(HLPBASE).cnt -DOCTMP_DIR = $(OUT_DIR)\$(PROJECT)_docs -HELPRTF = $(DOCTMP_DIR)\$(PROJECT).rtf -MAN2HELP = $(DOCTMP_DIR)\man2help.tcl -MAN2HELP2 = $(DOCTMP_DIR)\man2help2.tcl -INDEX = $(DOCTMP_DIR)\index.tcl -BMP = $(DOCTMP_DIR)\lamp.bmp -BMP_NOPATH = lamp.bmp -MAN2TCL = $(DOCTMP_DIR)\man2tcl.exe - -winhelp: docsetup $(HELPFILE) - -docsetup: - @if not exist $(DOCTMP_DIR)\nul mkdir $(DOCTMP_DIR) - -$(MAN2HELP) $(MAN2HELP2) $(INDEX): $(TCLTOOLSDIR)\$$(@F) - $(CPY) $(TCLTOOLSDIR)\$(@F) $(@D) - -$(BMP): - $(CPY) $(WINDIR)\rc\$(@F) $(@D) - -$(HELPFILE): $(HELPRTF) $(BMP) - cd $(DOCTMP_DIR) - start /wait hcrtf.exe -x <<$(PROJECT).hpj -[OPTIONS] -COMPRESS=12 Hall Zeck -LCID=0x409 0x0 0x0 ; English (United States) -TITLE=Tk Reference Manual -BMROOT=. -CNT=$(@B).cnt -HLP=$(@B).hlp - -[FILES] -$(PROJECT).rtf - -[WINDOWS] -main="Tcl/Tk Reference Manual",,27648,(r15263976),(r4227327) - -[CONFIG] -BrowseButtons() -CreateButton(1, "Web", ExecFile("http://www.tcl.tk")) -CreateButton(2, "SF", ExecFile("http://sf.net/projects/tcl")) -CreateButton(3, "Wiki", ExecFile("http://wiki.tcl.tk")) -CreateButton(4, "FAQ", ExecFile("http://www.purl.org/NET/Tcl-FAQ/")) -<< - cd $(MAKEDIR) - @$(CPY) "$(DOCTMP_DIR)\$(@B).hlp" "$(OUT_DIR)" - @$(CPY) "$(DOCTMP_DIR)\$(@B).cnt" "$(OUT_DIR)" - -$(MAN2TCL): $(TCLTOOLSDIR)\$$(@B).c - $(cc32) $(TK_CFLAGS) -Fo$(@D)\ $(TCLTOOLSDIR)\$(@B).c - $(link32) $(conlflags) -out:$@ -stack:16384 $(@D)\man2tcl.obj - $(_VC_MANIFEST_EMBED_EXE) - -$(HELPRTF): $(MAN2TCL) $(MAN2HELP) $(MAN2HELP2) $(INDEX) - $(TCLSH) $(MAN2HELP) -bitmap $(BMP_NOPATH) $(PROJECT) $(TK_VERSION) $(DOCDIR:\=/) - -install-docs: -!if exist($(HELPFILE)) - $(CPY) "$(HELPFILE)" "$(DOC_INSTALL_DIR)\" - $(CPY) "$(HELPCNT)" "$(DOC_INSTALL_DIR)\" - $(TCLSH) << -puts "Installing $(PROJECT)'s helpfile contents into Tcl's ..." -set f [open "$(DOC_INSTALL_DIR:\=/)/tcl$(TK_VERSION).cnt" r] -while {![eof $$f]} { - if {[regexp {:Include $(PROJECT)([0-9]{2}).cnt} [gets $$f] dummy ver]} { - if {$$ver == $(TK_VERSION)} { - puts "Already installed." - exit - } else { - # do something here logical to remove (or replace) it. - puts "$$ver != $(TK_VERSION), unfinished code path, die, die!" - exit 1 - } - } -} -close $$f -set f [open "$(DOC_INSTALL_DIR:\=/)/tcl$(TK_VERSION).cnt" a] -puts $$f {:Include $(HLPBASE).cnt} -close $$f -<< - start /wait winhlp32 -g $(DOC_INSTALL_DIR)\tcl$(TK_VERSION).hlp -!endif - -#--------------------------------------------------------------------- -# Special case object file targets -#--------------------------------------------------------------------- - -$(TMP_DIR)\testMain.obj: $(WINDIR)\winMain.c - $(cc32) $(WISH_CFLAGS) -DTK_TEST \ - -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \ - -Fo$@ $? - -$(TMP_DIR)\tkTest.obj: $(GENERICDIR)\tkTest.c - $(cc32) $(WISH_CFLAGS) -Fo$@ $? - -$(TMP_DIR)\tkOldTest.obj: $(GENERICDIR)\tkOldTest.c - $(cc32) $(WISH_CFLAGS) -Fo$@ $? - -$(TMP_DIR)\tkWinTest.obj: $(WINDIR)\tkWinTest.c - $(cc32) $(WISH_CFLAGS) -Fo$@ $? - -$(TMP_DIR)\tkSquare.obj: $(GENERICDIR)\tkSquare.c - $(cc32) $(WISH_CFLAGS) -Fo$@ $? - -$(TMP_DIR)\winMain.obj: $(WINDIR)\winMain.c - $(cc32) $(WISH_CFLAGS) \ - -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \ - -Fo$@ $? - -$(TMP_DIR)\tkMain2.obj: $(GENERICDIR)\tkMain.c - $(cc32) -DBUILD_tk $(TK_CFLAGS) -DTK_ASCII_MAIN -Fo$@ $? - -# The following objects are part of the stub library and should not -# be built as DLL objects but none of the symbols should be exported -# and no reference made to a C runtime. - -$(TMP_DIR)\tkStubLib.obj : $(GENERICDIR)\tkStubLib.c - $(cc32) $(STUB_CFLAGS) $(TK_INCLUDES) -Zl -DSTATIC_BUILD -Fo$@ $? - - -$(TMP_DIR)\wish.exe.manifest: $(WINDIR)\wish.exe.manifest.in - @nmakehlp -s << $** >$@ -@MACHINE@ $(MACHINE:IX86=X86) -@TK_WIN_VERSION@ $(TK_DOTVERSION).0.0 -<< - -#--------------------------------------------------------------------- -# Generate the source dependencies. Having dependency rules will -# improve incremental build accuracy without having to resort to a -# full rebuild just because some non-global header file like -# tclCompile.h was changed. These rules aren't needed when building -# from scratch. -#--------------------------------------------------------------------- - -depend: -!if !exist($(TCLSH)) - @echo Build tclsh first! -!else - set TCL_LIBRARY=$(TCL_LIBRARY) - $(TCLSH) $(TCLTOOLSDIR:\=/)/mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \ - -passthru:"-DBUILD_tk $(TK_INCLUDES)" $(GENERICDIR),$$(GENERICDIR) \ - $(WINDIR),$$(WINDIR) $(TTKDIR),$$(TTKDIR) $(XLIBDIR),$$(XLIBDIR) \ - $(BITMAPDIR),$$(BITMAPDIR) @<< -$(TKOBJS) -<< -!endif - -#--------------------------------------------------------------------- -# Dependency rules -#--------------------------------------------------------------------- - -$(TMP_DIR)\tk.res: \ - $(RCDIR)\buttons.bmp \ - $(RCDIR)\cursor*.cur \ - $(RCDIR)\tk.ico - -!if exist("$(OUT_DIR)\depend.mk") -!include "$(OUT_DIR)\depend.mk" -!message *** Dependency rules in use. -!else -!message *** Dependency rules are not being used. -!endif - -### add a spacer in the output -!message - -#--------------------------------------------------------------------- -# Implicit rules -#--------------------------------------------------------------------- - -{$(XLIBDIR)}.c{$(TMP_DIR)}.obj:: - $(cc32) -DBUILD_tk $(TK_CFLAGS) -Fo$(TMP_DIR)\ @<< -$< -<< - -{$(GENERICDIR)}.c{$(TMP_DIR)}.obj:: - $(cc32) -DBUILD_tk $(TK_CFLAGS) -Fo$(TMP_DIR)\ @<< -$< -<< - -{$(TTKDIR)}.c{$(TMP_DIR)}.obj:: - $(cc32) -DBUILD_tk $(TK_CFLAGS) -Fo$(TMP_DIR)\ @<< -$< -<< - -{$(WINDIR)}.c{$(TMP_DIR)}.obj:: - $(cc32) -DBUILD_tk $(TK_CFLAGS) -Fo$(TMP_DIR)\ @<< -$< -<< - -{$(ROOT)\unix}.c{$(TMP_DIR)}.obj:: - $(cc32) -DBUILD_tk $(TK_CFLAGS) -Fo$(TMP_DIR)\ @<< -$< -<< - -{$(RCDIR)}.rc{$(TMP_DIR)}.res: - $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" $(TCL_INCLUDES) \ - -d DEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \ - -d TCL_THREADS=$(TCL_THREADS) \ - -d STATIC_BUILD=$(STATIC_BUILD) \ - $< - -$(TMP_DIR)\tk.res: $(TMP_DIR)\wish.exe.manifest -$(TMP_DIR)\wish.res: $(TMP_DIR)\wish.exe.manifest - -.SUFFIXES: -.SUFFIXES:.c .rc - - -#--------------------------------------------------------------------- -# Installation. -#--------------------------------------------------------------------- - -install-binaries: - @echo installing binaries - @$(CPY) "$(WISH)" "$(BIN_INSTALL_DIR)\" -!if $(TKLIB) != $(TKIMPLIB) - @$(CPY) "$(TKLIB)" "$(BIN_INSTALL_DIR)\" -!endif - @$(CPY) "$(TKIMPLIB)" "$(LIB_INSTALL_DIR)\" - @$(CPY) "$(TKSTUBLIB)" "$(LIB_INSTALL_DIR)\" -!if !$(STATIC_BUILD) - @echo creating package index - @type << > $(OUT_DIR)\pkgIndex.tcl -if {[catch {package present Tcl $(TCL_PATCH_LEVEL)}]} { return } -if {($$::tcl_platform(platform) eq "unix") && ([info exists ::env(DISPLAY)] - || ([info exists ::argv] && ("-display" in $$::argv)))} { - package ifneeded Tk $(TK_PATCH_LEVEL) [list load [file join $$dir .. .. bin libtk$(TK_DOTVERSION).dll] Tk] -} else { - package ifneeded Tk $(TK_PATCH_LEVEL) [list load [file join $$dir .. .. bin $(TKLIBNAME)] Tk] -} -<< - @$(CPY) $(OUT_DIR)\pkgIndex.tcl "$(SCRIPT_INSTALL_DIR)\" -!endif - -#" - -install-libraries: - @echo installing Tk headers - @$(CPY) "$(GENERICDIR)\tk.h" "$(INCLUDE_INSTALL_DIR)\" - @$(CPY) "$(GENERICDIR)\tkDecls.h" "$(INCLUDE_INSTALL_DIR)\" - @$(CPY) "$(GENERICDIR)\tkPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\" - @$(CPY) "$(GENERICDIR)\tkIntXlibDecls.h" "$(INCLUDE_INSTALL_DIR)\" - @$(CPY) "$(XLIBDIR)\X11\*.h" "$(INCLUDE_INSTALL_DIR)\X11\" - @echo installing script library - @$(CPY) "$(ROOT)\library\*" "$(SCRIPT_INSTALL_DIR)\" - @echo installing theme library - @$(CPY) "$(ROOT)\library\ttk\*" "$(SCRIPT_INSTALL_DIR)\ttk\" - @echo installing demos - @$(CPY) "$(ROOT)\library\demos\*" "$(SCRIPT_INSTALL_DIR)\demos\" - @$(CPY) "$(ROOT)\library\demos\images\*" "$(SCRIPT_INSTALL_DIR)\demos\images\" - @echo installing images - @$(CPY) "$(ROOT)\library\images\*" "$(SCRIPT_INSTALL_DIR)\images\" - @echo installing language files - @$(CPY) "$(ROOT)\library\msgs\*" "$(SCRIPT_INSTALL_DIR)\msgs\" - -#" - -#--------------------------------------------------------------------- -# Clean up -#--------------------------------------------------------------------- - -tidy: -!if $(TKLIB) != $(TKIMPLIB) - @echo Removing $(TKLIB) ... - @if exist $(TKLIB) del $(TKLIB) -!endif - @echo Removing $(TKIMPLIB) ... - @if exist $(TKIMPLIB) del $(TKIMPLIB) - @echo Removing $(WISH) ... - @if exist $(WISH) del $(WISH) - @echo Removing $(TKTEST) ... - @if exist $(TKTEST) del $(TKTEST) - @echo Removing $(TKSTUBLIB) ... - @if exist $(TKSTUBLIB) del $(TKSTUBLIB) - -clean: - @echo Cleaning $(TMP_DIR)\* ... - @if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR) - @echo Cleaning $(WINDIR)\nmakehlp.obj ... - @if exist $(WINDIR)\nmakehlp.obj del $(WINDIR)\nmakehlp.obj - @echo Cleaning $(WINDIR)\nmakehlp.exe ... - @if exist $(WINDIR)\nmakehlp.exe del $(WINDIR)\nmakehlp.exe - @echo Cleaning $(WINDIR)\_junk.pch ... - @if exist $(WINDIR)\_junk.pch del $(WINDIR)\_junk.pch - @echo Cleaning $(WINDIR)\vercl.x ... - @if exist $(WINDIR)\vercl.x del $(WINDIR)\vercl.x - @echo Cleaning $(WINDIR)\vercl.i ... - @if exist $(WINDIR)\vercl.i del $(WINDIR)\vercl.i - @echo Cleaning $(WINDIR)\versions.vc ... - @if exist $(WINDIR)\versions.vc del $(WINDIR)\versions.vc - -realclean: hose - -hose: - @echo Hosing $(OUT_DIR)\* ... - @if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR) +#------------------------------------------------------------- -*- makefile -*-
+# makefile.vc --
+#
+# Microsoft Visual C++ makefile for use with nmake.exe v1.62+ (VC++ 5.0+)
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-2000 Ajuba Solutions.
+# Copyright (c) 2001-2005 ActiveState Corporation.
+# Copyright (c) 2001-2004 David Gravereaux.
+# Copyright (c) 2003-2008 Pat Thoyts.
+#------------------------------------------------------------------------------
+
+# Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or
+# VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir)
+!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WINDOWSSDKDIR)
+MSG = ^
+You need to run vcvars32.bat from Developer Studio or setenv.bat from the^
+Platform SDK first to setup the environment. Jump to this line to read^
+the build instructions.
+!error $(MSG)
+!endif
+
+#------------------------------------------------------------------------------
+# HOW TO USE this makefile:
+#
+# 1) It is now necessary to have MSVCDir, MSDevDir or MSSDK set in the
+# environment. This is used as a check to see if vcvars32.bat had been
+# run prior to running nmake or during the installation of Microsoft
+# Visual C++, MSVCDir had been set globally and the PATH adjusted.
+# Either way is valid.
+#
+# You'll need to run vcvars32.bat contained in the MsDev's vc(98)/bin
+# directory to setup the proper environment, if needed, for your
+# current setup. This is a needed bootstrap requirement and allows the
+# swapping of different environments to be easier.
+#
+# 2) To use the Platform SDK (not expressly needed), run setenv.bat after
+# vcvars32.bat according to the instructions for it. This can also
+# turn on the 64-bit compiler, if your SDK has it.
+#
+# 3) Targets are:
+# release -- Builds the core, the shell and the dlls. (default)
+# dlls -- Just builds the windows extensions.
+# shell -- Just builds the shell and the core.
+# core -- Only builds the core [tkXX.(dll|lib)].
+# all -- Builds everything.
+# test -- Builds and runs the test suite.
+# tktest -- Just builds the binaries for the test suite.
+# install -- Installs the built binaries and libraries to $(INSTALLDIR)
+# as the root of the install tree.
+# cwish -- Builds a console version of wish.
+# tidy/clean/hose -- varying levels of cleaning.
+# genstubs -- Rebuilds the Stubs table and support files (dev only).
+# depend -- Generates an accurate set of source dependancies for this
+# makefile. Helpful to avoid problems when the sources are
+# refreshed and you rebuild, but can "overbuild" when common
+# headers like tkInt.h just get small changes.
+# htmlhelp -- Builds a Windows .chm help file for Tcl and Tk from the
+# troff manual pages found in $(ROOT)\doc. You need to
+# have installed the HTML Help Compiler package from Microsoft
+# to produce the .chm file.
+# winhelp -- Builds the windows .hlp file for Tcl from the troff man
+# files found in $(ROOT)\doc.
+#
+# 4) Macros usable on the commandline:
+# TCLDIR=<path>
+# Sets the location for where to find the Tcl headers and
+# libraries. The install point is assumed when not specified.
+# Tk does need the source directory, though. Tk comes very close
+# to not needing the sources, but does, in fact, require them.
+#
+# INSTALLDIR=<path>
+# Sets where to install Tcl from the built binaries.
+# C:\Progra~1\Tcl is assumed when not specified.
+#
+# OPTS=loimpact,msvcrt,nothreads,noxp,pdbs,profile,square,static,staticpkg,symbols,unchecked,none
+# Sets special options for the core. The default is for none.
+# Any combination of the above may be used (comma separated).
+# 'none' will over-ride everything to nothing.
+#
+# loimpact = Adds a flag for how NT treats the heap to keep memory
+# in use, low. This is said to impact alloc performance.
+# msvcrt = Affects the static option only to switch it from
+# using libcmt(d) as the C runtime [by default] to
+# msvcrt(d). This is useful for static embedding
+# support.
+# nothreads= Turns off full multithreading support.
+# noxp = If you do not have the uxtheme.h header then you
+# cannot include support for XP themeing.
+# square = Include the demo square widget.
+# static = Builds a static library of the core instead of a
+# dll. The shell will be static (and large), as well.
+# staticpkg= Affects the static option only to switch wishXX.exe
+# to have the dde and reg extension linked inside it.
+# pdbs = Build detached symbols for release builds.
+# profile = Adds profiling hooks. Map file is assumed.
+# thrdalloc = Use the thread allocator (shared global free pool)
+# This is the default on threaded builds.
+# tclalloc = Use the old non-thread allocator
+# symbols = Debug build. Links to the debug C runtime, disables
+# optimizations and creates pdb symbols files.
+# unchecked = Allows a symbols build to not use the debug
+# enabled runtime (msvcrt.dll not msvcrtd.dll
+# or libcmt.lib not libcmtd.lib).
+#
+# STATS=compdbg,memdbg,none
+# Sets optional memory and bytecode compiler debugging code added
+# to the core. The default is for none. Any combination of the
+# above may be used (comma separated). 'none' will over-ride
+# everything to nothing.
+#
+# compdbg = Enables byte compilation logging.
+# memdbg = Enables the debugging memory allocator.
+#
+# CHECKS=64bit,fullwarn,nodep,none
+# Sets special macros for checking compatability.
+#
+# 64bit = Enable 64bit portability warnings (if available)
+# fullwarn = Builds with full compiler and link warnings enabled.
+# Very verbose.
+# nodep = Turns off compatability macros to ensure the core
+# isn't being built with deprecated functions.
+#
+# MACHINE=(ALPHA|AMD64|IA64|IX86)
+# Set the machine type used for the compiler, linker, and
+# resource compiler. This hook is needed to tell the tools
+# when alternate platforms are requested. IX86 is the default
+# when not specified. If the CPU environment variable has been
+# set (ie: recent Platform SDK) then MACHINE is set from CPU.
+#
+# TMP_DIR=<path>
+# OUT_DIR=<path>
+# Hooks to allow the intermediate and output directories to be
+# changed. $(OUT_DIR) is assumed to be
+# $(BINROOT)\(Release|Debug) based on if symbols are requested.
+# $(TMP_DIR) will de $(OUT_DIR)\<buildtype> by default.
+#
+# TESTPAT=<file>
+# Reads the tests requested to be run from this file.
+#
+# 5) Examples:
+#
+# Basic syntax of calling nmake looks like this:
+# nmake [-nologo] -f makefile.vc [target|macrodef [target|macrodef] [...]]
+#
+# Standard (no frills)
+# c:\tk_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat
+# Setting environment for using Microsoft Visual C++ tools.
+# c:\tk_src\win\>nmake -f makefile.vc release
+# c:\tk_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl
+#
+# Building for Win64
+# c:\tk_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat
+# Setting environment for using Microsoft Visual C++ tools.
+# c:\tk_src\win\>c:\progra~1\platfo~1\setenv.bat /pre64 /RETAIL
+# Targeting Windows pre64 RETAIL
+# c:\tk_src\win\>nmake -f makefile.vc MACHINE=IA64
+#
+#------------------------------------------------------------------------------
+#==============================================================================
+###############################################################################
+
+
+# //==================================================================\\
+# >>[ -> Do not modify below this line. <- ]<<
+# >>[ Please, use the commandline macros to modify how Tcl is built. ]<<
+# >>[ If you need more features, send us a patch for more macros. ]<<
+# \\==================================================================//
+
+
+###############################################################################
+#==============================================================================
+#------------------------------------------------------------------------------
+
+!if !exist("makefile.vc")
+MSG = ^
+You must run this makefile only from the directory it is in.^
+Please `cd` to its location first.
+!error $(MSG)
+!endif
+
+PROJECT = tk
+!include "rules.vc"
+
+!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
+!message *** Tcl sources.
+!endif
+
+# Extra makefile options processing...
+!if "$(OPTS)" == "" || [nmakehlp -f "$(OPTS)" "none"]
+HAVE_UXTHEME_H = 1
+TTK_SQUARE_WIDGET = 0
+!else
+!if [nmakehlp -f $(OPTS) "noxp"]
+!message *** Exclude support for XP theme
+HAVE_UXTHEME_H = 0
+!else
+HAVE_UXTHEME_H = 1
+!endif
+!if [nmakehlp -f "$(OPTS)" "square"]
+!message *** Include ttk square demo widget
+TTK_SQUARE_WIDGET = 1
+!else
+TTK_SQUARE_WIDGET = 0
+!endif
+!endif
+
+STUBPREFIX = $(PROJECT)stub
+WISHNAMEPREFIX = wish
+
+BINROOT = $(MAKEDIR) # originally .
+ROOT = $(MAKEDIR)\.. # originally ..
+
+TK_LIBRARY = $(ROOT)\library
+
+TKIMPLIB = "$(OUT_DIR)\$(PROJECT)$(TK_VERSION)$(SUFX).lib"
+TKLIBNAME = $(PROJECT)$(TK_VERSION)$(SUFX).$(EXT)
+TKLIB = "$(OUT_DIR)\$(TKLIBNAME)"
+
+TKSTUBLIBNAME = $(STUBPREFIX)$(TK_VERSION).lib
+TKSTUBLIB = "$(OUT_DIR)\$(TKSTUBLIBNAME)"
+
+WISH = "$(OUT_DIR)\$(WISHNAMEPREFIX)$(TK_VERSION)$(SUFX).exe"
+WISHC = "$(OUT_DIR)\$(WISHNAMEPREFIX)c$(TK_VERSION)$(SUFX).exe"
+
+TKTEST = "$(OUT_DIR)\$(PROJECT)test.exe"
+CAT32 = "$(OUT_DIR)\cat32.exe"
+
+LIB_INSTALL_DIR = $(_INSTALLDIR)\lib
+BIN_INSTALL_DIR = $(_INSTALLDIR)\bin
+DOC_INSTALL_DIR = $(_INSTALLDIR)\doc
+SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\$(PROJECT)$(TK_DOTVERSION)
+INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include
+
+WISHOBJS = \
+ $(TMP_DIR)\winMain.obj \
+!if $(TCL_USE_STATIC_PACKAGES)
+ $(TCLDDELIB) \
+ $(TCLREGLIB) \
+!endif
+ $(TMP_DIR)\wish.res
+
+TKTESTOBJS = \
+ $(TMP_DIR)\testMain.obj \
+ $(TMP_DIR)\tkSquare.obj \
+ $(TMP_DIR)\tkTest.obj \
+ $(TMP_DIR)\tkOldTest.obj \
+ $(TMP_DIR)\tkWinTest.obj
+
+XLIBOBJS = \
+ $(TMP_DIR)\xcolors.obj \
+ $(TMP_DIR)\xdraw.obj \
+ $(TMP_DIR)\xgc.obj \
+ $(TMP_DIR)\ximage.obj \
+ $(TMP_DIR)\xutil.obj
+
+TKOBJS = \
+ $(TMP_DIR)\tkConsole.obj \
+ $(TMP_DIR)\tkUnixMenubu.obj \
+ $(TMP_DIR)\tkUnixScale.obj \
+ $(XLIBOBJS) \
+ $(TMP_DIR)\tkWin3d.obj \
+ $(TMP_DIR)\tkWin32Dll.obj \
+ $(TMP_DIR)\tkWinButton.obj \
+ $(TMP_DIR)\tkWinClipboard.obj \
+ $(TMP_DIR)\tkWinColor.obj \
+ $(TMP_DIR)\tkWinConfig.obj \
+ $(TMP_DIR)\tkWinCursor.obj \
+ $(TMP_DIR)\tkWinDialog.obj \
+ $(TMP_DIR)\tkWinDraw.obj \
+ $(TMP_DIR)\tkWinEmbed.obj \
+ $(TMP_DIR)\tkWinFont.obj \
+ $(TMP_DIR)\tkWinImage.obj \
+ $(TMP_DIR)\tkWinInit.obj \
+ $(TMP_DIR)\tkWinKey.obj \
+ $(TMP_DIR)\tkWinMenu.obj \
+ $(TMP_DIR)\tkWinPixmap.obj \
+ $(TMP_DIR)\tkWinPointer.obj \
+ $(TMP_DIR)\tkWinRegion.obj \
+ $(TMP_DIR)\tkWinScrlbr.obj \
+ $(TMP_DIR)\tkWinSend.obj \
+ $(TMP_DIR)\tkWinSendCom.obj \
+ $(TMP_DIR)\tkWinWindow.obj \
+ $(TMP_DIR)\tkWinWm.obj \
+ $(TMP_DIR)\tkWinX.obj \
+ $(TMP_DIR)\stubs.obj \
+ $(TMP_DIR)\tk3d.obj \
+ $(TMP_DIR)\tkArgv.obj \
+ $(TMP_DIR)\tkAtom.obj \
+ $(TMP_DIR)\tkBind.obj \
+ $(TMP_DIR)\tkBitmap.obj \
+ $(TMP_DIR)\tkBusy.obj \
+ $(TMP_DIR)\tkButton.obj \
+ $(TMP_DIR)\tkCanvArc.obj \
+ $(TMP_DIR)\tkCanvBmap.obj \
+ $(TMP_DIR)\tkCanvImg.obj \
+ $(TMP_DIR)\tkCanvLine.obj \
+ $(TMP_DIR)\tkCanvPoly.obj \
+ $(TMP_DIR)\tkCanvPs.obj \
+ $(TMP_DIR)\tkCanvText.obj \
+ $(TMP_DIR)\tkCanvUtil.obj \
+ $(TMP_DIR)\tkCanvWind.obj \
+ $(TMP_DIR)\tkCanvas.obj \
+ $(TMP_DIR)\tkClipboard.obj \
+ $(TMP_DIR)\tkCmds.obj \
+ $(TMP_DIR)\tkColor.obj \
+ $(TMP_DIR)\tkConfig.obj \
+ $(TMP_DIR)\tkCursor.obj \
+ $(TMP_DIR)\tkEntry.obj \
+ $(TMP_DIR)\tkError.obj \
+ $(TMP_DIR)\tkEvent.obj \
+ $(TMP_DIR)\tkFileFilter.obj \
+ $(TMP_DIR)\tkFocus.obj \
+ $(TMP_DIR)\tkFont.obj \
+ $(TMP_DIR)\tkFrame.obj \
+ $(TMP_DIR)\tkGC.obj \
+ $(TMP_DIR)\tkGeometry.obj \
+ $(TMP_DIR)\tkGet.obj \
+ $(TMP_DIR)\tkGrab.obj \
+ $(TMP_DIR)\tkGrid.obj \
+ $(TMP_DIR)\tkImage.obj \
+ $(TMP_DIR)\tkImgBmap.obj \
+ $(TMP_DIR)\tkImgGIF.obj \
+ $(TMP_DIR)\tkImgPNG.obj \
+ $(TMP_DIR)\tkImgPPM.obj \
+ $(TMP_DIR)\tkImgPhoto.obj \
+ $(TMP_DIR)\tkImgPhInstance.obj \
+ $(TMP_DIR)\tkImgUtil.obj \
+ $(TMP_DIR)\tkListbox.obj \
+ $(TMP_DIR)\tkMacWinMenu.obj \
+ $(TMP_DIR)\tkMain.obj \
+ $(TMP_DIR)\tkMain2.obj \
+ $(TMP_DIR)\tkMenu.obj \
+ $(TMP_DIR)\tkMenubutton.obj \
+ $(TMP_DIR)\tkMenuDraw.obj \
+ $(TMP_DIR)\tkMessage.obj \
+ $(TMP_DIR)\tkPanedWindow.obj \
+ $(TMP_DIR)\tkObj.obj \
+ $(TMP_DIR)\tkOldConfig.obj \
+ $(TMP_DIR)\tkOption.obj \
+ $(TMP_DIR)\tkPack.obj \
+ $(TMP_DIR)\tkPlace.obj \
+ $(TMP_DIR)\tkPointer.obj \
+ $(TMP_DIR)\tkRectOval.obj \
+ $(TMP_DIR)\tkScale.obj \
+ $(TMP_DIR)\tkScrollbar.obj \
+ $(TMP_DIR)\tkSelect.obj \
+ $(TMP_DIR)\tkStyle.obj \
+ $(TMP_DIR)\tkText.obj \
+ $(TMP_DIR)\tkTextBTree.obj \
+ $(TMP_DIR)\tkTextDisp.obj \
+ $(TMP_DIR)\tkTextImage.obj \
+ $(TMP_DIR)\tkTextIndex.obj \
+ $(TMP_DIR)\tkTextMark.obj \
+ $(TMP_DIR)\tkTextTag.obj \
+ $(TMP_DIR)\tkTextWind.obj \
+ $(TMP_DIR)\tkTrig.obj \
+ $(TMP_DIR)\tkUndo.obj \
+ $(TMP_DIR)\tkUtil.obj \
+ $(TMP_DIR)\tkVisual.obj \
+ $(TMP_DIR)\tkStubInit.obj \
+ $(TMP_DIR)\tkWindow.obj \
+ $(TTK_OBJS) \
+!if !$(STATIC_BUILD)
+ $(TMP_DIR)\tk.res
+!endif
+
+TTK_OBJS = \
+ $(TMP_DIR)\ttkWinMonitor.obj \
+ $(TMP_DIR)\ttkWinTheme.obj \
+ $(TMP_DIR)\ttkWinXPTheme.obj \
+ $(TMP_DIR)\ttkBlink.obj \
+ $(TMP_DIR)\ttkButton.obj \
+ $(TMP_DIR)\ttkCache.obj \
+ $(TMP_DIR)\ttkClamTheme.obj \
+ $(TMP_DIR)\ttkClassicTheme.obj \
+ $(TMP_DIR)\ttkDefaultTheme.obj \
+ $(TMP_DIR)\ttkElements.obj \
+ $(TMP_DIR)\ttkEntry.obj \
+ $(TMP_DIR)\ttkFrame.obj \
+ $(TMP_DIR)\ttkImage.obj \
+ $(TMP_DIR)\ttkInit.obj \
+ $(TMP_DIR)\ttkLabel.obj \
+ $(TMP_DIR)\ttkLayout.obj \
+ $(TMP_DIR)\ttkManager.obj \
+ $(TMP_DIR)\ttkNotebook.obj \
+ $(TMP_DIR)\ttkPanedwindow.obj \
+ $(TMP_DIR)\ttkProgress.obj \
+ $(TMP_DIR)\ttkScale.obj \
+ $(TMP_DIR)\ttkScrollbar.obj \
+ $(TMP_DIR)\ttkScroll.obj \
+ $(TMP_DIR)\ttkSeparator.obj \
+ $(TMP_DIR)\ttkSquare.obj \
+ $(TMP_DIR)\ttkState.obj \
+ $(TMP_DIR)\ttkTagSet.obj \
+ $(TMP_DIR)\ttkTheme.obj \
+ $(TMP_DIR)\ttkTrace.obj \
+ $(TMP_DIR)\ttkTrack.obj \
+ $(TMP_DIR)\ttkTreeview.obj \
+ $(TMP_DIR)\ttkWidget.obj \
+ $(TMP_DIR)\ttkStubInit.obj
+
+TKSTUBOBJS = \
+ $(TMP_DIR)\tkStubLib.obj \
+ $(TMP_DIR)\ttkStubLib.obj
+
+
+WINDIR = $(ROOT)\win
+GENERICDIR = $(ROOT)\generic
+XLIBDIR = $(ROOT)\xlib
+TTKDIR = $(ROOT)\generic\ttk
+BITMAPDIR = $(ROOT)\bitmaps
+DOCDIR = $(ROOT)\doc
+RCDIR = $(WINDIR)\rc
+
+TK_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" -I"$(BITMAPDIR)" -I"$(XLIBDIR)" \
+ $(TCL_INCLUDES)
+
+CONFIG_DEFS =-DSTDC_HEADERS=1 -DHAVE_SYS_TYPES_H=1 -DHAVE_SYS_STAT_H=1 \
+ -DHAVE_STDLIB_H=1 -DHAVE_STRING_H=1 -DHAVE_MEMORY_H=1 \
+ -DHAVE_STRINGS_H=1 -DHAVE_INTTYPES_H=1 -DHAVE_STDINT_H=1 \
+ -DSUPPORT_CONFIG_EMBEDDED \
+!if $(HAVE_UXTHEME_H)
+ -DHAVE_UXTHEME_H=1 \
+!endif
+!if $(TTK_SQUARE_WIDGET)
+ -DTTK_SQUARE_WIDGET=1 \
+!endif
+
+TK_DEFINES =-DBUILD_ttk $(OPTDEFINES) $(CONFIG_DEFS) -Dinline=__inline
+
+#---------------------------------------------------------------------
+# Compile flags
+#---------------------------------------------------------------------
+
+!if !$(DEBUG)
+!if $(OPTIMIZING)
+### This cranks the optimization level to maximize speed
+### We can't use -O2 because sometimes it causes problems.
+cdebug = $(OPTIMIZATIONS)
+!else
+cdebug =
+!endif
+!if $(SYMBOLS)
+cdebug = $(cdebug) -Zi
+!endif
+!else if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
+### Warnings are too many, can't support warnings into errors.
+cdebug = -Zi -Od $(DEBUGFLAGS)
+!else
+cdebug = -Zi -WX $(DEBUGFLAGS)
+!endif
+
+### Declarations common to all compiler options
+cwarn = $(WARNINGS) -D _CRT_SECURE_NO_DEPRECATE -D _CRT_NONSTDC_NO_DEPRECATE
+cflags = -nologo -c $(COMPILERFLAGS) $(cwarn) -Fp$(TMP_DIR)^\
+
+!if $(MSVCRT)
+!if $(DEBUG) && !$(UNCHECKED)
+crt = -MDd
+!else
+crt = -MD
+!endif
+!else
+!if $(DEBUG) && !$(UNCHECKED)
+crt = -MTd
+!else
+crt = -MT
+!endif
+!endif
+
+BASE_CFLAGS = $(cdebug) $(cflags) $(crt) $(TK_INCLUDES)
+TK_CFLAGS = $(BASE_CFLAGS) $(TK_DEFINES) -DUSE_TCL_STUBS
+CON_CFLAGS = $(cdebug) $(cflags) $(crt) -DCONSOLE
+WISH_CFLAGS = $(BASE_CFLAGS) $(TK_DEFINES)
+STUB_CFLAGS = $(cflags) $(cdebug) $(TK_DEFINES)
+
+
+#---------------------------------------------------------------------
+# Link flags
+#---------------------------------------------------------------------
+
+!if $(DEBUG)
+ldebug = -debug -debugtype:cv
+!else
+ldebug = -release -opt:ref -opt:icf,3
+!if $(SYMBOLS)
+ldebug = $(ldebug) -debug -debugtype:cv
+!endif
+!endif
+
+### Declarations common to all linker options
+lflags = -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug)
+
+!if $(PROFILE)
+lflags = $(lflags) -profile
+!endif
+
+!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
+lflags = $(lflags) -nodefaultlib:libucrt.lib
+!endif
+
+!if $(ALIGN98_HACK) && !$(STATIC_BUILD)
+### Align sections for PE size savings.
+lflags = $(lflags) -opt:nowin98
+!else if !$(ALIGN98_HACK) && $(STATIC_BUILD)
+### Align sections for speed in loading by choosing the virtual page size.
+lflags = $(lflags) -align:4096
+!endif
+
+!if $(LOIMPACT)
+lflags = $(lflags) -ws:aggressive
+!endif
+
+dlllflags = $(lflags) -dll
+conlflags = $(lflags) -subsystem:console
+guilflags = $(lflags) -subsystem:windows
+
+tcllibs = $(TCLSTUBLIB) $(TCLIMPLIB)
+
+baselibs = netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib
+# Avoid 'unresolved external symbol __security_cookie' errors.
+# c.f. http://support.microsoft.com/?id=894573
+!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
+!if $(VCVERSION) > 1399 && $(VCVERSION) < 1500
+baselibs = $(baselibs) bufferoverflowU.lib
+!endif
+!endif
+!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
+baselibs = $(baselibs) ucrt.lib
+!endif
+
+guilibs = $(baselibs) gdi32.lib
+
+
+#---------------------------------------------------------------------
+# TkTest flags
+#---------------------------------------------------------------------
+
+!if "$(TESTPAT)" != ""
+TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT)
+!endif
+
+
+#---------------------------------------------------------------------
+# Project specific targets
+#---------------------------------------------------------------------
+
+release: setup $(TKSTUBLIB) $(WISH)
+all: release $(CAT32)
+core: setup $(TKSTUBLIB) $(TKLIB)
+cwish: $(WISHC)
+install: install-binaries install-libraries install-docs
+tktest: setup $(TKTEST) $(CAT32)
+
+
+test: test-classic test-ttk
+
+test-classic: setup $(TKTEST) $(TKLIB) $(CAT32)
+ @set TCL_LIBRARY=$(TCL_LIBRARY:\=/)
+ @set TK_LIBRARY=$(TK_LIBRARY:\=/)
+ @set TCLLIBPATH=
+!if $(TCLINSTALL)
+ @set PATH=$(_TCLDIR)\bin;$(PATH)
+!else
+ @set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH)
+!endif
+ $(DEBUGGER) $(TKTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) | $(CAT32)
+
+test-ttk: setup $(TKTEST) $(TKLIB) $(CAT32)
+ @set TCL_LIBRARY=$(TCL_LIBRARY:\=/)
+ @set TK_LIBRARY=$(TK_LIBRARY:\=/)
+ @set TCLLIBPATH=
+!if $(TCLINSTALL)
+ @set PATH=$(_TCLDIR)\bin;$(PATH)
+!else
+ @set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH)
+!endif
+ $(DEBUGGER) $(TKTEST) "$(ROOT:\=/)/tests/ttk/all.tcl" $(TESTFLAGS) | $(CAT32)
+
+runtest: setup $(TKTEST) $(TKLIB) $(CAT32)
+ @set TCL_LIBRARY=$(TCL_LIBRARY:\=/)
+ @set TK_LIBRARY=$(TK_LIBRARY:\=/)
+ @set TCLLIBPATH=
+!if $(TCLINSTALL)
+ @set PATH=$(_TCLDIR)\bin;$(PATH)
+!else
+ @set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH)
+!endif
+ $(DEBUGGER) $(TKTEST)
+
+rundemo: setup $(TKTEST) $(TKLIB) $(CAT32)
+ @set TCL_LIBRARY=$(TCL_LIBRARY:\=/)
+ @set TK_LIBRARY=$(TK_LIBRARY:\=/)
+ @set TCLLIBPATH=
+!if $(TCLINSTALL)
+ @set PATH=$(_TCLDIR)\bin;$(PATH)
+!else
+ @set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH)
+!endif
+ $(TKTEST) $(ROOT:\=/)\library\demos\widget
+
+shell: setup $(WISH)
+ @set TCL_LIBRARY=$(TCL_LIBRARY:\=/)
+ @set TK_LIBRARY=$(TK_LIBRARY:\=/)
+ @set TCLLIBPATH=
+!if $(TCLINSTALL)
+ @set PATH=$(_TCLDIR)\bin;$(PATH)
+!else
+ @set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH)
+!endif
+ $(DEBUGGER) $(WISH) <<
+ console show
+<<
+
+dbgshell: setup $(WISH)
+ @set TCL_LIBRARY=$(TCL_LIBRARY:\=/)
+ @set TK_LIBRARY=$(TK_LIBRARY:\=/)
+ @set TCLLIBPATH=
+!if $(TCLINSTALL)
+ @set PATH=$(_TCLDIR)\bin;$(PATH)
+!else
+ @set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH)
+!endif
+ windbg $(WISH)
+
+setup:
+ @if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR)
+ @if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR)
+
+!if !$(STATIC_BUILD)
+$(TKIMPLIB): $(TKLIB)
+!endif
+
+$(TKLIB): $(TKOBJS)
+!if $(STATIC_BUILD)
+ $(lib32) -nologo -out:$@ @<<
+$**
+<<
+!else
+ $(link32) $(dlllflags) -base:@$(COFFBASE),tk -out:$@ $(guilibs) \
+ $(TCLSTUBLIB) @<<
+$**
+<<
+ $(_VC_MANIFEST_EMBED_DLL)
+ -@del $*.exp
+!endif
+
+
+$(TKSTUBLIB): $(TKSTUBOBJS)
+ $(lib32) -nologo -nodefaultlib -out:$@ $**
+
+
+$(WISH): $(WISHOBJS) $(TKSTUBLIB) $(TKIMPLIB)
+ $(link32) $(guilflags) -stack:2300000 -out:$@ $(guilibs) $(tcllibs) $**
+ $(_VC_MANIFEST_EMBED_EXE)
+
+
+$(WISHC): $(WISHOBJS) $(TKSTUBLIB) $(TKIMPLIB)
+ $(link32) $(conlflags) -stack:2300000 -out:$@ $(guilibs) $(tcllibs) $**
+ $(_VC_MANIFEST_EMBED_EXE)
+
+
+$(TKTEST): $(TKTESTOBJS) $(TKSTUBLIB) $(TKIMPLIB)
+ $(link32) $(guilflags) -stack:2300000 -out:$@ $(guilibs) $(tcllibs) $**
+ $(_VC_MANIFEST_EMBED_EXE)
+
+
+$(CAT32): $(_TCLDIR)\win\cat.c
+ $(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $?
+ $(link32) $(conlflags) -out:$@ -stack:16384 $(TMP_DIR)\cat.obj $(baselibs)
+ $(_VC_MANIFEST_EMBED_EXE)
+
+#---------------------------------------------------------------------
+# Regenerate the stubs files. [Development use only]
+#---------------------------------------------------------------------
+
+genstubs:
+!if !exist($(TCLSH))
+ @echo Build tclsh first!
+!else
+ set TCL_LIBRARY=$(TCL_LIBRARY)
+ $(TCLSH) $(_TCLDIR)\tools\genStubs.tcl $(GENERICDIR) \
+ $(GENERICDIR)\$(PROJECT).decls $(GENERICDIR)\$(PROJECT)Int.decls
+!endif
+
+
+#---------------------------------------------------------------------
+# Build the Windows HTML help file.
+#---------------------------------------------------------------------
+
+# NOTE: you can define HHC on the command-line to override this
+!ifndef HHC
+HHC=""%ProgramFiles%\HTML Help Workshop\hhc.exe""
+!endif
+HTMLDIR=$(ROOT)\html
+HTMLBASE=TclTk$(VERSION)
+HHPFILE=$(HTMLDIR)\$(HTMLBASE).hhp
+CHMFILE=$(HTMLDIR)\$(HTMLBASE).chm
+
+htmlhelp: chmsetup $(CHMFILE)
+
+$(CHMFILE): $(DOCDIR)\*
+ @$(TCLSH) $(TCLTOOLSDIR)\tcltk-man2html.tcl
+ @echo Compiling HTML help project
+ @$(HHC) <<$(HHPFILE) >NUL
+[OPTIONS]
+Compatibility=1.1 or later
+Compiled file=$(HTMLBASE).chm
+Display compile progress=no
+Error log file=$(HTMLBASE).log
+Language=0x409 English (United States)
+Title=Tcl/Tk $(DOT_VERSION) Help
+[FILES]
+contents.htm
+docs.css
+Keywords
+TclCmd
+TclLib
+TkCmd
+TkLib
+UserCmd
+<<
+
+chmsetup:
+ @if not exist $(HTMLDIR)\nul mkdir $(HTMLDIR)
+
+#-------------------------------------------------------------------------
+# Build the old-style Windows .hlp file
+#-------------------------------------------------------------------------
+
+HLPBASE = $(PROJECT)$(TK_VERSION)
+HELPFILE = $(OUT_DIR)\$(HLPBASE).hlp
+HELPCNT = $(OUT_DIR)\$(HLPBASE).cnt
+DOCTMP_DIR = $(OUT_DIR)\$(PROJECT)_docs
+HELPRTF = $(DOCTMP_DIR)\$(PROJECT).rtf
+MAN2HELP = $(DOCTMP_DIR)\man2help.tcl
+MAN2HELP2 = $(DOCTMP_DIR)\man2help2.tcl
+INDEX = $(DOCTMP_DIR)\index.tcl
+BMP = $(DOCTMP_DIR)\lamp.bmp
+BMP_NOPATH = lamp.bmp
+MAN2TCL = $(DOCTMP_DIR)\man2tcl.exe
+
+winhelp: docsetup $(HELPFILE)
+
+docsetup:
+ @if not exist $(DOCTMP_DIR)\nul mkdir $(DOCTMP_DIR)
+
+$(MAN2HELP) $(MAN2HELP2) $(INDEX): $(TCLTOOLSDIR)\$$(@F)
+ $(CPY) $(TCLTOOLSDIR)\$(@F) $(@D)
+
+$(BMP):
+ $(CPY) $(WINDIR)\rc\$(@F) $(@D)
+
+$(HELPFILE): $(HELPRTF) $(BMP)
+ cd $(DOCTMP_DIR)
+ start /wait hcrtf.exe -x <<$(PROJECT).hpj
+[OPTIONS]
+COMPRESS=12 Hall Zeck
+LCID=0x409 0x0 0x0 ; English (United States)
+TITLE=Tk Reference Manual
+BMROOT=.
+CNT=$(@B).cnt
+HLP=$(@B).hlp
+
+[FILES]
+$(PROJECT).rtf
+
+[WINDOWS]
+main="Tcl/Tk Reference Manual",,27648,(r15263976),(r4227327)
+
+[CONFIG]
+BrowseButtons()
+CreateButton(1, "Web", ExecFile("http://www.tcl.tk"))
+CreateButton(2, "SF", ExecFile("http://sf.net/projects/tcl"))
+CreateButton(3, "Wiki", ExecFile("http://wiki.tcl.tk"))
+CreateButton(4, "FAQ", ExecFile("http://www.purl.org/NET/Tcl-FAQ/"))
+<<
+ cd $(MAKEDIR)
+ @$(CPY) "$(DOCTMP_DIR)\$(@B).hlp" "$(OUT_DIR)"
+ @$(CPY) "$(DOCTMP_DIR)\$(@B).cnt" "$(OUT_DIR)"
+
+$(MAN2TCL): $(TCLTOOLSDIR)\$$(@B).c
+ $(cc32) $(TK_CFLAGS) -Fo$(@D)\ $(TCLTOOLSDIR)\$(@B).c
+ $(link32) $(conlflags) -out:$@ -stack:16384 $(@D)\man2tcl.obj
+ $(_VC_MANIFEST_EMBED_EXE)
+
+$(HELPRTF): $(MAN2TCL) $(MAN2HELP) $(MAN2HELP2) $(INDEX)
+ $(TCLSH) $(MAN2HELP) -bitmap $(BMP_NOPATH) $(PROJECT) $(TK_VERSION) $(DOCDIR:\=/)
+
+install-docs:
+!if exist($(HELPFILE))
+ $(CPY) "$(HELPFILE)" "$(DOC_INSTALL_DIR)\"
+ $(CPY) "$(HELPCNT)" "$(DOC_INSTALL_DIR)\"
+ $(TCLSH) <<
+puts "Installing $(PROJECT)'s helpfile contents into Tcl's ..."
+set f [open "$(DOC_INSTALL_DIR:\=/)/tcl$(TK_VERSION).cnt" r]
+while {![eof $$f]} {
+ if {[regexp {:Include $(PROJECT)([0-9]{2}).cnt} [gets $$f] dummy ver]} {
+ if {$$ver == $(TK_VERSION)} {
+ puts "Already installed."
+ exit
+ } else {
+ # do something here logical to remove (or replace) it.
+ puts "$$ver != $(TK_VERSION), unfinished code path, die, die!"
+ exit 1
+ }
+ }
+}
+close $$f
+set f [open "$(DOC_INSTALL_DIR:\=/)/tcl$(TK_VERSION).cnt" a]
+puts $$f {:Include $(HLPBASE).cnt}
+close $$f
+<<
+ start /wait winhlp32 -g $(DOC_INSTALL_DIR)\tcl$(TK_VERSION).hlp
+!endif
+
+#---------------------------------------------------------------------
+# Special case object file targets
+#---------------------------------------------------------------------
+
+$(TMP_DIR)\testMain.obj: $(WINDIR)\winMain.c
+ $(cc32) $(WISH_CFLAGS) -DTK_TEST \
+ -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
+ -Fo$@ $?
+
+$(TMP_DIR)\tkTest.obj: $(GENERICDIR)\tkTest.c
+ $(cc32) $(WISH_CFLAGS) -Fo$@ $?
+
+$(TMP_DIR)\tkOldTest.obj: $(GENERICDIR)\tkOldTest.c
+ $(cc32) $(WISH_CFLAGS) -Fo$@ $?
+
+$(TMP_DIR)\tkWinTest.obj: $(WINDIR)\tkWinTest.c
+ $(cc32) $(WISH_CFLAGS) -Fo$@ $?
+
+$(TMP_DIR)\tkSquare.obj: $(GENERICDIR)\tkSquare.c
+ $(cc32) $(WISH_CFLAGS) -Fo$@ $?
+
+$(TMP_DIR)\winMain.obj: $(WINDIR)\winMain.c
+ $(cc32) $(WISH_CFLAGS) \
+ -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
+ -Fo$@ $?
+
+$(TMP_DIR)\tkMain2.obj: $(GENERICDIR)\tkMain.c
+ $(cc32) -DBUILD_tk $(TK_CFLAGS) -DTK_ASCII_MAIN -Fo$@ $?
+
+# The following objects are part of the stub library and should not
+# be built as DLL objects but none of the symbols should be exported
+# and no reference made to a C runtime.
+
+$(TMP_DIR)\tkStubLib.obj : $(GENERICDIR)\tkStubLib.c
+ $(cc32) $(STUB_CFLAGS) $(TK_INCLUDES) -Zl -DSTATIC_BUILD -Fo$@ $?
+
+
+$(TMP_DIR)\wish.exe.manifest: $(WINDIR)\wish.exe.manifest.in
+ @nmakehlp -s << $** >$@
+@MACHINE@ $(MACHINE:IX86=X86)
+@TK_WIN_VERSION@ $(TK_DOTVERSION).0.0
+<<
+
+#---------------------------------------------------------------------
+# Generate the source dependencies. Having dependency rules will
+# improve incremental build accuracy without having to resort to a
+# full rebuild just because some non-global header file like
+# tclCompile.h was changed. These rules aren't needed when building
+# from scratch.
+#---------------------------------------------------------------------
+
+depend:
+!if !exist($(TCLSH))
+ @echo Build tclsh first!
+!else
+ set TCL_LIBRARY=$(TCL_LIBRARY)
+ $(TCLSH) $(TCLTOOLSDIR:\=/)/mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \
+ -passthru:"-DBUILD_tk $(TK_INCLUDES)" $(GENERICDIR),$$(GENERICDIR) \
+ $(WINDIR),$$(WINDIR) $(TTKDIR),$$(TTKDIR) $(XLIBDIR),$$(XLIBDIR) \
+ $(BITMAPDIR),$$(BITMAPDIR) @<<
+$(TKOBJS)
+<<
+!endif
+
+#---------------------------------------------------------------------
+# Dependency rules
+#---------------------------------------------------------------------
+
+$(TMP_DIR)\tk.res: \
+ $(RCDIR)\buttons.bmp \
+ $(RCDIR)\cursor*.cur \
+ $(RCDIR)\tk.ico
+
+!if exist("$(OUT_DIR)\depend.mk")
+!include "$(OUT_DIR)\depend.mk"
+!message *** Dependency rules in use.
+!else
+!message *** Dependency rules are not being used.
+!endif
+
+### add a spacer in the output
+!message
+
+#---------------------------------------------------------------------
+# Implicit rules
+#---------------------------------------------------------------------
+
+{$(XLIBDIR)}.c{$(TMP_DIR)}.obj::
+ $(cc32) -DBUILD_tk $(TK_CFLAGS) -Fo$(TMP_DIR)\ @<<
+$<
+<<
+
+{$(GENERICDIR)}.c{$(TMP_DIR)}.obj::
+ $(cc32) -DBUILD_tk $(TK_CFLAGS) -Fo$(TMP_DIR)\ @<<
+$<
+<<
+
+{$(TTKDIR)}.c{$(TMP_DIR)}.obj::
+ $(cc32) -DBUILD_tk $(TK_CFLAGS) -Fo$(TMP_DIR)\ @<<
+$<
+<<
+
+{$(WINDIR)}.c{$(TMP_DIR)}.obj::
+ $(cc32) -DBUILD_tk $(TK_CFLAGS) -Fo$(TMP_DIR)\ @<<
+$<
+<<
+
+{$(ROOT)\unix}.c{$(TMP_DIR)}.obj::
+ $(cc32) -DBUILD_tk $(TK_CFLAGS) -Fo$(TMP_DIR)\ @<<
+$<
+<<
+
+{$(RCDIR)}.rc{$(TMP_DIR)}.res:
+ $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" $(TCL_INCLUDES) \
+ -d DEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \
+ -d TCL_THREADS=$(TCL_THREADS) \
+ -d STATIC_BUILD=$(STATIC_BUILD) \
+ $<
+
+$(TMP_DIR)\tk.res: $(TMP_DIR)\wish.exe.manifest
+$(TMP_DIR)\wish.res: $(TMP_DIR)\wish.exe.manifest
+
+.SUFFIXES:
+.SUFFIXES:.c .rc
+
+
+#---------------------------------------------------------------------
+# Installation.
+#---------------------------------------------------------------------
+
+install-binaries:
+ @echo installing binaries
+ @$(CPY) "$(WISH)" "$(BIN_INSTALL_DIR)\"
+!if $(TKLIB) != $(TKIMPLIB)
+ @$(CPY) "$(TKLIB)" "$(BIN_INSTALL_DIR)\"
+!endif
+ @$(CPY) "$(TKIMPLIB)" "$(LIB_INSTALL_DIR)\"
+ @$(CPY) "$(TKSTUBLIB)" "$(LIB_INSTALL_DIR)\"
+!if !$(STATIC_BUILD)
+ @echo creating package index
+ @type << > $(OUT_DIR)\pkgIndex.tcl
+if {[catch {package present Tcl $(TCL_PATCH_LEVEL)}]} { return }
+if {($$::tcl_platform(platform) eq "unix") && ([info exists ::env(DISPLAY)]
+ || ([info exists ::argv] && ("-display" in $$::argv)))} {
+ package ifneeded Tk $(TK_PATCH_LEVEL) [list load [file join $$dir .. .. bin libtk$(TK_DOTVERSION).dll] Tk]
+} else {
+ package ifneeded Tk $(TK_PATCH_LEVEL) [list load [file join $$dir .. .. bin $(TKLIBNAME)] Tk]
+}
+<<
+ @$(CPY) $(OUT_DIR)\pkgIndex.tcl "$(SCRIPT_INSTALL_DIR)\"
+!endif
+
+#"
+
+install-libraries:
+ @echo installing Tk headers
+ @$(CPY) "$(GENERICDIR)\tk.h" "$(INCLUDE_INSTALL_DIR)\"
+ @$(CPY) "$(GENERICDIR)\tkDecls.h" "$(INCLUDE_INSTALL_DIR)\"
+ @$(CPY) "$(GENERICDIR)\tkPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\"
+ @$(CPY) "$(GENERICDIR)\tkIntXlibDecls.h" "$(INCLUDE_INSTALL_DIR)\"
+ @$(CPY) "$(XLIBDIR)\X11\*.h" "$(INCLUDE_INSTALL_DIR)\X11\"
+ @echo installing script library
+ @$(CPY) "$(ROOT)\library\*" "$(SCRIPT_INSTALL_DIR)\"
+ @echo installing theme library
+ @$(CPY) "$(ROOT)\library\ttk\*" "$(SCRIPT_INSTALL_DIR)\ttk\"
+ @echo installing demos
+ @$(CPY) "$(ROOT)\library\demos\*" "$(SCRIPT_INSTALL_DIR)\demos\"
+ @$(CPY) "$(ROOT)\library\demos\images\*" "$(SCRIPT_INSTALL_DIR)\demos\images\"
+ @echo installing images
+ @$(CPY) "$(ROOT)\library\images\*" "$(SCRIPT_INSTALL_DIR)\images\"
+ @echo installing language files
+ @$(CPY) "$(ROOT)\library\msgs\*" "$(SCRIPT_INSTALL_DIR)\msgs\"
+
+#"
+
+#---------------------------------------------------------------------
+# Clean up
+#---------------------------------------------------------------------
+
+tidy:
+!if $(TKLIB) != $(TKIMPLIB)
+ @echo Removing $(TKLIB) ...
+ @if exist $(TKLIB) del $(TKLIB)
+!endif
+ @echo Removing $(TKIMPLIB) ...
+ @if exist $(TKIMPLIB) del $(TKIMPLIB)
+ @echo Removing $(WISH) ...
+ @if exist $(WISH) del $(WISH)
+ @echo Removing $(TKTEST) ...
+ @if exist $(TKTEST) del $(TKTEST)
+ @echo Removing $(TKSTUBLIB) ...
+ @if exist $(TKSTUBLIB) del $(TKSTUBLIB)
+
+clean:
+ @echo Cleaning $(TMP_DIR)\* ...
+ @if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR)
+ @echo Cleaning $(WINDIR)\nmakehlp.obj ...
+ @if exist $(WINDIR)\nmakehlp.obj del $(WINDIR)\nmakehlp.obj
+ @echo Cleaning $(WINDIR)\nmakehlp.exe ...
+ @if exist $(WINDIR)\nmakehlp.exe del $(WINDIR)\nmakehlp.exe
+ @echo Cleaning $(WINDIR)\_junk.pch ...
+ @if exist $(WINDIR)\_junk.pch del $(WINDIR)\_junk.pch
+ @echo Cleaning $(WINDIR)\vercl.x ...
+ @if exist $(WINDIR)\vercl.x del $(WINDIR)\vercl.x
+ @echo Cleaning $(WINDIR)\vercl.i ...
+ @if exist $(WINDIR)\vercl.i del $(WINDIR)\vercl.i
+ @echo Cleaning $(WINDIR)\versions.vc ...
+ @if exist $(WINDIR)\versions.vc del $(WINDIR)\versions.vc
+
+realclean: hose
+
+hose:
+ @echo Hosing $(OUT_DIR)\* ...
+ @if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR)
diff --git a/win/mkd.bat b/win/mkd.bat index f741daf..1bd5ccb 100644 --- a/win/mkd.bat +++ b/win/mkd.bat @@ -1,12 +1,12 @@ -@echo off - -if exist %1\nul goto end - -md %1 -if errorlevel 1 goto end - -echo Created directory %1 - -:end - - +@echo off
+
+if exist %1\nul goto end
+
+md %1
+if errorlevel 1 goto end
+
+echo Created directory %1
+
+:end
+
+
diff --git a/win/nmakehlp.c b/win/nmakehlp.c index b1a1517..84cf75c 100644 --- a/win/nmakehlp.c +++ b/win/nmakehlp.c @@ -606,8 +606,8 @@ SubstituteFile( sp = fopen(substitutions, "rt"); if (sp != NULL) { while (fgets(szBuffer, cbBuffer, sp) != NULL) { - char *ks, *ke, *vs, *ve; - ks = szBuffer; + unsigned char *ks, *ke, *vs, *ve; + ks = (unsigned char*)szBuffer; while (ks && *ks && isspace(*ks)) ++ks; ke = ks; while (ke && *ke && !isspace(*ke)) ++ke; @@ -616,7 +616,7 @@ SubstituteFile( ve = vs; while (ve && *ve && !(*ve == '\r' || *ve == '\n')) ++ve; *ke = 0, *ve = 0; - list_insert(&substPtr, ks, vs); + list_insert(&substPtr, (char*)ks, (char*)vs); } fclose(sp); } diff --git a/win/rc/lamp.bmp b/win/rc/lamp.bmp Binary files differindex 834c0f9..1e2f9d4 100644 --- a/win/rc/lamp.bmp +++ b/win/rc/lamp.bmp diff --git a/win/rc/tk_base.rc b/win/rc/tk_base.rc index 3e065c9..e6ab016 100644 --- a/win/rc/tk_base.rc +++ b/win/rc/tk_base.rc @@ -26,12 +26,12 @@ FONT 8, "Helv" BEGIN LTEXT "Directory &name:",-1,8,6,118,9 EDITTEXT edt10,8,26,144,12, WS_TABSTOP | ES_AUTOHSCROLL - LISTBOX lst2,8,40,144,64,LBS_SORT | LBS_OWNERDRAWFIXED | - LBS_HASSTRINGS | LBS_NOINTEGRALHEIGHT | + LISTBOX lst2,8,40,144,64,LBS_SORT | LBS_OWNERDRAWFIXED | + LBS_HASSTRINGS | LBS_NOINTEGRALHEIGHT | LBS_DISABLENOSCROLL | WS_VSCROLL | WS_TABSTOP LTEXT "Dri&ves:",stc4,8,106,92,9 - COMBOBOX cmb2,8,115,144,68,CBS_DROPDOWNLIST | CBS_OWNERDRAWFIXED | - CBS_AUTOHSCROLL | CBS_SORT | CBS_HASSTRINGS | WS_BORDER | + COMBOBOX cmb2,8,115,144,68,CBS_DROPDOWNLIST | CBS_OWNERDRAWFIXED | + CBS_AUTOHSCROLL | CBS_SORT | CBS_HASSTRINGS | WS_BORDER | WS_VSCROLL | WS_TABSTOP DEFPUSHBUTTON "OK",1,160,6,50,14,WS_GROUP PUSHBUTTON "Cancel",2,160,24,50,14,WS_GROUP @@ -42,8 +42,8 @@ BEGIN LTEXT "a",stc3,9,143,114,15 EDITTEXT edt1,7,158,135,20,NOT WS_TABSTOP LISTBOX lst1,8,205,134,42,LBS_NOINTEGRALHEIGHT - COMBOBOX cmb1,8,253,135,21,CBS_DROPDOWNLIST | CBS_OWNERDRAWFIXED | - CBS_AUTOHSCROLL | CBS_SORT | CBS_HASSTRINGS | WS_BORDER | + COMBOBOX cmb1,8,253,135,21,CBS_DROPDOWNLIST | CBS_OWNERDRAWFIXED | + CBS_AUTOHSCROLL | CBS_SORT | CBS_HASSTRINGS | WS_BORDER | WS_VSCROLL END diff --git a/win/rc/wish.ico b/win/rc/wish.ico Binary files differindex 05cad66..5801fb8 100644 --- a/win/rc/wish.ico +++ b/win/rc/wish.ico diff --git a/win/rc/wish.rc b/win/rc/wish.rc index 5cc2fa4..53e02fa 100644 --- a/win/rc/wish.rc +++ b/win/rc/wish.rc @@ -63,7 +63,7 @@ END // // Icon -// +// // The icon whose name or resource ID is lexigraphically first, is used // as the application's icon. // diff --git a/win/rmd.bat b/win/rmd.bat index d260936..820b76f 100644 --- a/win/rmd.bat +++ b/win/rmd.bat @@ -1,20 +1,20 @@ -@echo off - -if not exist %1\nul goto end - -echo Removing directory %1 - -if "%OS%" == "Windows_NT" goto winnt - -deltree /y %1 -if errorlevel 1 goto end -goto success - -:winnt -rmdir /s /q %1 -if errorlevel 1 goto end - -:success -echo Deleted directory %1 - -:end +@echo off
+
+if not exist %1\nul goto end
+
+echo Removing directory %1
+
+if "%OS%" == "Windows_NT" goto winnt
+
+deltree /y %1
+if errorlevel 1 goto end
+goto success
+
+:winnt
+rmdir /s /q %1
+if errorlevel 1 goto end
+
+:success
+echo Deleted directory %1
+
+:end
diff --git a/win/rules.vc b/win/rules.vc index adc3165..0d8cd6b 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -1,716 +1,716 @@ -#------------------------------------------------------------------------------ -# rules.vc -- -# -# Microsoft Visual C++ makefile include for decoding the commandline -# macros. This file does not need editing to build Tcl. -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# Copyright (c) 2001-2003 David Gravereaux. -# Copyright (c) 2003-2008 Patrick Thoyts -#------------------------------------------------------------------------------ - -!ifndef _RULES_VC -_RULES_VC = 1 - -cc32 = $(CC) # built-in default. -link32 = link -lib32 = lib -rc32 = $(RC) # built-in default. - -!ifndef INSTALLDIR -### Assume the normal default. -_INSTALLDIR = C:\Program Files\Tcl -!else -### Fix the path separators. -_INSTALLDIR = $(INSTALLDIR:/=\) -!endif - -#---------------------------------------------------------- -# Set the proper copy method to avoid overwrite questions -# to the user when copying files and selecting the right -# "delete all" method. -#---------------------------------------------------------- - -!if "$(OS)" == "Windows_NT" -RMDIR = rmdir /S /Q -ERRNULL = 2>NUL -!if ![ver | find "4.0" > nul] -CPY = echo y | xcopy /i >NUL -COPY = copy >NUL -!else -CPY = xcopy /i /y >NUL -COPY = copy /y >NUL -!endif -!else # "$(OS)" != "Windows_NT" -CPY = xcopy /i >_JUNK.OUT # On Win98 NUL does not work here. -COPY = copy >_JUNK.OUT # On Win98 NUL does not work here. -RMDIR = deltree /Y -NULL = \NUL # Used in testing directory existence -ERRNULL = >NUL # Win9x shell cannot redirect stderr -!endif -MKDIR = mkdir - -#------------------------------------------------------------------------------ -# Determine the host and target architectures and compiler version. -#------------------------------------------------------------------------------ - -_HASH=^# -_VC_MANIFEST_EMBED_EXE= -_VC_MANIFEST_EMBED_DLL= -VCVER=0 -!if ![echo VCVERSION=_MSC_VER > vercl.x] \ - && ![echo $(_HASH)if defined(_M_IX86) >> vercl.x] \ - && ![echo ARCH=IX86 >> vercl.x] \ - && ![echo $(_HASH)elif defined(_M_AMD64) >> vercl.x] \ - && ![echo ARCH=AMD64 >> vercl.x] \ - && ![echo $(_HASH)endif >> vercl.x] \ - && ![cl -nologo -TC -P vercl.x $(ERRNULL)] -!include vercl.i -!if ![echo VCVER= ^\> vercl.vc] \ - && ![set /a $(VCVERSION) / 100 - 6 >> vercl.vc] -!include vercl.vc -!endif -!endif -!if ![del $(ERRNUL) /q/f vercl.x vercl.i vercl.vc] -!endif - -!if ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i x86] -NATIVE_ARCH=IX86 -!else -NATIVE_ARCH=AMD64 -!endif - -# Since MSVC8 we must deal with manifest resources. -!if $(VCVERSION) >= 1400 -_VC_MANIFEST_EMBED_EXE=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1 -_VC_MANIFEST_EMBED_DLL=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2 -!endif - -!ifndef MACHINE -MACHINE=$(ARCH) -!endif - -!ifndef CFG_ENCODING -CFG_ENCODING = \"cp1252\" -!endif - -!message =============================================================================== - -#---------------------------------------------------------- -# build the helper app we need to overcome nmake's limiting -# environment. -#---------------------------------------------------------- - -!if !exist(nmakehlp.exe) -!if [$(cc32) -nologo nmakehlp.c -link -subsystem:console > nul] -!endif -!endif - -#---------------------------------------------------------- -# Test for compiler features -#---------------------------------------------------------- - -### test for optimizations -!if [nmakehlp -c -Ot] -!message *** Compiler has 'Optimizations' -OPTIMIZING = 1 -!else -!message *** Compiler does not have 'Optimizations' -OPTIMIZING = 0 -!endif - -OPTIMIZATIONS = - -!if [nmakehlp -c -Ot] -OPTIMIZATIONS = $(OPTIMIZATIONS) -Ot -!endif - -!if [nmakehlp -c -Oi] -OPTIMIZATIONS = $(OPTIMIZATIONS) -Oi -!endif - -!if [nmakehlp -c -Op] -OPTIMIZATIONS = $(OPTIMIZATIONS) -Op -!endif - -!if [nmakehlp -c -fp:strict] -OPTIMIZATIONS = $(OPTIMIZATIONS) -fp:strict -!endif - -!if [nmakehlp -c -Gs] -OPTIMIZATIONS = $(OPTIMIZATIONS) -Gs -!endif - -!if [nmakehlp -c -GS] -OPTIMIZATIONS = $(OPTIMIZATIONS) -GS -!endif - -!if [nmakehlp -c -GL] -OPTIMIZATIONS = $(OPTIMIZATIONS) -GL -!endif - -DEBUGFLAGS = - -!if [nmakehlp -c -RTC1] -DEBUGFLAGS = $(DEBUGFLAGS) -RTC1 -!elseif [nmakehlp -c -GZ] -DEBUGFLAGS = $(DEBUGFLAGS) -GZ -!endif - -COMPILERFLAGS =-W3 -DUNICODE -D_UNICODE - -# In v13 -GL and -YX are incompatible. -!if [nmakehlp -c -YX] -!if ![nmakehlp -c -GL] -OPTIMIZATIONS = $(OPTIMIZATIONS) -YX -!endif -!endif - -!if "$(MACHINE)" == "IX86" -### test for pentium errata -!if [nmakehlp -c -QI0f] -!message *** Compiler has 'Pentium 0x0f fix' -COMPILERFLAGS = $(COMPILERFLAGS) -QI0f -!else -!message *** Compiler does not have 'Pentium 0x0f fix' -!endif -!endif - -!if "$(MACHINE)" == "IA64" -### test for Itanium errata -!if [nmakehlp -c -QIA64_Bx] -!message *** Compiler has 'B-stepping errata workarounds' -COMPILERFLAGS = $(COMPILERFLAGS) -QIA64_Bx -!else -!message *** Compiler does not have 'B-stepping errata workarounds' -!endif -!endif - -!if "$(MACHINE)" == "IX86" -### test for -align:4096, when align:512 will do. -!if [nmakehlp -l -opt:nowin98] -!message *** Linker has 'Win98 alignment problem' -ALIGN98_HACK = 1 -!else -!message *** Linker does not have 'Win98 alignment problem' -ALIGN98_HACK = 0 -!endif -!else -ALIGN98_HACK = 0 -!endif - -LINKERFLAGS = - -!if [nmakehlp -l -ltcg] -LINKERFLAGS =-ltcg -!endif - -#---------------------------------------------------------- -# Decode the options requested. -#---------------------------------------------------------- - -!if "$(OPTS)" == "" || [nmakehlp -f "$(OPTS)" "none"] -STATIC_BUILD = 0 -TCL_THREADS = 1 -DEBUG = 0 -SYMBOLS = 0 -PROFILE = 0 -PGO = 0 -MSVCRT = 1 -LOIMPACT = 0 -TCL_USE_STATIC_PACKAGES = 0 -USE_THREAD_ALLOC = 1 -UNCHECKED = 0 -!else -!if [nmakehlp -f $(OPTS) "static"] -!message *** Doing static -STATIC_BUILD = 1 -!else -STATIC_BUILD = 0 -!endif -!if [nmakehlp -f $(OPTS) "msvcrt"] -!message *** Doing msvcrt -MSVCRT = 1 -!else -!if !$(STATIC_BUILD) -MSVCRT = 1 -!else -MSVCRT = 0 -!endif -!endif -!if [nmakehlp -f $(OPTS) "staticpkg"] && $(STATIC_BUILD) -!message *** Doing staticpkg -TCL_USE_STATIC_PACKAGES = 1 -!else -TCL_USE_STATIC_PACKAGES = 0 -!endif -!if [nmakehlp -f $(OPTS) "nothreads"] -!message *** Compile explicitly for non-threaded tcl -TCL_THREADS = 0 -USE_THREAD_ALLOC= 0 -!else -TCL_THREADS = 1 -USE_THREAD_ALLOC= 1 -!endif -!if [nmakehlp -f $(OPTS) "symbols"] -!message *** Doing symbols -DEBUG = 1 -!else -DEBUG = 0 -!endif -!if [nmakehlp -f $(OPTS) "pdbs"] -!message *** Doing pdbs -SYMBOLS = 1 -!else -SYMBOLS = 0 -!endif -!if [nmakehlp -f $(OPTS) "profile"] -!message *** Doing profile -PROFILE = 1 -!else -PROFILE = 0 -!endif -!if [nmakehlp -f $(OPTS) "pgi"] -!message *** Doing profile guided optimization instrumentation -PGO = 1 -!elseif [nmakehlp -f $(OPTS) "pgo"] -!message *** Doing profile guided optimization -PGO = 2 -!else -PGO = 0 -!endif -!if [nmakehlp -f $(OPTS) "loimpact"] -!message *** Doing loimpact -LOIMPACT = 1 -!else -LOIMPACT = 0 -!endif -!if [nmakehlp -f $(OPTS) "thrdalloc"] -!message *** Doing thrdalloc -USE_THREAD_ALLOC = 1 -!endif -!if [nmakehlp -f $(OPTS) "tclalloc"] -!message *** Doing tclalloc -USE_THREAD_ALLOC = 0 -!endif -!if [nmakehlp -f $(OPTS) "unchecked"] -!message *** Doing unchecked -UNCHECKED = 1 -!else -UNCHECKED = 0 -!endif -!endif - -#---------------------------------------------------------- -# Figure-out how to name our intermediate and output directories. -# We wouldn't want different builds to use the same .obj files -# by accident. -#---------------------------------------------------------- - -#---------------------------------------- -# Naming convention: -# t = full thread support. -# s = static library (as opposed to an -# import library) -# g = linked to the debug enabled C -# run-time. -# x = special static build when it -# links to the dynamic C run-time. -#---------------------------------------- -SUFX = tsgx - -!if $(DEBUG) -BUILDDIRTOP = Debug -!else -BUILDDIRTOP = Release -!endif - -!if "$(MACHINE)" != "IX86" -BUILDDIRTOP =$(BUILDDIRTOP)_$(MACHINE) -!endif -!if $(VCVER) > 6 -BUILDDIRTOP =$(BUILDDIRTOP)_VC$(VCVER) -!endif - -!if !$(DEBUG) || $(DEBUG) && $(UNCHECKED) -SUFX = $(SUFX:g=) -!endif - -TMP_DIRFULL = .\$(BUILDDIRTOP)\$(PROJECT)_ThreadedDynamicStaticX - -!if !$(STATIC_BUILD) -TMP_DIRFULL = $(TMP_DIRFULL:Static=) -SUFX = $(SUFX:s=) -EXT = dll -TMP_DIRFULL = $(TMP_DIRFULL:X=) -SUFX = $(SUFX:x=) -!else -TMP_DIRFULL = $(TMP_DIRFULL:Dynamic=) -EXT = lib -!if !$(MSVCRT) -TMP_DIRFULL = $(TMP_DIRFULL:X=) -SUFX = $(SUFX:x=) -!endif -!endif - -!if !$(TCL_THREADS) -TMP_DIRFULL = $(TMP_DIRFULL:Threaded=) -SUFX = $(SUFX:t=) -!endif - -!ifndef TMP_DIR -TMP_DIR = $(TMP_DIRFULL) -!ifndef OUT_DIR -OUT_DIR = .\$(BUILDDIRTOP) -!endif -!else -!ifndef OUT_DIR -OUT_DIR = $(TMP_DIR) -!endif -!endif - - -#---------------------------------------------------------- -# Decode the statistics requested. -#---------------------------------------------------------- - -!if "$(STATS)" == "" || [nmakehlp -f "$(STATS)" "none"] -TCL_MEM_DEBUG = 0 -TCL_COMPILE_DEBUG = 0 -!else -!if [nmakehlp -f $(STATS) "memdbg"] -!message *** Doing memdbg -TCL_MEM_DEBUG = 1 -!else -TCL_MEM_DEBUG = 0 -!endif -!if [nmakehlp -f $(STATS) "compdbg"] -!message *** Doing compdbg -TCL_COMPILE_DEBUG = 1 -!else -TCL_COMPILE_DEBUG = 0 -!endif -!endif - - -#---------------------------------------------------------- -# Decode the checks requested. -#---------------------------------------------------------- - -!if "$(CHECKS)" == "" || [nmakehlp -f "$(CHECKS)" "none"] -TCL_NO_DEPRECATED = 0 -WARNINGS = -W3 -!else -!if [nmakehlp -f $(CHECKS) "nodep"] -!message *** Doing nodep check -TCL_NO_DEPRECATED = 1 -!else -TCL_NO_DEPRECATED = 0 -!endif -!if [nmakehlp -f $(CHECKS) "fullwarn"] -!message *** Doing full warnings check -WARNINGS = -W4 -!if [nmakehlp -l -warn:3] -LINKERFLAGS = $(LINKERFLAGS) -warn:3 -!endif -!else -WARNINGS = -W3 -!endif -!if [nmakehlp -f $(CHECKS) "64bit"] && [nmakehlp -c -Wp64] -!message *** Doing 64bit portability warnings -WARNINGS = $(WARNINGS) -Wp64 -!endif -!endif - -!if $(PGO) > 1 -!if [nmakehlp -l -ltcg:pgoptimize] -LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pgoptimize -!else -MSG=^ -This compiler does not support profile guided optimization. -!error $(MSG) -!endif -!elseif $(PGO) > 0 -!if [nmakehlp -l -ltcg:pginstrument] -LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pginstrument -!else -MSG=^ -This compiler does not support profile guided optimization. -!error $(MSG) -!endif -!endif - -#---------------------------------------------------------- -# Set our defines now armed with our options. -#---------------------------------------------------------- - -OPTDEFINES = -DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) -DSTDC_HEADERS - -!if $(TCL_MEM_DEBUG) -OPTDEFINES = $(OPTDEFINES) -DTCL_MEM_DEBUG -!endif -!if $(TCL_COMPILE_DEBUG) -OPTDEFINES = $(OPTDEFINES) -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS -!endif -!if $(TCL_THREADS) -OPTDEFINES = $(OPTDEFINES) -DTCL_THREADS=1 -!if $(USE_THREAD_ALLOC) -OPTDEFINES = $(OPTDEFINES) -DUSE_THREAD_ALLOC=1 -!endif -!endif -!if $(STATIC_BUILD) -OPTDEFINES = $(OPTDEFINES) -DSTATIC_BUILD -!endif -!if $(TCL_NO_DEPRECATED) -OPTDEFINES = $(OPTDEFINES) -DTCL_NO_DEPRECATED -!endif - -!if !$(DEBUG) -OPTDEFINES = $(OPTDEFINES) -DNDEBUG -!if $(OPTIMIZING) -OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_OPTIMIZED -!endif -!endif -!if $(PROFILE) -OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_PROFILED -!endif -!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64" -OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_DO64BIT -!endif -!if $(VCVERSION) < 1300 -OPTDEFINES = $(OPTDEFINES) -DNO_STRTOI64 -!endif - -#---------------------------------------------------------- -# Locate the Tcl headers to build against -#---------------------------------------------------------- - -!if "$(PROJECT)" == "tcl" - -_TCL_H = ..\generic\tcl.h - -!else - -# If INSTALLDIR set to tcl root dir then reset to the lib dir. -!if exist("$(_INSTALLDIR)\include\tcl.h") -_INSTALLDIR=$(_INSTALLDIR)\lib -!endif - -!if !defined(TCLDIR) -!if exist("$(_INSTALLDIR)\..\include\tcl.h") -TCLINSTALL = 1 -_TCLDIR = $(_INSTALLDIR)\.. -_TCL_H = $(_INSTALLDIR)\..\include\tcl.h -TCLDIR = $(_INSTALLDIR)\.. -!else -MSG=^ -Failed to find tcl.h. Set the TCLDIR macro. -!error $(MSG) -!endif -!else -_TCLDIR = $(TCLDIR:/=\) -!if exist("$(_TCLDIR)\include\tcl.h") -TCLINSTALL = 1 -_TCL_H = $(_TCLDIR)\include\tcl.h -!elseif exist("$(_TCLDIR)\generic\tcl.h") -TCLINSTALL = 0 -_TCL_H = $(_TCLDIR)\generic\tcl.h -!else -MSG =^ -Failed to find tcl.h. The TCLDIR macro does not appear correct. -!error $(MSG) -!endif -!endif -!endif - -#-------------------------------------------------------------- -# Extract various version numbers from tcl headers -# The generated file is then included in the makefile. -#-------------------------------------------------------------- - -!if [echo REM = This file is generated from rules.vc > versions.vc] -!endif -!if [echo TCL_MAJOR_VERSION = \>> versions.vc] \ - && [nmakehlp -V "$(_TCL_H)" TCL_MAJOR_VERSION >> versions.vc] -!endif -!if [echo TCL_MINOR_VERSION = \>> versions.vc] \ - && [nmakehlp -V "$(_TCL_H)" TCL_MINOR_VERSION >> versions.vc] -!endif -!if [echo TCL_PATCH_LEVEL = \>> versions.vc] \ - && [nmakehlp -V "$(_TCL_H)" TCL_PATCH_LEVEL >> versions.vc] -!endif - -# If building the tcl core then we need additional package versions -!if "$(PROJECT)" == "tcl" -!if [echo PKG_HTTP_VER = \>> versions.vc] \ - && [nmakehlp -V ..\library\http\pkgIndex.tcl http >> versions.vc] -!endif -!if [echo PKG_TCLTEST_VER = \>> versions.vc] \ - && [nmakehlp -V ..\library\tcltest\pkgIndex.tcl tcltest >> versions.vc] -!endif -!if [echo PKG_MSGCAT_VER = \>> versions.vc] \ - && [nmakehlp -V ..\library\msgcat\pkgIndex.tcl msgcat >> versions.vc] -!endif -!if [echo PKG_PLATFORM_VER = \>> versions.vc] \ - && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform " >> versions.vc] -!endif -!if [echo PKG_SHELL_VER = \>> versions.vc] \ - && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform::shell" >> versions.vc] -!endif -!if [echo PKG_DDE_VER = \>> versions.vc] \ - && [nmakehlp -V ..\library\dde\pkgIndex.tcl "dde " >> versions.vc] -!endif -!if [echo PKG_REG_VER =\>> versions.vc] \ - && [nmakehlp -V ..\library\reg\pkgIndex.tcl registry >> versions.vc] -!endif -!endif - -!include versions.vc - -#-------------------------------------------------------------- -# Setup tcl version dependent stuff headers -#-------------------------------------------------------------- - -!if "$(PROJECT)" != "tcl" - -TCL_VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION) - -!if $(TCLINSTALL) -TCLSH = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe" -!if !exist($(TCLSH)) -TCLSH = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX:x=).exe" -!endif -TCLSTUBLIB = "$(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib" -TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib" -!if !exist($(TCLIMPLIB)) -TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:x=).lib" -!endif -TCL_LIBRARY = $(_TCLDIR)\lib -TCLREGLIB = "$(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib" -TCLDDELIB = "$(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib" -COFFBASE = \must\have\tcl\sources\to\build\this\target -TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target -TCL_INCLUDES = -I"$(_TCLDIR)\include" -!else -TCLSH = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX).exe" -!if !exist($(TCLSH)) -TCLSH = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX:x=).exe" -!endif -TCLSTUBLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib" -TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib" -!if !exist($(TCLIMPLIB)) -TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:x=).lib" -!endif -TCL_LIBRARY = $(_TCLDIR)\library -TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib" -TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib" -COFFBASE = "$(_TCLDIR)\win\coffbase.txt" -TCLTOOLSDIR = $(_TCLDIR)\tools -TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win" -!endif - -!endif - -#------------------------------------------------------------------------- -# Locate the Tk headers to build against -#------------------------------------------------------------------------- - -!if "$(PROJECT)" == "tk" -_TK_H = ..\generic\tk.h -_INSTALLDIR = $(_INSTALLDIR)\.. -!endif - -!ifdef PROJECT_REQUIRES_TK -!if !defined(TKDIR) -!if exist("$(_INSTALLDIR)\..\include\tk.h") -TKINSTALL = 1 -_TKDIR = $(_INSTALLDIR)\.. -_TK_H = $(_TKDIR)\include\tk.h -TKDIR = $(_TKDIR) -!elseif exist("$(_TCLDIR)\include\tk.h") -TKINSTALL = 1 -_TKDIR = $(_TCLDIR) -_TK_H = $(_TKDIR)\include\tk.h -TKDIR = $(_TKDIR) -!endif -!else -_TKDIR = $(TKDIR:/=\) -!if exist("$(_TKDIR)\include\tk.h") -TKINSTALL = 1 -_TK_H = $(_TKDIR)\include\tk.h -!elseif exist("$(_TKDIR)\generic\tk.h") -TKINSTALL = 0 -_TK_H = $(_TKDIR)\generic\tk.h -!else -MSG =^ -Failed to find tk.h. The TKDIR macro does not appear correct. -!error $(MSG) -!endif -!endif -!endif - -#------------------------------------------------------------------------- -# Extract Tk version numbers -#------------------------------------------------------------------------- - -!if defined(PROJECT_REQUIRES_TK) || "$(PROJECT)" == "tk" - -!if [echo TK_MAJOR_VERSION = \>> versions.vc] \ - && [nmakehlp -V $(_TK_H) TK_MAJOR_VERSION >> versions.vc] -!endif -!if [echo TK_MINOR_VERSION = \>> versions.vc] \ - && [nmakehlp -V $(_TK_H) TK_MINOR_VERSION >> versions.vc] -!endif -!if [echo TK_PATCH_LEVEL = \>> versions.vc] \ - && [nmakehlp -V $(_TK_H) TK_PATCH_LEVEL >> versions.vc] -!endif - -!include versions.vc - -TK_DOTVERSION = $(TK_MAJOR_VERSION).$(TK_MINOR_VERSION) -TK_VERSION = $(TK_MAJOR_VERSION)$(TK_MINOR_VERSION) - -!if "$(PROJECT)" != "tk" -!if $(TKINSTALL) -WISH = "$(_TKDIR)\bin\wish$(TK_VERSION)$(SUFX).exe" -!if !exist($(WISH)) -WISH = "$(_TKDIR)\bin\wish$(TK_VERSION)$(SUFX:x=).exe" -!endif -TKSTUBLIB = "$(_TKDIR)\lib\tkstub$(TK_VERSION).lib" -TKIMPLIB = "$(_TKDIR)\lib\tk$(TK_VERSION)$(SUFX).lib" -!if !exist($(TKIMPLIB)) -TKIMPLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tk$(TCL_VERSION)$(SUFX:x=).lib" -!endif -TK_INCLUDES = -I"$(_TKDIR)\include" -!else -WISH = "$(_TKDIR)\win\$(BUILDDIRTOP)\wish$(TCL_VERSION)$(SUFX).exe" -!if !exist($(WISH)) -WISH = "$(_TKDIR)\win\$(BUILDDIRTOP)\wish$(TCL_VERSION)$(SUFX:x=).exe" -!endif -TKSTUBLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tkstub$(TCL_VERSION).lib" -TKIMPLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tk$(TCL_VERSION)$(SUFX).lib" -!if !exist($(TKIMPLIB)) -TKIMPLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tk$(TCL_VERSION)$(SUFX:x=).lib" -!endif -TK_INCLUDES = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib" -!endif -!endif - -!endif - -#---------------------------------------------------------- -# Display stats being used. -#---------------------------------------------------------- - -!message *** Intermediate directory will be '$(TMP_DIR)' -!message *** Output directory will be '$(OUT_DIR)' -!message *** Suffix for binaries will be '$(SUFX)' -!message *** Optional defines are '$(OPTDEFINES)' -!message *** Compiler version $(VCVER). Target machine is $(MACHINE) -!message *** Host architecture is $(NATIVE_ARCH) -!message *** Compiler options '$(COMPILERFLAGS) $(OPTIMIZATIONS) $(DEBUGFLAGS) $(WARNINGS)' -!message *** Link options '$(LINKERFLAGS)' - -!endif +#------------------------------------------------------------------------------
+# rules.vc --
+#
+# Microsoft Visual C++ makefile include for decoding the commandline
+# macros. This file does not need editing to build Tcl.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# Copyright (c) 2001-2003 David Gravereaux.
+# Copyright (c) 2003-2008 Patrick Thoyts
+#------------------------------------------------------------------------------
+
+!ifndef _RULES_VC
+_RULES_VC = 1
+
+cc32 = $(CC) # built-in default.
+link32 = link
+lib32 = lib
+rc32 = $(RC) # built-in default.
+
+!ifndef INSTALLDIR
+### Assume the normal default.
+_INSTALLDIR = C:\Program Files\Tcl
+!else
+### Fix the path separators.
+_INSTALLDIR = $(INSTALLDIR:/=\)
+!endif
+
+#----------------------------------------------------------
+# Set the proper copy method to avoid overwrite questions
+# to the user when copying files and selecting the right
+# "delete all" method.
+#----------------------------------------------------------
+
+!if "$(OS)" == "Windows_NT"
+RMDIR = rmdir /S /Q
+ERRNULL = 2>NUL
+!if ![ver | find "4.0" > nul]
+CPY = echo y | xcopy /i >NUL
+COPY = copy >NUL
+!else
+CPY = xcopy /i /y >NUL
+COPY = copy /y >NUL
+!endif
+!else # "$(OS)" != "Windows_NT"
+CPY = xcopy /i >_JUNK.OUT # On Win98 NUL does not work here.
+COPY = copy >_JUNK.OUT # On Win98 NUL does not work here.
+RMDIR = deltree /Y
+NULL = \NUL # Used in testing directory existence
+ERRNULL = >NUL # Win9x shell cannot redirect stderr
+!endif
+MKDIR = mkdir
+
+#------------------------------------------------------------------------------
+# Determine the host and target architectures and compiler version.
+#------------------------------------------------------------------------------
+
+_HASH=^#
+_VC_MANIFEST_EMBED_EXE=
+_VC_MANIFEST_EMBED_DLL=
+VCVER=0
+!if ![echo VCVERSION=_MSC_VER > vercl.x] \
+ && ![echo $(_HASH)if defined(_M_IX86) >> vercl.x] \
+ && ![echo ARCH=IX86 >> vercl.x] \
+ && ![echo $(_HASH)elif defined(_M_AMD64) >> vercl.x] \
+ && ![echo ARCH=AMD64 >> vercl.x] \
+ && ![echo $(_HASH)endif >> vercl.x] \
+ && ![cl -nologo -TC -P vercl.x $(ERRNULL)]
+!include vercl.i
+!if ![echo VCVER= ^\> vercl.vc] \
+ && ![set /a $(VCVERSION) / 100 - 6 >> vercl.vc]
+!include vercl.vc
+!endif
+!endif
+!if ![del $(ERRNUL) /q/f vercl.x vercl.i vercl.vc]
+!endif
+
+!if ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i x86]
+NATIVE_ARCH=IX86
+!else
+NATIVE_ARCH=AMD64
+!endif
+
+# Since MSVC8 we must deal with manifest resources.
+!if $(VCVERSION) >= 1400
+_VC_MANIFEST_EMBED_EXE=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1
+_VC_MANIFEST_EMBED_DLL=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2
+!endif
+
+!ifndef MACHINE
+MACHINE=$(ARCH)
+!endif
+
+!ifndef CFG_ENCODING
+CFG_ENCODING = \"cp1252\"
+!endif
+
+!message ===============================================================================
+
+#----------------------------------------------------------
+# build the helper app we need to overcome nmake's limiting
+# environment.
+#----------------------------------------------------------
+
+!if !exist(nmakehlp.exe)
+!if [$(cc32) -nologo nmakehlp.c -link -subsystem:console > nul]
+!endif
+!endif
+
+#----------------------------------------------------------
+# Test for compiler features
+#----------------------------------------------------------
+
+### test for optimizations
+!if [nmakehlp -c -Ot]
+!message *** Compiler has 'Optimizations'
+OPTIMIZING = 1
+!else
+!message *** Compiler does not have 'Optimizations'
+OPTIMIZING = 0
+!endif
+
+OPTIMIZATIONS =
+
+!if [nmakehlp -c -Ot]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -Ot
+!endif
+
+!if [nmakehlp -c -Oi]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -Oi
+!endif
+
+!if [nmakehlp -c -Op]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -Op
+!endif
+
+!if [nmakehlp -c -fp:strict]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -fp:strict
+!endif
+
+!if [nmakehlp -c -Gs]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -Gs
+!endif
+
+!if [nmakehlp -c -GS]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -GS
+!endif
+
+!if [nmakehlp -c -GL]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -GL
+!endif
+
+DEBUGFLAGS =
+
+!if [nmakehlp -c -RTC1]
+DEBUGFLAGS = $(DEBUGFLAGS) -RTC1
+!elseif [nmakehlp -c -GZ]
+DEBUGFLAGS = $(DEBUGFLAGS) -GZ
+!endif
+
+COMPILERFLAGS =-W3 -DUNICODE -D_UNICODE
+
+# In v13 -GL and -YX are incompatible.
+!if [nmakehlp -c -YX]
+!if ![nmakehlp -c -GL]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -YX
+!endif
+!endif
+
+!if "$(MACHINE)" == "IX86"
+### test for pentium errata
+!if [nmakehlp -c -QI0f]
+!message *** Compiler has 'Pentium 0x0f fix'
+COMPILERFLAGS = $(COMPILERFLAGS) -QI0f
+!else
+!message *** Compiler does not have 'Pentium 0x0f fix'
+!endif
+!endif
+
+!if "$(MACHINE)" == "IA64"
+### test for Itanium errata
+!if [nmakehlp -c -QIA64_Bx]
+!message *** Compiler has 'B-stepping errata workarounds'
+COMPILERFLAGS = $(COMPILERFLAGS) -QIA64_Bx
+!else
+!message *** Compiler does not have 'B-stepping errata workarounds'
+!endif
+!endif
+
+!if "$(MACHINE)" == "IX86"
+### test for -align:4096, when align:512 will do.
+!if [nmakehlp -l -opt:nowin98]
+!message *** Linker has 'Win98 alignment problem'
+ALIGN98_HACK = 1
+!else
+!message *** Linker does not have 'Win98 alignment problem'
+ALIGN98_HACK = 0
+!endif
+!else
+ALIGN98_HACK = 0
+!endif
+
+LINKERFLAGS =
+
+!if [nmakehlp -l -ltcg]
+LINKERFLAGS =-ltcg
+!endif
+
+#----------------------------------------------------------
+# Decode the options requested.
+#----------------------------------------------------------
+
+!if "$(OPTS)" == "" || [nmakehlp -f "$(OPTS)" "none"]
+STATIC_BUILD = 0
+TCL_THREADS = 1
+DEBUG = 0
+SYMBOLS = 0
+PROFILE = 0
+PGO = 0
+MSVCRT = 1
+LOIMPACT = 0
+TCL_USE_STATIC_PACKAGES = 0
+USE_THREAD_ALLOC = 1
+UNCHECKED = 0
+!else
+!if [nmakehlp -f $(OPTS) "static"]
+!message *** Doing static
+STATIC_BUILD = 1
+!else
+STATIC_BUILD = 0
+!endif
+!if [nmakehlp -f $(OPTS) "msvcrt"]
+!message *** Doing msvcrt
+MSVCRT = 1
+!else
+!if !$(STATIC_BUILD)
+MSVCRT = 1
+!else
+MSVCRT = 0
+!endif
+!endif
+!if [nmakehlp -f $(OPTS) "staticpkg"] && $(STATIC_BUILD)
+!message *** Doing staticpkg
+TCL_USE_STATIC_PACKAGES = 1
+!else
+TCL_USE_STATIC_PACKAGES = 0
+!endif
+!if [nmakehlp -f $(OPTS) "nothreads"]
+!message *** Compile explicitly for non-threaded tcl
+TCL_THREADS = 0
+USE_THREAD_ALLOC= 0
+!else
+TCL_THREADS = 1
+USE_THREAD_ALLOC= 1
+!endif
+!if [nmakehlp -f $(OPTS) "symbols"]
+!message *** Doing symbols
+DEBUG = 1
+!else
+DEBUG = 0
+!endif
+!if [nmakehlp -f $(OPTS) "pdbs"]
+!message *** Doing pdbs
+SYMBOLS = 1
+!else
+SYMBOLS = 0
+!endif
+!if [nmakehlp -f $(OPTS) "profile"]
+!message *** Doing profile
+PROFILE = 1
+!else
+PROFILE = 0
+!endif
+!if [nmakehlp -f $(OPTS) "pgi"]
+!message *** Doing profile guided optimization instrumentation
+PGO = 1
+!elseif [nmakehlp -f $(OPTS) "pgo"]
+!message *** Doing profile guided optimization
+PGO = 2
+!else
+PGO = 0
+!endif
+!if [nmakehlp -f $(OPTS) "loimpact"]
+!message *** Doing loimpact
+LOIMPACT = 1
+!else
+LOIMPACT = 0
+!endif
+!if [nmakehlp -f $(OPTS) "thrdalloc"]
+!message *** Doing thrdalloc
+USE_THREAD_ALLOC = 1
+!endif
+!if [nmakehlp -f $(OPTS) "tclalloc"]
+!message *** Doing tclalloc
+USE_THREAD_ALLOC = 0
+!endif
+!if [nmakehlp -f $(OPTS) "unchecked"]
+!message *** Doing unchecked
+UNCHECKED = 1
+!else
+UNCHECKED = 0
+!endif
+!endif
+
+#----------------------------------------------------------
+# Figure-out how to name our intermediate and output directories.
+# We wouldn't want different builds to use the same .obj files
+# by accident.
+#----------------------------------------------------------
+
+#----------------------------------------
+# Naming convention:
+# t = full thread support.
+# s = static library (as opposed to an
+# import library)
+# g = linked to the debug enabled C
+# run-time.
+# x = special static build when it
+# links to the dynamic C run-time.
+#----------------------------------------
+SUFX = tsgx
+
+!if $(DEBUG)
+BUILDDIRTOP = Debug
+!else
+BUILDDIRTOP = Release
+!endif
+
+!if "$(MACHINE)" != "IX86"
+BUILDDIRTOP =$(BUILDDIRTOP)_$(MACHINE)
+!endif
+!if $(VCVER) > 6
+BUILDDIRTOP =$(BUILDDIRTOP)_VC$(VCVER)
+!endif
+
+!if !$(DEBUG) || $(DEBUG) && $(UNCHECKED)
+SUFX = $(SUFX:g=)
+!endif
+
+TMP_DIRFULL = .\$(BUILDDIRTOP)\$(PROJECT)_ThreadedDynamicStaticX
+
+!if !$(STATIC_BUILD)
+TMP_DIRFULL = $(TMP_DIRFULL:Static=)
+SUFX = $(SUFX:s=)
+EXT = dll
+TMP_DIRFULL = $(TMP_DIRFULL:X=)
+SUFX = $(SUFX:x=)
+!else
+TMP_DIRFULL = $(TMP_DIRFULL:Dynamic=)
+EXT = lib
+!if !$(MSVCRT)
+TMP_DIRFULL = $(TMP_DIRFULL:X=)
+SUFX = $(SUFX:x=)
+!endif
+!endif
+
+!if !$(TCL_THREADS)
+TMP_DIRFULL = $(TMP_DIRFULL:Threaded=)
+SUFX = $(SUFX:t=)
+!endif
+
+!ifndef TMP_DIR
+TMP_DIR = $(TMP_DIRFULL)
+!ifndef OUT_DIR
+OUT_DIR = .\$(BUILDDIRTOP)
+!endif
+!else
+!ifndef OUT_DIR
+OUT_DIR = $(TMP_DIR)
+!endif
+!endif
+
+
+#----------------------------------------------------------
+# Decode the statistics requested.
+#----------------------------------------------------------
+
+!if "$(STATS)" == "" || [nmakehlp -f "$(STATS)" "none"]
+TCL_MEM_DEBUG = 0
+TCL_COMPILE_DEBUG = 0
+!else
+!if [nmakehlp -f $(STATS) "memdbg"]
+!message *** Doing memdbg
+TCL_MEM_DEBUG = 1
+!else
+TCL_MEM_DEBUG = 0
+!endif
+!if [nmakehlp -f $(STATS) "compdbg"]
+!message *** Doing compdbg
+TCL_COMPILE_DEBUG = 1
+!else
+TCL_COMPILE_DEBUG = 0
+!endif
+!endif
+
+
+#----------------------------------------------------------
+# Decode the checks requested.
+#----------------------------------------------------------
+
+!if "$(CHECKS)" == "" || [nmakehlp -f "$(CHECKS)" "none"]
+TCL_NO_DEPRECATED = 0
+WARNINGS = -W3
+!else
+!if [nmakehlp -f $(CHECKS) "nodep"]
+!message *** Doing nodep check
+TCL_NO_DEPRECATED = 1
+!else
+TCL_NO_DEPRECATED = 0
+!endif
+!if [nmakehlp -f $(CHECKS) "fullwarn"]
+!message *** Doing full warnings check
+WARNINGS = -W4
+!if [nmakehlp -l -warn:3]
+LINKERFLAGS = $(LINKERFLAGS) -warn:3
+!endif
+!else
+WARNINGS = -W3
+!endif
+!if [nmakehlp -f $(CHECKS) "64bit"] && [nmakehlp -c -Wp64]
+!message *** Doing 64bit portability warnings
+WARNINGS = $(WARNINGS) -Wp64
+!endif
+!endif
+
+!if $(PGO) > 1
+!if [nmakehlp -l -ltcg:pgoptimize]
+LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pgoptimize
+!else
+MSG=^
+This compiler does not support profile guided optimization.
+!error $(MSG)
+!endif
+!elseif $(PGO) > 0
+!if [nmakehlp -l -ltcg:pginstrument]
+LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pginstrument
+!else
+MSG=^
+This compiler does not support profile guided optimization.
+!error $(MSG)
+!endif
+!endif
+
+#----------------------------------------------------------
+# Set our defines now armed with our options.
+#----------------------------------------------------------
+
+OPTDEFINES = -DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) -DSTDC_HEADERS
+
+!if $(TCL_MEM_DEBUG)
+OPTDEFINES = $(OPTDEFINES) -DTCL_MEM_DEBUG
+!endif
+!if $(TCL_COMPILE_DEBUG)
+OPTDEFINES = $(OPTDEFINES) -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
+!endif
+!if $(TCL_THREADS)
+OPTDEFINES = $(OPTDEFINES) -DTCL_THREADS=1
+!if $(USE_THREAD_ALLOC)
+OPTDEFINES = $(OPTDEFINES) -DUSE_THREAD_ALLOC=1
+!endif
+!endif
+!if $(STATIC_BUILD)
+OPTDEFINES = $(OPTDEFINES) -DSTATIC_BUILD
+!endif
+!if $(TCL_NO_DEPRECATED)
+OPTDEFINES = $(OPTDEFINES) -DTCL_NO_DEPRECATED
+!endif
+
+!if !$(DEBUG)
+OPTDEFINES = $(OPTDEFINES) -DNDEBUG
+!if $(OPTIMIZING)
+OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_OPTIMIZED
+!endif
+!endif
+!if $(PROFILE)
+OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_PROFILED
+!endif
+!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
+OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_DO64BIT
+!endif
+!if $(VCVERSION) < 1300
+OPTDEFINES = $(OPTDEFINES) -DNO_STRTOI64
+!endif
+
+#----------------------------------------------------------
+# Locate the Tcl headers to build against
+#----------------------------------------------------------
+
+!if "$(PROJECT)" == "tcl"
+
+_TCL_H = ..\generic\tcl.h
+
+!else
+
+# If INSTALLDIR set to tcl root dir then reset to the lib dir.
+!if exist("$(_INSTALLDIR)\include\tcl.h")
+_INSTALLDIR=$(_INSTALLDIR)\lib
+!endif
+
+!if !defined(TCLDIR)
+!if exist("$(_INSTALLDIR)\..\include\tcl.h")
+TCLINSTALL = 1
+_TCLDIR = $(_INSTALLDIR)\..
+_TCL_H = $(_INSTALLDIR)\..\include\tcl.h
+TCLDIR = $(_INSTALLDIR)\..
+!else
+MSG=^
+Failed to find tcl.h. Set the TCLDIR macro.
+!error $(MSG)
+!endif
+!else
+_TCLDIR = $(TCLDIR:/=\)
+!if exist("$(_TCLDIR)\include\tcl.h")
+TCLINSTALL = 1
+_TCL_H = $(_TCLDIR)\include\tcl.h
+!elseif exist("$(_TCLDIR)\generic\tcl.h")
+TCLINSTALL = 0
+_TCL_H = $(_TCLDIR)\generic\tcl.h
+!else
+MSG =^
+Failed to find tcl.h. The TCLDIR macro does not appear correct.
+!error $(MSG)
+!endif
+!endif
+!endif
+
+#--------------------------------------------------------------
+# Extract various version numbers from tcl headers
+# The generated file is then included in the makefile.
+#--------------------------------------------------------------
+
+!if [echo REM = This file is generated from rules.vc > versions.vc]
+!endif
+!if [echo TCL_MAJOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V "$(_TCL_H)" TCL_MAJOR_VERSION >> versions.vc]
+!endif
+!if [echo TCL_MINOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V "$(_TCL_H)" TCL_MINOR_VERSION >> versions.vc]
+!endif
+!if [echo TCL_PATCH_LEVEL = \>> versions.vc] \
+ && [nmakehlp -V "$(_TCL_H)" TCL_PATCH_LEVEL >> versions.vc]
+!endif
+
+# If building the tcl core then we need additional package versions
+!if "$(PROJECT)" == "tcl"
+!if [echo PKG_HTTP_VER = \>> versions.vc] \
+ && [nmakehlp -V ..\library\http\pkgIndex.tcl http >> versions.vc]
+!endif
+!if [echo PKG_TCLTEST_VER = \>> versions.vc] \
+ && [nmakehlp -V ..\library\tcltest\pkgIndex.tcl tcltest >> versions.vc]
+!endif
+!if [echo PKG_MSGCAT_VER = \>> versions.vc] \
+ && [nmakehlp -V ..\library\msgcat\pkgIndex.tcl msgcat >> versions.vc]
+!endif
+!if [echo PKG_PLATFORM_VER = \>> versions.vc] \
+ && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform " >> versions.vc]
+!endif
+!if [echo PKG_SHELL_VER = \>> versions.vc] \
+ && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform::shell" >> versions.vc]
+!endif
+!if [echo PKG_DDE_VER = \>> versions.vc] \
+ && [nmakehlp -V ..\library\dde\pkgIndex.tcl "dde " >> versions.vc]
+!endif
+!if [echo PKG_REG_VER =\>> versions.vc] \
+ && [nmakehlp -V ..\library\reg\pkgIndex.tcl registry >> versions.vc]
+!endif
+!endif
+
+!include versions.vc
+
+#--------------------------------------------------------------
+# Setup tcl version dependent stuff headers
+#--------------------------------------------------------------
+
+!if "$(PROJECT)" != "tcl"
+
+TCL_VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
+
+!if $(TCLINSTALL)
+TCLSH = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe"
+!if !exist($(TCLSH))
+TCLSH = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX:x=).exe"
+!endif
+TCLSTUBLIB = "$(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib"
+TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib"
+!if !exist($(TCLIMPLIB))
+TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:x=).lib"
+!endif
+TCL_LIBRARY = $(_TCLDIR)\lib
+TCLREGLIB = "$(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib"
+TCLDDELIB = "$(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib"
+COFFBASE = \must\have\tcl\sources\to\build\this\target
+TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target
+TCL_INCLUDES = -I"$(_TCLDIR)\include"
+!else
+TCLSH = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX).exe"
+!if !exist($(TCLSH))
+TCLSH = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX:x=).exe"
+!endif
+TCLSTUBLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib"
+TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib"
+!if !exist($(TCLIMPLIB))
+TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:x=).lib"
+!endif
+TCL_LIBRARY = $(_TCLDIR)\library
+TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib"
+TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib"
+COFFBASE = "$(_TCLDIR)\win\coffbase.txt"
+TCLTOOLSDIR = $(_TCLDIR)\tools
+TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"
+!endif
+
+!endif
+
+#-------------------------------------------------------------------------
+# Locate the Tk headers to build against
+#-------------------------------------------------------------------------
+
+!if "$(PROJECT)" == "tk"
+_TK_H = ..\generic\tk.h
+_INSTALLDIR = $(_INSTALLDIR)\..
+!endif
+
+!ifdef PROJECT_REQUIRES_TK
+!if !defined(TKDIR)
+!if exist("$(_INSTALLDIR)\..\include\tk.h")
+TKINSTALL = 1
+_TKDIR = $(_INSTALLDIR)\..
+_TK_H = $(_TKDIR)\include\tk.h
+TKDIR = $(_TKDIR)
+!elseif exist("$(_TCLDIR)\include\tk.h")
+TKINSTALL = 1
+_TKDIR = $(_TCLDIR)
+_TK_H = $(_TKDIR)\include\tk.h
+TKDIR = $(_TKDIR)
+!endif
+!else
+_TKDIR = $(TKDIR:/=\)
+!if exist("$(_TKDIR)\include\tk.h")
+TKINSTALL = 1
+_TK_H = $(_TKDIR)\include\tk.h
+!elseif exist("$(_TKDIR)\generic\tk.h")
+TKINSTALL = 0
+_TK_H = $(_TKDIR)\generic\tk.h
+!else
+MSG =^
+Failed to find tk.h. The TKDIR macro does not appear correct.
+!error $(MSG)
+!endif
+!endif
+!endif
+
+#-------------------------------------------------------------------------
+# Extract Tk version numbers
+#-------------------------------------------------------------------------
+
+!if defined(PROJECT_REQUIRES_TK) || "$(PROJECT)" == "tk"
+
+!if [echo TK_MAJOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V $(_TK_H) TK_MAJOR_VERSION >> versions.vc]
+!endif
+!if [echo TK_MINOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V $(_TK_H) TK_MINOR_VERSION >> versions.vc]
+!endif
+!if [echo TK_PATCH_LEVEL = \>> versions.vc] \
+ && [nmakehlp -V $(_TK_H) TK_PATCH_LEVEL >> versions.vc]
+!endif
+
+!include versions.vc
+
+TK_DOTVERSION = $(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)
+TK_VERSION = $(TK_MAJOR_VERSION)$(TK_MINOR_VERSION)
+
+!if "$(PROJECT)" != "tk"
+!if $(TKINSTALL)
+WISH = "$(_TKDIR)\bin\wish$(TK_VERSION)$(SUFX).exe"
+!if !exist($(WISH))
+WISH = "$(_TKDIR)\bin\wish$(TK_VERSION)$(SUFX:x=).exe"
+!endif
+TKSTUBLIB = "$(_TKDIR)\lib\tkstub$(TK_VERSION).lib"
+TKIMPLIB = "$(_TKDIR)\lib\tk$(TK_VERSION)$(SUFX).lib"
+!if !exist($(TKIMPLIB))
+TKIMPLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tk$(TCL_VERSION)$(SUFX:x=).lib"
+!endif
+TK_INCLUDES = -I"$(_TKDIR)\include"
+!else
+WISH = "$(_TKDIR)\win\$(BUILDDIRTOP)\wish$(TCL_VERSION)$(SUFX).exe"
+!if !exist($(WISH))
+WISH = "$(_TKDIR)\win\$(BUILDDIRTOP)\wish$(TCL_VERSION)$(SUFX:x=).exe"
+!endif
+TKSTUBLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tkstub$(TCL_VERSION).lib"
+TKIMPLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tk$(TCL_VERSION)$(SUFX).lib"
+!if !exist($(TKIMPLIB))
+TKIMPLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tk$(TCL_VERSION)$(SUFX:x=).lib"
+!endif
+TK_INCLUDES = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib"
+!endif
+!endif
+
+!endif
+
+#----------------------------------------------------------
+# Display stats being used.
+#----------------------------------------------------------
+
+!message *** Intermediate directory will be '$(TMP_DIR)'
+!message *** Output directory will be '$(OUT_DIR)'
+!message *** Suffix for binaries will be '$(SUFX)'
+!message *** Optional defines are '$(OPTDEFINES)'
+!message *** Compiler version $(VCVER). Target machine is $(MACHINE)
+!message *** Host architecture is $(NATIVE_ARCH)
+!message *** Compiler options '$(COMPILERFLAGS) $(OPTIMIZATIONS) $(DEBUGFLAGS) $(WARNINGS)'
+!message *** Link options '$(LINKERFLAGS)'
+
+!endif
@@ -559,7 +559,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ EXTRA_CFLAGS="" AC_DEFINE(MODULE_SCOPE, [extern], [No need to mark inidividual symbols as hidden]) - AC_CHECK_PROG(CYGPATH, cygpath, cygpath -w, echo) + AC_CHECK_PROG(CYGPATH, cygpath, cygpath -m, echo) SHLIB_SUFFIX=".dll" @@ -673,7 +673,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ if test "${GCC}" = "yes" ; then SHLIB_LD="" SHLIB_LD_LIBS='${LIBS}' - LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -lws2_32" + LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32" # mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32" STLIB_LD='${AR} cr' @@ -791,6 +791,13 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ # Add SHLIB_LD_LIBS to the Make rule, not here. LIBRARIES="\${SHARED_LIBRARIES}" EXESUFFIX="\${DBGX}.exe" + case "x`echo \${VisualStudioVersion}`" in + x1[[4-9]]*) + lflags="${lflags} -nodefaultlib:libucrt.lib" + ;; + *) + ;; + esac fi MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\[$]@" # DLLSUFFIX is separate because it is the building block for @@ -819,15 +826,21 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ ;; esac if test ! -d "${PATH64}" ; then - AC_MSG_WARN([Could not find 64-bit $MACHINE SDK to enable 64bit mode]) - AC_MSG_WARN([Ensure latest Platform SDK is installed]) - do64bit="no" - else - AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) + AC_MSG_WARN([Could not find 64-bit $MACHINE SDK]) fi + AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) fi - LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib ws2_32.lib" + LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib" + + case "x`echo \${VisualStudioVersion}`" in + x1[[4-9]]*) + LIBS="$LIBS ucrt.lib" + ;; + *) + ;; + esac + if test "$do64bit" != "no" ; then # The space-based-path will work for the Makefile, but will # not work if AC_TRY_COMPILE is called. TEA has the @@ -842,7 +855,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d" # Do not use -O2 for Win64 - this has proved buggy in code gen. CFLAGS_OPTIMIZE="-nologo -O1 ${runtime}" - lflags="-nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\"" + lflags="${lflags} -nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\"" LINKBIN="\"${PATH64}/link.exe\"" # Avoid 'unresolved external symbol __security_cookie' errors. # c.f. http://support.microsoft.com/?id=894573 @@ -854,7 +867,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d" # -O2 - create fast code (/Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy) CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}" - lflags="-nologo" + lflags="${lflags} -nologo" LINKBIN="link" fi diff --git a/win/tkConfig.sh.in b/win/tkConfig.sh.in index 7816b15..c511312 100644 --- a/win/tkConfig.sh.in +++ b/win/tkConfig.sh.in @@ -1,5 +1,5 @@ # tkConfig.sh -- -# +# # This shell script (for sh) is generated automatically by Tk's # configure script. It will create shell variables for most of # the configuration options discovered by the configure script. diff --git a/win/tkWin.h b/win/tkWin.h index adb943b..4d278d7 100644 --- a/win/tkWin.h +++ b/win/tkWin.h @@ -16,7 +16,7 @@ /* * We must specify the lower version we intend to support. In particular * the SystemParametersInfo API doesn't like to receive structures that - * are larger than it expects which affects the font assignements. + * are larger than it expects which affects the font assignments. * * WINVER = 0x0500 means Windows 2000 and above */ @@ -38,9 +38,9 @@ /* * The following messages are used to communicate between a Tk toplevel - * and its container window. A Tk container may not be able to provide - * service to all of the following requests at the moment. But an embedded - * Tk window will send out these requests to support external Tk container + * and its container window. A Tk container may not be able to provide + * service to all of the following requests at the moment. But an embedded + * Tk window will send out these requests to support external Tk container * application. */ @@ -61,7 +61,7 @@ /* * The following are sub-messages (wParam) for TK_INFO. An embedded window may - * send a TK_INFO message with one of the sub-messages to query a container + * send a TK_INFO message with one of the sub-messages to query a container * for verification and availability */ #define TK_CONTAINER_VERIFY 0x01 diff --git a/win/tkWinButton.c b/win/tkWinButton.c index ca6d48e..e46bcb3 100644 --- a/win/tkWinButton.c +++ b/win/tkWinButton.c @@ -1265,21 +1265,29 @@ ButtonProc( return 0; } case BN_CLICKED: { - int code; - Tcl_Interp *interp = butPtr->info.interp; - - if (butPtr->info.state != STATE_DISABLED) { - Tcl_Preserve((ClientData)interp); - code = TkInvokeButton((TkButton*)butPtr); - if (code != TCL_OK && code != TCL_CONTINUE - && code != TCL_BREAK) { - Tcl_AddErrorInfo(interp, "\n (button invoke)"); - Tcl_BackgroundException(interp, code); + /* + * OOPS: chromium fires WM_NULL regularly to ping if plugin is still + * alive. When using an external window (i.e. via the tcl plugin), this + * causes all buttons to fire once a second, so we need to make sure + * that we are not dealing with the chromium life check. + */ + if (wParam != 0 || lParam != 0) { + int code; + Tcl_Interp *interp = butPtr->info.interp; + + if (butPtr->info.state != STATE_DISABLED) { + Tcl_Preserve((ClientData)interp); + code = TkInvokeButton((TkButton*)butPtr); + if (code != TCL_OK && code != TCL_CONTINUE + && code != TCL_BREAK) { + Tcl_AddErrorInfo(interp, "\n (button invoke)"); + Tcl_BackgroundException(interp, code); + } + Tcl_Release((ClientData)interp); } - Tcl_Release((ClientData)interp); + Tcl_ServiceAll(); + return 0; } - Tcl_ServiceAll(); - return 0; } default: diff --git a/win/tkWinClipboard.c b/win/tkWinClipboard.c index 2501688..200883f 100644 --- a/win/tkWinClipboard.c +++ b/win/tkWinClipboard.c @@ -12,6 +12,7 @@ #include "tkWinInt.h" #include "tkSelect.h" +#include <shlobj.h> /* for DROPFILES */ static void UpdateClipboard(HWND hwnd); @@ -52,7 +53,7 @@ TkSelGetSelection( Tcl_DString ds; HGLOBAL handle; Tcl_Encoding encoding; - int result, locale; + int result, locale, noBackslash = 0; if ((selection != Tk_InternAtom(tkwin, "CLIPBOARD")) || (target != XA_STRING) @@ -132,7 +133,37 @@ TkSelGetSelection( if (encoding) { Tcl_FreeEncoding(encoding); } + } else if (IsClipboardFormatAvailable(CF_HDROP)) { + DROPFILES *drop; + handle = GetClipboardData(CF_HDROP); + if (!handle) { + CloseClipboard(); + goto error; + } + Tcl_DStringInit(&ds); + drop = (DROPFILES *) GlobalLock(handle); + if (drop->fWide) { + WCHAR *fname = (WCHAR *) ((char *) drop + drop->pFiles); + Tcl_DString dsTmp; + int count = 0, len; + + while (*fname != 0) { + if (count) { + Tcl_DStringAppend(&ds, "\n", 1); + } + len = Tcl_UniCharLen((Tcl_UniChar *) fname); + Tcl_DStringInit(&dsTmp); + Tcl_UniCharToUtfDString((Tcl_UniChar *) fname, len, &dsTmp); + Tcl_DStringAppend(&ds, Tcl_DStringValue(&dsTmp), + Tcl_DStringLength(&dsTmp)); + Tcl_DStringFree(&dsTmp); + fname += len + 1; + count++; + } + noBackslash = (count > 0); + } + GlobalUnlock(handle); } else { CloseClipboard(); goto error; @@ -146,6 +177,9 @@ TkSelGetSelection( while (*data) { if (data[0] == '\r' && data[1] == '\n') { data++; + } else if (noBackslash && data[0] == '\\') { + data++; + *destPtr++ = '/'; } else { *destPtr++ = *data++; } diff --git a/win/tkWinColor.c b/win/tkWinColor.c index 5eaeeb3..ba9815c 100644 --- a/win/tkWinColor.c +++ b/win/tkWinColor.c @@ -316,7 +316,8 @@ XAllocColor( if (GetDeviceCaps(dc, RASTERCAPS) & RC_PALETTE) { unsigned long sizePalette = GetDeviceCaps(dc, SIZEPALETTE); UINT newPixel, closePixel; - int new, refCount; + int new; + size_t refCount; Tcl_HashEntry *entryPtr; UINT index; @@ -361,9 +362,9 @@ XAllocColor( if (new) { refCount = 1; } else { - refCount = (PTR2INT(Tcl_GetHashValue(entryPtr))) + 1; + refCount = (size_t)Tcl_GetHashValue(entryPtr) + 1; } - Tcl_SetHashValue(entryPtr, INT2PTR(refCount)); + Tcl_SetHashValue(entryPtr, (void *)refCount); } else { /* * Determine what color will actually be used on non-colormap systems. @@ -407,7 +408,8 @@ XFreeColors( { TkWinColormap *cmap = (TkWinColormap *) colormap; COLORREF cref; - UINT count, index, refCount; + UINT count, index; + size_t refCount; int i; PALETTEENTRY entry, *entries; Tcl_HashEntry *entryPtr; @@ -427,7 +429,7 @@ XFreeColors( if (!entryPtr) { Tcl_Panic("Tried to free a color that isn't allocated"); } - refCount = PTR2INT(Tcl_GetHashValue(entryPtr)) - 1; + refCount = (size_t)Tcl_GetHashValue(entryPtr) - 1; if (refCount == 0) { cref = pixels[i] & 0x00ffffff; index = GetNearestPaletteIndex(cmap->palette, cref); @@ -444,7 +446,7 @@ XFreeColors( } Tcl_DeleteHashEntry(entryPtr); } else { - Tcl_SetHashValue(entryPtr, INT2PTR(refCount)); + Tcl_SetHashValue(entryPtr, (size_t)refCount); } } } diff --git a/win/tkWinDefault.h b/win/tkWinDefault.h index 6d1a0c9..29fe4ee 100644 --- a/win/tkWinDefault.h +++ b/win/tkWinDefault.h @@ -371,6 +371,7 @@ #define DEF_PANEDWINDOW_HEIGHT "" #define DEF_PANEDWINDOW_OPAQUERESIZE "1" #define DEF_PANEDWINDOW_ORIENT "horizontal" +#define DEF_PANEDWINDOW_PROXYBORDER "2" #define DEF_PANEDWINDOW_RELIEF "flat" #define DEF_PANEDWINDOW_SASHCURSOR "" #define DEF_PANEDWINDOW_SASHPAD "0" diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c index baebfc9..d7f63fb 100644 --- a/win/tkWinDialog.c +++ b/win/tkWinDialog.c @@ -14,18 +14,19 @@ #include "tkFont.h" #include <commdlg.h> /* includes common dialog functionality */ -#ifdef _MSC_VER -# pragma comment (lib, "comdlg32.lib") -#endif #include <dlgs.h> /* includes common dialog template defines */ #include <cderr.h> /* includes the common dialog error codes */ #include <shlobj.h> /* includes SHBrowseForFolder */ + #ifdef _MSC_VER # pragma comment (lib, "shell32.lib") +# pragma comment (lib, "comdlg32.lib") +# pragma comment (lib, "uuid.lib") #endif /* These needed for compilation with VC++ 5.2 */ +/* XXX - remove these since need at least VC 6 */ #ifndef BIF_EDITBOX #define BIF_EDITBOX 0x10 #endif @@ -34,6 +35,7 @@ #define BIF_VALIDATE 0x0020 #endif +/* This "new" dialog style is now actually the "old" dialog style post-Vista */ #ifndef BIF_NEWDIALOGSTYLE #define BIF_NEWDIALOGSTYLE 0x0040 #endif @@ -57,6 +59,10 @@ typedef struct ThreadSpecificData { HHOOK hMsgBoxHook; /* Hook proc for tk_messageBox and the */ HICON hSmallIcon; /* icons used by a parent to be used in */ HICON hBigIcon; /* the message box */ + int newFileDialogsState; +#define FDLG_STATE_INIT 0 /* Uninitialized */ +#define FDLG_STATE_USE_NEW 1 /* Use the new dialogs */ +#define FDLG_STATE_USE_OLD 2 /* Use the old dialogs */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -159,6 +165,408 @@ typedef struct OFNData { } OFNData; /* + * The following structure is used to gather options used by various + * file dialogs + */ +typedef struct OFNOpts { + Tk_Window tkwin; /* Owner window for dialog */ + Tcl_Obj *extObj; /* Default extension */ + Tcl_Obj *titleObj; /* Title for dialog */ + Tcl_Obj *filterObj; /* File type filter list */ + Tcl_Obj *typeVariableObj; /* Variable in which to store type selected */ + Tcl_Obj *initialTypeObj; /* Initial value of above, or NULL */ + Tcl_DString utfDirString; /* Initial dir */ + int multi; /* Multiple selection enabled */ + int confirmOverwrite; /* Confirm before overwriting */ + int mustExist; /* Used only for */ + int forceXPStyle; /* XXX - Force XP style even on newer systems */ + TCHAR file[TK_MULTI_MAX_PATH]; /* File name + XXX - fixed size because it was so + historically. Why not malloc'ed ? + XXX - also, TCHAR should really be WCHAR + because TkWinGetUnicodeEncoding is always + UCS2. + */ +} OFNOpts; + +/* Define the operation for which option parsing is to be done. */ +enum OFNOper { + OFN_FILE_SAVE, /* tk_getOpenFile */ + OFN_FILE_OPEN, /* tk_getSaveFile */ + OFN_DIR_CHOOSE /* tk_chooseDirectory */ +}; + + +/* + * The following definitions are required when using older versions of + * Visual C++ (like 6.0) and possibly MingW. Those headers do not contain + * required definitions for interfaces new to Vista that we need for + * the new file dialogs. Duplicating definitions is OK because they + * should forever remain unchanged. + * + * XXX - is there a better/easier way to use new data definitions with + * older compilers? Should we prefix definitions with Tcl_ instead + * of using the same names as in the SDK? + */ +#ifndef __IShellItem_INTERFACE_DEFINED__ +# define __IShellItem_INTERFACE_DEFINED__ +#ifdef __MSVCRT__ +typedef struct IShellItem IShellItem; + +typedef enum __MIDL_IShellItem_0001 { + SIGDN_NORMALDISPLAY = 0,SIGDN_PARENTRELATIVEPARSING = 0x80018001,SIGDN_PARENTRELATIVEFORADDRESSBAR = 0x8001c001, + SIGDN_DESKTOPABSOLUTEPARSING = 0x80028000,SIGDN_PARENTRELATIVEEDITING = 0x80031001,SIGDN_DESKTOPABSOLUTEEDITING = 0x8004c000, + SIGDN_FILESYSPATH = 0x80058000,SIGDN_URL = 0x80068000 +} SIGDN; + +typedef DWORD SICHINTF; + +typedef struct IShellItemVtbl +{ + BEGIN_INTERFACE + + HRESULT (STDMETHODCALLTYPE *QueryInterface)(IShellItem *, REFIID, void **); + ULONG (STDMETHODCALLTYPE *AddRef)(IShellItem *); + ULONG (STDMETHODCALLTYPE *Release)(IShellItem *); + HRESULT (STDMETHODCALLTYPE *BindToHandler)(IShellItem *, IBindCtx *, REFGUID, REFIID, void **); + HRESULT (STDMETHODCALLTYPE *GetParent)(IShellItem *, IShellItem **); + HRESULT (STDMETHODCALLTYPE *GetDisplayName)(IShellItem *, SIGDN, LPOLESTR *); + HRESULT (STDMETHODCALLTYPE *GetAttributes)(IShellItem *, SFGAOF, SFGAOF *); + HRESULT (STDMETHODCALLTYPE *Compare)(IShellItem *, IShellItem *, SICHINTF, int *); + + END_INTERFACE +} IShellItemVtbl; +struct IShellItem { + CONST_VTBL struct IShellItemVtbl *lpVtbl; +}; +#endif +#endif + +#ifndef __IShellItemArray_INTERFACE_DEFINED__ +#define __IShellItemArray_INTERFACE_DEFINED__ + +typedef enum SIATTRIBFLAGS { + SIATTRIBFLAGS_AND = 0x1, + SIATTRIBFLAGS_OR = 0x2, + SIATTRIBFLAGS_APPCOMPAT = 0x3, + SIATTRIBFLAGS_MASK = 0x3, + SIATTRIBFLAGS_ALLITEMS = 0x4000 +} SIATTRIBFLAGS; +#ifdef __MSVCRT__ +typedef ULONG SFGAOF; +#endif /* __MSVCRT__ */ +typedef struct IShellItemArray IShellItemArray; +typedef struct IShellItemArrayVtbl +{ + BEGIN_INTERFACE + + HRESULT ( STDMETHODCALLTYPE *QueryInterface )( + IShellItemArray *, REFIID riid,void **ppvObject); + ULONG ( STDMETHODCALLTYPE *AddRef )(IShellItemArray *); + ULONG ( STDMETHODCALLTYPE *Release )(IShellItemArray *); + HRESULT ( STDMETHODCALLTYPE *BindToHandler )(IShellItemArray *, + IBindCtx *, REFGUID, REFIID, void **); + /* flags is actually is enum GETPROPERTYSTOREFLAGS */ + HRESULT ( STDMETHODCALLTYPE *GetPropertyStore )( + IShellItemArray *, int, REFIID, void **); + /* keyType actually REFPROPERTYKEY */ + HRESULT ( STDMETHODCALLTYPE *GetPropertyDescriptionList )( + IShellItemArray *, void *, REFIID, void **); + HRESULT ( STDMETHODCALLTYPE *GetAttributes )(IShellItemArray *, + SIATTRIBFLAGS, SFGAOF, SFGAOF *); + HRESULT ( STDMETHODCALLTYPE *GetCount )( + IShellItemArray *, DWORD *); + HRESULT ( STDMETHODCALLTYPE *GetItemAt )( + IShellItemArray *, DWORD, IShellItem **); + /* ppenumShellItems actually (IEnumShellItems **) */ + HRESULT ( STDMETHODCALLTYPE *EnumItems )( + IShellItemArray *, void **); + + END_INTERFACE +} IShellItemArrayVtbl; + +struct IShellItemArray { + CONST_VTBL struct IShellItemArrayVtbl *lpVtbl; +}; + +#endif /* __IShellItemArray_INTERFACE_DEFINED__ */ + +/* + * Older compilers do not define these CLSIDs so we do so here under + * a slightly different name so as to not clash with the definitions + * in new compilers + */ +static const CLSID ClsidFileOpenDialog = { + 0xDC1C5A9C, 0xE88A, 0X4DDE, {0xA5, 0xA1, 0x60, 0xF8, 0x2A, 0x20, 0xAE, 0xF7} +}; +static const CLSID ClsidFileSaveDialog = { + 0xC0B4E2F3, 0xBA21, 0x4773, {0x8D, 0xBA, 0x33, 0x5E, 0xC9, 0x46, 0xEB, 0x8B} +}; +static const IID IIDIFileOpenDialog = { + 0xD57C7288, 0xD4AD, 0x4768, {0xBE, 0x02, 0x9D, 0x96, 0x95, 0x32, 0xD9, 0x60} +}; +static const IID IIDIFileSaveDialog = { + 0x84BCCD23, 0x5FDE, 0x4CDB, {0xAE, 0xA4, 0xAF, 0x64, 0xB8, 0x3D, 0x78, 0xAB} +}; +static const IID IIDIShellItem = { + 0x43826D1E, 0xE718, 0x42EE, {0xBC, 0x55, 0xA1, 0xE2, 0x61, 0xC3, 0x7B, 0xFE} +}; + +#ifdef __IFileDialog_INTERFACE_DEFINED__ +# define TCLCOMDLG_FILTERSPEC COMDLG_FILTERSPEC +#else + +/* Forward declarations for structs that are referenced but not used */ +typedef struct IPropertyStore IPropertyStore; +typedef struct IPropertyDescriptionList IPropertyDescriptionList; +typedef struct IFileOperationProgressSink IFileOperationProgressSink; +typedef enum FDAP { + FDAP_BOTTOM = 0, + FDAP_TOP = 1 +} FDAP; + +typedef struct { + LPCWSTR pszName; + LPCWSTR pszSpec; +} TCLCOMDLG_FILTERSPEC; + +enum _FILEOPENDIALOGOPTIONS { + FOS_OVERWRITEPROMPT = 0x2, + FOS_STRICTFILETYPES = 0x4, + FOS_NOCHANGEDIR = 0x8, + FOS_PICKFOLDERS = 0x20, + FOS_FORCEFILESYSTEM = 0x40, + FOS_ALLNONSTORAGEITEMS = 0x80, + FOS_NOVALIDATE = 0x100, + FOS_ALLOWMULTISELECT = 0x200, + FOS_PATHMUSTEXIST = 0x800, + FOS_FILEMUSTEXIST = 0x1000, + FOS_CREATEPROMPT = 0x2000, + FOS_SHAREAWARE = 0x4000, + FOS_NOREADONLYRETURN = 0x8000, + FOS_NOTESTFILECREATE = 0x10000, + FOS_HIDEMRUPLACES = 0x20000, + FOS_HIDEPINNEDPLACES = 0x40000, + FOS_NODEREFERENCELINKS = 0x100000, + FOS_DONTADDTORECENT = 0x2000000, + FOS_FORCESHOWHIDDEN = 0x10000000, + FOS_DEFAULTNOMINIMODE = 0x20000000, + FOS_FORCEPREVIEWPANEON = 0x40000000 +} ; +typedef DWORD FILEOPENDIALOGOPTIONS; + +typedef struct IFileDialog IFileDialog; +typedef struct IFileDialogVtbl +{ + BEGIN_INTERFACE + + HRESULT ( STDMETHODCALLTYPE *QueryInterface )( + IFileDialog *, REFIID, void **); + ULONG ( STDMETHODCALLTYPE *AddRef )( IFileDialog *); + ULONG ( STDMETHODCALLTYPE *Release )( IFileDialog *); + HRESULT ( STDMETHODCALLTYPE *Show )( IFileDialog *, HWND); + HRESULT ( STDMETHODCALLTYPE *SetFileTypes )( IFileDialog *, + UINT, const TCLCOMDLG_FILTERSPEC *); + HRESULT ( STDMETHODCALLTYPE *SetFileTypeIndex )(IFileDialog *, UINT); + HRESULT ( STDMETHODCALLTYPE *GetFileTypeIndex )(IFileDialog *, UINT *); + /* XXX - Actually pfde is IFileDialogEvents* but we do not use + this call and do not want to define IFileDialogEvents as that + pulls in a whole bunch of other stuff. */ + HRESULT ( STDMETHODCALLTYPE *Advise )( + IFileDialog *, void *, DWORD *); + HRESULT ( STDMETHODCALLTYPE *Unadvise )(IFileDialog *, DWORD); + HRESULT ( STDMETHODCALLTYPE *SetOptions )( + IFileDialog *, FILEOPENDIALOGOPTIONS); + HRESULT ( STDMETHODCALLTYPE *GetOptions )( + IFileDialog *, FILEOPENDIALOGOPTIONS *); + HRESULT ( STDMETHODCALLTYPE *SetDefaultFolder )( + IFileDialog *, IShellItem *); + HRESULT ( STDMETHODCALLTYPE *SetFolder )( + IFileDialog *, IShellItem *); + HRESULT ( STDMETHODCALLTYPE *GetFolder )( + IFileDialog *, IShellItem **); + HRESULT ( STDMETHODCALLTYPE *GetCurrentSelection )( + IFileDialog *, IShellItem **); + HRESULT ( STDMETHODCALLTYPE *SetFileName )( + IFileDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *GetFileName )( + IFileDialog *, LPWSTR *); + HRESULT ( STDMETHODCALLTYPE *SetTitle )( + IFileDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *SetOkButtonLabel )( + IFileDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *SetFileNameLabel )( + IFileDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *GetResult )( + IFileDialog *, IShellItem **); + HRESULT ( STDMETHODCALLTYPE *AddPlace )( + IFileDialog *, IShellItem *, FDAP); + HRESULT ( STDMETHODCALLTYPE *SetDefaultExtension )( + IFileDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *Close )( IFileDialog *, HRESULT); + HRESULT ( STDMETHODCALLTYPE *SetClientGuid )( + IFileDialog *, REFGUID); + HRESULT ( STDMETHODCALLTYPE *ClearClientData )( IFileDialog *); + /* pFilter actually IShellItemFilter. But deprecated in Win7 AND we do + not use it anyways. So define as void* */ + HRESULT ( STDMETHODCALLTYPE *SetFilter )( + IFileDialog *, void *); + + END_INTERFACE +} IFileDialogVtbl; + +struct IFileDialog { + CONST_VTBL struct IFileDialogVtbl *lpVtbl; +}; + + +typedef struct IFileSaveDialog IFileSaveDialog; +typedef struct IFileSaveDialogVtbl { + BEGIN_INTERFACE + + HRESULT ( STDMETHODCALLTYPE *QueryInterface )( + IFileSaveDialog *, REFIID, void **); + ULONG ( STDMETHODCALLTYPE *AddRef )( IFileSaveDialog *); + ULONG ( STDMETHODCALLTYPE *Release )( IFileSaveDialog *); + HRESULT ( STDMETHODCALLTYPE *Show )( + IFileSaveDialog *, HWND); + HRESULT ( STDMETHODCALLTYPE *SetFileTypes )( IFileSaveDialog * this, + UINT, const TCLCOMDLG_FILTERSPEC *); + HRESULT ( STDMETHODCALLTYPE *SetFileTypeIndex )( + IFileSaveDialog *, UINT); + HRESULT ( STDMETHODCALLTYPE *GetFileTypeIndex )( + IFileSaveDialog *, UINT *); + /* Actually pfde is IFileSaveDialogEvents* */ + HRESULT ( STDMETHODCALLTYPE *Advise )( + IFileSaveDialog *, void *, DWORD *); + HRESULT ( STDMETHODCALLTYPE *Unadvise )( IFileSaveDialog *, DWORD); + HRESULT ( STDMETHODCALLTYPE *SetOptions )( + IFileSaveDialog *, FILEOPENDIALOGOPTIONS); + HRESULT ( STDMETHODCALLTYPE *GetOptions )( + IFileSaveDialog *, FILEOPENDIALOGOPTIONS *); + HRESULT ( STDMETHODCALLTYPE *SetDefaultFolder )( + IFileSaveDialog *, IShellItem *); + HRESULT ( STDMETHODCALLTYPE *SetFolder )( + IFileSaveDialog *, IShellItem *); + HRESULT ( STDMETHODCALLTYPE *GetFolder )( + IFileSaveDialog *, IShellItem **); + HRESULT ( STDMETHODCALLTYPE *GetCurrentSelection )( + IFileSaveDialog *, IShellItem **); + HRESULT ( STDMETHODCALLTYPE *SetFileName )( + IFileSaveDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *GetFileName )( + IFileSaveDialog *, LPWSTR *); + HRESULT ( STDMETHODCALLTYPE *SetTitle )( + IFileSaveDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *SetOkButtonLabel )( + IFileSaveDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *SetFileNameLabel )( + IFileSaveDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *GetResult )( + IFileSaveDialog *, IShellItem **); + HRESULT ( STDMETHODCALLTYPE *AddPlace )( + IFileSaveDialog *, IShellItem *, FDAP); + HRESULT ( STDMETHODCALLTYPE *SetDefaultExtension )( + IFileSaveDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *Close )( IFileSaveDialog *, HRESULT); + HRESULT ( STDMETHODCALLTYPE *SetClientGuid )( + IFileSaveDialog *, REFGUID); + HRESULT ( STDMETHODCALLTYPE *ClearClientData )( IFileSaveDialog *); + /* pFilter Actually IShellItemFilter* */ + HRESULT ( STDMETHODCALLTYPE *SetFilter )( + IFileSaveDialog *, void *); + HRESULT ( STDMETHODCALLTYPE *SetSaveAsItem )( + IFileSaveDialog *, IShellItem *); + HRESULT ( STDMETHODCALLTYPE *SetProperties )( + IFileSaveDialog *, IPropertyStore *); + HRESULT ( STDMETHODCALLTYPE *SetCollectedProperties )( + IFileSaveDialog *, IPropertyDescriptionList *, BOOL); + HRESULT ( STDMETHODCALLTYPE *GetProperties )( + IFileSaveDialog *, IPropertyStore **); + HRESULT ( STDMETHODCALLTYPE *ApplyProperties )( + IFileSaveDialog *, IShellItem *, IPropertyStore *, + HWND, IFileOperationProgressSink *); + + END_INTERFACE + +} IFileSaveDialogVtbl; + +struct IFileSaveDialog { + CONST_VTBL struct IFileSaveDialogVtbl *lpVtbl; +}; + +typedef struct IFileOpenDialog IFileOpenDialog; +typedef struct IFileOpenDialogVtbl { + BEGIN_INTERFACE + + HRESULT ( STDMETHODCALLTYPE *QueryInterface )( + IFileOpenDialog *, REFIID, void **); + ULONG ( STDMETHODCALLTYPE *AddRef )( IFileOpenDialog *); + ULONG ( STDMETHODCALLTYPE *Release )( IFileOpenDialog *); + HRESULT ( STDMETHODCALLTYPE *Show )( IFileOpenDialog *, HWND); + HRESULT ( STDMETHODCALLTYPE *SetFileTypes )( IFileOpenDialog *, + UINT, const TCLCOMDLG_FILTERSPEC *); + HRESULT ( STDMETHODCALLTYPE *SetFileTypeIndex )( + IFileOpenDialog *, UINT); + HRESULT ( STDMETHODCALLTYPE *GetFileTypeIndex )( + IFileOpenDialog *, UINT *); + /* Actually pfde is IFileDialogEvents* */ + HRESULT ( STDMETHODCALLTYPE *Advise )( + IFileOpenDialog *, void *, DWORD *); + HRESULT ( STDMETHODCALLTYPE *Unadvise )( IFileOpenDialog *, DWORD); + HRESULT ( STDMETHODCALLTYPE *SetOptions )( + IFileOpenDialog *, FILEOPENDIALOGOPTIONS); + HRESULT ( STDMETHODCALLTYPE *GetOptions )( + IFileOpenDialog *, FILEOPENDIALOGOPTIONS *); + HRESULT ( STDMETHODCALLTYPE *SetDefaultFolder )( + IFileOpenDialog *, IShellItem *); + HRESULT ( STDMETHODCALLTYPE *SetFolder )( + IFileOpenDialog *, IShellItem *); + HRESULT ( STDMETHODCALLTYPE *GetFolder )( + IFileOpenDialog *, IShellItem **); + HRESULT ( STDMETHODCALLTYPE *GetCurrentSelection )( + IFileOpenDialog *, IShellItem **); + HRESULT ( STDMETHODCALLTYPE *SetFileName )( + IFileOpenDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *GetFileName )( + IFileOpenDialog *, LPWSTR *); + HRESULT ( STDMETHODCALLTYPE *SetTitle )( + IFileOpenDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *SetOkButtonLabel )( + IFileOpenDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *SetFileNameLabel )( + IFileOpenDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *GetResult )( + IFileOpenDialog *, IShellItem **); + HRESULT ( STDMETHODCALLTYPE *AddPlace )( + IFileOpenDialog *, IShellItem *, FDAP); + HRESULT ( STDMETHODCALLTYPE *SetDefaultExtension )( + IFileOpenDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *Close )( IFileOpenDialog *, HRESULT); + HRESULT ( STDMETHODCALLTYPE *SetClientGuid )( + IFileOpenDialog *, REFGUID); + HRESULT ( STDMETHODCALLTYPE *ClearClientData )( + IFileOpenDialog *); + HRESULT ( STDMETHODCALLTYPE *SetFilter )( + IFileOpenDialog *, + /* pFilter is actually IShellItemFilter */ + void *); + HRESULT ( STDMETHODCALLTYPE *GetResults )( + IFileOpenDialog *, IShellItemArray **); + HRESULT ( STDMETHODCALLTYPE *GetSelectedItems )( + IFileOpenDialog *, IShellItemArray **); + + END_INTERFACE +} IFileOpenDialogVtbl; + +struct IFileOpenDialog +{ + CONST_VTBL struct IFileOpenDialogVtbl *lpVtbl; +}; + +#endif /* __IFileDialog_INTERFACE_DEFINED__ */ + +/* * Definitions of functions used only in this file. */ @@ -166,9 +574,21 @@ static UINT APIENTRY ChooseDirectoryValidateProc(HWND hdlg, UINT uMsg, LPARAM wParam, LPARAM lParam); static UINT CALLBACK ColorDlgHookProc(HWND hDlg, UINT uMsg, WPARAM wParam, LPARAM lParam); +static void CleanupOFNOptions(OFNOpts *optsPtr); +static int ParseOFNOptions(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[], enum OFNOper oper, OFNOpts *optsPtr); +static int GetFileNameXP(Tcl_Interp *interp, OFNOpts *optsPtr, + enum OFNOper oper); +static int GetFileNameVista(Tcl_Interp *interp, OFNOpts *optsPtr, + enum OFNOper oper); static int GetFileName(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[], int isOpen); + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[], enum OFNOper oper); +static int MakeFilterVista(Tcl_Interp *interp, OFNOpts *optsPtr, + DWORD *countPtr, TCLCOMDLG_FILTERSPEC **dlgFilterPtrPtr, + DWORD *defaultFilterIndexPtr); +static void FreeFilterVista(DWORD count, TCLCOMDLG_FILTERSPEC *dlgFilterPtr); static int MakeFilter(Tcl_Interp *interp, Tcl_Obj *valuePtr, Tcl_DString *dsPtr, Tcl_Obj *initialPtr, int *indexPtr); @@ -178,6 +598,66 @@ static LRESULT CALLBACK MsgBoxCBTProc(int nCode, WPARAM wParam, LPARAM lParam); static void SetTkDialog(ClientData clientData); static const char *ConvertExternalFilename(TCHAR *filename, Tcl_DString *dsPtr); +static void LoadShellProcs(void); + + +/* Definitions of dynamically loaded Win32 calls */ +typedef HRESULT (STDAPICALLTYPE SHCreateItemFromParsingNameProc)( + PCWSTR pszPath, IBindCtx *pbc, REFIID riid, void **ppv); +struct ShellProcPointers { + SHCreateItemFromParsingNameProc *SHCreateItemFromParsingName; +} ShellProcs; + + +/* + *------------------------------------------------------------------------- + * + * LoadShellProcs -- + * + * Some shell functions are not available on older versions of + * Windows. This function dynamically loads them and stores pointers + * to them in ShellProcs. Any function that is not available has + * the corresponding pointer set to NULL. + * + * Note this call never fails. Unavailability of a function is not + * a reason for failure. Caller should check whether a particular + * function pointer is NULL or not. Once loaded a function stays + * forever loaded. + * + * XXX - we load the function pointers into global memory. This implies + * there is a potential (however small) for race conditions between + * threads. However, Tk is in any case meant to be loaded in exactly + * one thread so this should not be an issue and saves us from + * unnecessary bookkeeping. + * + * Return value: + * None. + * + * Side effects: + * ShellProcs is populated. + *------------------------------------------------------------------------- + */ +static void LoadShellProcs() +{ + static HMODULE shell32_handle = NULL; + + if (shell32_handle != NULL) + return; /* We have already been through here. */ + + /* + * XXX - Note we never call FreeLibrary. There is no point because + * shell32.dll is loaded at startup anyways and stays for the duration + * of the process so why bother with keeping track of when to unload + */ + shell32_handle = LoadLibrary(TEXT("shell32.dll")); + if (shell32_handle == NULL) /* Should never happen but check anyways. */ + return; + + ShellProcs.SHCreateItemFromParsingName = + (SHCreateItemFromParsingNameProc*) GetProcAddress(shell32_handle, + "SHCreateItemFromParsingName"); +} + /* *------------------------------------------------------------------------- @@ -487,7 +967,7 @@ Tk_GetOpenFileObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return GetFileName(clientData, interp, objc, objv, 1); + return GetFileName(clientData, interp, objc, objv, OFN_FILE_OPEN); } /* @@ -514,51 +994,61 @@ Tk_GetSaveFileObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return GetFileName(clientData, interp, objc, objv, 0); + return GetFileName(clientData, interp, objc, objv, OFN_FILE_SAVE); } /* *---------------------------------------------------------------------- * - * GetFileName -- + * CleanupOFNOptions -- * - * Calls GetOpenFileName() or GetSaveFileName(). + * Cleans up any storage allocated by ParseOFNOptions * * Results: - * See user documentation. + * None. * * Side effects: - * See user documentation. + * Releases resources held by *optsPtr + *---------------------------------------------------------------------- + */ +static void CleanupOFNOptions(OFNOpts *optsPtr) +{ + Tcl_DStringFree(&optsPtr->utfDirString); +} + + + +/* + *---------------------------------------------------------------------- * + * ParseOFNOptions -- + * + * Option parsing for tk_get{Open,Save}File + * + * Results: + * TCL_OK on success, TCL_ERROR otherwise + * + * Side effects: + * Returns option values in *optsPtr. Note these may include string + * pointers into objv[] *---------------------------------------------------------------------- */ static int -GetFileName( +ParseOFNOptions( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[], /* Argument objects. */ - int open) /* 1 to call GetOpenFileName(), 0 to call - * GetSaveFileName(). */ + enum OFNOper oper, /* 1 for Open, 0 for Save */ + OFNOpts *optsPtr) /* Output, uninitialized on entry */ { - OPENFILENAME ofn; - TCHAR file[TK_MULTI_MAX_PATH]; - OFNData ofnData; - int cdlgerr; - int filterIndex = 0, result = TCL_ERROR, winCode, oldMode, i, multi = 0; - int confirmOverwrite = 1; - const char *extension = NULL, *title = NULL; - Tk_Window tkwin = clientData; - HWND hWnd; - Tcl_Obj *filterObj = NULL, *initialTypeObj = NULL, *typeVariableObj = NULL; - Tcl_DString utfFilterString, utfDirString, ds; - Tcl_DString extString, filterString, dirString, titleString; - ThreadSpecificData *tsdPtr = - Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + int i; + Tcl_DString ds; enum options { FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE, FILE_PARENT, - FILE_TITLE, FILE_TYPEVARIABLE, FILE_MULTIPLE, FILE_CONFIRMOW + FILE_TITLE, FILE_TYPEVARIABLE, FILE_MULTIPLE, FILE_CONFIRMOW, + FILE_MUSTEXIST, }; struct Options { const char *name; @@ -586,115 +1076,528 @@ GetFileName( {"-typevariable", FILE_TYPEVARIABLE}, {NULL, FILE_DEFAULT/*ignored*/ } }; - const struct Options *const options = open ? openOptions : saveOptions; + static const struct Options dirOptions[] = { + {"-initialdir", FILE_INITDIR}, + {"-mustexist", FILE_MUSTEXIST}, + {"-parent", FILE_PARENT}, + {"-title", FILE_TITLE}, + {NULL, FILE_DEFAULT/*ignored*/ } + }; - file[0] = '\0'; - ZeroMemory(&ofnData, sizeof(OFNData)); - Tcl_DStringInit(&utfFilterString); - Tcl_DStringInit(&utfDirString); + const struct Options *options = NULL; - /* - * Parse the arguments. - */ + switch (oper) { + case OFN_FILE_SAVE: options = saveOptions; break; + case OFN_DIR_CHOOSE: options = dirOptions; break; + case OFN_FILE_OPEN: options = openOptions; break; + } + + ZeroMemory(optsPtr, sizeof(*optsPtr)); + // optsPtr->forceXPStyle = 1; + optsPtr->tkwin = clientData; + optsPtr->confirmOverwrite = 1; /* By default we ask for confirmation */ + Tcl_DStringInit(&optsPtr->utfDirString); + optsPtr->file[0] = 0; for (i = 1; i < objc; i += 2) { int index; const char *string; - Tcl_Obj *valuePtr = objv[i + 1]; + Tcl_Obj *valuePtr; if (Tcl_GetIndexFromObjStruct(interp, objv[i], options, sizeof(struct Options), "option", 0, &index) != TCL_OK) { - goto end; + /* + * XXX -xpstyle is explicitly checked for as it is undocumented + * and we do not want it to show in option error messages. + */ + if (strcmp(Tcl_GetString(objv[i]), "-xpstyle")) + goto error_return; + if (i + 1 == objc) { + Tcl_SetResult(interp, "value for \"-xpstyle\" missing", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL); + goto error_return; + } + if (Tcl_GetBooleanFromObj(interp, objv[i+1], + &optsPtr->forceXPStyle) != TCL_OK) + goto error_return; + + continue; + } else if (i + 1 == objc) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "value for \"%s\" missing", options[index].name)); - Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL); - goto end; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", options[index].name)); + Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL); + goto error_return; } + valuePtr = objv[i + 1]; string = Tcl_GetString(valuePtr); switch (options[index].value) { case FILE_DEFAULT: - if (string[0] == '.') { - string++; - } - extension = string; + optsPtr->extObj = valuePtr; break; case FILE_TYPES: - filterObj = valuePtr; + optsPtr->filterObj = valuePtr; break; case FILE_INITDIR: - Tcl_DStringFree(&utfDirString); + Tcl_DStringFree(&optsPtr->utfDirString); if (Tcl_TranslateFileName(interp, string, - &utfDirString) == NULL) { - goto end; - } + &optsPtr->utfDirString) == NULL) + goto error_return; break; case FILE_INITFILE: - if (Tcl_TranslateFileName(interp, string, &ds) == NULL) { - goto end; - } + if (Tcl_TranslateFileName(interp, string, &ds) == NULL) + goto error_return; Tcl_UtfToExternal(NULL, TkWinGetUnicodeEncoding(), - Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), 0, NULL, - (char *) file, sizeof(file), NULL, NULL, NULL); + Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), 0, NULL, + (char *) &optsPtr->file[0], sizeof(optsPtr->file), + NULL, NULL, NULL); Tcl_DStringFree(&ds); break; case FILE_PARENT: - tkwin = Tk_NameToWindow(interp, string, tkwin); - if (tkwin == NULL) { - goto end; - } + optsPtr->tkwin = Tk_NameToWindow(interp, string, clientData); + if (optsPtr->tkwin == NULL) + goto error_return; break; case FILE_TITLE: - title = string; + optsPtr->titleObj = valuePtr; break; case FILE_TYPEVARIABLE: - typeVariableObj = valuePtr; - initialTypeObj = Tcl_ObjGetVar2(interp, typeVariableObj, NULL, - TCL_GLOBAL_ONLY); + optsPtr->typeVariableObj = valuePtr; + optsPtr->initialTypeObj = Tcl_ObjGetVar2(interp, valuePtr, + NULL, TCL_GLOBAL_ONLY); break; case FILE_MULTIPLE: - if (Tcl_GetBooleanFromObj(interp, valuePtr, &multi) != TCL_OK) { - return TCL_ERROR; - } + if (Tcl_GetBooleanFromObj(interp, valuePtr, + &optsPtr->multi) != TCL_OK) + goto error_return; break; case FILE_CONFIRMOW: if (Tcl_GetBooleanFromObj(interp, valuePtr, - &confirmOverwrite) != TCL_OK) { - return TCL_ERROR; - } + &optsPtr->confirmOverwrite) != TCL_OK) + goto error_return; break; + case FILE_MUSTEXIST: + if (Tcl_GetBooleanFromObj(interp, valuePtr, + &optsPtr->mustExist) != TCL_OK) + goto error_return; + break; } } - if (MakeFilter(interp, filterObj, &utfFilterString, initialTypeObj, - &filterIndex) != TCL_OK) { + return TCL_OK; + +error_return: /* interp should already hold error */ + /* On error, we need to clean up anything we might have allocated */ + CleanupOFNOptions(optsPtr); + return TCL_ERROR; + +} + + +/* + *---------------------------------------------------------------------- + * VistaFileDialogsAvailable + * + * Checks whether the new (Vista) file dialogs can be used on + * the system. + * + * Returns: + * 1 if new dialogs are available, 0 otherwise + * + * Side effects: + * Loads required procedures dynamically if available. + * If new dialogs are available, COM is also initialized. + *---------------------------------------------------------------------- + */ +static int VistaFileDialogsAvailable() +{ + HRESULT hr; + IFileDialog *fdlgPtr = NULL; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + if (tsdPtr->newFileDialogsState == FDLG_STATE_INIT) { + tsdPtr->newFileDialogsState = FDLG_STATE_USE_OLD; + LoadShellProcs(); + if (ShellProcs.SHCreateItemFromParsingName != NULL) { + hr = CoInitialize(0); + /* XXX - need we schedule CoUninitialize at thread shutdown ? */ + + /* Ensure all COM interfaces we use are available */ + if (SUCCEEDED(hr)) { + hr = CoCreateInstance(&ClsidFileOpenDialog, NULL, + CLSCTX_INPROC_SERVER, &IIDIFileOpenDialog, (void **) &fdlgPtr); + if (SUCCEEDED(hr)) { + fdlgPtr->lpVtbl->Release(fdlgPtr); + hr = CoCreateInstance(&ClsidFileSaveDialog, NULL, + CLSCTX_INPROC_SERVER, &IIDIFileSaveDialog, + (void **) &fdlgPtr); + if (SUCCEEDED(hr)) { + fdlgPtr->lpVtbl->Release(fdlgPtr); + + /* Looks like we have all we need */ + tsdPtr->newFileDialogsState = FDLG_STATE_USE_NEW; + } + } + } + } + } + + return (tsdPtr->newFileDialogsState == FDLG_STATE_USE_NEW); +} + +/* + *---------------------------------------------------------------------- + * + * GetFileNameVista -- + * + * Displays the new file dialogs on Vista and later. + * This function must generally not be called unless the + * tsdPtr->newFileDialogsState is FDLG_STATE_USE_NEW but if + * it is, it will just pass the call to the older GetFileNameXP + * + * Results: + * TCL_OK - dialog was successfully displayed, results returned in interp + * TCL_ERROR - error return + * + * Side effects: + * Dialogs is displayed + *---------------------------------------------------------------------- + */ +static int GetFileNameVista(Tcl_Interp *interp, OFNOpts *optsPtr, + enum OFNOper oper) +{ + HRESULT hr; + HWND hWnd; + DWORD flags, nfilters, defaultFilterIndex; + TCLCOMDLG_FILTERSPEC *filterPtr = NULL; + IFileDialog *fdlgIf = NULL; + IShellItem *dirIf = NULL; + LPWSTR wstr; + Tcl_Obj *resultObj = NULL; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + int oldMode; + + if (tsdPtr->newFileDialogsState != FDLG_STATE_USE_NEW) { + /* XXX - should be an assert but Tcl does not seem to have one? */ + Tcl_SetResult(interp, "Internal error: GetFileNameVista: IFileDialog API not available", TCL_STATIC); + return TCL_ERROR; + } + + /* + * At this point new interfaces are supposed to be available. + * fdlgIf is actually a IFileOpenDialog or IFileSaveDialog + * both of which inherit from IFileDialog. We use the common + * IFileDialog interface for the most part, casting only for + * type-specific calls. + */ + Tk_MakeWindowExist(optsPtr->tkwin); + hWnd = Tk_GetHWND(Tk_WindowId(optsPtr->tkwin)); + + /* + * The only validation we need to do w.r.t caller supplied data + * is the filter specification so do that before creating + */ + if (MakeFilterVista(interp, optsPtr, &nfilters, &filterPtr, + &defaultFilterIndex) != TCL_OK) + return TCL_ERROR; + + /* + * Beyond this point, do not just return on error as there will be + * resources that need to be released/freed. + */ + + if (oper == OFN_FILE_OPEN || oper == OFN_DIR_CHOOSE) + hr = CoCreateInstance(&ClsidFileOpenDialog, NULL, + CLSCTX_INPROC_SERVER, &IIDIFileOpenDialog, (void **) &fdlgIf); + else + hr = CoCreateInstance(&ClsidFileSaveDialog, NULL, + CLSCTX_INPROC_SERVER, &IIDIFileSaveDialog, (void **) &fdlgIf); + + if (FAILED(hr)) + goto vamoose; + + /* + * Get current settings first because we want to preserve existing + * settings like whether to show hidden files etc. based on the + * user's existing preference + */ + hr = fdlgIf->lpVtbl->GetOptions(fdlgIf, &flags); + if (FAILED(hr)) + goto vamoose; + + if (filterPtr) { + /* + * Causes -filetypes {{All *}} -defaultextension ext to return + * foo.ext.ext when foo is typed into the entry box + * flags |= FOS_STRICTFILETYPES; + */ + hr = fdlgIf->lpVtbl->SetFileTypes(fdlgIf, nfilters, filterPtr); + if (FAILED(hr)) + goto vamoose; + hr = fdlgIf->lpVtbl->SetFileTypeIndex(fdlgIf, defaultFilterIndex); + if (FAILED(hr)) + goto vamoose; + } + + /* Flags are equivalent to those we used in the older API */ + + /* + * Following flags must be set irrespective of original setting + * XXX - should FOS_NOVALIDATE be there ? Note FOS_NOVALIDATE has different + * semantics than OFN_NOVALIDATE in the old API. + */ + flags |= + FOS_FORCEFILESYSTEM | /* Only want files, not other shell items */ + FOS_NOVALIDATE | /* Don't check for access denied etc. */ + FOS_PATHMUSTEXIST; /* The *directory* path must exist */ + + + if (oper == OFN_DIR_CHOOSE) { + flags |= FOS_PICKFOLDERS; + if (optsPtr->mustExist) + flags |= FOS_FILEMUSTEXIST; /* XXX - check working */ + } else + flags &= ~ FOS_PICKFOLDERS; + + if (optsPtr->multi) + flags |= FOS_ALLOWMULTISELECT; + else + flags &= ~FOS_ALLOWMULTISELECT; + + if (optsPtr->confirmOverwrite) + flags |= FOS_OVERWRITEPROMPT; + else + flags &= ~FOS_OVERWRITEPROMPT; + + hr = fdlgIf->lpVtbl->SetOptions(fdlgIf, flags); + if (FAILED(hr)) + goto vamoose; + + if (optsPtr->extObj != NULL) { + wstr = Tcl_GetUnicode(optsPtr->extObj); + if (wstr[0] == L'.') + ++wstr; + hr = fdlgIf->lpVtbl->SetDefaultExtension(fdlgIf, wstr); + if (FAILED(hr)) + goto vamoose; + } + + if (optsPtr->titleObj != NULL) { + hr = fdlgIf->lpVtbl->SetTitle(fdlgIf, + Tcl_GetUnicode(optsPtr->titleObj)); + if (FAILED(hr)) + goto vamoose; + } + + if (optsPtr->file[0]) { + hr = fdlgIf->lpVtbl->SetFileName(fdlgIf, optsPtr->file); + if (FAILED(hr)) + goto vamoose; + } + + if (Tcl_DStringValue(&optsPtr->utfDirString)[0] != '\0') { + Tcl_Obj *normPath, *iniDirPath; + iniDirPath = Tcl_NewStringObj(Tcl_DStringValue(&optsPtr->utfDirString), -1); + Tcl_IncrRefCount(iniDirPath); + normPath = Tcl_FSGetNormalizedPath(interp, iniDirPath); + /* XXX - Note on failures do not raise error, simply ignore ini dir */ + if (normPath) { + const WCHAR *nativePath; + Tcl_IncrRefCount(normPath); + nativePath = Tcl_FSGetNativePath(normPath); /* Points INTO normPath*/ + if (nativePath) { + hr = ShellProcs.SHCreateItemFromParsingName( + nativePath, NULL, + &IIDIShellItem, (void **) &dirIf); + if (SUCCEEDED(hr)) { + /* Note we use SetFolder, not SetDefaultFolder - see MSDN */ + fdlgIf->lpVtbl->SetFolder(fdlgIf, dirIf); /* Ignore errors */ + } + } + Tcl_DecrRefCount(normPath); /* ALSO INVALIDATES nativePath !! */ + } + Tcl_DecrRefCount(iniDirPath); + } + + oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); + hr = fdlgIf->lpVtbl->Show(fdlgIf, hWnd); + Tcl_SetServiceMode(oldMode); + + /* + * Ensure that hWnd is enabled, because it can happen that we have updated + * the wrapper of the parent, which causes us to leave this child disabled + * (Windows loses sync). + */ + + if (hWnd) + EnableWindow(hWnd, 1); + + /* + * Clear interp result since it might have been set during the modal loop. + * http://core.tcl.tk/tk/tktview/4a0451f5291b3c9168cc560747dae9264e1d2ef6 + */ + Tcl_ResetResult(interp); + + if (SUCCEEDED(hr)) { + if ((oper == OFN_FILE_OPEN) && optsPtr->multi) { + IShellItemArray *multiIf; + DWORD dw, count; + IFileOpenDialog *fodIf = (IFileOpenDialog *) fdlgIf; + hr = fodIf->lpVtbl->GetResults(fodIf, &multiIf); + if (SUCCEEDED(hr)) { + Tcl_Obj *multiObj; + hr = multiIf->lpVtbl->GetCount(multiIf, &count); + multiObj = Tcl_NewListObj(count, NULL); + if (SUCCEEDED(hr)) { + IShellItem *itemIf; + for (dw = 0; dw < count; ++dw) { + hr = multiIf->lpVtbl->GetItemAt(multiIf, dw, &itemIf); + if (FAILED(hr)) + break; + hr = itemIf->lpVtbl->GetDisplayName(itemIf, + SIGDN_FILESYSPATH, &wstr); + if (SUCCEEDED(hr)) { + Tcl_DString fnds; + ConvertExternalFilename(wstr, &fnds); + CoTaskMemFree(wstr); + Tcl_ListObjAppendElement( + interp, multiObj, + Tcl_NewStringObj(Tcl_DStringValue(&fnds), + Tcl_DStringLength(&fnds))); + } + itemIf->lpVtbl->Release(itemIf); + if (FAILED(hr)) + break; + } + } + multiIf->lpVtbl->Release(multiIf); + if (SUCCEEDED(hr)) + resultObj = multiObj; + else + Tcl_DecrRefCount(multiObj); + } + } else { + IShellItem *resultIf; + hr = fdlgIf->lpVtbl->GetResult(fdlgIf, &resultIf); + if (SUCCEEDED(hr)) { + hr = resultIf->lpVtbl->GetDisplayName(resultIf, SIGDN_FILESYSPATH, + &wstr); + if (SUCCEEDED(hr)) { + Tcl_DString fnds; + ConvertExternalFilename(wstr, &fnds); + resultObj = Tcl_NewStringObj(Tcl_DStringValue(&fnds), + Tcl_DStringLength(&fnds)); + CoTaskMemFree(wstr); + } + resultIf->lpVtbl->Release(resultIf); + } + } + if (SUCCEEDED(hr)) { + if (filterPtr && optsPtr->typeVariableObj) { + UINT ftix; + hr = fdlgIf->lpVtbl->GetFileTypeIndex(fdlgIf, &ftix); + if (SUCCEEDED(hr)) { + /* Note ftix is a 1-based index */ + if (ftix > 0 && ftix <= nfilters) { + Tcl_ObjSetVar2(interp, optsPtr->typeVariableObj, NULL, + Tcl_NewUnicodeObj(filterPtr[ftix-1].pszName, -1), + TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG); + } + } + } + } + } else { + if (hr == HRESULT_FROM_WIN32(ERROR_CANCELLED)) + hr = 0; /* User cancelled, return empty string */ + } + +vamoose: /* (hr != 0) => error */ + if (dirIf) + dirIf->lpVtbl->Release(dirIf); + if (fdlgIf) + fdlgIf->lpVtbl->Release(fdlgIf); + + if (filterPtr) + FreeFilterVista(nfilters, filterPtr); + + if (hr == 0) { + if (resultObj) /* May be NULL if user cancelled */ + Tcl_SetObjResult(interp, resultObj); + return TCL_OK; + } else { + if (resultObj) + Tcl_DecrRefCount(resultObj); + Tcl_SetObjResult(interp, TkWin32ErrorObj(hr)); + return TCL_ERROR; + } +} + + +/* + *---------------------------------------------------------------------- + * + * GetFileNameXP -- + * + * Displays the old pre-Vista file dialogs. + * + * Results: + * TCL_OK - if dialog was successfully displayed + * TCL_ERROR - error return + * + * Side effects: + * See user documentation. + *---------------------------------------------------------------------- + */ +static int GetFileNameXP(Tcl_Interp *interp, OFNOpts *optsPtr, enum OFNOper oper) +{ + OPENFILENAME ofn; + OFNData ofnData; + int cdlgerr; + int filterIndex = 0, result = TCL_ERROR, winCode, oldMode; + HWND hWnd; + Tcl_DString utfFilterString, ds; + Tcl_DString extString, filterString, dirString, titleString; + const char *str; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + ZeroMemory(&ofnData, sizeof(OFNData)); + Tcl_DStringInit(&utfFilterString); + Tcl_DStringInit(&dirString); /* XXX - original code was missing this + leaving dirString uninitialized for + the unlikely code path where cwd failed */ + + if (MakeFilter(interp, optsPtr->filterObj, &utfFilterString, + optsPtr->initialTypeObj, &filterIndex) != TCL_OK) { goto end; } - Tk_MakeWindowExist(tkwin); - hWnd = Tk_GetHWND(Tk_WindowId(tkwin)); + Tk_MakeWindowExist(optsPtr->tkwin); + hWnd = Tk_GetHWND(Tk_WindowId(optsPtr->tkwin)); ZeroMemory(&ofn, sizeof(OPENFILENAME)); ofn.lStructSize = sizeof(OPENFILENAME); ofn.hwndOwner = hWnd; ofn.hInstance = TkWinGetHInstance(ofn.hwndOwner); - ofn.lpstrFile = file; + ofn.lpstrFile = optsPtr->file; ofn.nMaxFile = TK_MULTI_MAX_PATH; ofn.Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST | OFN_NOCHANGEDIR - | OFN_EXPLORER | OFN_ENABLEHOOK| OFN_ENABLESIZING; + | OFN_EXPLORER| OFN_ENABLEHOOK| OFN_ENABLESIZING; ofn.lpfnHook = (LPOFNHOOKPROC) OFNHookProc; ofn.lCustData = (LPARAM) &ofnData; - if (open != 0) { + if (oper != OFN_FILE_SAVE) { ofn.Flags |= OFN_FILEMUSTEXIST; - } else if (confirmOverwrite) { + } else if (optsPtr->confirmOverwrite) { ofn.Flags |= OFN_OVERWRITEPROMPT; } if (tsdPtr->debugFlag != 0) { ofnData.interp = interp; } - if (multi != 0) { + if (optsPtr->multi != 0) { ofn.Flags |= OFN_ALLOWMULTISELECT; /* @@ -706,8 +1609,11 @@ GetFileName( ofnData.dynFileBuffer = ckalloc(512 * sizeof(TCHAR)); } - if (extension != NULL) { - Tcl_WinUtfToTChar(extension, -1, &extString); + if (optsPtr->extObj != NULL) { + str = Tcl_GetString(optsPtr->extObj); + if (str[0] == '.') + ++str; + Tcl_WinUtfToTChar(str, -1, &extString); ofn.lpstrDefExt = (TCHAR *) Tcl_DStringValue(&extString); } @@ -716,9 +1622,9 @@ GetFileName( ofn.lpstrFilter = (TCHAR *) Tcl_DStringValue(&filterString); ofn.nFilterIndex = filterIndex; - if (Tcl_DStringValue(&utfDirString)[0] != '\0') { - Tcl_WinUtfToTChar(Tcl_DStringValue(&utfDirString), - Tcl_DStringLength(&utfDirString), &dirString); + if (Tcl_DStringValue(&optsPtr->utfDirString)[0] != '\0') { + Tcl_WinUtfToTChar(Tcl_DStringValue(&optsPtr->utfDirString), + Tcl_DStringLength(&optsPtr->utfDirString), &dirString); } else { /* * NT 5.0 changed the meaning of lpstrInitialDir, so we have to ensure @@ -727,10 +1633,10 @@ GetFileName( Tcl_DString cwd; - Tcl_DStringFree(&utfDirString); - if ((Tcl_GetCwd(interp, &utfDirString) == NULL) || + Tcl_DStringFree(&optsPtr->utfDirString); + if ((Tcl_GetCwd(interp, &optsPtr->utfDirString) == NULL) || (Tcl_TranslateFileName(interp, - Tcl_DStringValue(&utfDirString), &cwd) == NULL)) { + Tcl_DStringValue(&optsPtr->utfDirString), &cwd) == NULL)) { Tcl_ResetResult(interp); } else { Tcl_WinUtfToTChar(Tcl_DStringValue(&cwd), @@ -740,8 +1646,8 @@ GetFileName( } ofn.lpstrInitialDir = (TCHAR *) Tcl_DStringValue(&dirString); - if (title != NULL) { - Tcl_WinUtfToTChar(title, -1, &titleString); + if (optsPtr->titleObj != NULL) { + Tcl_WinUtfToTChar(Tcl_GetString(optsPtr->titleObj), -1, &titleString); ofn.lpstrTitle = (TCHAR *) Tcl_DStringValue(&titleString); } @@ -750,7 +1656,7 @@ GetFileName( */ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); - if (open != 0) { + if (oper != OFN_FILE_SAVE) { winCode = GetOpenFileName(&ofn); } else { winCode = GetSaveFileName(&ofn); @@ -859,22 +1765,37 @@ GetFileName( Tcl_DStringFree(&ds); } result = TCL_OK; - if ((ofn.nFilterIndex > 0) && gotFilename && typeVariableObj - && filterObj) { + if ((ofn.nFilterIndex > 0) && gotFilename && optsPtr->typeVariableObj + && optsPtr->filterObj) { int listObjc, count; Tcl_Obj **listObjv = NULL; Tcl_Obj **typeInfo = NULL; - if (Tcl_ListObjGetElements(interp, filterObj, + if (Tcl_ListObjGetElements(interp, optsPtr->filterObj, &listObjc, &listObjv) != TCL_OK) { result = TCL_ERROR; } else if (Tcl_ListObjGetElements(interp, listObjv[ofn.nFilterIndex - 1], &count, &typeInfo) != TCL_OK) { result = TCL_ERROR; - } else if (Tcl_ObjSetVar2(interp, typeVariableObj, NULL, - typeInfo[0], TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { - result = TCL_ERROR; + } else { + /* + * BUGFIX for d43a10ce2fed950e00890049f3c273f2cdd12583 + * The original code was broken because it passed typeinfo[0] + * directly into Tcl_ObjSetVar2. In the case of typeInfo[0] + * pointing into a list which is also referenced by + * typeVariableObj, TOSV2 shimmers the object into + * variable intrep which loses the list representation. + * This invalidates typeInfo[0] which is freed but + * nevertheless stored as the value of the variable. + */ + Tcl_Obj *selFilterObj = typeInfo[0]; + Tcl_IncrRefCount(selFilterObj); + if (Tcl_ObjSetVar2(interp, optsPtr->typeVariableObj, NULL, + selFilterObj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { + result = TCL_ERROR; + } + Tcl_DecrRefCount(selFilterObj); } } } else if (cdlgerr == FNERR_INVALIDFILENAME) { @@ -892,6 +1813,8 @@ GetFileName( Tcl_DStringFree(&titleString); } if (ofn.lpstrInitialDir != NULL) { + /* XXX - huh? lpstrInitialDir is set from Tcl_DStringValue which + can never return NULL */ Tcl_DStringFree(&dirString); } Tcl_DStringFree(&filterString); @@ -899,8 +1822,7 @@ GetFileName( Tcl_DStringFree(&extString); } - end: - Tcl_DStringFree(&utfDirString); +end: Tcl_DStringFree(&utfFilterString); if (ofnData.dynFileBuffer != NULL) { ckfree(ofnData.dynFileBuffer); @@ -909,6 +1831,49 @@ GetFileName( return result; } + + +/* + *---------------------------------------------------------------------- + * + * GetFileName -- + * + * Calls GetOpenFileName() or GetSaveFileName(). + * + * Results: + * See user documentation. + * + * Side effects: + * See user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +GetFileName( + ClientData clientData, /* Main window associated with interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[], /* Argument objects. */ + enum OFNOper oper) /* 1 to call GetOpenFileName(), 0 to call + * GetSaveFileName(). */ +{ + OFNOpts ofnOpts; + int result; + + result = ParseOFNOptions(clientData, interp, objc, objv, oper, &ofnOpts); + if (result != TCL_OK) + return result; + + if (VistaFileDialogsAvailable() && ! ofnOpts.forceXPStyle) + result = GetFileNameVista(interp, &ofnOpts, oper); + else + result = GetFileNameXP(interp, &ofnOpts, oper); + + CleanupOFNOptions(&ofnOpts); + return result; +} + /* *------------------------------------------------------------------------- @@ -973,8 +1938,8 @@ OFNHookProc( buffer = ofnData->dynFileBuffer; hdlg = GetParent(hdlg); - selsize = SendMessage(hdlg, CDM_GETSPEC, 0, 0); - dirsize = SendMessage(hdlg, CDM_GETFOLDERPATH, 0, 0); + selsize = (int) SendMessage(hdlg, CDM_GETSPEC, 0, 0); + dirsize = (int) SendMessage(hdlg, CDM_GETFOLDERPATH, 0, 0); buffersize = (selsize + dirsize + 1); /* @@ -1232,6 +2197,145 @@ MakeFilter( /* *---------------------------------------------------------------------- * + * FreeFilterVista + * + * Frees storage previously allocated by MakeFilterVista. + * count is the number of elements in dlgFilterPtr[] + */ +static void FreeFilterVista(DWORD count, TCLCOMDLG_FILTERSPEC *dlgFilterPtr) +{ + if (dlgFilterPtr != NULL) { + DWORD dw; + for (dw = 0; dw < count; ++dw) { + if (dlgFilterPtr[dw].pszName != NULL) + ckfree(dlgFilterPtr[dw].pszName); + if (dlgFilterPtr[dw].pszSpec != NULL) + ckfree(dlgFilterPtr[dw].pszSpec); + } + ckfree(dlgFilterPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * MakeFilterVista -- + * + * Returns file type filters in a format required + * by the Vista file dialogs. + * + * Results: + * A standard TCL return value. + * + * Side effects: + * Various values are returned through the parameters as + * described in the comments below. + *---------------------------------------------------------------------- + */ +static int MakeFilterVista( + Tcl_Interp *interp, /* Current interpreter. */ + OFNOpts *optsPtr, /* Caller specified options */ + DWORD *countPtr, /* Will hold number of filters */ + TCLCOMDLG_FILTERSPEC **dlgFilterPtrPtr, /* Will hold pointer to filter array. + Set to NULL if no filters specified. + Must be freed by calling + FreeFilterVista */ + DWORD *initialIndexPtr) /* Will hold index of default type */ +{ + TCLCOMDLG_FILTERSPEC *dlgFilterPtr; + const char *initial = NULL; + FileFilterList flist; + FileFilter *filterPtr; + DWORD initialIndex = 0; + Tcl_DString ds, patterns; + int i; + + if (optsPtr->filterObj == NULL) { + *dlgFilterPtrPtr = NULL; + *countPtr = 0; + return TCL_OK; + } + + if (optsPtr->initialTypeObj) + initial = Tcl_GetString(optsPtr->initialTypeObj); + + TkInitFileFilters(&flist); + if (TkGetFileFilters(interp, &flist, optsPtr->filterObj, 1) != TCL_OK) + return TCL_ERROR; + + if (flist.filters == NULL) { + *dlgFilterPtrPtr = NULL; + *countPtr = 0; + return TCL_OK; + } + + Tcl_DStringInit(&ds); + Tcl_DStringInit(&patterns); + dlgFilterPtr = ckalloc(flist.numFilters * sizeof(*dlgFilterPtr)); + + for (i = 0, filterPtr = flist.filters; + filterPtr; + filterPtr = filterPtr->next, ++i) { + const char *sep; + FileFilterClause *clausePtr; + int nbytes; + + /* Check if this entry should be shown as the default */ + if (initial && strcmp(initial, filterPtr->name) == 0) + initialIndex = i+1; /* Windows filter indices are 1-based */ + + /* First stash away the text description of the pattern */ + Tcl_WinUtfToTChar(filterPtr->name, -1, &ds); + nbytes = Tcl_DStringLength(&ds); /* # bytes, not Unicode chars */ + nbytes += sizeof(WCHAR); /* Terminating \0 */ + dlgFilterPtr[i].pszName = ckalloc(nbytes); + memmove((void *) dlgFilterPtr[i].pszName, Tcl_DStringValue(&ds), nbytes); + Tcl_DStringFree(&ds); + + /* + * Loop through and join patterns with a ";" Each "clause" + * corresponds to a single textual description (called typename) + * in the tk_getOpenFile docs. Each such typename may occur + * multiple times and all these form a single filter entry + * with one clause per occurence. Further each clause may specify + * multiple patterns. Hence the nested loop here. + */ + sep = ""; + for (clausePtr=filterPtr->clauses ; clausePtr; + clausePtr=clausePtr->next) { + GlobPattern *globPtr; + for (globPtr = clausePtr->patterns; globPtr; + globPtr = globPtr->next) { + Tcl_DStringAppend(&patterns, sep, -1); + Tcl_DStringAppend(&patterns, globPtr->pattern, -1); + sep = ";"; + } + } + + /* Again we need a Unicode form of the string */ + Tcl_WinUtfToTChar(Tcl_DStringValue(&patterns), -1, &ds); + nbytes = Tcl_DStringLength(&ds); /* # bytes, not Unicode chars */ + nbytes += sizeof(WCHAR); /* Terminating \0 */ + dlgFilterPtr[i].pszSpec = ckalloc(nbytes); + memmove((void *)dlgFilterPtr[i].pszSpec, Tcl_DStringValue(&ds), nbytes); + Tcl_DStringFree(&ds); + Tcl_DStringFree(&patterns); + } + + if (initialIndex == 0) + initialIndex = 1; /* If no default, show first entry */ + *initialIndexPtr = initialIndex; + *dlgFilterPtrPtr = dlgFilterPtr; + *countPtr = flist.numFilters; + + TkFreeFileFilters(&flist); + return TCL_OK; +} + + +/* + *---------------------------------------------------------------------- + * * Tk_ChooseDirectoryObjCmd -- * * This function implements the "tk_chooseDirectory" dialog box for the @@ -1307,102 +2411,60 @@ Tk_ChooseDirectoryObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { TCHAR path[MAX_PATH]; - int oldMode, result = TCL_ERROR, i; + int oldMode, result; LPCITEMIDLIST pidl; /* Returned by browser */ BROWSEINFO bInfo; /* Used by browser */ ChooseDir cdCBData; /* Structure to pass back and forth */ LPMALLOC pMalloc; /* Used by shell */ - Tk_Window tkwin = clientData; HWND hWnd; - const char *utfTitle = NULL;/* Title for window */ TCHAR saveDir[MAX_PATH]; Tcl_DString titleString; /* Title */ - Tcl_DString initDirString; /* Initial directory */ Tcl_DString tempString; /* temporary */ Tcl_Obj *objPtr; - static const char *const optionStrings[] = { - "-initialdir", "-mustexist", "-parent", "-title", NULL - }; - enum options { - DIR_INITIAL, DIR_EXIST, DIR_PARENT, FILE_TITLE - }; + OFNOpts ofnOpts; + const char *utfDir; + + result = ParseOFNOptions(clientData, interp, objc, objv, + OFN_DIR_CHOOSE, &ofnOpts); + if (result != TCL_OK) + return result; + + /* Use new dialogs if available */ + if (VistaFileDialogsAvailable() && ! ofnOpts.forceXPStyle) { + result = GetFileNameVista(interp, &ofnOpts, OFN_DIR_CHOOSE); + CleanupOFNOptions(&ofnOpts); + return result; + } - /* - * Initialize - */ + /* Older dialogs */ path[0] = '\0'; ZeroMemory(&cdCBData, sizeof(ChooseDir)); cdCBData.interp = interp; + cdCBData.mustExist = ofnOpts.mustExist; - /* - * Process the command line options - */ - - for (i = 1; i < objc; i += 2) { - int index; - const char *string; + utfDir = Tcl_DStringValue(&ofnOpts.utfDirString); + if (utfDir[0] != '\0') { const TCHAR *uniStr; - Tcl_Obj *optionPtr, *valuePtr; - optionPtr = objv[i]; - valuePtr = objv[i + 1]; + Tcl_WinUtfToTChar(Tcl_DStringValue(&ofnOpts.utfDirString), -1, + &tempString); + uniStr = (TCHAR *) Tcl_DStringValue(&tempString); - if (Tcl_GetIndexFromObjStruct(interp, optionPtr, optionStrings, - sizeof(char *), "option", 0, &index) != TCL_OK) { - goto cleanup; - } - if (i + 1 == objc) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "value for \"%s\" missing", Tcl_GetString(optionPtr))); - Tcl_SetErrorCode(interp, "TK", "DIRDIALOG", "VALUE", NULL); - goto cleanup; - } + /* Convert possible relative path to full path to keep dialog happy. */ - string = Tcl_GetString(valuePtr); - switch ((enum options) index) { - case DIR_INITIAL: - if (Tcl_TranslateFileName(interp,string,&initDirString) == NULL) { - goto cleanup; - } - Tcl_WinUtfToTChar(Tcl_DStringValue(&initDirString), -1, - &tempString); - uniStr = (TCHAR *) Tcl_DStringValue(&tempString); - - /* - * Convert possible relative path to full path to keep dialog - * happy. - */ - - GetFullPathName(uniStr, MAX_PATH, saveDir, NULL); - _tcsncpy(cdCBData.initDir, saveDir, MAX_PATH); - Tcl_DStringFree(&initDirString); - Tcl_DStringFree(&tempString); - break; - case DIR_EXIST: - if (Tcl_GetBooleanFromObj(interp, valuePtr, - &cdCBData.mustExist) != TCL_OK) { - goto cleanup; - } - break; - case DIR_PARENT: - tkwin = Tk_NameToWindow(interp, string, tkwin); - if (tkwin == NULL) { - goto cleanup; - } - break; - case FILE_TITLE: - utfTitle = string; - break; - } + GetFullPathName(uniStr, MAX_PATH, saveDir, NULL); + _tcsncpy(cdCBData.initDir, saveDir, MAX_PATH); } + /* XXX - rest of this (original) code has no error checks at all. */ + /* * Get ready to call the browser */ - Tk_MakeWindowExist(tkwin); - hWnd = Tk_GetHWND(Tk_WindowId(tkwin)); + Tk_MakeWindowExist(ofnOpts.tkwin); + hWnd = Tk_GetHWND(Tk_WindowId(ofnOpts.tkwin)); /* * Setup the parameters used by SHBrowseForFolder @@ -1416,8 +2478,8 @@ Tk_ChooseDirectoryObjCmd( } bInfo.lParam = (LPARAM) &cdCBData; - if (utfTitle != NULL) { - Tcl_WinUtfToTChar(utfTitle, -1, &titleString); + if (ofnOpts.titleObj != NULL) { + Tcl_WinUtfToTChar(Tcl_GetString(ofnOpts.titleObj), -1, &titleString); bInfo.lpszTitle = (LPTSTR) Tcl_DStringValue(&titleString); } else { bInfo.lpszTitle = TEXT("Please choose a directory, then select OK."); @@ -1455,6 +2517,10 @@ Tk_ChooseDirectoryObjCmd( oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); GetCurrentDirectory(MAX_PATH, saveDir); if (SHGetMalloc(&pMalloc) == NOERROR) { + /* + * XXX - MSDN says CoInitialize must have been called before + * SHBrowseForFolder can be used but don't see that called anywhere. + */ pidl = SHBrowseForFolder(&bInfo); /* @@ -1506,14 +2572,8 @@ Tk_ChooseDirectoryObjCmd( Tcl_DStringFree(&ds); } - result = TCL_OK; - - if (utfTitle != NULL) { - Tcl_DStringFree(&titleString); - } - - cleanup: - return result; + CleanupOFNOptions(&ofnOpts); + return TCL_OK; } /* diff --git a/win/tkWinEmbed.c b/win/tkWinEmbed.c index a908a1f..8bfd295 100644 --- a/win/tkWinEmbed.c +++ b/win/tkWinEmbed.c @@ -101,8 +101,8 @@ int TkpTestembedCmd( ClientData clientData, Tcl_Interp *interp, - int argc, - const char **argv) + int objc, + Tcl_Obj *const objv[]) { return TCL_OK; } @@ -257,10 +257,13 @@ TkpUseWindow( return TCL_OK; } - if (Tcl_GetInt(interp, string, &id) != TCL_OK) { + if ( +#ifdef _WIN64 + (sscanf(string, "0x%p", &hwnd) != 1) && +#endif + Tcl_GetInt(interp, string, (int *) &hwnd) != TCL_OK) { return TCL_ERROR; } - hwnd = (HWND) INT2PTR(id); if ((HWND)winPtr->privatePtr == hwnd) { return TCL_OK; } diff --git a/win/tkWinFont.c b/win/tkWinFont.c index 86f63ac..9172b00 100644 --- a/win/tkWinFont.c +++ b/win/tkWinFont.c @@ -33,7 +33,7 @@ typedef struct FontFamily { struct FontFamily *nextPtr; /* Next in list of all known font families. */ - int refCount; /* How many SubFonts are referring to this + size_t refCount; /* How many SubFonts are referring to this * FontFamily. When the refCount drops to * zero, this FontFamily may be freed. */ /* @@ -1869,8 +1869,7 @@ FreeFontFamily( if (familyPtr == NULL) { return; } - familyPtr->refCount--; - if (familyPtr->refCount > 0) { + if (familyPtr->refCount-- > 1) { return; } for (i = 0; i < FONTMAP_PAGES; i++) { diff --git a/win/tkWinInit.c b/win/tkWinInit.c index 4a327a2..b1b2d6b 100644 --- a/win/tkWinInit.c +++ b/win/tkWinInit.c @@ -159,6 +159,57 @@ TkpDisplayWarning( } /* + * ---------------------------------------------------------------------- + * + * Win32ErrorObj -- + * + * Returns a string object containing text from a COM or Win32 error code + * + * Results: + * A Tcl_Obj containing the Win32 error message. + * + * Side effects: + * Removed the error message from the COM threads error object. + * + * ---------------------------------------------------------------------- + */ + +Tcl_Obj* +TkWin32ErrorObj( + HRESULT hrError) +{ + LPTSTR lpBuffer = NULL, p = NULL; + TCHAR sBuffer[30]; + Tcl_Obj* errPtr = NULL; + + FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM + | FORMAT_MESSAGE_IGNORE_INSERTS, NULL, (DWORD)hrError, + LANG_NEUTRAL, (LPTSTR)&lpBuffer, 0, NULL); + + if (lpBuffer == NULL) { + lpBuffer = sBuffer; + wsprintf(sBuffer, TEXT("Error Code: %08lX"), hrError); + } + + if ((p = _tcsrchr(lpBuffer, TEXT('\r'))) != NULL) { + *p = TEXT('\0'); + } + +#ifdef _UNICODE + errPtr = Tcl_NewUnicodeObj(lpBuffer, (int)wcslen(lpBuffer)); +#else + errPtr = Tcl_NewStringObj(lpBuffer, (int)strlen(lpBuffer)); +#endif /* _UNICODE */ + + if (lpBuffer != sBuffer) { + LocalFree((HLOCAL)lpBuffer); + } + + return errPtr; +} + + +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/win/tkWinInt.h b/win/tkWinInt.h index 580e58f..0e2c844 100644 --- a/win/tkWinInt.h +++ b/win/tkWinInt.h @@ -201,9 +201,15 @@ MODULE_SCOPE void TkpWinToplevelDetachWindow(TkWindow *winPtr); MODULE_SCOPE int TkpWmGetState(TkWindow *winPtr); /* + * Common routines used in Windows implementation + */ +MODULE_SCOPE Tcl_Obj * TkWin32ErrorObj(HRESULT hrError); + + +/* * The following functions are not present in old versions of Windows - * API headers but are used in the Tk source to ensure 64bit - * compatability. + * API headers but are used in the Tk source to ensure 64bit + * compatibility. */ #ifndef GetClassLongPtr diff --git a/win/tkWinPort.h b/win/tkWinPort.h index 95cad78..965dbc5 100644 --- a/win/tkWinPort.h +++ b/win/tkWinPort.h @@ -87,6 +87,13 @@ #define REDO_KEYSYM_LOOKUP /* + * See ticket [916c1095438eae56]: GetVersionExW triggers warnings + */ +#if defined(_MSC_VER) +# pragma warning(disable:4996) +#endif + +/* * The following macro checks to see whether there is buffered * input data available for a stdio FILE. */ @@ -105,7 +112,7 @@ | ((p)->green & 0xff00) | (((p)->blue << 8) & 0xff0000)) | 0x20000000) /* - * These calls implement native bitmaps which are not currently + * These calls implement native bitmaps which are not currently * supported under Windows. The macros eliminate the calls. */ diff --git a/win/tkWinScrlbr.c b/win/tkWinScrlbr.c index a280626..1b3717e 100644 --- a/win/tkWinScrlbr.c +++ b/win/tkWinScrlbr.c @@ -217,10 +217,10 @@ CreateProc( if (scrollPtr->info.vertical) { style = WS_CHILD | WS_VISIBLE | WS_CLIPCHILDREN | WS_CLIPSIBLINGS - | SBS_VERT | SBS_RIGHTALIGN; + | SBS_VERT; } else { style = WS_CHILD | WS_VISIBLE | WS_CLIPCHILDREN | WS_CLIPSIBLINGS - | SBS_HORZ | SBS_BOTTOMALIGN; + | SBS_HORZ; } scrollPtr->hwnd = CreateWindow(TEXT("SCROLLBAR"), NULL, style, diff --git a/win/tkWinSend.c b/win/tkWinSend.c index 7fde655..6c4731a 100644 --- a/win/tkWinSend.c +++ b/win/tkWinSend.c @@ -77,7 +77,6 @@ static int FindInterpreterObject(Tcl_Interp *interp, static int Send(LPDISPATCH pdispInterp, Tcl_Interp *interp, int async, ClientData clientData, int objc, Tcl_Obj *const objv[]); -static Tcl_Obj * Win32ErrorObj(HRESULT hrError); static void SendTrace(const char *format, ...); static Tcl_EventProc SendEventProc; @@ -281,7 +280,7 @@ TkGetInterpNames( if (objList != NULL) { Tcl_DecrRefCount(objList); } - Tcl_SetObjResult(interp, Win32ErrorObj(hr)); + Tcl_SetObjResult(interp, TkWin32ErrorObj(hr)); result = TCL_ERROR; } @@ -451,7 +450,7 @@ FindInterpreterObject( pROT->lpVtbl->Release(pROT); } if (FAILED(hr) && result == TCL_OK) { - Tcl_SetObjResult(interp, Win32ErrorObj(hr)); + Tcl_SetObjResult(interp, TkWin32ErrorObj(hr)); result = TCL_ERROR; } return result; @@ -809,56 +808,6 @@ Send( /* * ---------------------------------------------------------------------- * - * Win32ErrorObj -- - * - * Returns a string object containing text from a COM or Win32 error code - * - * Results: - * A Tcl_Obj containing the Win32 error message. - * - * Side effects: - * Removed the error message from the COM threads error object. - * - * ---------------------------------------------------------------------- - */ - -static Tcl_Obj* -Win32ErrorObj( - HRESULT hrError) -{ - LPTSTR lpBuffer = NULL, p = NULL; - TCHAR sBuffer[30]; - Tcl_Obj* errPtr = NULL; - - FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM - | FORMAT_MESSAGE_IGNORE_INSERTS, NULL, (DWORD)hrError, - LANG_NEUTRAL, (LPTSTR)&lpBuffer, 0, NULL); - - if (lpBuffer == NULL) { - lpBuffer = sBuffer; - wsprintf(sBuffer, TEXT("Error Code: %08lX"), hrError); - } - - if ((p = _tcsrchr(lpBuffer, TEXT('\r'))) != NULL) { - *p = TEXT('\0'); - } - -#ifdef _UNICODE - errPtr = Tcl_NewUnicodeObj(lpBuffer, (int)wcslen(lpBuffer)); -#else - errPtr = Tcl_NewStringObj(lpBuffer, (int)strlen(lpBuffer)); -#endif /* _UNICODE */ - - if (lpBuffer != sBuffer) { - LocalFree((HLOCAL)lpBuffer); - } - - return errPtr; -} - -/* - * ---------------------------------------------------------------------- - * * TkWinSend_SetExcepInfo -- * * Convert the error information from a Tcl interpreter into a COM diff --git a/win/tkWinTest.c b/win/tkWinTest.c index 6036995..d824ee4 100644 --- a/win/tkWinTest.c +++ b/win/tkWinTest.c @@ -27,8 +27,9 @@ HWND tkWinCurrentDialog; static int TestclipboardObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int TestwineventCmd(ClientData clientData, - Tcl_Interp *interp, int argc, const char **argv); +static int TestwineventObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); static int TestfindwindowObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -67,7 +68,7 @@ TkplatformtestInit( Tcl_CreateObjCommand(interp, "testclipboard", TestclipboardObjCmd, (ClientData) Tk_MainWindow(interp), NULL); - Tcl_CreateCommand(interp, "testwinevent", TestwineventCmd, + Tcl_CreateObjCommand(interp, "testwinevent", TestwineventObjCmd, (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateObjCommand(interp, "testfindwindow", TestfindwindowObjCmd, (ClientData) Tk_MainWindow(interp), NULL); @@ -78,6 +79,42 @@ TkplatformtestInit( return TCL_OK; } +struct TestFindControlState { + int id; + HWND control; +}; + +/* Callback for window enumeration - used for TestFindControl */ +BOOL CALLBACK TestFindControlCallback( + HWND hwnd, + LPARAM lParam +) +{ + struct TestFindControlState *fcsPtr = (struct TestFindControlState *)lParam; + fcsPtr->control = GetDlgItem(hwnd, fcsPtr->id); + /* If we have found the control, return FALSE to stop the enumeration */ + return fcsPtr->control == NULL ? TRUE : FALSE; +} + +/* + * Finds the descendent control window with the specified ID and returns + * its HWND. + */ +HWND TestFindControl(HWND root, int id) +{ + struct TestFindControlState fcs; + + fcs.control = GetDlgItem(root, id); + if (fcs.control == NULL) { + /* Control is not a direct child. Look in descendents */ + fcs.id = id; + fcs.control = NULL; + EnumChildWindows(root, TestFindControlCallback, (LPARAM) &fcs); + } + return fcs.control; +} + + /* *---------------------------------------------------------------------- * @@ -220,7 +257,7 @@ TestclipboardObjCmd( /* *---------------------------------------------------------------------- * - * TestwineventCmd -- + * TestwineventObjCmd -- * * This function implements the testwinevent command. It provides a way * to send messages to windows dialogs. @@ -235,19 +272,21 @@ TestclipboardObjCmd( */ static int -TestwineventCmd( +TestwineventObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { HWND hwnd = 0; HWND child = 0; + HWND control; int id; char *rest; UINT message; WPARAM wParam; LPARAM lParam; + LRESULT result; static const TkStateMap messageMap[] = { {WM_LBUTTONDOWN, "WM_LBUTTONDOWN"}, {WM_LBUTTONUP, "WM_LBUTTONUP"}, @@ -258,33 +297,23 @@ TestwineventCmd( {-1, NULL} }; - if ((argc == 3) && (strcmp(argv[1], "debug") == 0)) { + if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]), "debug") == 0)) { int b; - if (Tcl_GetBoolean(interp, argv[2], &b) != TCL_OK) { + if (Tcl_GetBoolean(interp, Tcl_GetString(objv[2]), &b) != TCL_OK) { return TCL_ERROR; } TkWinDialogDebug(b); return TCL_OK; } - if (argc < 4) { + if (objc < 4) { return TCL_ERROR; } -#if 0 - TkpScanWindowId(interp, argv[1], &id); - if ( -#ifdef _WIN64 - (sscanf(string, "0x%p", &number) != 1) && -#endif /* _WIN64 */ - Tcl_GetInt(interp, string, (int *)&number) != TCL_OK) { - return TCL_ERROR; - } -#endif - hwnd = INT2PTR(strtol(argv[1], &rest, 0)); - if (rest == argv[1]) { - hwnd = FindWindowA(NULL, argv[1]); + hwnd = INT2PTR(strtol(Tcl_GetString(objv[1]), &rest, 0)); + if (rest == Tcl_GetString(objv[1])) { + hwnd = FindWindowA(NULL, Tcl_GetString(objv[1])); if (hwnd == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("no such window", -1)); return TCL_ERROR; @@ -292,14 +321,14 @@ TestwineventCmd( } UpdateWindow(hwnd); - id = strtol(argv[2], &rest, 0); - if (rest == argv[2]) { + id = strtol(Tcl_GetString(objv[2]), &rest, 0); + if (rest == Tcl_GetString(objv[2])) { char buf[256]; child = GetWindow(hwnd, GW_CHILD); while (child != NULL) { SendMessageA(child, WM_GETTEXT, (WPARAM) sizeof(buf), (LPARAM) buf); - if (strcasecmp(buf, argv[2]) == 0) { + if (strcasecmp(buf, Tcl_GetString(objv[2])) == 0) { id = GetDlgCtrlID(child); break; } @@ -307,19 +336,20 @@ TestwineventCmd( } if (child == NULL) { Tcl_AppendResult(interp, "could not find a control matching \"", - argv[2], "\"", NULL); + Tcl_GetString(objv[2]), "\"", NULL); return TCL_ERROR; } } - message = TkFindStateNum(NULL, NULL, messageMap, argv[3]); + + message = TkFindStateNum(NULL, NULL, messageMap, Tcl_GetString(objv[3])); wParam = 0; lParam = 0; - if (argc > 4) { - wParam = strtol(argv[4], NULL, 0); + if (objc > 4) { + wParam = strtol(Tcl_GetString(objv[4]), NULL, 0); } - if (argc > 5) { - lParam = strtol(argv[5], NULL, 0); + if (objc > 5) { + lParam = strtol(Tcl_GetString(objv[5]), NULL, 0); } switch (message) { @@ -327,7 +357,19 @@ TestwineventCmd( Tcl_DString ds; char buf[256]; +#if 0 GetDlgItemTextA(hwnd, id, buf, 256); +#else + control = TestFindControl(hwnd, id); + if (control == NULL) { + Tcl_SetObjResult(interp, + Tcl_ObjPrintf("Could not find control with id %d", id)); + return TCL_ERROR; + } + buf[0] = 0; + SendMessageA(control, WM_GETTEXT, (WPARAM)sizeof(buf), + (LPARAM) buf); +#endif Tcl_ExternalToUtfDString(NULL, buf, -1, &ds); Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL); Tcl_DStringFree(&ds); @@ -335,21 +377,27 @@ TestwineventCmd( } case WM_SETTEXT: { Tcl_DString ds; - BOOL result; - Tcl_UtfToExternalDString(NULL, argv[4], -1, &ds); - result = SetDlgItemTextA(hwnd, id, Tcl_DStringValue(&ds)); + control = TestFindControl(hwnd, id); + if (control == NULL) { + Tcl_SetObjResult(interp, + Tcl_ObjPrintf("Could not find control with id %d", id)); + return TCL_ERROR; + } + Tcl_UtfToExternalDString(NULL, Tcl_GetString(objv[4]), -1, &ds); + result = SendMessageA(control, WM_SETTEXT, 0, + (LPARAM) Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); if (result == 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to send text to dialog: ", -1)); - AppendSystemError(interp, GetLastError()); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to send text to dialog: ", -1)); + AppendSystemError(interp, GetLastError()); + return TCL_ERROR; } break; } case WM_COMMAND: { char buf[TCL_INTEGER_SPACE]; - if (argc < 5) { + if (objc < 5) { wParam = MAKEWPARAM(id, 0); lParam = (LPARAM)child; } @@ -391,6 +439,7 @@ TestfindwindowObjCmd( Tcl_DString titleString, classString; HWND hwnd = NULL; int r = TCL_OK; + DWORD myPid; Tcl_DStringInit(&classString); Tcl_DStringInit(&titleString); @@ -404,8 +453,30 @@ TestfindwindowObjCmd( if (objc == 3) { class = Tcl_WinUtfToTChar(Tcl_GetString(objv[2]), -1, &classString); } - + if (title[0] == 0) + title = NULL; +#if 0 hwnd = FindWindow(class, title); +#else + /* We want find a window the belongs to us and not some other process */ + hwnd = NULL; + myPid = GetCurrentProcessId(); + while (1) { + DWORD pid, tid; + hwnd = FindWindowEx(NULL, hwnd, class, title); + if (hwnd == NULL) + break; + tid = GetWindowThreadProcessId(hwnd, &pid); + if (tid == 0) { + /* Window has gone */ + hwnd = NULL; + break; + } + if (pid == myPid) + break; /* Found it */ + } + +#endif if (hwnd == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to find window: ", -1)); diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 017cba9..768ee69 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -148,7 +148,7 @@ typedef struct { */ typedef struct WinIconInstance { - int refCount; /* Number of instances that share this data + size_t refCount; /* Number of instances that share this data * structure. */ BlockOfIconImagesPtr iconBlock; /* Pointer to icon resource data for image */ @@ -1421,9 +1421,7 @@ static void DecrIconRefCount( WinIconPtr titlebaricon) { - titlebaricon->refCount--; - - if (titlebaricon->refCount <= 0) { + if (titlebaricon->refCount-- <= 1) { if (titlebaricon->iconBlock != NULL) { FreeIconBlock(titlebaricon->iconBlock); } @@ -5730,7 +5728,7 @@ WmWaitVisibilityOrMapProc( * This function is invoked by a widget when it wishes to set a grid * coordinate system that controls the size of a top-level window. It * provides a C interface equivalent to the "wm grid" command and is - * usually asscoiated with the -setgrid option. + * usually associated with the -setgrid option. * * Results: * None. diff --git a/win/winMain.c b/win/winMain.c index 36dbea9..62bcbd8 100644 --- a/win/winMain.c +++ b/win/winMain.c @@ -224,7 +224,7 @@ Tcl_AppInit( */ /* - * Call Tcl_CreateCommand for application-specific commands, if they + * Call Tcl_CreateObjCommand for application-specific commands, if they * weren't already created by the init procedures called above. */ diff --git a/win/wish.exe.manifest.in b/win/wish.exe.manifest.in index 7db42e3..4829471 100644 --- a/win/wish.exe.manifest.in +++ b/win/wish.exe.manifest.in @@ -20,6 +20,8 @@ </trustInfo> <compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1"> <application> + <!-- Windows 10 --> + <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}"/> <!-- Windows 8.1 --> <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/> <!-- Windows 8 --> |
