Xchat has a tcl-plugin and here is a place to discuss and share tcl scripts for xchat. 

----

Sharing a script structure that can be used with xchat, it has examples of simple hotkeys and locking the input box requiring a password.
-Pelle Otterholm

In this example the only .tcl file in ~/.xchat2 is main.tcl , the rest of the scripts
are in subdirectories of ~/.xchat2/scripts and are sourced by main.tcl.


''~/.xchat2/main.tcl file (linux) :''
======
# Added test case so paths can be set for windows to.
if {[string match Linux $tcl_platform(os)]} {
    set xchatdir ~/.xchat2
} else {
    set xchatdir [string map {\\ /} "$env(APPDATA)/X-Chat\ 2"]
}

# Helper array for proper paths/dirs , we dont want to edit every script if we change directories files would live in.
array set location [list main $xchatdir/main.tcl scripts $xchatdir/scripts data $xchatdir/scripts/data tools $xchatdir/scripts/tools]
# which scripts do we want to run ? this is the name of the files.
set tools { tools trigger }

proc initialize {type} {
    upvar 1 [namespace current]::$type t
    foreach file $t {
        if $::verbose { puts "sourcing $file" }
        uplevel #0 source $::location($type)/$file
    }
}

initialize tools
======

''~/.xchat2/scripts/tools/tools file (linux) :''
======
namespace eval ::tools {
    # usage string function for aliases
    proc a_usage {name text} {
        uplevel [list puts "Usage: /$name $text"]
    }

    variable weekday
    array set weekday { 1 Monday 2 Tuesday 3 Wednesday 4 Thursday 5 Friday 6 Saturday 7 Sunday }
    proc weekday {num} {
        if {[info exists ::tools::weekday($num)]} {
            return $::tools::weekday($num)
        }
        puts "out of bounds, $num should be between 1 and 7"
    }

    proc selected_users {action {complement 0}} {
        foreach user [getlist users] {
            foreach {away host lasttalk nick prefix realname selected} $user { break }
            if {$complement == 0} {
                if {$selected == 1} { eval $action }
            } else {
                if {$selected == 0} { eval $action }
            }
        }
    }

    proc randomstring {digits} {
        set chars [split 0123456789aAbBcCdDeEfFgGhHiIjJkKlLmMoOpPqQrRsStTuUvVwWxXyYzZ!\"#¤%&/()=?\\<>,\;.:-_ ""]
        set length [llength $chars]
        set i 0
        while {$digits > $i} {
            append rstring [lindex $chars [expr int($length*rand())]]
            incr i
        }
        return $rstring
    }

    proc stripcolor {intext} {return [regsub -all -- {\003[0-9][0-9]?(,)?[0-9]?[0-9]?|^[\[[0-9][0-9]?((;)[0-9][0-9]?)*m} $intext {}] }
    proc splitsrc {} { uplevel 1 "scan \$_src \"%\\\[^!\\\]!%\\\[^@\\\]@%s\" _nick _ident _host" }

    # Procedure to generate arrays of config data etc
    proc generate {name file} {
        upvar $name n
        set fd [open $file r]
        while {![eof $fd]} {
            gets $fd data
            if {[is_comment $data]} { continue }
            set n([lindex $data 0]) [lrange $data 1 end]
        }
        close $fd
    }

    proc unixtime {} { return "[clock seconds]" }
    proc privmsg { dest text } { raw "PRIVMSG $dest :$text" }
    proc notice { dest text } { raw "NOTICE $dest :$text" }
    proc action { dest text } { raw "PRIVMSG $dest :\001ACTION $text\001" }
    proc ctcp { dest text } { raw "PRIVMSG $dest :\001$text\001" }
    proc ctcr { dest text } { raw "NOTICE $dest :\001$text\001" }
    proc joinchan { channel {key {}} } { raw "JOIN $channel :$key" }
    proc partchan { channel text } { raw "PART $channel :$text" }
    proc mode { args } { raw "MODE [join $args " "]" }
    proc quit { text } { raw "QUIT :$text" }
    proc op { channel nicks } { raw "MODE $channel +[string repeat o [llength $nicks]] $nicks" }
    proc deop { channel nicks } { raw "MODE $channel -[string repeat o [llength $nicks]] $nicks" }
    proc voice { channel nicks } { raw "MODE $channel +[string repeat v [llength $nicks]] $nicks" }
    proc unvoice { channel nicks } { raw "MODE $channel -[string repeat v [llength $nicks]] $nicks" }
    proc ban { channel nicks } { command "/ban $nicks" }
    proc unban { channel hosts } { raw "MODE $channel :-[string repeat b [llength $hosts]] $hosts" }
    proc is_ip_addr { addr } { return [regexp {([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)} $addr] }

    proc longip { ip } {
        global tcl_precision
        set tcl_precision 17
        set result 0
        regexp {([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)} $ip s b3 b2 b1 b0
        if { ![string compare $ip $s] } {
            set total 0
            set total [expr $total + double($b3) * pow(256,3)]
            set total [expr $total + double($b2) * pow(256,2)]
            set total [expr $total + double($b1) * pow(256,1)]
            set total [expr $total + double($b0) * pow(256,0)]
            set result [format "%10.0f" $total]
        }
        return $result
    }

    proc mask { type mask } {
        set n "*"
        set u "*"
        set a "*"
        scan $mask "%\[^!\]!%\[^@\]@%s" n u a
        set n [string trimleft $n "@+"]
        set u [string trimleft $u "~"]
        set h $a
        set d ""
        if { [is_ip_addr $a] } {
            set a [split $a .]
            set a [lreplace $a end end *]
        } else {
            set a [split $a .]
            if { [llength $a] > 2 } { set a [lreplace $a 0 0 *] }
        }
        set d [join $a .]
        switch "$type" {
            "0" { return "*!$u@$h" }
            "1" { return "*!*$u@$h" }
            "2" { return "*!*@$h" }
            "3" { return "*!*$u@$d" }
            "4" { return "*!*@$d" }
            "5" { return "$n!$u@$h" }
            "6" { return "$n!*$u@$h" }
            "7" { return "$n!*@$h" }
            "8" { return "$n!*$u@$d" }
            "9" { return "$n!*@$d" }
        }
        return "$n!$u@$h"
    }

    # Toggle function, if variable does not exists
    # the function creates the variable and set it
    # to off. If the variable is set to anything
    # different to 0, the function sets it to 1.
    proc toggle {name {level "\#0"}} {
        if {[uplevel $level info exists $name]} {
            upvar $level $name n
            if {[string match $n 1]} {
                puts "$name off"
                set n 0
            } else {
                puts "$name on"
                set n 1
            }
            return
        } else {
            upvar $level $name n
            puts "$name created, set to off"
            set n 0
        }
    }

}

##################################
# aliases bound to the tool procs

alias randomstring {
    set rest [split $_rest " "]
    if {[llength $rest] < 2} {
        a_usage $_cmd "<channel> <length>"
        complete
    }
    /msg [lindex $rest 0] [randomstring [lindex $rest 1]]
    complete
}

alias unixtime {
    puts unixtime
    complete
}
======



****Hotkey trigger functionality****
''~/xchat2/scripts/tools/trigger file (linux) :''
======
namespace eval ::tools::trigger {
    variable toggle
    variable verbose
    variable context
    ::tools::toggle ::tools::trigger::verbose
    proc context {{context main}} {
        set ::tools::trigger::context $context
    }
    context
    proc check {input} {
        foreach {foo num state boolascii} $input { break }
        if $::tools::trigger::verbose { puts "$num pressed ( $input )" }
        if {[info exists ::tools::trigger::trigger($::tools::trigger::context,$num)]} {
            eval $::tools::trigger::trigger($::tools::trigger::context,$num)
            return 1
        }
        return 0
    }
    proc hotkey {key name body} {
        set ::tools::trigger::trigger($::tools::trigger::context,$key) $name
        proc $name {} $body
    }
    proc triggers {} {
        if {![info exists ::tools::trigger::trigger]} {
            puts "No triggers found"
            return
        }
        foreach key [array names ::tools::trigger::trigger] {
            lappend result "$::tools::trigger::trigger($key) [lindex [split $key ","] 0]"
        }
        puts $result
    }
}

# source the scripts defining the hotkeys
source $location(scripts)/triggers/main
source $location(scripts)/triggers/inputlock
======


****Example of main context definitions****
''~/xchat2/scripts/triggers/main file (linux) :''
======
# Make hotkey for F2 that toggles verbosity
tools::trigger::hotkey 65471 F2 { ::tools::toggle ::tools::trigger::verbose }
# Make hotkey for F3 that join #tcl channel
tools::trigger::hotkey 65472 F3 { /join #tcl }
tools::trigger::hotkey 65474 F5 { /msg #tcl hello }
======


****Lock the inputbox****
''~/xchat2/scripts/triggers/inputlock file (linux) :''
======
namespace eval ::tools::inputlock {
    variable password

    proc unlock {} { ::tools::trigger::context }
    proc lock {} { ::tools::trigger::context inputlock }

    proc set_pass {{pw unlock}} {
        if {[string match "" $pw]} {
            set ::tools::inputlock::password unlock
            return
        }
        set ::tools::inputlock::password $pw
    }

    proc check_pass {str} {
        if {[string match $::tools::inputlock::password $str]} {
            return 1
        } else {
            return 0
        }
    }

    proc locked {} {
        ::tools::inputlock::lock
        /settext "Enter password : "
        /setcursor [string length [inputbox]]
        ::tools::trigger::hotkey 65293 ENTER {
            set input [string trimleft [lindex [split [inputbox] ":"] 1]]
            if {[::tools::inputlock::check_pass $input] } {
                /settext ""
                ::tools::inputlock::unlock
            } else {
                /settext ""
                after 0 {
                    /settext "Enter password : "
                    /setcursor [string length [inputbox]]
                }
            }
            complete EAT_ALL
        }
    }
}


alias lock {
    ::tools::inputlock::set_pass $_rest
    ::tools::inputlock::locked
    complete
}
======


----

<<categories>>Enter Category Here