attline.tcl 9.86 KB
Newer Older
1 2 3 4 5 6 7 8
# attline.tcl --
#
#       "Attention line" -- chat plugin for Tkabber.
#       Draws horizontal line in chat windows separating read and unread
#       messages.
#
# Author: Konstantin Khomoutov <flatworm@users.sourceforge.net>
#
9 10 11 12 13
# See license.terms for the terms of distribution.

package require msgcat

namespace eval attline {
14 15 16
    ::msgcat::mcload [file join [file dirname [info script]] msgs]

    if {![::plugins::is_registered attline]} {
17 18 19 20 21 22 23 24 25
        ::plugins::register attline \
                            -namespace [namespace current] \
                            -source [info script] \
                            -description [::msgcat::mc "Whether the Attention\
                                                        Line plugin is\
                                                        loaded."] \
                            -loadcommand [namespace code load] \
                            -unloadcommand [namespace code unload]
        return
26 27 28 29 30 31
    }

    frame .fakeframe -class Chat
    text .fakeframe.faketext

    option add *Chat.attentionLineHeight 1 widgetDefault
32 33 34
    option add *Chat.attentionLineColor  [get_conf .fakeframe.faketext \
                                                   -foreground] \
                                         widgetDefault
35 36 37 38 39
    option add *Chat.attentionLinePadX   5 widgetDefault
    option add *Chat.attentionLinePadY   0 widgetDefault

    destroy .fakeframe

40 41 42 43
    variable state
    variable options

    proc my what {
44
        return [uplevel 1 namespace current]::$what
45 46
    }
    proc mycmd args {
47
        lreplace $args 0 0 [uplevel 1 namespace current]::[lindex $args 0]
48 49 50 51 52
    }

    custom::defgroup Plugins [::msgcat::mc "Plugins options."] -group Tkabber

    custom::defgroup {Attention Line} \
53 54 55 56 57
        [::msgcat::mc "Attention Line chat plugin options.\
                       This plugin draws horizontal line separating\
                       read and unread messages in chat windows."] \
        -group Plugins \
        -group Chat
58 59

    custom::defvar options(expires_after) 1000 \
60 61 62 63 64
        [::msgcat::mc "Time (in milliseconds) after which unread messages\
                       in the currently active chat window are considered read\
                       and the attention line is considered expired."] \
        -group {Attention Line} \
        -type integer
65 66

    custom::defvar options(remove_expired) false \
67 68 69 70
        [::msgcat::mc "Remove the attention line after it was expired\
                       from its chat window."] \
        -group {Attention Line} \
        -type boolean
71
}
72

73
proc attline::load {} {
74 75 76 77 78 79 80 81
    hook::add open_chat_post_hook [mycmd setup_chat_win]
    # must perform after the hook from 'log on open' plugin:
    hook::add open_chat_post_hook [mycmd draw_chat_history_separator] 101
    hook::add close_chat_post_hook [mycmd cleanup]
    # must perform earlier than drawing of timestamp:
    hook::add draw_message_hook [mycmd on_draw_message] 5.5
    hook::add got_focus_hook  [mycmd on_focused]
    hook::add lost_focus_hook [mycmd on_lost_focus]
82 83

    foreach chatid [chat::opened] {
84
        setup_chat_win $chatid ""
85 86 87 88 89 90 91 92 93 94 95 96 97 98
    }
}

proc attline::unload {} {
    variable state

    hook::remove open_chat_post_hook [mycmd setup_chat_win]
    hook::remove open_chat_post_hook [mycmd draw_chat_history_separator] 101
    hook::remove close_chat_post_hook [mycmd cleanup]
    hook::remove draw_message_hook [mycmd on_draw_message] 5.5
    hook::remove got_focus_hook  [mycmd on_focused]
    hook::remove lost_focus_hook [mycmd on_lost_focus]

    foreach chatid [chat::opened] {
99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114
        set cw [chat::chat_win $chatid]
        set iw [chat::input_win $chatid]
        bind $iw <<ChatSeeAttentionLine>> {}

        set al [attline $cw]
        set script [split [bind $cw <Configure>] \n]
        set idx [lsearch -exact $script \
                         [mycmd reconfigure_attention_line $cw $al]]
        if {$idx >= 0} {
            bind $cw <Configure> [join [lreplace $script $idx $idx] \n]
        }

        if {[drawn $cw]} {
            delete_attention_line $cw
        }
        cleanup $chatid
115 116 117
    }

    catch {unset state}
118 119 120 121 122 123 124 125 126
}

proc attline::attline {cw} {
    return $cw.attention_line
}

proc attline::unread {cw {val ""}} {
    variable state
    if {$val == ""} {
127
        return $state($cw,unread)
128
    } else {
129
        set state($cw,unread) $val
130 131 132 133 134 135
    }
}

proc attline::atbottom {cw {val ""}} {
    variable state
    if {$val == ""} {
136
        return $state($cw,atbottom)
137
    } else {
138
        set state($cw,atbottom) $val
139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156
    }
}

proc attline::isvisible {text index} {
    expr {[llength [$text bbox $index]] > 0}
}

proc attline::setup_chat_win {chatid type} {
    variable state
    set cw [chat::chat_win $chatid]
    set iw [chat::input_win $chatid]

    set state($cw,mainwindow) [chat::winid $chatid]

    #unread $cw [expr {![has_focus $chatid]}]
    unread $cw false
    atbottom $cw false

157
    bind $iw <<ChatSeeAttentionLine>> [mycmd see_attention_line $cw]
158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180

    return
}

proc attline::cleanup {chatid} {
    variable state

    set cw [chat::chat_win $chatid]

    cancel_attline_expiration $cw

    unset state($cw,mainwindow)
    unset state($cw,unread)
    unset state($cw,atbottom)
}

proc attline::getopt {cw opt} {
    variable state

    chat::query_optiondb $state($cw,mainwindow) $opt
}

proc attline::on_draw_message {chatid from type body x} {
181
    if {[::xmpp::delay::exists $x]} return
182 183 184 185

    set cw [chat::chat_win $chatid]

    if {![has_focus $chatid] && ![unread $cw]} {
186 187 188 189 190 191
        unread $cw true
        if {[drawn $cw]} {
            redraw_attention_line $cw
        } else {
            draw_attention_line $cw
        }
192 193 194 195 196 197 198 199 200 201 202 203
    }
    atbottom $cw false

    return
}

proc attline::drawn {cw} {
    winfo exists [attline $cw]
}

proc attline::draw_chat_history_separator {chatid type} {
    if {[string equal $type chat]} {
204 205 206 207 208
        set cw [chat::chat_win $chatid]
        # Draw only if text widget isn't empty (has some history lines):
        if {[$cw compare 1.0 < end-1c]} {
            draw_attention_line $cw
        }
209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244
    }

    return
}

proc attline::draw_attention_line {cw} {
    set al [attline $cw]

    frame $al
    bind $cw <Configure> +[mycmd reconfigure_attention_line $cw $al]
    # Prevent destructed attention line from killing its parent
    # in windowed mode when there's no explicit handler and the
    # event is forwarded upstream:
    bind $al <Destroy> +break

    $cw window create end -window $al

    reconfigure_attention_line $cw $al

    debugmsg attline "drawn"
}

proc attline::delete_attention_line {cw} {
    set state [$cw cget -state]
    $cw configure -state normal
    $cw delete [attline $cw]
    $cw configure -state $state

    debugmsg attline "deleted"
}

proc attline::redraw_attention_line {cw} {
    set al [attline $cw]
    set ix [$cw index $al]

    if {[atbottom $cw]} {
245 246
        debugmsg attline "at bottom, won't redraw"
        return
247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266
    }

    set state [$cw cget -state]
    $cw configure -state normal

    $cw window configure $ix -window {}
    $cw delete $ix

    $cw window create end -window $al

    reconfigure_attention_line $cw $al

    $cw configure -state $state

    debugmsg attline "redrawn"
}

proc attline::see_attention_line {cw} {
    set al [attline $cw]
    if {[winfo exists $al] && ![isvisible $cw $al]} {
267
        $cw see $al
268 269 270 271 272 273
    }
}

proc attline::internal_width {cw} {
    # We assume $cw is mapped...
    expr { [winfo width $cw]
274 275 276
        - 2 * [$cw cget -borderwidth]
        - 2 * [$cw cget -padx]
        - 2 * [$cw cget -highlightthickness]
277 278 279 280 281 282 283 284
    }
}

proc attline::reconfigure_attention_line {cw al} {
    if {![winfo exists $al]} return

    set padx [getopt $cw attentionLinePadX]
    $al configure \
285 286 287
        -background [getopt $cw attentionLineColor] \
        -height     [getopt $cw attentionLineHeight] \
        -width      [expr {[internal_width $cw] - 2 * $padx }]
288
    $cw window configure $al \
289 290
        -padx       $padx \
        -pady       [getopt $cw attentionLinePadY] \
291 292 293 294 295 296
}

proc attline::has_focus {chatid} {
    global usetabbar

    if {$usetabbar} {
297 298
        expr {![string equal [focus -displayof .] ""] && \
            [string equal [chat::winid $chatid] [ifacetk::nbpath [.nb raise]]]}
299
    } else {
300 301 302
        set fw [focus -displayof .]
        expr {![string equal $fw ""] && \
            [string equal [winfo toplevel $fw] [chat::winid $chatid]]}
303 304 305 306 307 308 309 310 311 312
    }
}

proc attline::on_focused {w} {
    set chatid [chat::winid_to_chatid $w]
    if {$chatid == ""} return

    set cw [chat::chat_win $chatid]
    debugmsg attline "focused; unread? [unread $cw]"
    if {[unread $cw]} {
313 314
        see_attention_line $cw
        schedule_attline_expiration $cw
315 316 317 318 319 320 321 322 323 324
    }
}

proc attline::on_lost_focus {w} {
    set chatid [chat::winid_to_chatid $w]
    if {$chatid == ""} return

    set cw [chat::chat_win $chatid]
    debugmsg attline "lost focus; unread? [unread $cw]"
    if {[unread $cw]} {
325
        cancel_attline_expiration $cw
326
    } elseif {[drawn $cw]} {
327 328
        redraw_attention_line $cw
        atbottom $cw true
329 330 331 332 333 334 335 336 337 338
    }
}

proc attline::schedule_attline_expiration {cw} {
    variable state
    variable options

    set exptime $options(expires_after)

    if {$exptime <= 0} {
339 340 341 342
        # Immediate expiration:
        unread $cw false
        debugmsg attline "expired immediately"
        return
343 344 345 346 347 348 349 350 351
    }

    set state($cw,expiring) [after $exptime [mycmd expire_attention_line $cw]]
    debugmsg attline "expiration scheduled for after $exptime"
}

proc attline::cancel_attline_expiration {cw} {
    variable state
    if {[info exists state($cw,expiring)]} {
352 353 354
        after cancel $state($cw,expiring)
        unset state($cw,expiring)
        debugmsg attline "expiration cancelled"
355 356 357 358 359 360 361 362
    }
}

proc attline::expire_attention_line {cw} {
    variable state
    variable options

    if {[info exists state($cw,expiring)]} {
363 364 365 366 367 368
        unread $cw false
        unset state($cw,expiring)
        if {$options(remove_expired) && [drawn $cw]} {
            delete_attention_line $cw
        }
        debugmsg attline "expired"
369 370 371
    }
}

372
# vim:ts=8:sw=4:sts=4:et