Tk Source Code

Check-in [71242c43]
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-5-branch
Files: files | file ages | folders
SHA1: 71242c4310bd095a630695ac9a3aad2e860c2434
User & Date: jan.nijtmans 2012-06-10 14:57:13
Context
2012-06-11
08:57
[Bug 3294450]: Do clipping of ttk text elements correctly. check-in: bd1d53d6 user: dkf tags: core-8-5-branch
2012-06-10
14:58
[Bug 3534137]: $tcl_platform(platform) != [tk windowingsystem] check-in: b26cfe78 user: jan.nijtmans tags: trunk
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:19
eliminate some ANSI_ARGS check-in: 81bffa40 user: jan.nijtmans tags: core-8-5-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.

219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
    # display (Motif style) and de-iconify it.

    ::tk::PlaceWindow $dlg

    # 7. Ensure that we are topmost.

    raise $dlg
    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 "$dlg"} {
	    wm attributes $dlg -topmost 1
	}
    }








|







219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
    # display (Motif style) and de-iconify it.

    ::tk::PlaceWindow $dlg

    # 7. Ensure that we are topmost.

    raise $dlg
    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 "$dlg"} {
	    wm attributes $dlg -topmost 1
	}
    }

Changes to library/button.tcl.

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







|







35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
    bind Checkbutton <ButtonRelease-1> {
	tk::ButtonUp %W
    }
    bind Checkbutton <Leave> {
	tk::ButtonLeave %W
    }
}
if {"win32" eq [tk windowingsystem]} {
    bind Checkbutton <equal> {
	tk::CheckRadioInvoke %W select
    }
    bind Checkbutton <plus> {
	tk::CheckRadioInvoke %W select
    }
    bind Checkbutton <minus> {
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
bind Checkbutton <FocusIn> {}

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







|







127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
bind Checkbutton <FocusIn> {}

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/demos/menu.tcl.

52
53
54
55
56
57
58
59
60
61
62
63
64
65
66

set m $w.menu.basic
$w.menu add cascade -label "Basic" -menu $m -underline 0
menu $m -tearoff 0
$m add command -label "Long entry that does nothing"
if {[tk windowingsystem] eq "aqua"} {
    set modifier Command
} elseif {$tcl_platform(platform) == "windows"} {
    set modifier Control
} else {
    set modifier Meta
}
foreach i {A B C D E F} {
    $m add command -label "Print letter \"$i\"" -underline 14 \
	    -accelerator Meta+$i -command "puts $i" -accelerator $modifier+$i







|







52
53
54
55
56
57
58
59
60
61
62
63
64
65
66

set m $w.menu.basic
$w.menu add cascade -label "Basic" -menu $m -underline 0
menu $m -tearoff 0
$m add command -label "Long entry that does nothing"
if {[tk windowingsystem] eq "aqua"} {
    set modifier Command
} elseif {[tk windowingsystem] == "win32"} {
    set modifier Control
} else {
    set modifier Meta
}
foreach i {A B C D E F} {
    $m add command -label "Print letter \"$i\"" -underline 14 \
	    -accelerator Meta+$i -command "puts $i" -accelerator $modifier+$i

Changes to library/demos/text.tcl.

63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
the insertion cursor to the end of the line, or it deletes the newline
character if that is the only thing left on the line.  Control-o opens
a new line by inserting a newline character to the right of the insertion
cursor.  Control-t transposes the two characters on either side of the
insertion cursor.  Control-z undoes the last editing action performed,
and }

switch $tcl_platform(platform) {
    "unix" {
	$w.text insert end "Control-Shift-z"
    }
    "windows" {
	$w.text insert end "Control-y"
    }
}

$w.text insert end { redoes undone edits.

7. Resize the window.  This widget has been configured with the "setGrid"







|
|


|







63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
the insertion cursor to the end of the line, or it deletes the newline
character if that is the only thing left on the line.  Control-o opens
a new line by inserting a newline character to the right of the insertion
cursor.  Control-t transposes the two characters on either side of the
insertion cursor.  Control-z undoes the last editing action performed,
and }

switch [tk windowingsystem] {
    "aqua" - "x11" {
	$w.text insert end "Control-Shift-z"
    }
    "win32" {
	$w.text insert end "Control-y"
    }
}

$w.text insert end { redoes undone edits.

7. Resize the window.  This widget has been configured with the "setGrid"

Changes to library/entry.tcl.

210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
bind Entry <Tab> {# nothing}
if {[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:








|







210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
bind Entry <Tab> {# nothing}
if {[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:

570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
# 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







|







570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
# 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.

1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
	} 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,







|







1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
	} 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.

217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
bind Spinbox <Tab> {# nothing}
if {[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:








|







217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
bind Spinbox <Tab> {# nothing}
if {[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.

535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
    if {$x > [lindex $bbox 0]} {
	$w mark gravity $anchorname right
    } else {
	$w mark gravity $anchorname left
    }
    # 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
    }
}







|







535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
    if {$x > [lindex $bbox 0]} {
	$w mark gravity $anchorname right
    } else {
	$w mark gravity $anchorname left
    }
    # 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
    }
}
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
# 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







|







1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
# 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.

201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
# 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







|







201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
# 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

Changes to library/ttk/entry.tcl.

225
226
227
228
229
230
231
232
233
234
235
236
237
238
239

## NextWord -- Find the next word position.
#	Note: The "next word position" follows platform conventions:
#	either the next end-of-word position, or the start-of-word
#	position following the next end-of-word position.
#
set ::ttk::entry::State(startNext) \
	[string equal $::tcl_platform(platform) "windows"]

proc ttk::entry::NextWord {w start} {
    variable State
    set pos [tcl_endOfWord [$w get] [$w index $start]]
    if {$pos >= 0 && $State(startNext)} {
	set pos [tcl_startOfNextWord [$w get] $pos]
    }







|







225
226
227
228
229
230
231
232
233
234
235
236
237
238
239

## NextWord -- Find the next word position.
#	Note: The "next word position" follows platform conventions:
#	either the next end-of-word position, or the start-of-word
#	position following the next end-of-word position.
#
set ::ttk::entry::State(startNext) \
	[string equal [tk windowingsystem] "win32"]

proc ttk::entry::NextWord {w start} {
    variable State
    set pos [tcl_endOfWord [$w get] [$w index $start]]
    if {$pos >= 0 && $State(startNext)} {
	set pos [tcl_startOfNextWord [$w get] $pos]
    }

Changes to tests/constraints.tcl.

195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
update
set x [list [.t bbox 1.3] [.t bbox 2.5]]
destroy .t
if {![string match {{22 3 6 15} {31 18 [34] 15}} $x]} {
    testConstraint fonts 0
}
testConstraint textfonts [expr {
    [testConstraint fonts] || $tcl_platform(platform) eq "windows"
}]

# constraints for the visuals available..
testConstraint pseudocolor8 [expr {
    ([catch {
	toplevel .t -visual {pseudocolor 8} -colormap new
    }] == 0) && ([winfo depth .t] == 8)







|







195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
update
set x [list [.t bbox 1.3] [.t bbox 2.5]]
destroy .t
if {![string match {{22 3 6 15} {31 18 [34] 15}} $x]} {
    testConstraint fonts 0
}
testConstraint textfonts [expr {
    [testConstraint fonts] || [tk windowingsystem] eq "win32"
}]

# constraints for the visuals available..
testConstraint pseudocolor8 [expr {
    ([catch {
	toplevel .t -visual {pseudocolor 8} -colormap new
    }] == 0) && ([winfo depth .t] == 8)