Tk Source Code

Check-in [c19c493c]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:[Bug 3534137]: $tcl_platform(platform) != [tk windowingsystem]
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-4-branch
Files: files | file ages | folders
SHA1: c19c493c7d473f5193ba52d511011992c043a309
User & Date: jan.nijtmans 2012-06-10 14:47:24
Context
2012-06-19
09:55
SetOptions.3: minor doc fix make various other tables CONST (All backported from Tk 8.6) check-in: 213ad7fd user: jan.nijtmans tags: core-8-4-branch
2012-06-10
14:57
[Bug 3534137]: $tcl_platform(platform) != [tk windowingsystem] check-in: 71242c43 user: jan.nijtmans tags: core-8-5-branch
14:47
[Bug 3534137]: $tcl_platform(platform) != [tk windowingsystem] check-in: c19c493c user: jan.nijtmans tags: core-8-4-branch
2012-06-08
22:11
function def in front check-in: 8c1ea956 user: jan.nijtmans tags: core-8-4-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.






1
2
3
4
5
6
7





2012-06-08  Jan Nijtmans  <[email protected]>

	* generic/tkMain.c:   Implement TkCygwinMainEx for loading
	* generic/tkWindow.c: Cygwin's Tk_MainEx from the Tk dll.

2012-06-07  Jan Nijtmans  <[email protected]>

>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
2012-06-10  Jan Nijtmans  <[email protected]>

	* library/*.tcl:      [Bug 3534137]: $tcl_platform(platform) !=
	[tk windowingsystem]

2012-06-08  Jan Nijtmans  <[email protected]>

	* generic/tkMain.c:   Implement TkCygwinMainEx for loading
	* generic/tkWindow.c: Cygwin's Tk_MainEx from the Tk dll.

2012-06-07  Jan Nijtmans  <[email protected]>

Changes to library/bgerror.tcl.

90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
    set ret [catch {::tkerror $err} msg];
    if {$ret != 1} {return -code $ret $msg}

    # Ok the application's tkerror either failed or was not found
    # we use the default dialog then :
    set windowingsystem [tk windowingsystem]

    if {($tcl_platform(platform) eq "macintosh")
             || ($windowingsystem eq "aqua")} {
	set ok		[mc Ok]
	set messageFont	system
	set textRelief	flat
	set textHilight	0
    } else {
	set ok		[mc OK]







|







90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
    set ret [catch {::tkerror $err} msg];
    if {$ret != 1} {return -code $ret $msg}

    # Ok the application's tkerror either failed or was not found
    # we use the default dialog then :
    set windowingsystem [tk windowingsystem]

    if {($windowingsystem eq "classic")
             || ($windowingsystem eq "aqua")} {
	set ok		[mc Ok]
	set messageFont	system
	set textRelief	flat
	set textHilight	0
    } else {
	set ok		[mc OK]
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
    destroy .bgerrorDialog
    toplevel .bgerrorDialog -class ErrorDialog
    wm withdraw .bgerrorDialog
    wm title .bgerrorDialog $title
    wm iconname .bgerrorDialog ErrorDialog
    wm protocol .bgerrorDialog WM_DELETE_WINDOW { }

    if {($tcl_platform(platform) eq "macintosh")
            || ($windowingsystem eq "aqua")} {
	::tk::unsupported::MacWindowStyle style .bgerrorDialog moveableAlert {}
    } elseif {$windowingsystem eq "x11"} {
	wm attributes .bgerrorDialog -type dialog
    }

    frame .bgerrorDialog.bot







|







139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
    destroy .bgerrorDialog
    toplevel .bgerrorDialog -class ErrorDialog
    wm withdraw .bgerrorDialog
    wm title .bgerrorDialog $title
    wm iconname .bgerrorDialog ErrorDialog
    wm protocol .bgerrorDialog WM_DELETE_WINDOW { }

    if {($windowingsystem eq "classic")
            || ($windowingsystem eq "aqua")} {
	::tk::unsupported::MacWindowStyle style .bgerrorDialog moveableAlert {}
    } elseif {$windowingsystem eq "x11"} {
	wm attributes .bgerrorDialog -type dialog
    }

    frame .bgerrorDialog.bot
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
    # Max-width of message is the width of the screen...
    set wrapwidth [winfo screenwidth .bgerrorDialog]
    # ...minus the width of the icon, padding and a fudge factor for
    # the window manager decorations and aesthetics.
    set wrapwidth [expr {$wrapwidth-60-[winfo pixels .bgerrorDialog 9m]}]
    label .bgerrorDialog.msg -justify left -text $text -font $messageFont \
	    -wraplength $wrapwidth
    if {($tcl_platform(platform) eq "macintosh")
            || ($windowingsystem eq "aqua")} {
	# On the Macintosh, use the stop bitmap
	label .bgerrorDialog.bitmap -bitmap stop
    } else {
	# On other platforms, make the error icon
	canvas .bgerrorDialog.bitmap -width 32 -height 32 -highlightthickness 0
	.bgerrorDialog.bitmap create oval 0 0 31 31 -fill red -outline black







|







186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
    # Max-width of message is the width of the screen...
    set wrapwidth [winfo screenwidth .bgerrorDialog]
    # ...minus the width of the icon, padding and a fudge factor for
    # the window manager decorations and aesthetics.
    set wrapwidth [expr {$wrapwidth-60-[winfo pixels .bgerrorDialog 9m]}]
    label .bgerrorDialog.msg -justify left -text $text -font $messageFont \
	    -wraplength $wrapwidth
    if {($windowingsystem eq "classic")
            || ($windowingsystem eq "aqua")} {
	# On the Macintosh, use the stop bitmap
	label .bgerrorDialog.bitmap -bitmap stop
    } else {
	# On other platforms, make the error icon
	canvas .bgerrorDialog.bitmap -width 32 -height 32 -highlightthickness 0
	.bgerrorDialog.bitmap create oval 0 0 31 31 -fill red -outline black
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
		-in .bgerrorDialog.bot	\
		-column $i		\
		-row 0			\
		-sticky ew		\
		-padx 10
	grid columnconfigure .bgerrorDialog.bot $i -weight 1
	# We boost the size of some Mac buttons for l&f
	if {($tcl_platform(platform) eq "macintosh")
	    || ($windowingsystem eq "aqua")} {
	    if {($name eq "ok") || ($name eq "dismiss")} {
		grid columnconfigure .bgerrorDialog.bot $i -minsize 90
	    }
	    grid configure .bgerrorDialog.$name -pady 7
	}
	incr i







|







222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
		-in .bgerrorDialog.bot	\
		-column $i		\
		-row 0			\
		-sticky ew		\
		-padx 10
	grid columnconfigure .bgerrorDialog.bot $i -weight 1
	# We boost the size of some Mac buttons for l&f
	if {($windowingsystem eq "classic")
	    || ($windowingsystem eq "aqua")} {
	    if {($name eq "ok") || ($name eq "dismiss")} {
		grid columnconfigure .bgerrorDialog.bot $i -minsize 90
	    }
	    grid configure .bgerrorDialog.$name -pady 7
	}
	incr i
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
    # display (Motif style) and de-iconify it.

    ::tk::PlaceWindow .bgerrorDialog

    # 7. Ensure that we are topmost.

    raise .bgerrorDialog
    if {$tcl_platform(platform) eq "windows"} {
	# Place it topmost if we aren't at the top of the stacking
	# order to ensure that it's seen
	if {[lindex [wm stackorder .] end] ne ".bgerrorDialog"} {
	    wm attributes .bgerrorDialog -topmost 1
	}
    }








|







247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
    # display (Motif style) and de-iconify it.

    ::tk::PlaceWindow .bgerrorDialog

    # 7. Ensure that we are topmost.

    raise .bgerrorDialog
    if {[tk windowingsystem] eq "win32"} {
	# Place it topmost if we aren't at the top of the stacking
	# order to ensure that it's seen
	if {[lindex [wm stackorder .] end] ne ".bgerrorDialog"} {
	    wm attributes .bgerrorDialog -topmost 1
	}
    }

Changes to library/button.tcl.

32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
    bind Checkbutton <1> {
	tk::ButtonDown %W
    }
    bind Checkbutton <ButtonRelease-1> {
	tk::ButtonUp %W
    }
}
if {"windows" eq $tcl_platform(platform)} {
    bind Checkbutton <equal> {
	tk::CheckRadioInvoke %W select
    }
    bind Checkbutton <plus> {
	tk::CheckRadioInvoke %W select
    }
    bind Checkbutton <minus> {







|







32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
    bind Checkbutton <1> {
	tk::ButtonDown %W
    }
    bind Checkbutton <ButtonRelease-1> {
	tk::ButtonUp %W
    }
}
if {"win32" eq [tk windowingsystem]} {
    bind Checkbutton <equal> {
	tk::CheckRadioInvoke %W select
    }
    bind Checkbutton <plus> {
	tk::CheckRadioInvoke %W select
    }
    bind Checkbutton <minus> {
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
}

bind Radiobutton <FocusIn> {}
bind Radiobutton <Leave> {
    tk::ButtonLeave %W
}

if {"windows" eq $tcl_platform(platform)} {

#########################
# Windows implementation 
#########################

# ::tk::ButtonEnter --
# The procedure below is invoked when the mouse pointer enters a







|







121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
}

bind Radiobutton <FocusIn> {}
bind Radiobutton <Leave> {
    tk::ButtonLeave %W
}

if {"win32" eq [tk windowingsystem]} {

#########################
# Windows implementation 
#########################

# ::tk::ButtonEnter --
# The procedure below is invoked when the mouse pointer enters a

Changes to library/entry.tcl.

205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
bind Entry <Tab> {# nothing}
if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} {
	bind Entry <Command-KeyPress> {# nothing}
}

# On Windows, paste is done using Shift-Insert.  Shift-Insert already
# generates the <<Paste>> event, so we don't need to do anything here.
if {$tcl_platform(platform) ne "windows"} {
    bind Entry <Insert> {
	catch {tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]}
    }
}

# Additional emacs-like bindings:








|







205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
bind Entry <Tab> {# nothing}
if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} {
	bind Entry <Command-KeyPress> {# nothing}
}

# On Windows, paste is done using Shift-Insert.  Shift-Insert already
# generates the <<Paste>> event, so we don't need to do anything here.
if {[tk windowingsystem] ne "win32"} {
    bind Entry <Insert> {
	catch {tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]}
    }
}

# Additional emacs-like bindings:

557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
# end-of-word position or the next start-of-word position after the next
# end-of-word position.
#
# Arguments:
# w -		The entry window in which the cursor is to move.
# start -	Position at which to start search.

if {$tcl_platform(platform) eq "windows"}  {
    proc ::tk::EntryNextWord {w start} {
	set pos [tcl_endOfWord [$w get] [$w index $start]]
	if {$pos >= 0} {
	    set pos [tcl_startOfNextWord [$w get] $pos]
	}
	if {$pos < 0} {
	    return end







|







557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
# end-of-word position or the next start-of-word position after the next
# end-of-word position.
#
# Arguments:
# w -		The entry window in which the cursor is to move.
# start -	Position at which to start search.

if {[tk windowingsystem] eq "win32"}  {
    proc ::tk::EntryNextWord {w start} {
	set pos [tcl_endOfWord [$w get] [$w index $start]]
	if {$pos >= 0} {
	    set pos [tcl_startOfNextWord [$w get] $pos]
	}
	if {$pos < 0} {
	    return end

Changes to library/menu.tcl.

1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
	} else {
	    incr y [expr {-([$menu yposition $entry] \
		    + [$menu yposition [expr {$entry+1}]])/2}]
	}
	incr x [expr {-[winfo reqwidth $menu]/2}]
    }

    if {$tcl_platform(platform) eq "windows"} {
	# osVersion is not available in safe interps
	set ver 5
	if {[info exists tcl_platform(osVersion)]} {
	    scan $tcl_platform(osVersion) %d ver
	}

	# We need to fix some problems with menu posting on Windows,







|







1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
	} else {
	    incr y [expr {-([$menu yposition $entry] \
		    + [$menu yposition [expr {$entry+1}]])/2}]
	}
	incr x [expr {-[winfo reqwidth $menu]/2}]
    }

    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
	}

	# We need to fix some problems with menu posting on Windows,

Changes to library/scale.tcl.

56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
bind Scale <B2-Leave> { }
bind Scale <B2-Enter> { }
bind Scale <ButtonRelease-2> {
    tk::CancelRepeat
    tk::ScaleEndDrag %W
    tk::ScaleActivate %W %x %y
}
if {$tcl_platform(platform) eq "windows"} {
    # On Windows do the same with button 3, as that is the right mouse button
    bind Scale <3>		[bind Scale <2>]
    bind Scale <B3-Motion>	[bind Scale <B2-Motion>]
    bind Scale <B3-Leave>	[bind Scale <B2-Leave>]
    bind Scale <B3-Enter>	[bind Scale <B2-Enter>]
    bind Scale <ButtonRelease-3> [bind Scale <ButtonRelease-2>]
}







|







56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
bind Scale <B2-Leave> { }
bind Scale <B2-Enter> { }
bind Scale <ButtonRelease-2> {
    tk::CancelRepeat
    tk::ScaleEndDrag %W
    tk::ScaleActivate %W %x %y
}
if {[tk windowingsystem] eq "win32"} {
    # On Windows do the same with button 3, as that is the right mouse button
    bind Scale <3>		[bind Scale <2>]
    bind Scale <B3-Motion>	[bind Scale <B2-Motion>]
    bind Scale <B3-Leave>	[bind Scale <B2-Leave>]
    bind Scale <B3-Enter>	[bind Scale <B2-Enter>]
    bind Scale <ButtonRelease-3> [bind Scale <ButtonRelease-2>]
}

Changes to library/spinbox.tcl.

213
214
215
216
217
218
219
220
221
222
223
224
225
226
227

if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} {
	bind Spinbox <Command-KeyPress> {# nothing}
}

# On Windows, paste is done using Shift-Insert.  Shift-Insert already
# generates the <<Paste>> event, so we don't need to do anything here.
if {$tcl_platform(platform) ne "windows"} {
    bind Spinbox <Insert> {
	catch {::tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]}
    }
}

# Additional emacs-like bindings:








|







213
214
215
216
217
218
219
220
221
222
223
224
225
226
227

if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} {
	bind Spinbox <Command-KeyPress> {# nothing}
}

# On Windows, paste is done using Shift-Insert.  Shift-Insert already
# generates the <<Paste>> event, so we don't need to do anything here.
if {[tk windowingsystem] ne "win32"} {
    bind Spinbox <Insert> {
	catch {::tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]}
    }
}

# Additional emacs-like bindings:

Changes to library/text.tcl.

341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
    catch { %W edit undo }
}

bind Text <<Redo>> {
    catch { %W edit redo }
}

if {$tcl_platform(platform) ne "windows"} {
bind Text <Control-v> {
    if {!$tk_strictMotif} {
	tk::TextScrollPages %W 1
    }
}
}








|







341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
    catch { %W edit undo }
}

bind Text <<Redo>> {
    catch { %W edit redo }
}

if {[tk windowingsystem] ne "win32"} {
bind Text <Control-v> {
    if {!$tk_strictMotif} {
	tk::TextScrollPages %W 1
    }
}
}

526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
    set Priv(selectMode) char
    set Priv(mouseMoved) 0
    set Priv(pressX) $x
    $w mark set insert [TextClosestGap $w $x $y]
    $w mark set anchor insert
    # Allow focus in any case on Windows, because that will let the
    # selection be displayed even for state disabled text widgets.
    if {$::tcl_platform(platform) eq "windows" || [$w cget -state] eq "normal"} {focus $w}
    if {[$w cget -autoseparators]} {$w edit separator}
}

# ::tk::TextSelectTo --
# This procedure is invoked to extend the selection, typically when
# dragging it with the mouse.  Depending on the selection mode (character,
# word, line) it selects in different-sized units.  This procedure







|







526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
    set Priv(selectMode) char
    set Priv(mouseMoved) 0
    set Priv(pressX) $x
    $w mark set insert [TextClosestGap $w $x $y]
    $w mark set anchor insert
    # Allow focus in any case on Windows, because that will let the
    # selection be displayed even for state disabled text widgets.
    if {[tk windowingsystem] eq "win32" || [$w cget -state] eq "normal"} {focus $w}
    if {[$w cget -autoseparators]} {$w edit separator}
}

# ::tk::TextSelectTo --
# This procedure is invoked to extend the selection, typically when
# dragging it with the mouse.  Depending on the selection mode (character,
# word, line) it selects in different-sized units.  This procedure
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
# end-of-word position or the next start-of-word position after the next
# end-of-word position.
#
# Arguments:
# w -		The text window in which the cursor is to move.
# start -	Position at which to start search.

if {$tcl_platform(platform) eq "windows"}  {
    proc ::tk::TextNextWord {w start} {
	TextNextPos $w [TextNextPos $w $start tcl_endOfWord] \
	    tcl_startOfNextWord
    }
} else {
    proc ::tk::TextNextWord {w start} {
	TextNextPos $w $start tcl_endOfWord







|







1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
# end-of-word position or the next start-of-word position after the next
# end-of-word position.
#
# Arguments:
# w -		The text window in which the cursor is to move.
# start -	Position at which to start search.

if {[tk windowingsystem] eq "win32"}  {
    proc ::tk::TextNextWord {w start} {
	TextNextPos $w [TextNextPos $w $start tcl_endOfWord] \
	    tcl_startOfNextWord
    }
} else {
    proc ::tk::TextNextWord {w start} {
	TextNextPos $w $start tcl_endOfWord

Changes to library/tk.tcl.

195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
# Arguments:
#   w	The widget for which the selection will be retrieved.
#	Important for the -displayof property.
#   sel	The source of the selection (PRIMARY or CLIPBOARD)
# Results:
#   Returns the selection, or an error if none could be found
#
if {$tcl_platform(platform) eq "unix"} {
    proc ::tk::GetSelection {w {sel PRIMARY}} {
	if {[catch {selection get -displayof $w -selection $sel \
		-type UTF8_STRING} txt] \
		&& [catch {selection get -displayof $w -selection $sel} txt]} {
	    return -code error "could not find default selection"
	} else {
	    return $txt







|







195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
# Arguments:
#   w	The widget for which the selection will be retrieved.
#	Important for the -displayof property.
#   sel	The source of the selection (PRIMARY or CLIPBOARD)
# Results:
#   Returns the selection, or an error if none could be found
#
if {[tk windowingsystem] ne "win32"} {
    proc ::tk::GetSelection {w {sel PRIMARY}} {
	if {[catch {selection get -displayof $w -selection $sel \
		-type UTF8_STRING} txt] \
		&& [catch {selection get -displayof $w -selection $sel} txt]} {
	    return -code error "could not find default selection"
	} else {
	    return $txt
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
    }
}
# ----------------------------------------------------------------------
# Read in files that define all of the class bindings.
# ----------------------------------------------------------------------

if {$::tk_library ne ""} {
    if {$tcl_platform(platform) eq "macintosh"} {
	proc ::tk::SourceLibFile {file} {
	    if {[catch {
		namespace eval :: \
			[list source [file join $::tk_library $file.tcl]]
	    }]} {
		namespace eval :: [list source -rsrc $file]
	    }







|







401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
    }
}
# ----------------------------------------------------------------------
# Read in files that define all of the class bindings.
# ----------------------------------------------------------------------

if {$::tk_library ne ""} {
    if {[tk windowingsystem] eq "classic"} {
	proc ::tk::SourceLibFile {file} {
	    if {[catch {
		namespace eval :: \
			[list source [file join $::tk_library $file.tcl]]
	    }]} {
		namespace eval :: [list source -rsrc $file]
	    }