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 <patthoyts@users.sourceforge.net>

diff --git a/bin/bf_irc.tcl b/bin/bf_irc.tcl
index 16d7ff4a3f9bd0a32d92ad83a3b681ba283dfd4f..34fba2ad56fb9f03e7dfb021683ba7b927870fe7 100644 (file)
--- 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 <Enter> [list UrlEnter %W]
     $chan(window) chat tag bind URL <Leave> [list UrlLeave %W]
     $chan(window) chat tag bind URL <Button-1> [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) <Destroy> "+unset -nocomplain $Channel"
-    bind $chan(window) <Button-3> [list IrcChatContextMenu $Chat $Channel %W %x %y]
+    bind [$chan(window) chat] <Button-3> \
+        [list IrcChatContextMenu $Chat $Channel %W %x %y]
+    bind $chan(window) <<TabSelected>> \
+        [list IrcWindowRaised $Chat $Channel %W]
+    #bind $chan(window) <Unmap> \
+    #    [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 b56940e11d99d9008457a6fac4d55471b66d1ca9..b838c84a060c8de3be35291073beff7822bdb61b 100644 (file)
--- 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 <Control-F2> {console show}
+    bind $app.nb <<NotebookTabChanged>> [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 <<TabSelected>>
+}
+
+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]