Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Support detection of suspend/resume. Added a muc join hook, ignore empty messages with chatstate notifications in chat windows. Some themeing on the colour dialog. |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
59d2cae22ccf453650975a16b8d34990 |
User & Date: | patthoyts 2009-05-13 12:02:08.000 |
Context
2009-05-23
| ||
08:01 | Add the XMPP.org issuer check-in: 929584d5c5 user: patthoyts tags: trunk | |
2009-05-13
| ||
12:02 | Support detection of suspend/resume. Added a muc join hook, ignore empty messages with chatstate notifications in chat windows. Some themeing on the colour dialog. check-in: 59d2cae22c user: patthoyts tags: trunk | |
2009-04-23
| ||
00:54 | removed misguided xml quoting from nicks and fixed a bug that prevented sending to a backslashed nick. check-in: b6d9df0907 user: patthoyts tags: trunk | |
Changes
Changes to apps/tkchat/ChangeLog.
1 2 3 4 5 6 7 | 2009-04-23 Pat Thoyts <[email protected]> * tkchat.tcl: removed misguided xml quoting from nicks and fixed a bug that prevented sending to a backslashed nick. * tkchat.tcl: tighten up our handling of jids by making more use of the jidsplit and jidequal functions. | > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | 2009-05-13 Pat Thoyts <[email protected]> * tkchat.tcl: Added a muc join hook, ignore empty messages with chatstate notifications in chat windows. Some themeing on the colour dialog. * tkchat_power.tcl: Support detection of suspend/resume. 2009-04-23 Pat Thoyts <[email protected]> * tkchat.tcl: removed misguided xml quoting from nicks and fixed a bug that prevented sending to a backslashed nick. * tkchat.tcl: tighten up our handling of jids by making more use of the jidsplit and jidequal functions. |
︙ | ︙ |
Changes to apps/tkchat/tkchat.tcl.
︙ | ︙ | |||
43 44 45 46 47 48 49 | package require uri ; # tcllib catch {package require tls} ; # tls (optional) catch {package require choosefont}; # font selection (optional) catch {package require picoirc} ; # irc client (optional) catch {package require img::png} ; # more image types (optional) catch {package require img::jpeg} ; # more image types (optional) | | | 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 | package require uri ; # tcllib catch {package require tls} ; # tls (optional) catch {package require choosefont}; # font selection (optional) catch {package require picoirc} ; # irc client (optional) catch {package require img::png} ; # more image types (optional) catch {package require img::jpeg} ; # more image types (optional) package require sha1 ; # tcllib package require jlib ; # jlib package require muc ; # jlib package require disco ; # jlib catch {package require khim} ; # khim (optional) catch {package require tooltip 1.2};# tooltips (optional) |
︙ | ︙ | |||
254 255 256 257 258 259 260 | } } 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} | | | 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 | } } 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.466 2009/05/13 12:02:08 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." \ |
︙ | ︙ | |||
1392 1393 1394 1395 1396 1397 1398 | } } # 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 | | > > | | 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 | } } # 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?\"" } |
︙ | ︙ | |||
5102 5103 5104 5105 5106 5107 5108 5109 5110 5111 5112 5113 5114 5115 | foreach idx [lsort [array names Options Macro,*]] { $w insert end [format "%-10s %s" [string range $idx 6 end] $Options($idx)] } } proc ::tkchat::ChangeColors {} { global Options variable DlgData variable DlgDone variable OnlineUsers # clear old data unset -nocomplain DlgData # make copy of current settings | > | 5104 5105 5106 5107 5108 5109 5110 5111 5112 5113 5114 5115 5116 5117 5118 | foreach idx [lsort [array names Options Macro,*]] { $w insert end [format "%-10s %s" [string range $idx 6 end] $Options($idx)] } } proc ::tkchat::ChangeColors {} { global Options variable NS variable DlgData variable DlgDone variable OnlineUsers # clear old data unset -nocomplain DlgData # make copy of current settings |
︙ | ︙ | |||
5124 5125 5126 5127 5128 5129 5130 | set t .opts catch {destroy $t} Dialog $t wm protocol $t WM_DELETE_WINDOW {set ::tkchat::DlgDone cancel} wm withdraw $t wm title $t "Color Settings" | | | < | | | | 5127 5128 5129 5130 5131 5132 5133 5134 5135 5136 5137 5138 5139 5140 5141 5142 5143 5144 5145 5146 5147 5148 5149 5150 5151 5152 5153 5154 5155 5156 5157 5158 5159 5160 5161 5162 5163 5164 5165 5166 5167 5168 | set t .opts catch {destroy $t} Dialog $t wm protocol $t WM_DELETE_WINDOW {set ::tkchat::DlgDone cancel} wm withdraw $t wm title $t "Color Settings" ${NS}::label $t.l1 -text "Posting Color" label $t.l2 -text "Example Text" -background white \ -foreground \#$DlgData(MyColor) -font ACT ${NS}::button $t.myclr -text "Change..." -command { set tmp [tk_chooseColor \ -title "Select Your User Color" \ -initialcolor \#$::tkchat::DlgData(MyColor)] if { $tmp ne "" } { .opts.l2 configure -foreground $tmp set ::tkchat::DlgData(MyColor) [string range $tmp 1 end] } } ${NS}::labelframe $t.f -text "Colour overrides" -height 300 canvas $t.f.cvs -yscrollcommand [list $t.f.scr set] \ -width 10 -height 300 -highlightthickness 0 -bd 0 bind $t <Button-4> [list $t.f.cvs yview scroll -1 units] bind $t <Button-5> [list $t.f.cvs yview scroll 1 units] ${NS}::scrollbar $t.f.scr -command [list $t.f.cvs yview] pack $t.f.cvs -side left -expand 1 -fill both pack $t.f.scr -side left -fill y set f [frame $t.f.cvs.frm] $t.f.cvs create window 0 0 -anchor nw -window $f bind $f <Configure> { [winfo parent %W] configure -width [expr {%w+5}] -scrollregion [list 0 0 %w %h] } foreach {key str} { 1 "All\nDefault" 2 "All\nInverted" 3 "All\nCustom"} { button $f.all$key -text $str -command \ [string map [list %val% $key] { foreach idx [array names DlgData Color,*] { set idx [string range $idx 6 end] set DlgData($idx) %val% } }] } |
︙ | ︙ | |||
5182 5183 5184 5185 5186 5187 5188 | grid [label $f.offline -text "Offline Users"] - - - foreach nick $Options(NickList) { set nick [lindex $nick 0] if { [lsearch -exact $UserList $nick] == -1 } { buildRow $f NICK-$nick $nick } } | | | < < | | < < | | < < | | | 5184 5185 5186 5187 5188 5189 5190 5191 5192 5193 5194 5195 5196 5197 5198 5199 5200 5201 5202 5203 5204 5205 5206 5207 5208 | grid [label $f.offline -text "Offline Users"] - - - foreach nick $Options(NickList) { set nick [lindex $nick 0] if { [lsearch -exact $UserList $nick] == -1 } { buildRow $f NICK-$nick $nick } } ${NS}::frame $t.f2 ${NS}::button $t.f2.ok -text "OK" -default active\ -command { set ::tkchat::DlgDone ok } ${NS}::button $t.f2.app -text "Apply" \ -command { set ::tkchat::DlgDone apply } ${NS}::button $t.f2.can -text "Cancel" \ -command { set ::tkchat::DlgDone cancel} pack $t.f2.ok $t.f2.app $t.f2.can -side left -expand 1 -fill none grid $t.l1 $t.l2 $t.myclr x -padx 1 -pady 3 -sticky {} #grid $t.l3 - - - -padx 1 -pady 3 -sticky ew grid $t.f - - - -padx 1 -pady 5 -sticky news grid $t.f2 - - - -padx 1 -pady 10 -sticky news grid rowconfigure $t 2 -weight 1 grid columnconfigure $t 3 -weight 1 wm resizable $t 0 1 catch {::tk::PlaceWindow $t widget .} wm deiconify $t |
︙ | ︙ | |||
8173 8174 8175 8176 8177 8178 8179 | if {[jlib::jidequal $node@$domain $conference]} { set from $resource set w [getChatWidget $m(-from) $from] } else { set from $node set w [getChatWidget $m(-from) $from] } | | > > > > | | | 8169 8170 8171 8172 8173 8174 8175 8176 8177 8178 8179 8180 8181 8182 8183 8184 8185 8186 8187 8188 8189 8190 8191 8192 8193 8194 8195 8196 8197 8198 8199 8200 8201 8202 8203 8204 8205 | if {[jlib::jidequal $node@$domain $conference]} { set from $resource set w [getChatWidget $m(-from) $from] } else { set from $node set w [getChatWidget $m(-from) $from] } # If someone sends chatstate notifications we may # get empty bodies. Ignore them. if {[string length $m(-body)] == 0} { return } LogPrivateChat [normalized_jid $m(-from)] \ $from $timestamp $m(-body) if {$w eq ".txt"} { ::tkchat::addMessage $w $color $from " whispers: $m(-body)" \ ACTION end $timestamp } else { if { [string match -nocase "/me *" $m(-body)] } { set m(-body) [string range $m(-body) 4 end] set msgtype ACTION } else { set msgtype NORMAL if {[string match "Realname*" $m(-body)]} { # We are handling IRC whois data - should do some # caching if we can get the nick (mod the bridge) } } ::tkchat::addMessage \ $w $color $from $m(-body) $msgtype end $timestamp } } groupchat { jlib::splitjidex $m(-from) node domain nick if { [info exists m(-subject)] && $m(-subject) ne ""} { # changing topic. variable ::tkchat::chatWindowTitle |
︙ | ︙ | |||
8708 8709 8710 8711 8712 8713 8714 8715 8716 8717 8718 8719 8720 8721 | $jabber send_presence -type available -from $jid \ -to $conference -show away -status $AwayStatus \ -extras [list [get_caps]] } tkchat::addStatus 0 "Joined chat at $conference" autoStatus #after 500 [namespace origin ParticipantVersions] } default { ::tkchat::addSystem .txt "MucEnter: type=$type, args='$args'" } } } | > > > | 8708 8709 8710 8711 8712 8713 8714 8715 8716 8717 8718 8719 8720 8721 8722 8723 8724 | $jabber send_presence -type available -from $jid \ -to $conference -show away -status $AwayStatus \ -extras [list [get_caps]] } tkchat::addStatus 0 "Joined chat at $conference" autoStatus #after 500 [namespace origin ParticipantVersions] # We have joined the conference so run any join hooks ::tkchat::Hook run join -muc $conference -nick [$muc mynick $conference] } default { ::tkchat::addSystem .txt "MucEnter: type=$type, args='$args'" } } } |
︙ | ︙ | |||
9047 9048 9049 9050 9051 9052 9053 | } away { .pane.names image create $mark -image ::tkchat::roster::away } xa { .pane.names image create $mark -image ::tkchat::roster::xa } | | | 9050 9051 9052 9053 9054 9055 9056 9057 9058 9059 9060 9061 9062 9063 9064 | } away { .pane.names image create $mark -image ::tkchat::roster::away } xa { .pane.names image create $mark -image ::tkchat::roster::xa } disabled - offline { .pane.names image create $mark -image ::tkchat::roster::disabled } } if { [info exists OnlineUsers($network-$nick,jid)] } { set tags [list NICK NICK-$nick URL URL-[incr ::URLID]] .pane.names insert $mark "$nick" $tags "\n" NICK .pane.names tag bind URL-$::URLID <Button-1> [list \ |
︙ | ︙ |
Added apps/tkchat/tkchat_power.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 | # Tkchat plugin that listens for power announcements and suspend changes. # # We should record the suspension time so that on resume we can decide # if we should override the history reload and send a presence notification # that we are offline. # # Requires the winpm extension from http://tkwinpm.googlecode.com/ if {[catch { package require winpm }]} { return } namespace eval ::tkchat::power { variable version 1.0.0 variable suspended 0 } proc ::tkchat::power::OnSuspend {} { variable suspended [clock seconds] ::tkchat::addSystem .txt "system suspended" catch {::tkjabber::away "system going to sleep" offline} } proc ::tkchat::power::OnResume {} { global Options variable suspended set msg "system resumed" if {$Options(HistoryLines) != 0 && ([clock seconds] - $suspended) > 300} { set ::tkjabber::HaveHistory 0 append msg ", enabling history refetch on reconnection" } tkchat::addSystem .txt $msg catch {::tkjabber::back "system resumed" online} } proc ::tkchat::power::InitHook {} { winpm bind PBT_APMSUSPEND [list [namespace origin OnSuspend]] winpm bind PBT_APMRESUMESUSPEND [list [namespace origin OnResume]] } # ------------------------------------------------------------------------- ::tkchat::Hook add init ::tkchat::power::InitHook package provide tkchat::power $::tkchat::power::version # ------------------------------------------------------------------------- |