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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
# singularity.tcl --
#
# When a new chat window is about to be opened this plugin
# checks whether any chats with other resources of this chat peer
# are currently opened and closes them all, if any.
# In other words, it ensures that only one chat window per bare
# JID is opened at any given time.
#
# Author: Konstantin Khomoutov <flatworm@users.sourceforge.net>
#
# See license.terms for the terms of distribution.
# See README for usage details.
namespace eval singularity {
::msgcat::mcload [file join [file dirname [info script]] msgs]
if {![::plugins::is_registered singularity]} {
::plugins::register singularity \
-namespace [namespace current] \
-source [info script] \
-description [::msgcat::mc \
"Whether the Singularity plugin is loaded."]\n[::msgcat::mc \
"This plugin allows closing obsolete chat windows\
for a contact when a new chat session window\
with that contact is about to be opened."] \
-loadcommand [namespace code load] \
-unloadcommand [namespace code unload]
return
}
}
proc singularity::load {} {
variable contexts; array set contexts {}
hook::add open_chat_pre_hook \
[namespace current]::process_new_chat_opening
hook::add open_chat_post_hook \
[namespace current]::restore_chat_context
}
proc singularity::unload {} {
hook::remove open_chat_pre_hook \
[namespace current]::process_new_chat_opening
hook::remove open_chat_post_hook \
[namespace current]::restore_chat_context
variable contexts; unset contexts
}
proc singularity::process_new_chat_opening {chatid type} {
if {![string equal $type chat]} return
set from [chat::get_jid $chatid]
set barejid [::xmpp::jid::stripResource $from]
if {[chat::is_groupchat [chat::chatid \
[chat::get_xlib $chatid] $barejid]]} return
variable contexts
upvar 0 contexts(input,$chatid) savedinput
upvar 0 contexts(history,$chatid) savedhistory
variable [namespace parent]::history
set savedinput ""
set savedhistory [list {}]
foreach cid [chat::opened] {
set jid [chat::get_jid $cid]
if {![::xmpp::jid::equal $from $jid] &&
[::xmpp::jid::equal $barejid [::xmpp::jid::stripResource $jid]]} {
if {$savedinput != ""} { append savedinput \n }
append savedinput [[chat::input_win $cid] get 1.0 end-1c]
set savedhistory \
[concat $savedhistory [lrange $history(stack,$cid) 1 end]]
chat::close $cid
}
}
}
proc singularity::restore_chat_context {chatid type} {
if {![string equal $type chat]} return
variable contexts
upvar 0 contexts(input,$chatid) savedinput
upvar 0 contexts(history,$chatid) savedhistory
if {![info exists savedinput]} return
variable [namespace parent]::history
[chat::input_win $chatid] insert end $savedinput
set history(stack,$chatid) $savedhistory
set history(pos,$chatid) 0
unset savedinput savedhistory
}
# vim:ts=8:sw=4:sts=4:et
|
