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.

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.

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)  
................................................................................
    }
}

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.465 2009/04/23 00:54:35 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." \
................................................................................
    }
}

# 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

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

        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, version, options or save"
	}
    }
    switch -exact -- $do {
	add {
            if {[llength $args] > 2} {
                return -code error "wrong # args: should be \"add hook cmd ?priority?\""
            }
................................................................................
    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
................................................................................
    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"

    label $t.l1 -text "Posting Color"
    label $t.l2 -text "Example Text" -background white \
	-foreground \#$DlgData(MyColor) -font ACT
    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]
	}
    }

    label $t.l3 -text "Display Color Overrides"
    frame $t.f -relief sunken -bd 2 -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]
    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 -padx 0 -pady 0 -command \
		[string map [list %val% $key] {
		    foreach idx [array names DlgData Color,*] {
			set idx [string range $idx 6 end]
			set DlgData($idx) %val%
		    }
		}]
    }
................................................................................
    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
	}
    }
    frame $t.f2
    button $t.f2.ok \
	    -width 8 \
	    -text "OK" \
	    -command { set ::tkchat::DlgDone ok }
    button $t.f2.app \
	    -width 8 \
	    -text "Apply" \
	    -command { set ::tkchat::DlgDone apply }
    button $t.f2.can \
	    -width 8 \
	    -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
................................................................................
            if {[jlib::jidequal [email protected]$domain $conference]} {
                set from $resource
                set w [getChatWidget $m(-from) $from]
            } else {
                set from $node
                set w [getChatWidget $m(-from) $from]
            }
            




            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)] } {
................................................................................
		} 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
................................................................................
		$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'"
	}
    }
}

................................................................................
		}
		away {
		    .pane.names image create $mark -image ::tkchat::roster::away
		}
		xa {
		    .pane.names image create $mark -image ::tkchat::roster::xa
		}
		disabled {
		    .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 \

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)  
................................................................................
    }
}

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." \
................................................................................
    }
}

# 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?\""
            }
................................................................................
    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
................................................................................
    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%
		    }
		}]
    }
................................................................................
    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
................................................................................
            if {[jlib::jidequal [email protected]$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)] } {
................................................................................
		} 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
................................................................................
		$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'"
	}
    }
}

................................................................................
		}
		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 \

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