plugins/chat/muc_ignore.tcl

# $Id$
# Support for ignoring occupant activity in MUC rooms.
#
# A note on runtime ruleset format:
# * A hash is used to hold ignore rules at runtime; each key
#   uniquely refers to its related "xlib, room, occupant,
#   message type" tuple; the existence of a key is used to
#   determine the fact of some type of a room occupant messages
#   being ignored.
# * The format of the ruleset keys is as follows:
#   SESSION_JID NUL ROOM_JID/OCCUPANT NUL TYPE
#   where:
#   * NUL means character with code 0 (\u0000 in Tcl lingo).
#     It is used since ASCII NUL is prohibited in JIDs;
#   * SESSION_JID is the bare JID of a particular connection of
#     the Tkabber user (support for multiaccounting);
#   * ROOM_JID is the room bare JID;
#   * OCCUPANT is either an occupant's room nick OR her full
#     bare JID, if it's available;
#   * TYPE is either "chat" or "groupchat", literally, which determines
#     the type of messages to ignore.

namespace eval mucignore {
    variable options

    variable ignored

    variable tid 0
    variable tags

    variable menustate

    # Cutsomize section:

    custom::defvar stored_rules {} \
	"Stored MUC ignore rules" \
	-group Hidden \
	-type string

    hook::add post_custom_restore [namespace current]::restore_rules

    custom::defgroup {MUC Ignoring} \
	[::msgcat::mc "Ignoring groupchat and chat messages\
		       from selected occupants of multi-user conference\
		       rooms."] \
	-group Privacy \
	-group Chat

    custom::defvar options(transient_rules) 0 \
	[::msgcat::mc "When set, all changes to the ignore rules are\
		       applied only until Tkabber is closed\;\
		       they are not saved and thus will be not restored at\
		       the next run."] \
	-group {MUC Ignoring} \
	-type boolean

    # Event handlers:

    # Handlers for creating various menus:
    hook::add chat_create_conference_menu_hook \
	[namespace current]::setup_muc_menu
    hook::add chat_create_user_menu_hook \
	[namespace current]::setup_private_muc_chat_menu
    hook::add roster_create_groupchat_user_menu_hook \
	[namespace current]::setup_occupant_menu
    hook::add finload_hook \
	[namespace current]::on_init

    # Block private MUC messages:
    hook::add process_message_hook \
	[namespace current]::process_message

    # Weed out MUC room messages upon entering a room:
    hook::add open_chat_post_hook \
	[namespace current]::sanitize_muc_display

    # Catch presence of ignored users.
    # NOTE: the order of this handler must be higher than
    # that of ::muc::process_presence (which is the default of 50)
    # since that handler extracts and stores the room occupant's
    # real JID in the non-anonymous rooms.
    hook::add client_presence_hook \
	[namespace current]::catch_junkie_presence 55

    # Adjust ignore rules on nick renames.
    # NOTE: this hook must be run earlier than client_presence_hook.
    hook::add room_nickname_changed_hook \
	[namespace current]::trace_room_nick_change

    hook::add generate_completions_hook \
	[namespace current]::add_completions

    hook::add chat_send_message_hook \
	[namespace current]::handle_commands
}

# "Ignore tags" are used to mark whole messages posted in the room
# by an ignored occupant. Their names are autogenerated and unique
# throughout one Tkabber run. Each tag is bound to one particular
# "room JID" of the ignored occupant. Ignore tags may be rebound
# to another room JID when these change (on nickname changes).

# Creates the ignore tag for a particular "room JID".
# If matching tag exists, this proc does nothing, silently.
# This provides for ignore tag "persistence".
proc mucignore::ignore_tag_create {roomjid} {
    variable tid
    variable tags

    if {[info exists tags($roomjid)]} return

    set tags($roomjid) IGNORED-$tid
    incr tid
}

proc mucignore::ignore_tag_get {roomjid} {
    variable tags

    set tags($roomjid)
}

proc mucignore::ignore_tag_rebind {from to} {
    variable tags

    set tags($to) $tags($from)
    unset tags($from)
}

proc mucignore::ignore_tag_forget {roomjid} {
    variable tags

    unset tags($roomjid)
}

# Returns bare JID of the session identified by $xlib
proc mucignore::session_bare_jid {xlib} {
    ::::xmpp::jid::stripResource [connection_jid $xlib]
}

# Tries to get the real bare JID of the room occupant identified
# by the $room_occupant_jid; returns that JID if it's available,
# empty string otherwise.
proc mucignore::get_real_bare_jid {xlib room_occupant_jid} {
    set real_jid [::muc::get_real_jid $xlib $room_occupant_jid]
    if {$real_jid != {}} {
	return [::::xmpp::jid::stripResource $real_jid]
    } else {
	return {}
    }
}

# Creates an ignore rule suitable for using as a key to a hash of rules.
# Expects:
# * entity -- session's bare JID;
# * jid -- JID to ignore ("room/nick" or "room/real_bare_jid");
# * type -- type of chat to ignore ("groupchat" or "chat").
# These parts are joined using the NUL character (since its appearance
# is prohibited in any part of a JID) and so the rule can be reliably
# split back into parts.
# See also: [split_rule].
proc mucignore::mkrulekey {entity jid type} {
    join [list $entity $jid $type] \u0000
}

# Creates an ignore rule suitable for using as a key to a hash of rules.
# The $xlib parameter is converted to the session's bare JID first.
# It's just a convenient wrapper around [mkrulekey].
proc mucignore::mkrule {xlib jid type} {
    mkrulekey [session_bare_jid $xlib] $jid $type
}

# Splits given rule into the list of [entity jid type], where:
# * entity -- is a bare JID of the user's session;
# * jid -- is a JID to be ignored (usually a full room JID);
# * type -- one of: "groupchat" or "chat", designating the type of messages
#   originating from jid to be ignored.
# This proc reverses what [mkrulekey] does.
proc mucignore::split_rule {rule} {
    split $rule \u0000
}

proc mucignore::setup_muc_menu {m xlib jid} {
    # TODO
    return
    $m add command \
	-label [::msgcat::mc "Edit MUC ignore rules"] \
	-command [list [namespace current]::editor::open $xlib $jid]
}

proc mucignore::on_init {} {
    # TODO
    return
    set menu [.mainframe getmenu plugins]
    $menu add command -label [::msgcat::mc "Edit MUC ignore rules"] \
        -command [list [namespace current]::editor::open {} {}]
}

proc mucignore::setup_private_muc_chat_menu {m xlib jid} {
    set room [::::xmpp::jid::stripResource $jid]
    if {![::chat::is_groupchat [::chat::chatid $xlib $room]]} return

    setup_occupant_menu $m $xlib $jid
}

# Prepares two global variables mirroring the current state of
# ignoring for the room occupant on which groupchat roster nick
# the menu is being created. They are used to represent
# ignore state checkbutton menu entries.
proc mucignore::setup_occupant_menu {m xlib jid} {
    variable ignored
    variable menustate

    set our_nick [::get_our_groupchat_nick [
	::chat::chatid $xlib [
	    ::::xmpp::jid::stripResource $jid]]]
    set nick [::chat::get_nick $xlib $jid groupchat]

    if {$nick == $our_nick} {
	# don't allow to ignore ourselves
	set state disabled
    } else {
	set state normal
    }

    foreach type {groupchat chat} {
	set menustate($xlib,$jid,$type) [
	    info exists ignored([mkrule $xlib $jid $type])]
    }

    set sm [menu $m.mucignore -tearoff 0]
    $m add cascade -menu $sm \
	-state $state \
	-label [::msgcat::mc "Ignore"]

    $sm add checkbutton -label [::msgcat::mc "Ignore groupchat messages"] \
	-variable [namespace current]::menustate($xlib,$jid,groupchat) \
	-command [list [namespace current]::menu_toggle_ignoring \
		       $xlib $jid groupchat]
    $sm add checkbutton -label [::msgcat::mc "Ignore chat messages"] \
	-variable [namespace current]::menustate($xlib,$jid,chat) \
	-command [list [namespace current]::menu_toggle_ignoring \
		       $xlib $jid chat]

    bind $m <Destroy> +[double% [list \
	[namespace current]::menu_cleanup_state $xlib $jid]]
}

proc mucignore::menu_toggle_ignoring {xlib jid type} {
    variable menustate

    if {$menustate($xlib,$jid,$type)} {
	occupant_ignore $xlib $jid $type
    } else {
	occupant_attend $xlib $jid $type
    }
}

proc mucignore::menu_cleanup_state {xlib jid} {
    variable menustate

    array unset menustate $xlib,$jid,*
}

# Ignores specified room occupant:
# * Creates an ignore rule for her;
# * Creates an ignore tag, if needed;
# * Hides messages tagged with that tag, if any;
# * Builds and saves current ruleset to the Customize db.
proc mucignore::occupant_ignore {xlib jid args} {
    variable options
    variable ignored

    foreach type $args {
	set ignored([mkrule $xlib $jid $type]) true

	if {$type == "groupchat"} {
	    ignore_tag_create $jid
	    room_weed_messages $xlib $jid true
	}
    }

    if {!$options(transient_rules)} {
	store_rules $xlib
    }
}

# Un-ignores specified room occupant:
# * Removes her ignore rules;
# * Shows any hidden messages from her;
# * Ignore tag is NOT removed to provide for "quick picking"
#   into what the ignored occupant have had written so far --
#   when she is ignored again, all her messages tagged with
#   the appropriate ignore tag are again hidden.
# * Builds and saves current ruleset to the Customize db.
proc mucignore::occupant_attend {xlib jid args} {
    variable options
    variable ignored

    foreach type $args {
	set rule [mkrule $xlib $jid $type]
	if {[info exists ignored($rule)]} {
	    unset ignored($rule)
	    if {$type == "groupchat"} {
		room_weed_messages $xlib $jid false
		# we don't use [ignore_tag_forget] here
		# so when we switch ignoring back on,
		# all already marked messagess will be weed out
	    }
	}
    }

    if {!$options(transient_rules)} {
	store_rules $xlib
    }
}

# Hides or shows messages tagged as ignored for the $jid, if any.
proc mucignore::room_weed_messages {xlib jid hide} {
    set room [::::xmpp::jid::stripResource $jid]
    set cw [::chat::chat_win [::chat::chatid $xlib $room]]

    $cw tag configure [ignore_tag_get $jid] -elide $hide
}

# This handler blocks further processing of the private room message
# if its sender is blacklisted.
# If the message is groupchat and its sender is blacklisted, it sets
# the appropriate message property so that other message handlers
# could treat such message in some special way.
proc mucignore::process_message {xlib from id type args} {
    variable ignored

    if {$type == "chat" && \
	[info exists ignored([mkrule $xlib $from chat])]} {
	return stop
    }
}

proc mucignore::is_ignored {xlib jid type} {
    variable ignored

    if {[info exists ignored([mkrule $xlib $jid $type])]} {
	return [ignore_tag_get $jid]
    } else {
	return ""
    }
}

# This handler is being run after opening the chat window.
# It searches the ignore rules for JIDs matching the JID of the room,
# extracts them from the rules and weeds out their messages from
# the room display (chatlog).
# NOTE that it gets executed before any presences arrive from the room
# occupants, so the whole idea is to weed out messages with known (ignored)
# nicks.
proc mucignore::sanitize_muc_display {chatid type} {
    variable ignored

    if {$type != "groupchat"} return

    set xlib [::chat::get_xlib $chatid]
    set jid [::chat::get_jid $chatid]

    foreach rule [array names ignored [mkrule $xlib $jid/* groupchat]] {
	set junkie [lindex [split_rule $rule] 1]
	# TODO handle "real JIDs" case...
	ignore_tag_create $junkie
	room_weed_messages $xlib $junkie true
    }
}

# This handler is being run after the room_nickname_changed_hook
# (which takes care of renaming the ignore list entries).
# This proc serves two purposes:
# * It converts rules from real JIDs and room JIDs and back
#   so that room JIDs are used for rule matching and real JIDs
#   are stored, if they are available, between sessions.
# * It arranges for chat log display to be prepared to weed out
#   messages from ignored JIDs.

# TODO why does real JID is available when this handler is run with
#      $type == "unavailable". memory leak in chats.tcl?
# TODO use chat_user_enter/chat_user_exit instead?
proc mucignore::catch_junkie_presence {xlib from pres args} {
    variable options
    variable ignored

    set room [::::xmpp::jid::stripResource $from]
    set rjid [get_real_bare_jid $xlib $from]

    if {$pres == "available"} {
	debugmsg mucignore "avail: $from; real jid: $rjid"
	foreach type {groupchat chat} {
	    if {$rjid != {} && \
		[info exists ignored([mkrule $xlib $room/$rjid $type])]} {
		rename_rule_jid $xlib $room/$rjid $from $type
	    }
	}

	if {[info exists ignored([mkrule $xlib $from groupchat])]} {
	    ignore_tag_create $from
	    room_weed_messages $xlib $from true
	}
    } elseif {$pres == "unavailable"} {
	debugmsg mucignore "unavail: $from; real jid: $rjid"
	if {[info exists ignored([mkrule $xlib $from groupchat])]} {
	    ignore_tag_forget $from
	}

	foreach type {groupchat chat} {
	    if {$rjid != {} && \
		[info exists ignored([mkrule $xlib $from $type])]} {
		rename_rule_jid $xlib $from $room/$rjid $type
	    }
	}
    }
}

proc mucignore::trace_room_nick_change {chatid oldnick newnick} {
    variable ignored

    set xlib [chat::get_xlib $chatid]
    set room [chat::get_jid $chatid]
    foreach type {groupchat chat} {
	if {[info exists ignored([mkrule $xlib $room/$oldnick $type])]} {
	    rename_rule_jid $xlib $room/$oldnick $room/$newnick $type

	    if {$type == "groupchat"} {
		ignore_tag_rebind $room/$oldnick $room/$newnick
	    }
	}
    }
}

proc mucignore::rename_rule_jid {xlib from to type} {
    variable ignored

    set oldrule [mkrule $xlib $from $type]
    set newrule [mkrule $xlib $to $type]

    set ignored($newrule) [set ignored($oldrule)]
    unset ignored($oldrule)

    debugmsg mucignore "rule renamed:\
	[string map {\u0000 |} $oldrule]\
	[string map {\u0000 |} $newrule]"
}

proc mucignore::explode_room_jid {xlib room_occupant_jid vroom voccupant} {
    upvar 1 $vroom room $voccupant occupant

    set room [::::xmpp::jid::stripResource $room_occupant_jid]

    set occupant [get_real_bare_jid $xlib $room_occupant_jid]
    if {$occupant == {}} {
	set occupant [::::xmpp::jid::resource $room_occupant_jid]
    }
}

# Parses the runtime hash of ignore rules, makes up the hierarchical list
# (a tree) of ignore rules, resolving the room JIDs to real JIDs,
# if possible, then saves the list to the corresponding Customize variable.
# The list has the form:
# * session_bare_jid_1
#   * room_bare_jid_1
#     * occupant_1 (nick or real_jid)
#       * "groupchat" or "chat" or both
# ...and so on
proc mucignore::store_rules {xlib} {
    variable ignored
    variable stored_rules

    array set entities {}

    foreach rule [array names ignored] {
	lassign [split_rule $rule] entity jid type

	explode_room_jid $xlib $jid room occupant

	set entities($entity) 1

	set rooms rooms_$entity
	if {![info exists $rooms]} {
	    array set $rooms {}
	}
	set [set rooms]($room) 1

	set occupants occupants_$entity$room
	if {![info exists $occupants]} {
	    array set $occupants {}
	}

	lappend [set occupants]($occupant) $type
    }

    set LE {}
    foreach entity [array names entities] {
	set LR {}
	foreach room [array names rooms_$entity] {
	    set LO {}
	    set occupants occupants_$entity$room
	    foreach occupant [array names $occupants] {
		lappend LO $occupant [set [set occupants]($occupant)]
	    }

	    lappend LR $room $LO
	}

	lappend LE $entity $LR
    }

    set stored_rules [list 1.0 $LE] ;# also record "ruleset syntax" version

    debugmsg mucignore "STORED: $LE"
}

proc mucignore::restore_rules {args} {
    variable ignored
    variable stored_rules

    array set ignored {}

    set failed [catch {
	lassign $stored_rules version ruleset
	array set entities $ruleset
	foreach entity [array names entities] {
	    array set rooms $entities($entity)
	    foreach room [array names rooms] {
		array set occupants $rooms($room)
		foreach occupant [array names occupants] {
		    foreach type $occupants($occupant) {
			set ignored([mkrulekey $entity $room/$occupant $type]) true
		    }
		}
		array unset occupants
	    }
	    array unset rooms
	}
    } err]

    if {$failed} {
	global errorInfo
	set bt $errorInfo

	set stored_rules {}

	after idle [list error \
	    [::msgcat::mc "Error loading MUC ignore rules, purged."] $bt]
    }

    debugmsg mucignore "RESTORED: [string map {\u0000 |} [array names ignored]]"
}

proc mucignore::add_completions {chatid compsvar wordstart line} {
    upvar 0 $compsvar comps
    lappend comps "/ignore " "/unignore "
}

proc mucignore::handle_commands {chatid user body type} {
    set xlib [chat::get_xlib $chatid]

    if {[string equal -length 8 $body "/ignore "]} {
	set nick [string range $body 8 end]
	set jid [chat::get_jid $chatid]/$nick
	occupant_ignore $xlib $jid $type

	set msg [::msgcat::mc "%s was ignored" $nick]
	::chat::add_message $chatid "" chat $msg {}

	return stop
    }
    if {[string equal -length 10 $body "/unignore "]} {
	set nick [string range $body 10 end]
	set jid [chat::get_jid $chatid]/$nick
	occupant_attend $xlib $jid $type

	set msg [::msgcat::mc "%s was unignored" $nick]
	::chat::add_message $chatid "" chat $msg {}

	return stop
    }
}

########################################################################
# MUC Ignore ruleset editor
########################################################################

namespace eval mucignore::editor {}

# ...
# NOTE that both $xlib and $jid may be empty at the time of invocation.
proc mucignore::editor::open {xlib jid} {
    set w .mucignore_rules_editor
    if {[winfo exists $w]} {
	return
    }

    add_win $w -title [::msgcat::mc "MUC Ignore Rules"] \
	-tabtitle [::msgcat::mc "MUC Ignore"] \
	-class MUCIgnoreRulesetEditor \
	-raise 1
	#-raisecmd "focus [list $w.input]"

    set sw [ScrolledWindow $w.sw -auto both]
    set t [Tree $w.tree -background [$w cget -background]]
    $sw setwidget $t

    bind $sw <Destroy> [list [namespace current]::cleanup [double% $w]]

    pack $sw -fill both -expand true

    # NOTE that BWidget Tree doesn't aceept keyboard bindings.

    $t bindText <Double-ButtonPress-1> [list %W toggle]
    bind $w <KeyPress-Return> [list [namespace current]::tree_toggle [double% $t]]

    bind $w <KeyPress-F2> [list [namespace current]::tree_edit_item [double% $t]]
    bind $w <Any-KeyPress-Insert> [list [namespace current]::tree_insert_item [double% $t]]
    bind $w <Any-KeyPress-Delete> [list [namespace current]::tree_insert_item [double% $t]]
}

proc mucignore::editor::cleanup {w} {
    # TODO do appropriate cleanup...
}

proc mucignore::editor::tree_toggle {t} {
    set node [lindex [$t selection get] 0]
    if {$node != {}} {
	$t toggle $node
    }
}

proc mucignore::editor::tree_edit_item {t} {
    set node [lindex [$t selection get] 0]
    if {$node == {}} return

    set text [$t itemcget $node -text]

    $t edit $node $text
}

proc mucignore::editor::tree_insert_item {t} {
    set parent [lindex [$t selection get] 0]

    if {$parent == {}} {
	set parent root
    }

    # TODO implement
    #add_nodes $t $parent {New {}}
}

# vim:ts=8:sw=4:sts=4:noet