From fed5ef3634b737600cee8bc25955f4a0216d3e6d Mon Sep 17 00:00:00 2001 From: Pat Thoyts Date: Sun, 14 Feb 2010 02:08:05 +0000 Subject: [PATCH] Support connect to multiple channels and last-seen message marking. When connecting or reconnecting we can join a number of channels and we need to re-join all channels on a reconnect. When a tab is hidden and new messages are received place a marker and also handle alert regexps with a bright background and a tab icon if someone addresses me or mentions something I care about. Signed-off-by: Pat Thoyts --- bin/bf_irc.tcl | 131 +++++++++++++++++++++++++++++++++++++++++------ bin/bullfrog.tcl | 26 +++++++++- 2 files changed, 138 insertions(+), 19 deletions(-) diff --git a/bin/bf_irc.tcl b/bin/bf_irc.tcl index 16d7ff4..34fba2a 100644 --- a/bin/bf_irc.tcl +++ b/bin/bf_irc.tcl @@ -22,11 +22,13 @@ proc IrcLogin {app} { variable $dlg {} variable irc if {![info exists irc]} { - array set irc {server irc.freenode.net port 6667 channel "" passwd ""} + array set irc {server irc.freenode.net port 6667 + channel "" passwd "" nick ""} } if {![winfo exists $dlg]} { set dlg [toplevel $dlg -class Dialog] wm withdraw $dlg + catch {wm attributes $dlg -type dialog} wm transient $dlg $app wm title $dlg "IRC Login" @@ -73,7 +75,11 @@ proc IrcLogin {app} { catch {::tk::PlaceWindow $dlg widget $app} wm deiconify $dlg tkwait visibility $dlg - focus -force $dlg.f.ok + if {$irc(nick) eq ""} { + focus $f.nn + } else { + focus -force $f.pw + } grab $dlg vwait [namespace which -variable $dlg] grab release $dlg @@ -82,7 +88,7 @@ proc IrcLogin {app} { if {[set $dlg] eq "ok"} { after idle [list [namespace origin IrcConnect] $app \ -server $irc(server) -port $irc(port) \ - -channel $irc(channel) \ + -channels $irc(channel) \ -nick $irc(nick) -passwd $irc(passwd)] } } @@ -94,11 +100,13 @@ proc IrcConnect {app args} { upvar #0 $Chat chat array set chat [list app $app type irc passwd "" nick ""\ bytes_read 0 bytes_write 0] + set chat(alerts) {\\mtkchat\\M \\mpatthoyts\\M} + set Chat [namespace which -variable $Chat] while {[string match -* [set option [lindex $args 0]]]} { switch -exact -- $option { -server { set chat(server) [Pop args 1] } -port { set chat(port) [Pop args 1] } - -channel { set chat(channel) [Pop args 1] } + -channels { set chat(channels) [Pop args 1] } -nick { set chat(nick) [Pop args 1] } -passwd { set chat(passwd) [Pop args 1] } default { @@ -111,9 +119,9 @@ proc IrcConnect {app args} { $chat(window) names hide set chat(targets) [list] set url irc://$chat(server):$chat(port) - if {[info exists chat(channel)] && $chat(channel) ne ""} { - append url /$chat(channel) - } + #if {[info exists chat(channel)] && $chat(channel) ne ""} { + # append url /$chat(channel) + #} set chat(irc) [picoirc::connect \ [list [namespace origin IrcCallback] $Chat] \ $chat(nick) $chat(passwd) $url] @@ -124,9 +132,9 @@ proc IrcConnect {app args} { return $Chat } -proc IrcJoinChannel {Chat args} { - variable ircuid - # FIX ME: +proc IrcJoinChannel {Chat channel} { + upvar #0 $Chat chat + picoirc::send $chat(irc) "JOIN $channel" } # Reshow and optionally raise a tab window @@ -152,7 +160,8 @@ proc IrcAddChannel {Chat channel {raise true}} { array set chan [array get chat] set chan(channel) $channel set chan(window) [chatwidget::chatwidget $chat(window)$channel] - lappend chat(targets) [list $channel $chan(window)] + set chan(unseen) 0 + lappend chat(targets) [list $channel $chan(window) $Channel] set m0 [font measure ChatwidgetFont {[00:00]m}] set m1 [font measure ChatwidgetFont [string repeat m 10]] set mm [expr {$m0 + $m1}] @@ -160,6 +169,7 @@ proc IrcAddChannel {Chat channel {raise true}} { $chan(window) chat tag configure MSG -lmargin1 $mm -lmargin2 $mm $chan(window) chat tag configure NICK -font ChatwidgetBoldFont $chan(window) chat tag configure TYPE-system -font ChatwidgetItalicFont + $chan(window) chat tag configure ALERT -background yellow $chan(window) chat tag bind URL [list UrlEnter %W] $chan(window) chat tag bind URL [list UrlLeave %W] $chan(window) chat tag bind URL [list UrlClick %W %x %y] @@ -172,7 +182,12 @@ proc IrcAddChannel {Chat channel {raise true}} { [list [namespace origin IrcNickTooltip] $Chat leave %W %x %y] $chan(window) hook add post [list ::picoirc::post $chan(irc) $channel] bind $chan(window) "+unset -nocomplain $Channel" - bind $chan(window) [list IrcChatContextMenu $Chat $Channel %W %x %y] + bind [$chan(window) chat] \ + [list IrcChatContextMenu $Chat $Channel %W %x %y] + bind $chan(window) <> \ + [list IrcWindowRaised $Chat $Channel %W] + #bind $chan(window) \ + # [list IrcWindowUnmapped $Chat $Channel %W] $chat(app).nb add $chan(window) -text $channel if {$raise} { after idle [list $chat(app).nb select $chan(window)] @@ -207,6 +222,11 @@ proc IrcChannelNickMenu {Chat Channel w x y} { destroy $w.popup set m [menu $w.popup -tearoff 0] $m add command -label "$nick" -state disabled + set elide [$channel(window) chat tag cget NICK-$nick -elide] + if {![string is boolean -strict $elide]} {set elide false} + set label [expr {$elide ? "Show user" : "Hide user"}] + $m add command -label $label \ + -command [list UserShow $channel(window) $nick $elide] $m add separator switch -exact -- $group { users - operators { @@ -253,6 +273,73 @@ proc IrcFindWindow {Chat target} { return $w } +# Update the unseen message counter if this tab not visible. +proc IrcUnseen {Chat target w alert} { + upvar #0 $Chat chat + set active [$chat(app).nb select] + if {$active ne $w} { + upvar #0 $Chat/$target chan + if {[info exists chan]} { + incr chan(unseen) + WindowTitle $Chat $w "$chan(unseen) $target" $alert + + # If not already marked - mark last seen location + # we dont delete these but must remember when this has been + # seen again. (See IrcWindowUnmapped) + if {![info exists chan(lastread)]} { + set cw [$chan(window) chat] + set i [$cw index "end - 1 line linestart"] + set i [$cw index "$i + 7 char"] + set oldstate [$cw cget -state] + $cw configure -state normal + #$cw replace $i $i " " + $cw image create $i -image ::img::important + $cw configure -state $oldstate + $cw see end + set chan(lastread) $i + } + } + } +} + +proc IrcWindowRaised {Chat Channel w} { + upvar #0 $Chat chat + upvar #0 $Channel chan + set title [$chat(app).nb tab $w -text] + if {[regexp {^\d+ (.*)$} $title -> tail]} { + $chat(app).nb tab $w -text $tail + } + set chan(unseen) 0 + if {[info exists chan(lastread)]} {unset chan(lastread)} + # unalert the tab (if it had an alert icon) + $chat(app).nb tab $w -image {} +} + +# check for defined alerts +proc IrcCheckAlert {Chat msg} { + upvar #0 $Chat chat + foreach alert $chat(alerts) { + if {[regexp $alert $msg]} { return 1 } + } + return 0 +} + +proc IrcReconnect {Chat context} { + + ::picoirc::reconnect $context +} + +proc IrcOnConnected {Chat context} { + upvar #0 $Chat chat + # join all channels + if {[llength $chat(channels)] > 0} { + foreach channel $chat(channels) { + IrcJoinChannel $Chat $channel + } + set chat(channels) {} + } +} + proc IrcCallback {Chat context state args} { upvar #0 $Chat chat upvar #0 $context irc @@ -266,12 +353,19 @@ proc IrcCallback {Chat context state args} { $chat(window) message "Logging into $irc(server) as $irc(nick)" -type system Status $Chat "Connection to IRC server established." State $Chat connected + after idle [list IrcOnConnected $Chat $context] } close { - puts "connection close: $args" + # setup channel list for reconnection + foreach target $chat(targets) { + lappend $chat(channels) [lindex $target 0] + } if {[llength $args] != 0} { $chat(window) message "Failed to connect: [lindex $args 0]" -type system Status $Chat [lindex $args 0] + set r [tk_messageBox -icon error -title "Failed to connect" \ + -type retrycancel -message [lindex $args 0]] + if {$r eq "retry"} { set irc(retry) 1 } } else { $chat(window) message "Disconnected from server" -type system Status $Chat "Disconnected." @@ -280,7 +374,7 @@ proc IrcCallback {Chat context state args} { if {$irc(retry)} { Status $Chat "Attempting to reconnect..." set irc(retry) 0 - after $irc(retry_delay) [list ::picoirc::reconnect $context] + after $irc(retry_delay) [list IrcReconnect $Chat $context] } } userlist { @@ -352,8 +446,11 @@ proc IrcCallback {Chat context state args} { } else { regexp {<([^>]+)> (.+)} $msg -> nick msg } - } - $w message $msg -nick $nick -type $type + } + set alert [IrcCheckAlert $Chat $msg] + IrcUnseen $Chat $target $w $alert + set tags [expr {$alert ? "ALERT" : ""}] + $w message $msg -nick $nick -type $type -tags $tags } system { foreach {target msg} $args break @@ -379,7 +476,7 @@ proc IrcCallback {Chat context state args} { IrcCallbackNick $w $action $target $nick $new } else { foreach window_target $chat(targets) { - foreach {window_channel w} $window_target break + foreach {window_channel w var} $window_target break set current [$w name list -full] if {[lsearch -index 0 $current $nick] != -1} { IrcCallbackNick $w $action $target $nick $new diff --git a/bin/bullfrog.tcl b/bin/bullfrog.tcl index b56940e..b838c84 100644 --- a/bin/bullfrog.tcl +++ b/bin/bullfrog.tcl @@ -46,6 +46,7 @@ namespace eval ::img { image create photo ::img::presence::unavailable -file $imgdir/guy-grey.png image create photo ::img::network::connected -file $imgdir/network-transmit-receive.png image create photo ::img::network::disconnected -file $imgdir/network-offline.png + image create photo ::img::important -file $imgdir/emblem-important.png } proc Main {args} { @@ -131,6 +132,7 @@ proc Main {args} { ttk::notebook::enableTraversal $app.nb bind $app {console show} + bind $app.nb <> [namespace code "OnTabSelected %W"] wm geometry .chat 600x400 wm deiconify $app @@ -229,6 +231,7 @@ proc OnPostAction {app menu} { irc* { # main: irc0 # channel: irc0#tcltest + } xmlconsole - debug* - @@ -304,7 +307,13 @@ proc AttachWindow {app w {index end}} { wm title $w $title } } -proc WindowTitle {Session w {title {}}} { + +proc OnTabSelected {nb} { + set w [$nb select] + event generate $w <> +} + +proc WindowTitle {Session w {title {}} {alert {}}} { upvar #0 $Session session if {[lsearch -exact [$session(app).nb tabs] $w] == -1} { if {$title eq {}} { @@ -316,11 +325,24 @@ proc WindowTitle {Session w {title {}}} { if {$title eq {}} { return [$session(app).nb tab $w -text] } else { - $session(app).nb tab $w -text $title + $session(app).nb tab $w -text $title -compound left + if {$alert ne {}} { + if {$alert} { + $session(app).nb tab $w -image ::img::important + } + } } } } +# Implements hiding a given nick or unhiding. +# chatwindow must be an instance of chatwidget and show must be boolean. +proc UserShow {chatwindow nick show} { + set elide [expr {!$show}] + $chatwindow chat tag configure NICK-$nick -elide $elide + $chatwindow names tag configure NICK-$nick -overstrike $elide +} + proc UrlEnter {w} { variable cursor:$w set cursor:$w [$w cget -cursor] -- 2.23.0