Tk Source Code

Check-in [b26cfe78]
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 | trunk
Files: files | file ages | folders
SHA1: b26cfe788b6b09ebba7c4e08f214a52894fdbb39
User & Date: jan.nijtmans 2012-06-10 14:58:08
Context
2012-06-11
08:06
Fix broken commits so function definitions match declarations and returns are of values that should be produced. check-in: 636d4ee5 user: dkf tags: trunk
2012-06-10
18:40
Adapt some test-output to match the changed functionality check-in: 14d887e7 user: jan.nijtmans tags: bug-2443069
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
2012-06-08
22:50
merge-mark check-in: 33ff53a1 user: jan.nijtmans tags: trunk
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.
	* generic/tkInt.decls:   Change XChangeWindowAttributes signature and
	* generic/tkIntXlibDeclsDecls.h: many others to match Xorg, needed for Cygwin.

>
>
>
>
>







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.
	* generic/tkInt.decls:   Change XChangeWindowAttributes signature and
	* generic/tkIntXlibDeclsDecls.h: many others to match Xorg, needed for Cygwin.

Changes to library/bgerror.tcl.

229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
    # 7. Set a grab and claim the focus too.

    ::tk::SetFocusGrab $dlg $dlg.ok

    # 8. 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
        }
    }








|







229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
    # 7. Set a grab and claim the focus too.

    ::tk::SetFocusGrab $dlg $dlg.ok

    # 8. 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.

88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
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"







|
|


|







88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
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.

215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
}
# Tk-on-Cocoa generates characters for these two keys. [Bug 2971663]
bind Entry <Down> {# nothing}
bind Entry <Up> {# 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:








|







215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
}
# Tk-on-Cocoa generates characters for these two keys. [Bug 2971663]
bind Entry <Down> {# nothing}
bind Entry <Up> {# 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:

575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
# 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







|







575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
# 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.

219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
bind Spinbox <Next> {# 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:








|







219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
bind Spinbox <Next> {# 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.

556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
    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
    }
}







|







556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
    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
    }
}
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
# 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







|







1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
# 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.

202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
# 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]} then {
	    return -code error "could not find default selection"







|







202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
# 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]} then {
	    return -code error "could not find default selection"

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.

231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
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)







|







231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
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)