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} { 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 {} { 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 } { 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
}~/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~/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 }~/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
}