TclApps Library Source Code
Check-in [925cd04255]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:Improved aqua support. Drops the ffidl code in favour of using tclgrowl and tkdock for alerts and n Fix some incorrect mouse bindings on this platform. [PT: Refactored this patch to use hooks, adding an alert hook at the same time] Signed-off-by: Kevin Walzer <[email protected]> Signed-off-by: Pat Thoyts <[email protected]>
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 925cd04255ce202d956e38527c385d7e2b76e4ba
User & Date: patthoyts 2011-05-16 17:14:28
Context
2011-05-16
17:17
Removed focused flag from hook arguments as this may be derived from the window Signed-off-by: Pat Thoyts <[email protected]> check-in: 92b41aaa85 user: patthoyts tags: trunk
17:14
Improved aqua support. Drops the ffidl code in favour of using tclgrowl and tkdock for alerts and n Fix some incorrect mouse bindings on this platform. [PT: Refactored this patch to use hooks, adding an alert hook at the same time] Signed-off-by: Kevin Walzer <[email protected]> Signed-off-by: Pat Thoyts <[email protected]> check-in: 925cd04255 user: patthoyts tags: trunk
2011-05-12
21:25
Make all http requests explictly ipv4 when using 8.6. There is currently a bug in the ipv6 socket handling in 8.6 where if a site has an ipv6 address and does not provide a services on that address then socket -async will return an error to tcl. A synchronous socket will try ipv6 and then ipv4 before returning to tcl. To work around this we can force http requests to use ipv4 until this is fixed so that async sockets operate like the synchronous ones. Signed-off-by: Pat Thoyts <[email protected]> check-in: 35f975c8d8 user: patthoyts tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to apps/tkchat/tkchat.tcl.

88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
...
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
....
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180


1181

1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
....
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
....
1452
1453
1454
1455
1456
1457
1458

1459
1460
1461
1462
1463
1464
1465
1466
1467
1468

1469
1470
1471
1472
1473
1474

1475
1476
1477
1478
1479
1480
1481
....
2812
2813
2814
2815
2816
2817
2818





2819
2820

2821
2822
2823
2824
2825
2826
2827
....
2873
2874
2875
2876
2877
2878
2879




2880

2881
2882
2883
2884
2885
2886
2887
....
2918
2919
2920
2921
2922
2923
2924


2925



2926
2927
2928
2929
2930
2931
2932
....
3289
3290
3291
3292
3293
3294
3295


3296



3297
3298
3299
3300
3301
3302
3303
....
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
....
3627
3628
3629
3630
3631
3632
3633

3634
3635
3636
3637
3638
3639
3640
....
5498
5499
5500
5501
5502
5503
5504
5505
5506
5507
5508
5509
5510
5511
5512
....
6096
6097
6098
6099
6100
6101
6102




6103
6104
6105
6106
6107
6108
6109
....
6186
6187
6188
6189
6190
6191
6192

6193
6194
6195
6196
6197
6198
6199
6200
....
9120
9121
9122
9123
9124
9125
9126




9127
9128

9129
9130
9131
9132
9133
9134
9135
....
9746
9747
9748
9749
9750
9751
9752
9753

9754
9755
9756
9757
9758
9759
9760
.....
10021
10022
10023
10024
10025
10026
10027



10028
10029

10030
10031
10032
10033
10034
10035
10036
    package require idle
}] } then {
    # Not supported / available...
    namespace eval ::idle {}
    proc ::idle::supported {} {return 0}
}

# enable OSX-specific (un-hide window) alerting if available
if {[tk windowingsystem] eq "aqua"} {
    if {[catch {package present Ffidl 0.6}]} {
	# look for ffidl.kit
	if {[set ffidl [auto_execok ffidl.kit]] ne ""} {
		source $ffidl
	} elseif {[info exists starkit::topdir]} {
		# look next to tkchat.kit/tkchat.vfs
		set ffidl [file join [file dirname $starkit::topdir] ffidl.kit]
		if {[file exists $ffidl]} {
			source $ffidl
		}
	} else {
		# look next to tkchat.tcl
		set ffidl [file join $tkchat_dir ffidl.kit]
		if {[file exists $ffidl]} {
			source $ffidl
		}
	}
    }
    if {![catch {package require Ffidl 0.6}]} {
        # Ffidl code + carbon hooks courtesy of Daniel Steffen - see
        # http://wiki.tcl.tk/ffidl
        catch {
            # hooks to Carbon API to set application name
            ::ffidl::callout CPSSetProcessName {pointer-byte pointer-utf8} \
                            sint32 \
                [::ffidl::symbol /System/Library/Frameworks/ApplicationServices.framework/Frameworks/CoreGraphics.framework/CoreGraphics CPSSetProcessName]
              CPSSetProcessName [binary format n2 {0 2}] "TkChat"

            # hooks to Carbon API to Show + Hide process
            ::ffidl::callout ShowHideProcess {pointer-byte int} sint32 \
                    [::ffidl::symbol /System/Library/Frameworks/Carbon.framework/Carbon ShowHideProcess]
        }
    }
}

# 8.4 doesn't provide this - we use it for i18n on menus.
if {[llength [info commands ::tk::AmpMenuArgs]] == 0} {
    proc ::tk::AmpMenuArgs {widget add type args} {
        set options {}
        foreach {opt val} $args {
            if {$opt eq "-label"} {
                lassign [UnderlineAmpersand $val] newlabel under
................................................................................
    ::http::register http 80 ::socket_inet4
}

namespace eval ::tkchat {
    variable chatWindowTitle "The Tcler's Chat"

    variable HEADUrl {http://tcllib.cvs.sourceforge.net/*checkout*/tcllib/tclapps/apps/tkchat/tkchat.tcl?revision=HEAD}
    variable rcsid   {$Id: tkchat.tcl,v 1.483 2011/05/12 21:25:58 patthoyts Exp $}

    variable MSGS
    set MSGS(entered) [list \
	    "%user% has entered the chat!" \
	    "Out of a cloud of smoke, %user% appears!" \
	    "%user% saunters in." \
	    "%user% wanders in." \
................................................................................
}

# Beep and/or deiconify and raise the main window as an idle callback.
# This is done as an idle callback because there might be many requests
# to alert in a row and we want to batch them all together into one
# action.
#
proc ::tkchat::alertWhenIdle { w } {
    variable alert_pending

    if { ![info exists alert_pending] } {
	set alert_pending 1
	if { $::Options(AutoBookmark) && $w eq ".txt" && [focus] == {} } {
	    .txt mark set AddBookmark "end - 1 line linestart"
	    BookmarkToggle auto
	}


	after idle [list [namespace origin alertCallback] $w]

    }
}

proc ::tkchat::alertCallback {w} {
    global Options
    variable alert_pending

    set top [winfo toplevel $w]
    unset -nocomplain alert_pending
    if {$Options(Alert,RAISE) && [llength [focus -displayof $top]]==0} {
	# Only call this if the window doesn't already have focus
        if {[tk windowingsystem] eq "aqua" \
            && [llength [package provide Ffidl]] > 0} {
            ShowHideProcess [binary format n2 {0 2}] 1
        }
	wm deiconify $top
	raise $top
    }
    if {$Options(Alert,SOUND)} bell
}

# Check to see if an alert is desired for the given message.  Issue
................................................................................
    if { $nick ne $Options(Nickname) } {
	set subjectFound [checkSubject $w $msgtype $nick $msg]
	if { !$alert && $Options(Alert,SUBJECT) && $subjectFound } {
	    set alert 1
	}
    }
    if { $alert } {
	alertWhenIdle $w
    }
    set LastPost($nick) $now
    return $subjectFound
}

proc ::tkchat::checkSubject { w msgtype nick msg } {
    global Options
................................................................................

# Hooks:
#  message hooks are called before displaying a new message
#  preinit hooks are called after app initialization before gui creation
#  init hooks are called after gui creation before login
#  login hooks are called after login to the jabber server
#  join hooks are called after successfully joining a conference

#  version hooks are called once we get the current version from the web
#  save hook are called when saving options to file.
#  options hooks are called to add pages to the Preferences dialog
proc ::tkchat::Hook {do type args} {
    switch -exact -- $type {
	message { set Hook [namespace current]::MessageHooks }
        preinit { set Hook [namespace current]::PreInitHooks }
        init    { set Hook [namespace current]::InitHooks }
        login   { set Hook [namespace current]::LoginHooks }
        join    { set Hook [namespace current]::JoinHooks }

        version { set Hook [namespace current]::VersionHooks }
        save    { set Hook [namespace current]::SaveHooks }
        options { set Hook [namespace current]::OptionsHooks }
	default {
	    return -code error "unknown hook type \"$type\":\
                must be message, preinit, init, login, join, version, options or save"

	}
    }
    switch -exact -- $do {
	add {
            if {[llength $args] > 2} {
                return -code error "wrong # args: should be \"add hook cmd ?priority?\""
            }
................................................................................
            }
        }
    }

    ## Help Menu
    ##
    set m .mbar.help





    tk::AmpMenuArgs $m add command -label [mc "&Quick Help..."] \
        -command [list [namespace origin Help]]

    tk::AmpMenuArgs $m add command -label [mc "Help (&wiki)..."] \
        -command [list [namespace origin gotoURL] http://wiki.tcl.tk/tkchat]
    $m add separator
    tk::AmpMenuArgs $m add cascade -label [mc "Translate selection"] \
        -command [list [namespace origin babelfishMenu]]
    $m add separator
    tk::AmpMenuArgs $m add command -label [mc "&Check version"] \
................................................................................
        ${NS}::frame .txtframe -style FakeText
    } else {
        ${NS}::frame .txtframe
    }

    CreateTxtAndSbar





    bind .txt <Button-3> [namespace code [list OnTextPopup %W %x %y]]

    bind .txt <Button-1> [namespace code [list OnTextFocus %W]]

    # user display
    ScrolledWidget text .pane.names 0 1\
	    -background "#[getColor MainBG]" \
	    -foreground "#[getColor MainFG]" \
	    -relief sunken \
................................................................................
    bind .eMsg <Key-Up>		::tkchat::entryUp
    bind .eMsg <Key-Down>	::tkchat::entryDown
    bind .eMsg <Key-Tab>	{ ::tkchat::nickComplete ; break }
    bind .eMsg <Key-Prior>	{ .txt yview scroll -1 pages }
    bind .eMsg <Key-Next>	{ .txt yview scroll  1 pages }
    bind .eMsg <Shift-Key-Up>   { .txt yview scroll -1 units }
    bind .eMsg <Shift-Key-Down> { .txt yview scroll  1 units }


    bind .eMsg <Button-3>       [namespace code [list OnEntryPopup %W %X %Y]]




    text .tMsg -height 6 -font FNT
    bind .tMsg <Key-Tab>	{ ::tkchat::nickComplete ; break }

    ${NS}::button .post -text [mc Post] -command [namespace code userPost]

    if {$useTile} {
................................................................................
    $w configure -cursor {}
}

proc ::tkchat::SetChatWindowBindings { parent jid } {

    set post [list ::tkchat::userPostOneToOne $parent $jid]



    bind $parent.txt  <Button-3>  { ::tkchat::OnTextPopup %W %x %y }



    bind $parent.eMsg <Return>	  $post
    bind $parent.eMsg <KP_Enter>  $post
    $parent.post configure -command $post
    wm title $parent $::tkjabber::ChatWindows(title.$jid)
    wm protocol $parent WM_DELETE_WINDOW \
	    [list ::tkchat::DeleteChatWindow $parent $jid]
    bind $parent <FocusIn> \
................................................................................
    $w.text tag configure h1 -font {Sans -12 bold}
    if {[llength [info command ::tkchat::img::Tkchat]] != 0} {
	#$w.text image create end -image ::tkchat::img::Tkchat -name Icon -padx 20
    }
    $w.text insert end \
	"TkChat v$rcsVersion\n" title "$ver\n\n" {h1 center} \
	"$rcsid\n\n" center \
	[mc "Copyright (c) %s by following authors:" "2001-2008"] {} "\n\n" {}

    lappend txt "Bruce B Hartweg"       "<[email protected]>"
    lappend txt "Don Porter"		"<[email protected]>"
    lappend txt "Pat Thoyts"		"<[email protected]>"
    lappend txt "Jeff Hobbs"		"<[email protected]>"
    lappend txt "Ryan Casey"		"<[email protected]>"
    lappend txt "Reinhard Max"		"<[email protected]>"
................................................................................
    lappend txt "Pascal Scheffers"	"<[email protected]>"
    lappend txt "Joe English"		"<[email protected]>"
    lappend txt "Joe Mistachkin"	"<[email protected]>"
    lappend txt "Donal K. Fellows"      "<[email protected]>"
    lappend txt "Daniel South"		"<[email protected]>"
    lappend txt "Steve Landers"		"<[email protected]>"
    lappend txt "Elchonon Edelson"	"<[email protected]>"


    insertHelpText $w.text $txt

    grid $w -sticky news
    grid rowconfigure $dlg 0 -weight 1
    grid columnconfigure $dlg 0 -weight 1

................................................................................
proc ::tkchat::quit {} {
    global Options
    set a "yes"
    if {$Options(AskBeforeQuit)} {
        set q [mc "Are you sure you want to quit?"]
        set a [tk_messageBox -type yesno -default yes \
                   -title [mc "Tkchat confirm quit"] \
                   -message $q]
    }
    if { $a eq "yes" } {
        ::tkchat::saveRC
        exit
    }
}

................................................................................
	set OnlineUsers($network,hideMenu) 0
    }

    # Process command line args
    set nologin 0
    set tkonly $Options(UseTkOnly)
    while {[string match -* [set option [lindex $args 0]]]} {




	switch -exact -- $option {
	    -nologin   { set nologin 1 }
	    -tkonly    { set tkonly 1 }
	    -style     { set Options(Style) [Pop args 1] }
	    -theme     { set Options(Theme) [Pop args 1] }
	    -loglevel  { set Options(LogLevel) [Pop args 1] }
	    -useragent { set Options(UserAgent) [Pop args 1] }
................................................................................
    SetTheme $Options(Theme)
    CreateGUI
    foreach idx [array names Options Visibility,*] {
	set tag [string range $idx 11 end]
	.txt tag configure $tag -elide $Options($idx)
    }


    Hook add message [namespace origin IncrMessageCounter]
    BookmarkInit

    Hook run init

    if {$Options(UseProxy)} {
	if {$Options(ProxyHost) != "" && $Options(ProxyPort) != ""} {
            # nothing
................................................................................
		.mb.mnu add command \
			-label $nick \
			-command [list ::tkchat::MsgTo $nick]
	    } else {
		.pane.names insert $mark "$nick\n" \
			[list NICK NICK-$nick URL-[incr ::URLID]]
	    }




	    .pane.names tag bind URL-$::URLID <Button-3> \
		    [list ::tkchat::OnNamePopup $nick $network %X %Y]

	    .pane.names tag bind URL-$::URLID <Control-Button-1> \
		    [list ::tkchat::OnNamePopup $nick $network %X %Y]
	}
	.pane.names insert end "\n"
    }
    .pane.names insert 1.0 "$total Users Online\n\n" TITLE
    .pane.names yview moveto [lindex $scrollview 0]
................................................................................
	set ChatWindows(title.$jid) "$from <$jid>"
	::tkchat::SetChatWindowBindings $ChatWindows(toplevel.$jid) $jid
    }

    if { [info exists ChatWindows(toplevel.$jid)] } {
	if { ![string match "$ChatWindows(toplevel.$jid)*" [focus]] } {
	    wm title $ChatWindows(toplevel.$jid) "* $ChatWindows(title.$jid)"
	    ::tkchat::alertWhenIdle $ChatWindows(txt.$jid)

	}
    }

    if { [info exists ChatWindows(txt.$jid)] } {
	return $ChatWindows(txt.$jid)
    }

................................................................................
	    break
        }
    }
    set m [menu $dlg.popup -tearoff 0]
    $m add command -label [mc "Clear"] -command [list $f.txt delete 0.0 end]
    $m add command -label [mc "Eval in whiteboard"] \
        -command [list [namespace origin PasteEval] $dlg]



    bind $f.txt <Button-3> [list tk_popup $m %X %Y]
    

    bind $dlg <Key-Escape> [list $cancel invoke]
    pack $f2.lbl -side left
    pack $subject -side right -fill x -expand 1
    pack $cancel $send -side right
    grid $f2    -     -sticky ew -pady 2
    grid $f.txt $f.vs -sticky news
    grid $f3    -     -sticky se






<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







|







 







|








>
>
|
>



|





|

<
<
<
<







 







|







 







>










>





|
>







 







>
>
>
>
>
|
|
>







 







>
>
>
>
|
>







 







>
>
|
>
>
>







 







>
>
|
>
>
>







 







|







 







>







 







|







 







>
>
>
>







 







>
|







 







>
>
>
>
|

>







 







|
>







 







>
>
>
|
|
>







88
89
90
91
92
93
94





































95
96
97
98
99
100
101
...
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
....
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158




1159
1160
1161
1162
1163
1164
1165
....
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
....
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
....
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
....
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
....
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
....
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
....
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
....
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
....
5485
5486
5487
5488
5489
5490
5491
5492
5493
5494
5495
5496
5497
5498
5499
....
6083
6084
6085
6086
6087
6088
6089
6090
6091
6092
6093
6094
6095
6096
6097
6098
6099
6100
....
6177
6178
6179
6180
6181
6182
6183
6184
6185
6186
6187
6188
6189
6190
6191
6192
....
9112
9113
9114
9115
9116
9117
9118
9119
9120
9121
9122
9123
9124
9125
9126
9127
9128
9129
9130
9131
9132
....
9743
9744
9745
9746
9747
9748
9749
9750
9751
9752
9753
9754
9755
9756
9757
9758
.....
10019
10020
10021
10022
10023
10024
10025
10026
10027
10028
10029
10030
10031
10032
10033
10034
10035
10036
10037
10038
    package require idle
}] } then {
    # Not supported / available...
    namespace eval ::idle {}
    proc ::idle::supported {} {return 0}
}






































# 8.4 doesn't provide this - we use it for i18n on menus.
if {[llength [info commands ::tk::AmpMenuArgs]] == 0} {
    proc ::tk::AmpMenuArgs {widget add type args} {
        set options {}
        foreach {opt val} $args {
            if {$opt eq "-label"} {
                lassign [UnderlineAmpersand $val] newlabel under
................................................................................
    ::http::register http 80 ::socket_inet4
}

namespace eval ::tkchat {
    variable chatWindowTitle "The Tcler's Chat"

    variable HEADUrl {http://tcllib.cvs.sourceforge.net/*checkout*/tcllib/tclapps/apps/tkchat/tkchat.tcl?revision=HEAD}
    variable rcsid   {$Id: tkchat.tcl,v 1.484 2011/05/16 17:14:28 patthoyts Exp $}

    variable MSGS
    set MSGS(entered) [list \
	    "%user% has entered the chat!" \
	    "Out of a cloud of smoke, %user% appears!" \
	    "%user% saunters in." \
	    "%user% wanders in." \
................................................................................
}

# Beep and/or deiconify and raise the main window as an idle callback.
# This is done as an idle callback because there might be many requests
# to alert in a row and we want to batch them all together into one
# action.
#
proc ::tkchat::alertWhenIdle {w nick msg} {
    variable alert_pending

    if { ![info exists alert_pending] } {
	set alert_pending 1
	if { $::Options(AutoBookmark) && $w eq ".txt" && [focus] == {} } {
	    .txt mark set AddBookmark "end - 1 line linestart"
	    BookmarkToggle auto
	}
        set top [winfo toplevel $w]
        set focused [expr {[llength [focus -displayof $top]] != 0}]
        after idle [list [namespace origin Hook] run \
                        alert $w $focused $nick $msg]
    }
}

proc ::tkchat::alertCallback {w focused nick msg} {
    global Options
    variable alert_pending

    set top [winfo toplevel $w]
    unset -nocomplain alert_pending
    if {$Options(Alert,RAISE) && !$focused} {
	# Only call this if the window doesn't already have focus




	wm deiconify $top
	raise $top
    }
    if {$Options(Alert,SOUND)} bell
}

# Check to see if an alert is desired for the given message.  Issue
................................................................................
    if { $nick ne $Options(Nickname) } {
	set subjectFound [checkSubject $w $msgtype $nick $msg]
	if { !$alert && $Options(Alert,SUBJECT) && $subjectFound } {
	    set alert 1
	}
    }
    if { $alert } {
	alertWhenIdle $w $nick $msg
    }
    set LastPost($nick) $now
    return $subjectFound
}

proc ::tkchat::checkSubject { w msgtype nick msg } {
    global Options
................................................................................

# Hooks:
#  message hooks are called before displaying a new message
#  preinit hooks are called after app initialization before gui creation
#  init hooks are called after gui creation before login
#  login hooks are called after login to the jabber server
#  join hooks are called after successfully joining a conference
#  alert hooks are called when the user should be notified offline
#  version hooks are called once we get the current version from the web
#  save hook are called when saving options to file.
#  options hooks are called to add pages to the Preferences dialog
proc ::tkchat::Hook {do type args} {
    switch -exact -- $type {
	message { set Hook [namespace current]::MessageHooks }
        preinit { set Hook [namespace current]::PreInitHooks }
        init    { set Hook [namespace current]::InitHooks }
        login   { set Hook [namespace current]::LoginHooks }
        join    { set Hook [namespace current]::JoinHooks }
        alert   { set Hook [namespace current]::AlertHooks }
        version { set Hook [namespace current]::VersionHooks }
        save    { set Hook [namespace current]::SaveHooks }
        options { set Hook [namespace current]::OptionsHooks }
	default {
	    return -code error "unknown hook type \"$type\":\
                must be message, preinit, init, login, join, alert,\
                version, options or save"
	}
    }
    switch -exact -- $do {
	add {
            if {[llength $args] > 2} {
                return -code error "wrong # args: should be \"add hook cmd ?priority?\""
            }
................................................................................
            }
        }
    }

    ## Help Menu
    ##
    set m .mbar.help
    if {[tk windowingsystem] == "aqua"} {
        proc ::tk::mac::ShowHelp {} {
            ::tkchat::Help
        }
    } else {
        tk::AmpMenuArgs $m add command -label [mc "&Quick Help..."] \
            -command [list [namespace origin Help]]
    }
    tk::AmpMenuArgs $m add command -label [mc "Help (&wiki)..."] \
        -command [list [namespace origin gotoURL] http://wiki.tcl.tk/tkchat]
    $m add separator
    tk::AmpMenuArgs $m add cascade -label [mc "Translate selection"] \
        -command [list [namespace origin babelfishMenu]]
    $m add separator
    tk::AmpMenuArgs $m add command -label [mc "&Check version"] \
................................................................................
        ${NS}::frame .txtframe -style FakeText
    } else {
        ${NS}::frame .txtframe
    }

    CreateTxtAndSbar

    # button-3 is the scrollwheel on Aqua -- button-2 is better for this
    if { [tk windowingsystem] eq "aqua"} {
        bind .txt <Button-2> [namespace code [list OnTextPopup %W %x %y]]
    } else {
        bind .txt <Button-3> [namespace code [list OnTextPopup %W %x %y]]
    }
    bind .txt <Button-1> [namespace code [list OnTextFocus %W]]

    # user display
    ScrolledWidget text .pane.names 0 1\
	    -background "#[getColor MainBG]" \
	    -foreground "#[getColor MainFG]" \
	    -relief sunken \
................................................................................
    bind .eMsg <Key-Up>		::tkchat::entryUp
    bind .eMsg <Key-Down>	::tkchat::entryDown
    bind .eMsg <Key-Tab>	{ ::tkchat::nickComplete ; break }
    bind .eMsg <Key-Prior>	{ .txt yview scroll -1 pages }
    bind .eMsg <Key-Next>	{ .txt yview scroll  1 pages }
    bind .eMsg <Shift-Key-Up>   { .txt yview scroll -1 units }
    bind .eMsg <Shift-Key-Down> { .txt yview scroll  1 units }
    # button-3 is the scrollwheel on Aqua -- button-2 is better for this
    if { [tk windowingsystem] eq "aqua"} {
        bind .eMsg <Button-2>   [namespace code [list OnEntryPopup %W %X %Y]]
    } else {
        bind .eMsg <Button-3>   [namespace code [list OnEntryPopup %W %X %Y]]
    }

    text .tMsg -height 6 -font FNT
    bind .tMsg <Key-Tab>	{ ::tkchat::nickComplete ; break }

    ${NS}::button .post -text [mc Post] -command [namespace code userPost]

    if {$useTile} {
................................................................................
    $w configure -cursor {}
}

proc ::tkchat::SetChatWindowBindings { parent jid } {

    set post [list ::tkchat::userPostOneToOne $parent $jid]

    # button-3 is the scrollwheel on Aqua -- button-2 is better for this
    if { [tk windowingsystem] eq "aqua"} {
        bind $parent.txt <Button-2> { ::tkchat::OnTextPopup %W %x %y }
    } else {
        bind $parent.txt <Button-3> { ::tkchat::OnTextPopup %W %x %y }
    }
    bind $parent.eMsg <Return>	  $post
    bind $parent.eMsg <KP_Enter>  $post
    $parent.post configure -command $post
    wm title $parent $::tkjabber::ChatWindows(title.$jid)
    wm protocol $parent WM_DELETE_WINDOW \
	    [list ::tkchat::DeleteChatWindow $parent $jid]
    bind $parent <FocusIn> \
................................................................................
    $w.text tag configure h1 -font {Sans -12 bold}
    if {[llength [info command ::tkchat::img::Tkchat]] != 0} {
	#$w.text image create end -image ::tkchat::img::Tkchat -name Icon -padx 20
    }
    $w.text insert end \
	"TkChat v$rcsVersion\n" title "$ver\n\n" {h1 center} \
	"$rcsid\n\n" center \
	[mc "Copyright (c) %s by following authors:" "2001-2011"] {} "\n\n" {}

    lappend txt "Bruce B Hartweg"       "<[email protected]>"
    lappend txt "Don Porter"		"<[email protected]>"
    lappend txt "Pat Thoyts"		"<[email protected]>"
    lappend txt "Jeff Hobbs"		"<[email protected]>"
    lappend txt "Ryan Casey"		"<[email protected]>"
    lappend txt "Reinhard Max"		"<[email protected]>"
................................................................................
    lappend txt "Pascal Scheffers"	"<[email protected]>"
    lappend txt "Joe English"		"<[email protected]>"
    lappend txt "Joe Mistachkin"	"<[email protected]>"
    lappend txt "Donal K. Fellows"      "<[email protected]>"
    lappend txt "Daniel South"		"<[email protected]>"
    lappend txt "Steve Landers"		"<[email protected]>"
    lappend txt "Elchonon Edelson"	"<[email protected]>"
    lappend txt "Kevin Walzer"          "<[email protected]>"

    insertHelpText $w.text $txt

    grid $w -sticky news
    grid rowconfigure $dlg 0 -weight 1
    grid columnconfigure $dlg 0 -weight 1

................................................................................
proc ::tkchat::quit {} {
    global Options
    set a "yes"
    if {$Options(AskBeforeQuit)} {
        set q [mc "Are you sure you want to quit?"]
        set a [tk_messageBox -type yesno -default yes \
                   -title [mc "Tkchat confirm quit"] \
                   -message $q -icon info]
    }
    if { $a eq "yes" } {
        ::tkchat::saveRC
        exit
    }
}

................................................................................
	set OnlineUsers($network,hideMenu) 0
    }

    # Process command line args
    set nologin 0
    set tkonly $Options(UseTkOnly)
    while {[string match -* [set option [lindex $args 0]]]} {
        if {[tk windowingsystem] eq "aqua" && [string match -psn* $option]} {
            Pop args
            continue
        }
	switch -exact -- $option {
	    -nologin   { set nologin 1 }
	    -tkonly    { set tkonly 1 }
	    -style     { set Options(Style) [Pop args 1] }
	    -theme     { set Options(Theme) [Pop args 1] }
	    -loglevel  { set Options(LogLevel) [Pop args 1] }
	    -useragent { set Options(UserAgent) [Pop args 1] }
................................................................................
    SetTheme $Options(Theme)
    CreateGUI
    foreach idx [array names Options Visibility,*] {
	set tag [string range $idx 11 end]
	.txt tag configure $tag -elide $Options($idx)
    }

    Hook add alert [namespace origin alertCallback] 40
    Hook add message [namespace origin IncrMessageCounter] 40
    BookmarkInit

    Hook run init

    if {$Options(UseProxy)} {
	if {$Options(ProxyHost) != "" && $Options(ProxyPort) != ""} {
            # nothing
................................................................................
		.mb.mnu add command \
			-label $nick \
			-command [list ::tkchat::MsgTo $nick]
	    } else {
		.pane.names insert $mark "$nick\n" \
			[list NICK NICK-$nick URL-[incr ::URLID]]
	    }
            if {[tk windowingsystem] eq "aqua"} {
                .pane.names tag bind URL-$::URLID <Button-2> \
		    [list ::tkchat::OnNamePopup $nick $network %X %Y]
            } else {
                .pane.names tag bind URL-$::URLID <Button-3> \
		    [list ::tkchat::OnNamePopup $nick $network %X %Y]
            }
	    .pane.names tag bind URL-$::URLID <Control-Button-1> \
		    [list ::tkchat::OnNamePopup $nick $network %X %Y]
	}
	.pane.names insert end "\n"
    }
    .pane.names insert 1.0 "$total Users Online\n\n" TITLE
    .pane.names yview moveto [lindex $scrollview 0]
................................................................................
	set ChatWindows(title.$jid) "$from <$jid>"
	::tkchat::SetChatWindowBindings $ChatWindows(toplevel.$jid) $jid
    }

    if { [info exists ChatWindows(toplevel.$jid)] } {
	if { ![string match "$ChatWindows(toplevel.$jid)*" [focus]] } {
	    wm title $ChatWindows(toplevel.$jid) "* $ChatWindows(title.$jid)"
	    ::tkchat::alertWhenIdle $ChatWindows(txt.$jid) $from \
                "Chat message from $from <$jid>"
	}
    }

    if { [info exists ChatWindows(txt.$jid)] } {
	return $ChatWindows(txt.$jid)
    }

................................................................................
	    break
        }
    }
    set m [menu $dlg.popup -tearoff 0]
    $m add command -label [mc "Clear"] -command [list $f.txt delete 0.0 end]
    $m add command -label [mc "Eval in whiteboard"] \
        -command [list [namespace origin PasteEval] $dlg]
    if {[tk windowingsystem] eq "aqua"} {
        bind $f.txt <Button-2> [list tk_popup $m %X %Y]
    } else {
        bind $f.txt <Button-3> [list tk_popup $m %X %Y]
    }

    bind $dlg <Key-Escape> [list $cancel invoke]
    pack $f2.lbl -side left
    pack $subject -side right -fill x -expand 1
    pack $cancel $send -side right
    grid $f2    -     -sticky ew -pady 2
    grid $f.txt $f.vs -sticky news
    grid $f3    -     -sticky se

Added apps/tkchat/tkchat_aqua.tcl.


























































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
# MacOS X support
#
# Use the Growl notification system on Mac's to alert the user of new
# messages via popup message and dock icon change.

#if {[tk windowingsystem] ne "aqua"} { return }

package require msgcat

namespace eval ::tkchat::aqua {
    variable version 1.0.0
    namespace import ::msgcat::mc
}

proc ::tkchat::aqua::InitHook {} {
    variable growl [expr {![catch {package require tclgrowl}]}]
    variable tkdock [expr {![catch {package require tkdock}]}]

    if {$tkdock && [info exists starkit::topdir]} {
        variable Resources
        set MacOS [file dirname $starkit::topdir]
        set Resources [file dirname $MacOS]/Resources
        # tkdock sites under lib beside tkchat.kit in the app bundle
        lappend auto_path $MacOS/lib
        bind all <FocusIn> +::tkdock::origIcon
    }
    InitAlertMenu
}

proc ::tkchat::aqua::AlertHook {w raise nick msg} {
    global Options
    variable growl
    variable tkdock
    variable Resources
    if {$raise && $growl && $Options(Alert,GROWL)} {
        growl::message TkChat "Message from $nick" $msg
    }
    if {$tkdock} {
        ::tkdock::switchIcon $Resources/tkchat_warn.icns
    }
}

# Hook the messages. If a message arrives and we are not focused, the
# message counter is incremented and we ammend the dock icon here.
# PT: is this correct, resetting the origIcon on missed messages?
proc ::tkchat::aqua::MessageHook {nick msg msgtype args} {
    variable tkdock
    if {$tkdock && [focus] eq {} && $msgtype ne "TRAFFIC"} {
        ::tkdock::origIcon
    }
}

# Update the Alert menu with MacOS specific entries
proc ::tkchat::aqua::InitAlertMenu {} {
    global Options
    variable growl
    variable menuDone
    if {[info exists menuDone]} { return }
    if {!$growl} { return }
    if {![winfo exists .mbar.alert]} { return }

    # Insert our items just before the final separator (or append)
    set end [.mbar.alert index end]
    for {set ndx $end} {$ndx >= 0} {incr ndx -1} {
        if {[.mbar.alert type $ndx] eq "separator"} { break }
    }
    if {$ndx < 0} {set ndx end}
    
    # If growl is unavailable then disable the menu item.
    set state "disabled"
    if {$growl && [growl::available]} {
        set state "normal"
    }

    foreach {tag text state} [list \
                            GROWL "&Use Growl for alerts" $state \
                            BOUNCE "Bou&nce icon on alert" normal] {
        foreach {label charindex} [tk::UnderlineAmpersand $text] break
	.mbar.alert insert $ndx checkbutton \
            -label [mc $label] -underline $charindex \
            -variable Options(Alert,$tag) \
            -onvalue 1 -offvalue 0 -state $state
        incr ndx
    }
    set menuDone 1
}

# -------------------------------------------------------------------------
::tkchat::Hook add init ::tkchat::aqua::InitHook
::tkchat::Hook add alert ::tkchat::aqua::AlertHook
::tkchat::Hook add message ::tkchat::aqua::MessageHook
package provide tkchat::aqua $::tkchat::aqua::version
# -------------------------------------------------------------------------