#! /bin/sh # \ exec wish8.3 "$0" "$@" ############################################################################# # # # Copyright (C) 1996-2001 Andreas Gelhausen # # # # This program is free software; you can redistribute it and/or modify # # it under the terms of the GNU General Public License as published by # # the Free Software Foundation; either version 2 of the License, or # # (at your option) any later version. # # # # This program is distributed in the hope that it will be useful, # # but WITHOUT ANY WARRANTY; without even the implied warranty of # # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # # GNU General Public License for more details. # # # # You should have received a copy of the GNU General Public License along # # with this program; if not, write to the Free Software Foundation, Inc., # # 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA # # # ############################################################################# global tkirc_version date set tkirc_version "2.46" set date "2001-07-21" set print_debug 0 ############################################################################# # # Sofern es nicht bereits vorhanden ist, wird das Verzeichnis ~/.tkirc2/ # mit dem erforderlichen Inhalt angelegt. if {[catch {file mkdir "~/.tkirc2/.data/"} err]} { puts stderr "$err" exit } if {[catch {file mkdir "~/.tkirc2/autoload/"} err]} { puts stderr "$err" exit } ############################################################################# # # Die Default-Pfade werden hier festgelegt. Bei Veränderungen durch den # Benutzer werden sie während einer Sitzung ggf. angepaßt. Diese Pfade # werden nur beachtet, wenn sie deklariert worden sind. Dementsprechend # sollten sie auch im tkircrc gesetzt werden. #set path(logs) "~/.tkirc2/" set path(preferences) "~/.tkirc2/" #set path(save_article) "~/" #set path(save_buffer) "~/" #set path(save_msgids) "~/" #set path(save_urls) "~/" #set path(dcc_get) "~/" #set path(dcc_send) "~/" ############################################################################# # # Dieser Abschnitt befaßt sich mit den über "Save preferences" # abspeicherbaren Einstellungen von tkirc. set style(options) { normal bold special url msgid search underline reverse } global color set color(options) { -foreground -background -activebackground -highlightcolor -highlightbackground -insertbackground -selectforeground -selectbackground } set color(defaultvalues) { "#000000" "#d9d9d9" "#ececec" "#000000" "#d9d9d9" "#000000" "#000000" "#c3c3c3" } set color(ansi) "mono" # ANSI-colors: # black, red, green, yellow, # blue, magenta, cyan, white set color(ansivalues) { "#000000" "#DD0000" "#00DD00" "#DDDD00" "#0000DD" "#C000C0" "#00C0C0" "#FFFFFF" } set color(mirc) "mono" # mIRC-colors: # white, black, dark blue, green, # red, brown, purple, orange, # yellow, light green, cyan, light blue, # blue, lavendar, gray, light gray set color(mircvalues) { "#FFFFFF" "#000000" "#0000A0" "#00C000" "#DD0000" "#580000" "#C000C0" "#FFA500" "#DDDD00" "#80DD80" "#008080" "#00C0FF" "#0060D0" "#6000DD" "#808080" "#C0C0C0" } set font(_Button_) "Helvetica -12 bold" set font(_Checkbutton_) "Helvetica -12 bold" set font(_Entry_) "Helvetica -12" set font(_Label_) "Helvetica -12 bold" set font(_Listbox_) "Helvetica -12 bold" set font(_Menu_) "Helvetica -12 bold" set font(_Menubutton_) "Helvetica -12 bold" set font(_Radiobutton_) "Helvetica -12 bold" set font(_Text_) "Courier -12" set prefs(globalvars) { beep_on_private_when_present beep_on_private_when_away beep_on_public_when_present beep_on_public_when_away beep_on_invite_when_present beep_on_invite_when_away beep_on_ctrlG_when_present beep_on_ctrlG_when_away show_address_on_message_when_present show_address_on_message_when_away show_address_on_message_in_logfile show_address_on_notice_when_present show_address_on_notice_when_away show_address_on_notice_in_logfile show_time_on_private_when_present show_time_on_private_when_away show_time_on_public_when_present show_time_on_public_when_away chat_window_on_message_when_present chat_window_on_message_when_away chat_window_on_notice_when_present chat_window_on_notice_when_away request_on_dcc_chat request_on_dcc_send request_on_invite request_on_kick crap_to_active_window messages_to_active_window silence } set prefs(defaultvalues) { 1 1 0 0 0 0 1 1 0 1 0 0 1 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 } set prefs(windowvars) { show_time_on_each_line hide_joins hide_leaves hide_signoffs show_commandline show_topic show_userlist use_margin display_types sort_userlist_alphabeticly sort_userlist_by_channelmodes auto_popup margin_size } proc setColor {w options color} { if {"$color" == ""} { return } foreach option $options { catch { $w config $option $color } } foreach child [winfo children $w] { setColor $child $options $color } } proc getColor {w option} { if [catch {$w cget $option} value] { foreach child [winfo children $w] { set value "[getColor $child $option]" if {"$value" != ""} { return "$value" } } set value "" } return "$value" } proc chooseColor {name} { global color win set initialColor "[getColor . $name]" set farbe [tk_chooseColor -title "Choose color `$name'" -parent . \ -initialcolor $initialColor] if [string compare "$farbe" ""] { setColor . $name $farbe set color([string trimleft "$name" "-"]) $farbe } } proc setDefaultColors { } { global color win for {set i 0} {$i < [llength "$color(options)"]} {incr i} { set value "[lindex "$color(defaultvalues)" $i]" set option "[lindex "$color(options)" $i]" setColor . "$option" "$value" set color([string trimleft "$option" "-"]) "$value" } } proc setFont {w type font} { set class [winfo class $w] if [catch {font metrics "$font"} err] { return "$err" } if {[string compare "$class" "$type"] == 0} { $w configure -font "$font" } foreach child [winfo children $w] { setFont $child $type $font } } proc getFont {w type} { set class [winfo class $w] if {[string compare "$class" "$type"] == 0 \ && ![catch {$w cget -font} font]} { return "$font" } else { foreach child [winfo children $w] { set font "[getFont $child $type]" if {"$font" != ""} { return "$font" } } return "" } } proc chooseFont {class} { global font set font(selected:class) "$class" set tmp "[getFont . $class]" if {[llength "$tmp"] < 2} { set font(selected:name) "Helvetica" set font(selected:size) "12" set font(selected:bold) 0 set font(selected:italic) 0 } else { set font(selected:name) "[lindex "$tmp" 0]" set font(selected:size) "[string trimleft "[lindex "$tmp" 1]" "-"]" set font(selected:bold) [expr [lsearch "$tmp" "bold"]+1 > 0] set font(selected:italic) [expr [lsearch "$tmp" "italic"]+1 > 0] } set path ".font" if {[RequestLevel $path]} { grab $path wm title $path " Choose font '$class' " bind $path "grab release $path ; destroy $path" set body $path.body Frame $body -bd 1 -relief raised pack $body -side top -ipady 10 -fill x -expand true Frame $body.f1 -bd 0 pack $body.f1 -expand true -fill x Label $body.f1.label -bd 0 -text "Name:" pack $body.f1.label -padx 5 -side left eval tk_optionMenu $body.f1.name font(selected:name) [font families] pack $body.f1.name -padx 5 -side right -expand true -fill x bind $body.f1.name "displayFont" Frame $body.f2 -bd 0 pack $body.f2 -expand true -fill x Label $body.f2.label -bd 0 -text "Size: " pack $body.f2.label -padx 5 -side left Scale $body.f2.size1 -orient horizontal -from 1 -to 42 \ -command "displayFont size" -variable font(selected:size) -showvalue 0 pack $body.f2.size1 -side left -fill x -expand true bind $body.f2.size1 "displayFont" Label $body.f2.size2 -bd 0 -text "[format "%2s" "$font(selected:size)"]" pack $body.f2.size2 -padx 5 -side left Frame $body.f3 -bd 0 pack $body.f3 Checkbutton $body.f3.bold -variable font(selected:bold) \ -text "bold" -command displayFont pack $body.f3.bold -padx 10 -side left Checkbutton $body.f3.italic -variable font(selected:italic) \ -text "italic" -command displayFont pack $body.f3.italic -padx 10 -side left Frame $body.f4 -bd 1 -height 50 pack $body.f4 -expand true -fill both set tmp "\{$font(selected:name)\} -$font(selected:size)" Label $body.f4.example -font "$tmp" -relief sunken -text "AaZz 123" pack $body.f4.example -fill x -expand true set buttons $path.buttons Frame $buttons -bd 1 -relief raised pack $buttons -ipady 10 -side top -fill x Button $buttons.ok -text " OK " -command "displayFont ok" pack $buttons.ok -side left -padx 25 -fill x Button $buttons.cancel -text " Cancel " -command "displayFont cancel" pack $buttons.cancel -side right -padx 25 -fill x } } proc displayFont {args} { global font style win lappend thisfont "$font(selected:name)" "-$font(selected:size)" if {$font(selected:bold) != 0} { lappend thisfont "bold" } if {$font(selected:italic) != 0} { lappend thisfont "italic" } if {[lsearch -exact "$args" "cancel"] != -1} { grab release .font ; destroy .font } elseif {[lsearch -exact "$args" "ok"] != -1} { grab release .font ; destroy .font setFont . "$font(selected:class)" "$thisfont" set font([string tolower "$font(selected:class)"]) "$thisfont" if {[string compare "Text" "$font(selected:class)"] == 0} { set tmp "[getFont . Text]" if {"$tmp" != ""} { set style(normal) "-font \{$tmp\}" set style(bold) "-font \{$tmp bold\}" set style(italic) "-font \{$tmp italic\}" } foreach wnum "$win(list)" { InitStyles $wnum } } } elseif {[lsearch -exact "$args" "size"] != -1} { .font.body.f2.size2 configure -text "[format "%2s" "$font(selected:size)"]" } else { .font.body.f4.example configure -font "$thisfont" } } proc setDefaultFonts { } { global font foreach x "[array names font _*_]" { setFont . [string trim "$x" "_"] "$font($x)" set font([string tolower "[string trim "$x" "_"]"]) "$font($x)" } } proc setDefaults { } { global prefs win setDefaultColors setDefaultFonts setDefaultStyles for {set i 0} {$i < [llength "$prefs(globalvars)"]} {incr i} { global [lindex "$prefs(globalvars)" $i] set [lindex "$prefs(globalvars)" $i] [lindex "$prefs(defaultvalues)" $i] } foreach x "geometry $prefs(windowvars)" { global $x foreach y "[array names $x "*"]" { unset $x\($y) } } set geometry(lags) "234x45" set geometry(msgids) "499x123" set geometry(notified) "499x158" set geometry(suspected) "499x158" set geometry(urls) "499x123" foreach x "lags msgids notified suspected urls" { if {[winfo exists .$x]} { wm geometry .$x $geometry($x) } } foreach x "* $win(list)" { set geometry($x) "543x220" set hide_joins($x) 0 set hide_leaves($x) 0 set hide_signoffs($x) 0 set show_commandline($x) 1 set show_topic($x) 1 set show_userlist($x) 1 set use_margin($x) 1 set display_types($x) 1 set sort_userlist_alphabeticly($x) 0 set sort_userlist_by_channelmodes($x) 0 set auto_popup($x) 0 set margin_size($x) 70 set show_time_on_each_line($x) 0 } foreach x "$win(list)" { if {[winfo exists .win$x]} { wm geometry .win$x $geometry($x) } } } proc loadPrefs {num fromfile} { global margin path prefs win if {[string length "$fromfile"] == 0} { if [info exists path(preferences)] { catch {cd "$path(preferences)"} } FileRequest " Please select the file to load the \npreferences from!" "Load" "loadPrefs $num \:file" "" "preferences" 0 return } if [file exists "$fromfile"] { source "$fromfile" } else { set margin(text) "error" write2crap $win($num,irc) "*** File '$fromfile' does not exist" } } proc savePrefs {num tofile} { global irc margin path prefs win if {[string length "$tofile"] == 0} { if [info exists path(preferences)] { catch {cd "$path(preferences)"} } FileRequest " Please select the file to save the \npreferences in!" "Save" "savePrefs $num \:file" "" "preferences" 0 return } set file "[OpenFile "$tofile" w]" if {"$file" != ""} { puts $file "\n## global values" foreach x "$prefs(globalvars)" { global $x if [info exists $x] { puts $file "global $x ; set $x [set $x]" } } foreach x "geometry $prefs(windowvars)" { global $x if [info exists $x\(*)] { puts $file "global $x ; set $x\(*) [set $x\(*)]" } } puts $file "\n## on-procedures" puts $file "global on_tkircstart_prefs" puts $file "\n## colors" global color ; puts $file "global color" foreach x "$color(options)" { set y "[string trimleft "$x" "-"]" set color($y) "[getColor . "$x"]" puts $file "set color($y) \"[set color($y)]\"" } foreach x "ansi mirc" { puts $file "set color($x) \"[set color($x)]\"" } puts $file "\n## fonts" global font ; puts $file "global font" foreach x "[array names font _*_]" { set class "[string trim "$x" "_"]" set index "[string tolower "$class"]" set font($index) "[getFont . "$class"]" puts $file "set font($index) \"[set font($index)]\"" } puts $file "\n## values for windows" # Die Nummern der Fenster werden ggf. neu vergeben, falls # eine Fensternummer fehlt. set newwin 0 foreach oldwin "$win(list)" { if [IsFakeWindow $oldwin] { # Windows von Skripts werden nicht beachtet. continue } puts $file "# window $newwin" puts $file "set geometry($newwin) [wm geometry .win$oldwin]" foreach x "$prefs(windowvars)" { global $x if [info exists $x\($oldwin)] { puts $file "set $x\($newwin) [set $x\($oldwin)]" } } if {$win($oldwin,irc) == [lindex "$irc(list)" 0]} { if {$newwin > 0} { puts $file "append on_tkircstart_prefs \{send2tkirc 0 \{/newwin\};\}" } if {$oldwin == $irc([lindex "$irc(list)" 0],crap)} { puts $file "append on_tkircstart_prefs \{send2tkirc 0 \{/set crapwindow $newwin\};\}" } if {$oldwin == $irc([lindex "$irc(list)" 0],mesg)} { puts $file "append on_tkircstart_prefs \{send2tkirc 0 \{/set messagewindow $newwin\};\}" } } incr newwin } foreach x "lags msgids notified suspected urls" { puts $file "\n# window $x" if [winfo exists .$x] { puts $file "set geometry($x) [wm geometry .$x]" puts $file "append on_tkircstart_prefs \{send2tkirc 0 \{/$x\};\}" } elseif [info exists geometry($x)] { puts $file "set geometry($x) [set geometry($x)]" } } global irc foreach x "$irc(list)" { foreach y "lags" { puts $file "# window $y$x" if [winfo exists .$y$x] { puts $file "set geometry($y$x) [wm geometry .$y$x]" puts $file "append on_tkircstart_prefs \{send2tkirc 0 \{/$y\};\}" } elseif [info exists geometry_$y$x] { puts $file "set geometry($y$x) [set geometry($x$x)]" } } } close $file set margin(text) "note" write2crap $win($num,irc) "*** Preferences saved to file '$tofile'" } } ############################################################################# # # In dem folgenden Abschnitt werden die verschiedenen Textstyles generiert # bzw. bearbeitet. proc setDefaultStyles { } { global font style win set style(normal) "-font \{$font(text)\}" set style(bold) "-font \{$font(text) bold\}" set style(italic) "-font \{$font(text) italic\}" set style(reverse) "" set style(underline) "-underline on" set style(url) "-borderwidth 1 -relief raised" set style(msgid) "-borderwidth 1 -relief raised" set style(search) "-background #880000 -foreground white" foreach wnum "$win(list)" { InitStyles $wnum } } proc InitStyles {wnum} { global margin_size use_margin style user_styles win if {[IsFakeWindow $wnum] || [WindowDoesNotExist $wnum]} { return } set widget "[GetWindowPath $wnum].body.left.traffic.text" if {$use_margin($wnum) != 0} { eval $widget tag configure style(user:-1) $style(normal) -lmargin2 $margin_size($wnum) } else { eval $widget tag configure style(user:-1) $style(normal) -lmargin2 0 } for {set i 0} {$i < [llength "$user_styles"]} {incr i} { set entry "[lindex "$user_styles" $i]" if {$use_margin($wnum) != 0} { eval $widget tag configure style(user:$i) [lindex "$entry" 1] -lmargin2 $margin_size($wnum) } else { eval $widget tag configure style(user:$i) [lindex "$entry" 1] -lmargin2 0 } } } proc newStyle {wnum index text} { global margin_size style use_margin win set widget "[GetWindowPath $wnum].body.left.traffic.text" if {$use_margin($wnum) != 0} { eval $widget tag configure style($index) $text -lmargin2 $margin_size($wnum) set style($index) "$text -lmargin2 $margin_size($wnum)" } else { eval $widget tag configure style($index) $text -lmargin2 0 set style($index) "$text -lmargin2 0" } return "style($index)" } proc redrawMargin {wnum} { global margin_size use_margin style set widget "[GetWindowPath $wnum].body.left.traffic.text" foreach x "[$widget dump 1.0 end]" { if {$use_margin($wnum) != 0} { $widget tag configure $x -lmargin2 $margin_size($wnum) } else { $widget tag configure $x -lmargin2 0 } } if {$use_margin($wnum) != 0} { $widget configure -tabs "$margin_size($wnum) left" } else { $widget configure -tabs "0 left" } } ############################################################################# # # Hier wird ein neues Widget names "multilistbox" erstellt. # Syntax: multilistbox option name ?-notitles? ?arg arg ...? proc multilistbox {option path args} { global multilistbox foreach x "notitles" { set i [lsearch -exact "$args" "-$x"] set [set x] [expr $i+1] if {[set $x]} { set args "[lreplace "$args" $i $i]" } } switch -- "$option" { create { # multilistbox create $path -notitles [$title $width] [$title $width] ... set columns [llength "$args"] set multilistbox($path) $columns Frame $path -bd 2 -relief sunken Frame $path.frameb ; pack $path.frameb -side right -fill y Scrollbar $path.frameb.bar -width 10 -orient vertical \ -command "multilistbox yview $path" if {$notitles == 0} { Label $path.frameb.label -text " " pack $path.frameb.label } pack $path.frameb.bar -expand true -fill y for {set i 0} {$i < $columns} {incr i} { set title "[lindex "[lindex "$args" $i]" 0]" set width "[lindex "[lindex "$args" $i]" 1]" Frame $path.frame$i pack $path.frame$i -side left -expand true -fill both if {$notitles == 0} { Label $path.frame$i.label -text "$title" pack $path.frame$i.label } Listbox $path.frame$i.list -exportselection false -relief raised \ -yscrollcommand "multilistbox set $path $i {}" if {"$width" != ""} { $path.frame$i.list configure -width "$width" } pack $path.frame$i.list -padx 0 -ipadx 0 -side left -expand true \ -fill both foreach x "1 2 3" { bind $path.frame$i.list \ "multilistbox set $path $i %y" bind $path.frame$i.list \ "multilistbox set $path $i %y" bind $path.frame$i.list \ "multilistbox set $path $i %y" } } bind $path "global multilistbox ; unset multilistbox($path)" } set { # multilistbox set $path $x $y $args if {![winfo exists $path]} { return } set columns $multilistbox($path) set x "[lindex "$args" 0]" set y "[lindex "$args" 1]" set args "[lreplace "$args" 0 1]" if {"$y" != ""} { set selected "[$path.frame$x.list nearest $y]" } else { set selected "[$path.frame$x.list curselection]" } set yview "[lindex "[$path.frame$x.list yview]" 0]" for {set i 0} {$i < $columns} {incr i} { eval $path.frame$i.list yview moveto $yview eval $path.frame$i.list selection clear 0 end foreach z "$selected" { eval $path.frame$i.list selection set $z } } if {"$args" != ""} { eval $path.frameb.bar set $args } } yview { # multilistbox yview $path $y if {![winfo exists $path]} { return } set columns $multilistbox($path) for {set i 0} {$i < $columns} {incr i} { eval $path.frame$i.list yview $args } } delete { # multilistbox delete $path $args if {![winfo exists $path]} { return } set columns $multilistbox($path) for {set i 0} {$i < $columns} {incr i} { eval $path.frame$i.list delete $args } } curselection { # multilistbox curselection $path if {![winfo exists $path]} { return -1 } set columns $multilistbox($path) return "[$path.frame0.list curselection]" } insert { # multilistbox insert $path $place ?args? if {![winfo exists $path]} { return } set columns $multilistbox($path) set place "[lindex "$args" 0]" set args "[lreplace "$args" 0 0]" set end "[lindex "[$path.frame0.list yview]" 1]" for {set i 0} {$i < $columns} {incr i} { if {"[lindex "$args" $i]" != ""} { $path.frame$i.list insert $place "[lindex "$args" $i]" } else { $path.frame$i.list insert $place " " } if {$end == 1 && [string compare "$place" "end"] == 0} { $path.frame$i.list yview end } } } get { # multilistbox get $path $x $y if {![winfo exists $path]} { return "" } set columns $multilistbox($path) set x "[lindex "$args" 0]" set y "[lindex "$args" 1]" return "[$path.frame$x.list get $y]" } bind { # multilistbox bind $path $sequence $command if {![winfo exists $path]} { return } set columns $multilistbox($path) set sequence "[lindex "$args" 0]" set command "[lindex "$args" 1]" for {set i 0} {$i < $columns} {incr i} { bind $path.frame$i.list $sequence "$command" } } } } ############################################################################# # # Die folgenden Variablen, denen auch von einem Benutzer innerhalb seines # tkircrcs Werte zugewiesen werden können, erhalten nun ihre Default-Werte. set user_styles { { {^(\*|\+|\*\*|\=)».*} {-foreground #00aa00} {} {# send private message/notice/action} } { {^((<|-)$me(>|-\ |»|\+)|\* $me( |»|\+)).*} {-foreground #007700} {} {# send message/notice/action to channel} } { {^(\*|\+|\*\* |\=)[^ *+].*} {-foreground #dd0000} {} {# receive private message/notice/action} } { {^(\-\-\-|\[ notify \]).+ (is here|was here).*$} {-foreground #cc9900} {} {# notify messages} } { {^(\-\-\-|\[ suspect \]).+ (is suspect|was suspect).*$} {-foreground #996600} {} {# suspect messages} } { {^(.*[^a-zA-Z0-9]|)($me|ircii)(|[^a-zA-Z0-9].*)$} {-foreground #aa0000} {} {# my/your nickname or ircII} } { {^(\( |)([0-9][0-9][0-9])(| \)).*} {-foreground #440044} {} {# numerics} } { {^(\*\*\*|\[ signoff \]).+ has signed off \(([^ .]+\.)+[^ .]+ ([^ .]+\.)+[^ ]+\)$} {-foreground #ff5500} {} {# faked netsplit-signoff} } { {^(\-\-\-.|\[ )Net(split|join).*} {-foreground #ff5500} {} {# netsplit or netjoin} } { {^(\-\-\-|\+\+\+|\[ (alert|error|failure|note|notify|warning) \]).*} {-foreground #aa0000} {} {# this program wants to tell you something} } { {^(\*\*\*|\[ ).*} {-foreground #000066} {} {# three stars messages} } } set history_max 20 set lines_max 256 set lines_all 0 set ircpath "irc" set leavetext_limit 80 set topic_limit 80 set kickreason_limit 80 set margin(text) "" set react_to_netsplits 1 set react_to_takeover 0 set takeover_users 3 set takeover_period 300 set takeover_kick_reasons {} set takeover_star_patterns {} set react_to_ctcp_flood 0 set host_flood_ignore_period 300 set global_flood_ignore_period 120 set preferred_channels {"#tkirc" "#test" "#channel1" "#channel2"} set preferred_signoffmessages {"I'll be back"} set preferred_partmessages {"I'll be back"} set preferred_topics {"Please use your own default topic! =;^)" "Where do you want to join today?"} set preferred_awayreasons {"Be back later"} set preferred_kickreasons {"No flooding"} set preferred_servers {} set default_servers { {"us.ircnet.org" 6667 "IRCnet - Random US server"} {"eu.ircnet.org" 6667 "IRCnet - Random EU server"} {"au.ircnet.org" 6667 "IRCnet - Random AU server"} {"irc.belwue.de" 6667 "IRCnet - Germany (Belwue)"} {"irc.fu-berlin.de" 6667 "IRCnet - Germany (Berlin)"} {"irc.netsurf.de" 6667 "IRCnet - Germany (Netsurf)"} {"irc.funet.fi" 6667 "IRCnet - Finland (Funet)"} {"irc.chat.org" 6667 "EFnet - Random server" } {"irc.nijenrode.nl" 6667 "EFnet - Netherlands"} {"irc.homelien.no" 6667 "EFnet - Norway"} {"efnet.demon.co.uk" 6667 "EFnet - United Kingdom"} {"US.Undernet.Org" 6667 "Undernet - Random US server"} {"EU.Undernet.Org" 6667 "Undernet - Random EU server"} {"DE.Undernet.Org" 6667 "Undernet - Germany"} {"FR.Undernet.Org" 6667 "Undernet - France"} {"UK.Undernet.Org" 6667 "Undernet - United Kingdom"} {"irc.us.dal.net" 6667 "DALnet - Random US server"} {"irc.eu.dal.net" 6667 "DALnet - Random EU server"} } set preferred_nicknames {} set nick_completion_mode 2 set nick_completion_suffix ": " set nick_completion_prefer_number 5 ; # nick_completion_mode == 1 set nick_completion_prefer_period 600 ; # nick_completion_mode == 2 set send_away_notice 0 set auto_mark_away 0 set auto_away_period 900 set auto_away_text "" set auto_unmark_away 0 set on_urlclick {~/.tkirc2/netscape.sh "$url"} set on_msgclick {StringRequest "Which newsserver do you want to use?" "news.server's.name" "Cancel|" "Show article|showarticle \"\$string\" {$msgid}"} set words_to_complete {} set tab_aliases {} set entry_bindings {} set escape_sign "^" set show_only_background_channels 0 set CHANNEL_NAME_WIDTH 12 ############################################################################# # # Die folgenden Routinen kümmern sich um Aktionen, die mit den selektierten # Benutzern durchgeführt werden sollen. proc unselect {wnum} { set path "[GetWindowPath $wnum]" $path.body.right.list.users selection clear 0 end } proc selected {wnum command args} { global margin win set inum $win($wnum,irc) set nicks "" if {"$win($wnum,popupnick)" != ""} { append nicks "$win($wnum,popupnick)" } else { set path "[GetWindowPath $wnum]" set numbers "[$path.body.right.list.users curselection]" foreach x "$numbers" { append nicks "[TrimNick "[$path.body.right.list.users get $x]"] " } if {"$numbers" == "" && "$win($wnum,query)" != ""} { append nicks "[string trimleft "$win($wnum,query)" "="] " } } set nicks "[expand "[string trim "$nicks" " "]"]" if {[string compare "$command" "popup2"] && "$nicks" == ""} { return } switch -exact -- "$command" { ban { if {[llength "$nicks"] > 1} { set margin(text) "note" print2text $wnum "--- Please select only one user for ban!" } else { set channel "[GetActual $wnum]" set cnum [ChannelNumber $inum "$channel"] if {$cnum != -1} { BanRequest $inum $cnum "[lindex "$nicks" 0]" "" "" } } } chat - dchat { foreach x "$nicks" { send2tkirc $wnum "/$command [expandescape "$x"]" } } ctcp { foreach x "$nicks" { write2irc $win($wnum,irc) "/ctcp $x $args" queued } } dsend { set filename "[lindex "$args" 0]" if {"$filename" == ""} { if [info exists path(dcc_send)] { catch {cd "$path(dcc_send)"} } FileRequest " Please select the file(s) to send via DCC!" "Send" "selected $wnum dsend \:file" "" "" 1 } else { foreach x "$nicks" { write2irc $win($wnum,irc) "/dcc send $x $filename" } } } ignore { foreach x "$nicks" { set margin(text) "ignore" write2crap $win($wnum,irc) "*** Ignoring MSGs NOTICEs INVITEs and CTCPs from $x" foreach y "MSGS NOTICES CTCPS INVITES" { FilterLine $win($wnum,irc) "[subst -nobackslashes {\*\*\*?Ignoring $y from [expand "$x"]}]" } write2irc $win($wnum,irc) "/ignore $x MSGs NOTICEs INVITEs CTCPs" queued } } unignore { foreach x "$nicks" { set margin(text) "ignore" write2crap $win($wnum,irc) "*** Not ignoring MSGs NOTICEs INVITEs and CTCPs from $x" foreach y "MSGS NOTICES CTCPS INVITES" { FilterLine $win($wnum,irc) "[subst -nobackslashes {\*\*\*?Not ignoring $y from [expand "$x"]}]" FilterLine $win($wnum,irc) "[subst -nobackslashes {\*\*\*?[expand "$x"] is not on the ignorance list}]" } write2irc $win($wnum,irc) "/ignore $x -MSGs -NOTICEs -INVITEs -CTCPs" queued } } kick { set len [llength "$nicks"] if {$len > 3} { set margin(text) "note" print2text $wnum "--- Please don't select more than 3 users for kick!" } else { set channel "[GetActual $wnum]" set cnum [ChannelNumber $inum "$channel"] if {$cnum != -1} { KickRequest $inum $cnum "$nicks" "" } } } mode { set pre "[lindex "$args" 0]" set mode "[lindex "$args" 1]" set channel [GetActual $wnum] set cnum [ChannelNumber $inum "$channel"] if {$cnum != -1} { foreach x "$nicks" { append flags "$mode" ; append cnicks "$x " if {[string length "$flags"] > 2} { write2irc $win($wnum,irc) "/mode $channel $pre$flags $cnicks" queued unselect $wnum ; set flags "" ; set cnicks "" } } if {[string length "$flags"] > 0} { write2irc $win($wnum,irc) "/mode $channel $pre$flags $cnicks" queued unselect $wnum } } } op { selected $wnum mode + o } deop { selected $wnum mode - o } voice { selected $wnum mode + v } unvoice { selected $wnum mode - v } popup - popup2 { set x [lindex "$args" 0] set y [lindex "$args" 1] tk_popup [GetWindowPath $wnum].menu.user.menu $x $y if {[string compare "$command" "popup2"] == 0} { set win($wnum,popupnick) "[lindex "$args" 2]" bind [GetWindowPath $wnum].menu.popup.menu "after 1000 \"global win ; set win($wnum,popupnick) {}\"" } } query { if {[llength "$nicks"] > 1} { set margin(text) "note" print2text $wnum "--- Please select only one user for query!" } else { foreach x "$nicks" { parsein $wnum "/query $x" } } } who { foreach x "$nicks" { write2irc $win($wnum,irc) "/who -nick $x" queued } unselect $wnum } whois { foreach x "$nicks" { if {[lsearch "$args" "double"] != -1} { write2irc $win($wnum,irc) "/whois $x $x" queued } else { write2irc $win($wnum,irc) "/whois $x" queued } } if {[lsearch "$args" "nounselect"] == -1} { unselect $wnum } } } } ############################################################################# # # Hier werden die Hilfstexte für die von tkirc unterstützten Befehle # erstellt. Durch die Verwendung des Arrays "help" können auch in # Zusatzskripts definierte Kommandos mit Hilfstexten versehen werden. global help set help(bancomment) " Usage: \x02\BANCOMMENT\x02 (|) This command allows you to set a comment to a ban of channel . or selects the certain ban of 's banlist. See also: \x1f\BANINFOS\x1f " set help(baninfos) " Usage: \x02\BANINFOS\x02 This command shows you more informations of 's bans than: \x1f\MODE\x1f b See also: \x1f\BANCOMMENT\x1f \x1f\MODE\x1f for information about changing channel characteristics. " set help(bannick) " Usage: \x02\BANNICK\x02 To ban someone from a window's current channel you just need to know that user's nickname. This command opens a new window you can select a banpattern in. " set help(banrequest) " Usage: \x02\BANREQUEST\x02 \[\] If you don't want to type a banpattern manually, use this command and you will get a window to select a banpattern via mouse. See also: \x1f\KICKREQUEST\x1f " set help(chat) " Usage: \x02\CHAT\x02 \[,\[...\]\] A new window will be opened for a private conversation with all users specified through \[,\[...\]\]. Each line that you type in this new window without a leading '/' will be sent as private message to all specified users. See also: \x1f\QUERY\x1f " set help(clear) " Usage: \x02\CLEAR\x02 The active window will be cleared. " set help(clearall) " Usage: \x02\CLEARALL\x02 All traffic windows will be cleared. " set help(close) " Usage: \x02\CLOSE\x02 The active window will be closed. " set help(closelog) " Usage: \x02\CLOSELOG\x02 \[( \x02\ALL\x02 | \x02\CRAP\x02 | \x02\MESSAGES\x02 | \x02\CHANNEL\x02 | \x02\QUERY\x02 | \x02\WINDOW\x02 ) \[\x02\ON\x02 |\]\] To close a certain logfile via \x1f\CLOSELOG\x1f, you need nearly the same definitions that you've used to open it via \x1f\LOG\x1f. See also: \x1f\LOG\x1f for the meaning of \x1f\CLOSELOG\x1f\'s arguments. " set help(dchat) " Usage: \x02\DCHAT\x02 A new window for a private DCC conversation with user will be opened. Each line you type in this new window without a leading '/' will be directly sent (via DCC protocol) to user . See also: \x1f\DCC CHAT\x1f " set help(kickrequest) " Usage: \x02\KICKREQUEST\x02 \[\] This command opens a request window to kick user from channel . See also: \x1f\BANREQUEST\x1f " set help(lags) " Usage: \x02\LAGS\x02 This command opens a window to display the lag times of the current connection. " set help(log) " Usage: \x02\LOG\x02 \[( \x02\ALL\x02 | \x02\CRAP\x02 | \x02\MESSAGES\x02 | \x02\CHANNEL\x02 | \x02\QUERY\x02 | \x02\WINDOW\x02 ) \[\x02\ON\x02 |\] \[\x02\TO\x02 \] \[\x02\-DATE\x02\] \[\x02\-RAW\x02\] \[\x02\-TIME\x02\]\] Since version 2 of tkirc it exists only one command for logging. -- If you use command \x1f\LOG\x1f without any parameters, you will get a list of all opened logfiles. It's possible to log from different sources. Examples: \x1f\ALL\x1f All incoming and outgoing messages are logged into the same logfile. \x1f\CRAP\x1f You can use this keyword to log all kinds of crap (numerics, output from ircII, etc.). Each connection has its own window for crap-messages. Please see also the 'c' in some window titles! \x1f\MESSAGES\x1f This keyword stands for all private messages (and notices) that you send or receive. \x1f\CHANNEL\x1f Here you see how to log the traffic of channel . \x1f\QUERY\x1f This example shows you how to log the private conversation with user . \x1f\WINDOW\x1f To log the traffic of a certain window you just need to know that window's number. Each of tkirc's traffic windows has a unique number that you can find on the left side at each window's title. Through tkirc's support of multiple servers it can be useful to specify a certain server or connection. Examples: \x1f\ON\x1f *.de This example limits the logging to messages that are sent or received from a server matching the pattern *.de (a german server). \x1f\ON\x1f #0 In this way you can limit the logging to a certain connection (here connection #0 is specified). The different connections of a session are displayed behind the server in all window titles. If you don't use \x1f\ON\x1f, tkirc limits the logging to the current connection. To choose a file you want to log into, you can use keyword \x1f\TO\x1f. Example: \x1f\TO\x1f /tmp/tkirc.log If you don't choose a certain logfile, tkirc creates a filename out of the given source. Examples: ~/.tkirc2/IrcLog.all, ~/.tkirc2/IrcLog.#tkirc, ... \x1f\LOG\x1f supports another three options: \x1f\-DATE\x1f Use this option and you will get additional date stamps for each logged line. \x1f\-RAW\x1f If you want to log the messages as tkirc receives them, you can use option \x1f\RAW\x1f. \x1f\-TIME\x1f This option allows you to get additional time stamps for each logged line. Together with option \x1f\DATE\x1f you will have the full time of arrival. See also: \x1f\CLOSELOG\x1f " set help(msgids) " Usage: \x02\MSGIDS\x02 This command opens a window for all message IDs that were detected during the current session. " set help(newwin) " Usage: \x02\NEWWIN\x02 This command opens a new traffic window. See also: \x1f\CLOSE\x1f " set help(notified) " Usage: \x02\NOTIFIED\x02 This command opens a window to display all notified users. See also: \x1f\NOTIFY\x1f " set help(notify) " Usage: \x02\NOTIFY\x02 \[\[-\] \[!@] \[-\x02\COMMENT\x02 \"\"\] \[-\x02\CHANNEL\x02 \] \[-\x02\SERVER\x02 \] \[-\x02\COMMAND\x02 \"\"\]\] tkirc's notify handling was totally rewritten for version 2. It's based to IRC's command ISON and supports pattern matching for internet addresses. There are several ways to use \x1f\NOTIFY\x1f... By using \x1f\NOTIFY\x1f without any parameter, tkirc will show you all entries of your notification list. If you're doing this for the first time, this list should be empty. =:^) To add someone to your notification list, you just need to know his/her nickname. If you also know his/her address (@) you should use an address pattern to prevent notification messages for other users which are using the same nickname. Examples: \x1f\NOTIFY\x1f ernie or \x1f\NOTIFY\x1f ernie!*ernie@*.sesame.street.com To remove a certain user from the notification list you just need to call \x1f\NOTIFY\x1f with the same parameters like you've done before for adding and an additional minus before the nickname. Examples: \x1f\NOTIFY\x1f -ernie or \x1f\NOTIFY\x1f -ernie!*ernie@*.sesame.street.com It's also possible to use the number of a certain \x1f\NOTIFY\x1f-entry for removing. These numbers are displayed by using \x1f\NOTIFY\x1f without any parameter (see above). Since tkirc's version 2 you can use some additional options for the \x1f\NOTIFY\x1f-command: \x1f\-COMMENT\x1f \"\" The option \x1f\-COMMENT\x1f allows you to set a comment, that will be added to the notification messages for a single person. \x1f\-CHANNEL\x1f Usually the command \x1f\NOTIFY\x1f detects users on the same IRC-network you're just connected to. Then you will get messages when this user connects to or leaves the IRC-network. Now it's also possible to get notification messages when someone joins are leaves a certain channel. Example: \x1f\NOTIFY\x1f ernie -channel #unix -comment \"Does Ernie use unix?\" It's also possible to use patterns instead of valid channel names. Maybe you want to be informed when ernie joins/leaves any channel you're on: \x1f\NOTIFY\x1f ernie -channel * -comment \"Ernie is near!\" \x1f\-SERVER\x1f Do you often connect to more than one IRC-network at the same time? Then you can bound a call of \x1f\NOTIFY\x1f to a single server or to a group of servers. The following example will only effect something, if you're connected to a german server: \x1f\NOTIFY\x1f ernie -server *.de \x1f\-COMMAND\x1f You can automatically react to a user that is notified by tkirc. It's possible to use Tcl-commands as well as ircII-commands. tkirc distinguishes these commands on the leading '/' (for ircII-commands). Examples: \x1f\NOTIFY\x1f ernie -command \"/chat \$nick\" or \x1f\NOTIFY\x1f ernie -command \"puts \\\"nick=\$nick, address=\$address\\\"\" See also: \x1f\SUSPECT\x1f " set help(suspect) " Usage: \x02\SUSPECT\x02 \[\[-\] \[!@] \[-\x02\COMMENT\x02 \"\"\] \[-\x02\CHANNEL\x02 \] \[-\x02\SERVER\x02 \] \[-\x02\COMMAND\x02 \"\"\]\] See also: \x1f\NOTIFY\x1f " set help(savebuffer) " Usage: \x02\SAVEBUFFER\x02 The buffer of the current window will be saved into file . " set help(search) " Usage: \x02\SEARCH\x02 This command highlights all occurrences of '' in the text field and jumps to it/the next. " set help(takeovers) " Usage: \x02\TAKEOVERS\x02 Shows you a list of all detected (possible) channel takeovers. " set help(urls) " Usage: \x02\URLS\x02 This command opens a window for all universal resource locators (URLs) that were detected during the current session. " set help(wjoin) " Usage: \x02\WJOIN\x02 -\x02\INVITE\x02| \[\] This command opens a new window for each channel and executes command JOIN for all given channels. See also: \x1f\JOIN\x1f " proc on_command_help {window arguments} { global help irc on_args set inum $on_args(irc) set len [llength "$arguments"] set list "[line2list "$arguments"]" if {$len == 0} { # Die Liste der Kommandos wird ausgegeben. print2text $irc($inum,crap) "*** additional choices:" set i 0 ; set helpline "" foreach x "[lsort "[string tolower "[array names help *]"]"]" { if {![string match ":*:" "$x"]} { if {[incr i] < 5} { append helpline "[format "%-12s " "$x"]" } else { print2text $irc($inum,crap) "$helpline$x" set i 0 ; set helpline "" update } } } if {$i != 0} { write2crap $inum "$helpline" } write2irc $inum "/help" } else { set command "[string tolower "[lindex "$list" 0]"]" if {[info exists help($command)]} { print2text $irc($inum,crap) "*** Help on $command" foreach x "[split "[string trim "$help($command)" "\n"]" "\n"]" { print2text $irc($inum,crap) "$x" update } } else { write2irc $inum "/help $arguments" } } } ############################################################################# # # Mit Hilfe der folgenden Routinen werden der Ban- und der KickRequest # realisiert. proc Ban_SetNickButton {bnum} { global ban set a .ban$bnum.body.address if {"[$a.nick cget -text]" == "*"} { $a.nick configure -text "[reduce "$ban($bnum:nick)"]" } else { $a.nick configure -text "*" } } proc Ban_SetUserButton {bnum} { global ban set a .ban$bnum.body.address if {"[$a.user cget -text]" == "*"} { $a.user configure -text "$ban($bnum:user)" if {"[$a.tilde cget -text]" == "!"} { $a.tilde configure -text "!*" } } else { $a.user configure -text "*" if {"[$a.tilde cget -text]" == "!*"} { $a.tilde configure -text "!" } } } proc Ban_SetAddressButton {bnum button} { global ban set elements [llength "$ban($bnum:hostlist)"] set a .ban$bnum.body.address if {"[$a.$button cget -text]" != "[lindex "$ban($bnum:hostlist)" $button]"} { $a.$button configure -text "[lindex "$ban($bnum:hostlist)" $button]" for {set i $button} {$i < [expr $elements-1]} {incr i} { set post [expr $i + 1] if {"[$a.$post cget -text]" != "[lindex "$ban($bnum:hostlist)" $post]"} { $a.$post configure -text "[lindex "$ban($bnum:hostlist)" $post]" \ -state normal $a.point$i configure -text "." } else { break } } } else { $a.$button configure -text "*" for {set i 1} {$i < $elements} {incr i} { set pre [expr $i - 1] if {"[$a.$i cget -text]" != "[lindex "$ban($bnum:hostlist)" $i]"} { if {"[$a.$pre cget -text]" != "[lindex "$ban($bnum:hostlist)" $pre]"} { $a.point$pre configure -text "" $a.$i configure -text "" -state disabled } } } } } proc BanClose {bnum} { global ban closewindow .ban$bnum foreach x "[array names ban $bnum:*]" { unset ban($x) } } proc BanRequest {inum cnum nick address reason args} { if {"$address" == ""} { set address "[AddressOfNick $inum "$nick"]" } if {"$address" == ""} { set command "BanRequest $inum $cnum [expand "$nick"] \"[expand "$address"]\" \"$reason\" $args" AddToWhoisQueue $inum "$nick" "Getting informations to ban..." "$command" return } set takeover [expr [lsearch "$args" "-takeover"]+1] set kickstate [expr [lsearch "$args" "-kick"]+1] global ban chan irc win set bnum [incr win(reqcount)] set ban($bnum:channel) "$chan($cnum)" set ban($bnum:cnum) $cnum set ban($bnum:irc) $inum set ban($bnum:nick) "[expand "$nick"]" set at [string first "@" "$address"] set ban($bnum:user) "[string range "$address" 0 [expr $at-1]]" if [regexp -- {^[\^~+=-].*} "$ban($bnum:user)"] { set ban($bnum:user) "[string range "$ban($bnum:user)" 1 end]" } set len [string length "$ban($bnum:user)"] if {$len > 8} { set ban($bnum:user) "[string range "$ban($bnum:user)" [expr $len - 8] end]" } set ban($bnum:hostlist) "[split "[lindex "[split "$address" "@"]" end]" "."]" set ban($bnum:address) "$address" set path ".ban$bnum" if {[RequestLevel $path]} { global geometry if {[info exists geometry(ban)]} { wm geometry $path $geometry(ban) } if {"$nick" != ""} { wm title $path " tkirc: Ban-Kick '$nick'" } else { wm title $path " tkirc: Ban-Kick" } bind $path "BanClose $bnum" Label $path.top -text "Please select the pattern to ban user $nick\n($ban($bnum:address)) from channel $ban($bnum:channel):" pack $path.top -side top -padx 2 -pady 2 -ipadx 10 Frame $path.body pack $path.body -fill x -padx 2 -pady 2 set a $path.body.address Frame $a -relief sunken -bd 1 pack $a -side top -expand true -fill x if {$takeover != 0} { Button $a.nick -text "*" -bd 0 -state disabled } else { Button $a.nick -text "*" -bd 0 -command "Ban_SetNickButton $bnum" } pack $a.nick -side left -padx 0 -ipadx 0 if {$takeover != 0} { Label $a.tilde -text "!" -bd 0 } else { Label $a.tilde -text "!*" -bd 0 } pack $a.tilde -side left -padx 0 -ipadx 0 if {$takeover != 0} { Button $a.user -text "*" -bd 0 -command "Ban_SetUserButton $bnum" } else { Button $a.user -text "$ban($bnum:user)" -bd 0 \ -command "Ban_SetUserButton $bnum" } pack $a.user -side left -padx 0 -ipadx 0 Label $a.at -text "@" -bd 0 pack $a.at -side left -padx 0 -ipadx 0 for {set i 0} {$i < [llength "$ban($bnum:hostlist)"]} {incr i} { set element "[lindex "$ban($bnum:hostlist)" $i]" if {$takeover != 0} { global takeover_star_patterns foreach x "$takeover_star_patterns" { if [strmatch "$x" "$element"] { set element "*" break } } } Button $a.$i -text "$element" -bd 0 \ -command "Ban_SetAddressButton $bnum $i" pack $a.$i -side left -padx 0 -ipadx 0 if {$i < [expr [llength "$ban($bnum:hostlist)"] - 1]} { Label $a.point$i -text "." -bd 0 pack $a.point$i -side left -padx 0 -ipadx 0 } } set f $path.buttons Frame $f pack $f -fill x -pady 2 -side bottom Button $f.cancel -text "Cancel" -command "BanClose $bnum" pack $f.cancel -side right if {$takeover != 0} { DefaultButton $f.bankick -text "Ban + Kick" \ -command "BanKick $bnum -takeover -ban -kick ; closewindow .ban$bnum" pack $f.bankick -side right bind $path "BanKick $bnum -takeover -ban -kick ; closewindow .ban$bnum" Button $f.kick -text "Kick" \ -command "BanKick $bnum -takeover -kick ; closewindow .ban$bnum" Button $f.ban -text "Ban" \ -command "BanKick $bnum -takeover -ban ; BanClose $bnum" pack $f.kick $f.ban -side right } else { Button $f.wait -text "Kick + Wait" -command "BanKick $bnum -kick" pack $f.wait -side left Button $f.bankick -text "Ban + Kick" \ -command "BanKick $bnum -ban -kick ; BanClose $bnum" pack $f.bankick -side right Focus $f.bankick if {$kickstate != 0} { DefaultButton $f.kick -text "Kick" \ -command "BanKick $bnum -kick ; BanClose $bnum" bind $path "BanKick $bnum -kick ; BanClose $bnum" Button $f.ban -text "Ban" \ -command "BanKick $bnum -ban ; BanClose $bnum" } else { Button $f.kick -text "Kick" \ -command "BanKick $bnum -kick ; BanClose $bnum" DefaultButton $f.ban -text "Ban" \ -command "BanKick $bnum -ban ; BanClose $bnum" bind $path "BanKick $bnum -ban ; BanClose $bnum" } pack $f.kick $f.ban -side right Label $path.mid -text "Please select the kickmessage, if you want to kick too:" pack $path.mid -side top -padx 2 -pady 2 -ipadx 10 Frame $path.reasons InitKickReasonList $path pack $path.reasons -expand true -fill both if {"$reason" != ""} { $path.reasons.entry delete 0 end $path.reasons.entry insert end "$reason" } } } } proc KickWarScriptUser {bnum} { global ban chan irc margin alreadykicked global takeover_kick_reasons takeover_period set cnum $ban($bnum:cnum) set wnum $chan($cnum,window) set inum $ban($bnum:irc) set channel "$ban($bnum:channel)" set address "[join "$ban($bnum:hostlist)" "."]" set secs [clock seconds] set count 0 ; set i 0 ; set matchnicks "" foreach x "$chan($cnum,addresses)" { if {[strmatch "*$address" "$x"]} { set nick [lindex "$chan($cnum,nicks)" $i] set period [expr $secs - [lindex "$chan($cnum,jointimes)" $i]] if {$period < $takeover_period} { # User hat innerhalb der letzten 'takeover_period' Sekunden # gejoint. if {[strcmp "$nick" "$irc($inum,nick)"]} { if {[lSearch "$alreadykicked" "$nick"] == -1} { set alen [llength "$alreadykicked"] set rlen [llength "$takeover_kick_reasons"] if {$rlen != 0} { set j [expr $alen % $rlen] set kmsg "[lindex "$takeover_kick_reasons" $j]" send2tkirc $wnum "/kick [expandescape "$channel $nick"] $kmsg" } else { send2tkirc $wnum "/kick [expandescape "$channel $nick"] *zupf*" } lappend alreadykicked "$nick" } # Zähler auch für den Fall erhöhen, daß der User schon # gekickt, der Kick aber noch nicht bestätigt wurde. incr count } } else { # User ist länger als 'takeover_period' Sekunden auf dem Kanal. append matchnicks " $nick" } } incr i } if {$count > 0} { after 5000 [list KickWarScriptUser $bnum] } else { if {[string length "$matchnicks"]} { set margin(text) "alert" print2channels "$cnum" "--- Some users left with matching addresses (longer than $takeover_period seconds on this channel):$matchnicks" } global takeover set i [lsearch -exact "$takeover(tries)" "$cnum $address"] if {$i != -1} { set takeover(tries) "[lreplace "$takeover(tries)" $i $i]" } } } proc BanKick {bnum args} { global ban irc margin alreadykicked set takeover [expr [lsearch "$args" "-takeover"]+1] set banstate [expr [lsearch "$args" "-ban"]+1] set kickstate [expr [lsearch "$args" "-kick"]+1] if {$banstate != 0 || $takeover != 0} { set a .ban$bnum.body.address if {$takeover != 0} { append user "*!" } else { append user "[$a.nick cget -text]!" } append address "[string trimleft "[$a.tilde cget -text]" "!"]" append address "[$a.user cget -text]@" set len [llength "$ban($bnum:hostlist)"] for {set i 0} {$i < $len} {incr i} { append address "[$a.$i cget -text]" if {$i < [expr $len - 1]} { append address "[$a.point$i cget -text]" } } append user "$address" } if {!$takeover} { if {$banstate != 0} { if {[isOpOnChannel $ban($bnum:cnum) "$ban($bnum:nick)"]} { write2irc $ban($bnum:irc) "/quote mode $ban($bnum:channel) -o+b $ban($bnum:nick) $user" } else { write2irc $ban($bnum:irc) "/quote mode $ban($bnum:channel) +b $user" } } if {$kickstate != 0} { foreach x "$ban($bnum:nick)" { send2tkirc $irc($ban($bnum:irc),crap) "/kick [expandescape "$ban($bnum:channel) $x"] [.ban$bnum.reasons.entry get]" } } } else { if {![isOpOnChannel $ban($bnum:cnum) "$irc($ban($bnum:irc),nick)"]} { set margin(text) "error" write2crap $ban($bnum:irc) "--- You are not channel operator on $ban($bnum:channel)!" beep BanRequest $ban($bnum:irc) $ban($bnum:cnum) {} "$user" {} -takeover } else { if {$banstate != 0} { write2irc $ban($bnum:irc) "/quote mode $ban($bnum:channel) +b $user" urgent } if {$kickstate != 0} { set alreadykicked "" KickWarScriptUser $bnum } } } } proc KickRequest {inum cnum nicks reason} { if {[llength "$nicks"] == 1 && "[AddressOfNick $inum "[lindex "$nicks" 0]"]" != ""} { BanRequest $inum $cnum "[lindex "$nicks" 0]" "" "$reason" -kick return } global ban chan irc win set bnum [incr win(reqcount)] set ban($bnum:channel) "$chan($cnum)" set ban($bnum:cnum) $cnum set ban($bnum:irc) $inum set ban($bnum:nick) "$nicks" set path ".ban$bnum" if {[RequestLevel $path]} { global geometry if {[info exists geometry(kick)]} { wm geometry $path $geometry(kick) } wm title $path " tkirc: Kick user(s) from the channel" bind $path "BanClose $bnum" Label $path.mid -text "Please select one of your preferred kickmessages or a new one:" pack $path.mid -side top -padx 2 -pady 2 Frame $path.reasons InitKickReasonList $path pack $path.reasons -expand true -fill both if {"$reason" != ""} { $path.reasons.entry delete 0 end $path.reasons.entry insert end "$reason" } set f $path.buttons Frame $f pack $f -fill x -pady 2 DefaultButton $f.ban -text "Kick" \ -command "BanKick $bnum -kick ; BanClose $bnum" bind $path "BanKick $bnum -kick ; BanClose $bnum" Button $f.cancel -text "Cancel" -command "BanClose $bnum" pack $f.cancel $f.ban -side right } } ###################################################################### # USER'S STARTUP AND SUPPORT OF TKIRCRC-FOR TKIRC AND IRC # ###################################################################### proc on_tkircstart { } { } proc on_ircIIstart { } { } proc on_connect { } { } proc notified_clear {inum args} { global notified for {set i [expr [llength "$notified(inums)"]-1]} {$i >= 0} {set i [expr $i-1]} { if {$inum == [lindex "$notified(inums)" $i]} { multilistbox delete .notified.list $i if {"$args" != ""} { foreach x "nicks addresses cnums inums" { set notified($x) "[lreplace "$notified($x)" $i $i]" } } } } } proc suspected_clear {inum args} { global suspected for {set i [expr [llength "$suspected(inums)"]-1]} {$i >= 0} {set i [expr $i-1]} { if {$inum == [lindex "$suspected(inums)" $i]} { multilistbox delete .suspected.list $i if {"$args" != ""} { foreach x "nicks addresses cnums inums" { set suspected($x) "[lreplace "$suspected($x)" $i $i]" } } } } } set GreyForegroundWidgets "" proc ReloadTKircRC {file} { global irc win margin set tmp "" lappend tmp \ print_debug crapwindow messagewindow color path style \ font geometry send_away_notice \ auto_mark_away auto_away_period auto_away_text auto_unmark_away \ history_max lines_max ircpath \ beep_on_private_when_present beep_on_private_when_away \ beep_on_public_when_present beep_on_public_when_away \ beep_on_invite_when_present beep_on_invite_when_away \ beep_on_ctrlG_when_present beep_on_ctrlG_when_away \ show_address_on_message_when_present show_address_on_message_when_away \ show_address_on_message_in_logfile show_address_on_notice_when_present \ show_address_on_notice_when_away show_address_on_notice_in_logfile \ show_time_on_private_when_present show_time_on_private_when_away \ show_time_on_public_when_present show_time_on_public_when_away \ chat_window_on_message_when_present chat_window_on_message_when_away \ chat_window_on_notice_when_present chat_window_on_notice_when_away \ silence request_on_dcc_chat request_on_dcc_send request_on_invite \ request_on_kick \ auto_popup hide_joins hide_leaves hide_signoffs \ show_commandline show_time_on_each_line show_topic show_userlist \ sort_userlist_alphabeticly sort_userlist_by_channelmodes \ use_margin display_types margin_size beeptext entry_bindings \ react_to_netsplits react_to_takeover takeover_users takeover_period \ takeover_kick_reasons takeover_star_patterns \ react_to_ctcp_flood host_flood_ignore_period global_flood_ignore_period \ preferred_nicknames preferred_channels preferred_signoffmessages \ preferred_partmessages preferred_topics \ preferred_awayreasons preferred_kickreasons preferred_servers \ notify noteserv note on_urlclick on_msgclick \ words_to_complete tab_aliases nick_completion_mode nick_completion_suffix \ nick_completion_prefer_number nick_completion_prefer_period user_styles \ escape_sign ircserver channelhop_period \ show_only_background_channels foreach x "$tmp" { global $x if {![info exists $x]} { set $x "" } } if {"$file" != ""} { if {[file exists "$file"]} { source "$file" } } else { foreach dir "/usr/local/lib/tkirc /usr/pkg/lib/tkirc ~/.tkirc2" { # Preferences if {[file exists "$dir/preferences"]} { source "$dir/preferences" } # RC-Dateien if {[file exists "$dir/tkircrc"]} { source "$dir/tkircrc" } # Autoload-Skripte if {[file exists "$dir/autoload/"]} { set before "[pwd]" cd "$dir/autoload/" if {![catch {glob -nocomplain *.tcl} sourcefiles]} { foreach x "$sourcefiles" { if {[file isfile "$x"]} { source "$dir/autoload/$x" } } } cd "$before" } } } if {[string length "$escape_sign"] > 1} { set escape_sign "^" set margin(text) "error" print2crap "--- Variable escape_sign set to default (value was too long)" } if {[info exists font(text)]} { set style(normal) "-font \{$font(text)\}" set style(bold) "-font \{$font(text) bold\}" set style(italic) "-font \{$font(text) italic\}" } foreach x "$color(options)" { set y [string trimleft "$x" "-"] if [info exists color($y)] { setColor . $x $color($y) } } foreach x "[array names font _*_]" { set class "[string trim "$x" "_"]" set index "[string tolower "$class"]" if [info exists font($index)] { setFont . "$class" "$font($index)" } } foreach inum "$irc(list)" { ExecOnCommands reload $inum } } ###################################################################### # GLOBAL VARIABLES # ###################################################################### set nickname "" ; # Diese Variablen werden für jede set server "" ; # empfangene Zeile verändert. set away "" set raw(line) "" set raw(type) "" set raw(lasttype) "" set ircserver "" set messagewindow 0 set crapwindow 0 set beeptext "" set beepstate 1 # 0: public, 1: private set linetype 0 set history(msg,max) 5 set notified(nicks) "" set notified(addresses) "" set notified(cnums) "" set notified(inums) "" set suspected(nicks) "" set suspected(addresses) "" set suspected(cnums) "" set suspected(inums) "" # element of takeover(tries): " " set takeover(tries) "" set takeover(times) "" # to detect and to handle netsplits set split(count) 0 set join(count) 0 set psplit(state) 0 set pjoin(state) 0 set lastOPjoin "" # send away notice set san(nicks) "" set san(times) "" set san(message) "" # for scanning URLs and MSGIDs foreach x "dates times values" { set urls($x) "" set msgids($x) "" } # zum Auswerten einer away-Bestätigung set automatic_away 0 # for '/search' set search_lastview -1 set search_laststring "" # for ignoring CTCPs (flood protection) set ctcp_list "" set ctcp_count 1 # for scanning banlist on join set banlist(filter) "" # each request window has its own ID set win(reqcount) 1 set default_entry_bindings { { {%W delete insert end ; break}} { {%W delete 0 insert ; break}} { {%W icursor 0 ; %W xview 0 ; break}} { {%W icursor end ; %W xview end ; break}} { {EntryOneWordLeft %W}} { {EntryOneWordRight %W}} { {InsertFromClipboard %W ; break}} { {+%W xview insert}} { {%W insert insert \017}} { {%W insert insert \037}} { {%W insert insert \026}} { {+InitIdleTime}} } ###################################################################### # DEBUG # ###################################################################### proc debug {text} { global lines_all lines_max print_debug if {$print_debug != 0} { puts stdout "debug: $text" flush stdout } } ##################### # BASIC FUNCTIONS # ##################### proc beep { } { global silence if {!$silence} { bell } } proc isDigit {c} { return [regexp {[0-9]} "$c"] } proc isPattern {text} { if {[string first "*" "$text"] >= 0 || [string first "?" "$text"] >= 0} { return 1 } return 0 } proc time {args} { if {[llength "$args"] == 1} { return "[clock format [lindex "$args" 0] -format "%H:%M"]" } else { return "[clock format [clock seconds] -format "%H:%M"]" } } proc time2 {args} { if {[llength "$args"] == 1} { return "[clock format [lindex "$args" 0] -format "%H:%M:%S"]" } else { return "[clock format [clock seconds] -format "%H:%M:%S"]" } } proc date {args} { if {[llength "$args"] == 1} { return "[clock format [lindex "$args" 0] -format "%y-%m-%d"]" } else { return "[clock format [clock seconds] -format "%y-%m-%d"]" } } proc longdate {args} { if {[llength "$args"] == 1} { return "[clock format [lindex "$args" 0] -format "%y-%m-%d %H:%M:%S"]" } else { return "[clock format [clock seconds] -format "%y-%m-%d %H:%M:%S"]" } } proc linetime { } { global away linetype global show_time_on_private_when_present show_time_on_private_when_away global show_time_on_public_when_present show_time_on_public_when_away if {$linetype != 0} { if {"$away" == "" && $show_time_on_private_when_present != 0} { return " ([time])" } elseif {"$away" != "" && $show_time_on_private_when_away != 0} { return " ([time])" } } else { if {"$away" == "" && $show_time_on_public_when_present != 0} { return " ([time])" } elseif {"$away" != "" && $show_time_on_public_when_away != 0} { return " ([time])" } } return "" } proc SetEnterFocus {window widget} { bind $window "focus $widget ; bind $window {}" } proc Focus {widget} { set now "[focus]" set next "$widget" foreach x "now next" { set $x "[split "[set $x]" "."]" } if {[string compare "[lindex "$now" 1]" "[lindex "$next" 1]"] == 0} { # Das Fenster ist bereits im Besitz des Focus. focus $widget } else { # Das Widget wird erst aktiviert, wenn das Fenster wieder im Besitz # des Focus ist. SetEnterFocus .[lindex "$next" 1] $widget } } proc request {textbody args} { # Example call: # request "Do you really want to delete file '$name'?" \ # "Cancel|puts stdout Cancel" "Delete|puts stdout Delete" global win set path ".req[incr win(reqcount)]" if {[RequestLevel $path]} { # grab set $path set width 40 ; set height 1 wm title $path " tkirc: Request " bind $path "grab release $path ; destroy $path" Frame $path.f1 -bd 1 -relief sunken pack $path.f1 -padx 2 -pady 2 -expand true -side top -fill x set newbody "" ; set i 0 ; set j 0 while { $i < [expr [string length $textbody] - 1] } { set tmp [string range $textbody $i end] set spacenum [string first " " $tmp] if {$spacenum > $width} { set width $spacenum } set tmp [string range $textbody $i [expr $width + $i]] set spacenum [string last " " $tmp] if {[string length $tmp] < $width} { append newbody $tmp break } elseif {$spacenum == -1} { append newbody $tmp set i [expr $i + $width] } else { append newbody [string range $tmp 0 [expr $spacenum - 1]] set i [expr $i + $spacenum + 1] } append newbody "\n" incr height } Label $path.f1.label -width $width -height $height -bd 0 -text "$newbody" pack $path.f1.label -side top -pady 3 -expand true Frame $path.f2 pack $path.f2 -ipadx 2 -ipady 2 -padx 2 -pady 2 -side top -fill x set i 0 foreach buttondef $args { set trenn [string first "|" "$buttondef"] set text " " append text [string range $buttondef 0 [expr $trenn - 1]] append text " " set action [string range $buttondef [expr $trenn + 1] end] append action " ; grab release $path ; destroy $path" Button $path.f2.$i -text "$text" -command "$action" if {$i == 0} { pack $path.f2.$i -side right -pady 2 } else { pack $path.f2.$i -side left -pady 2 } incr i } } } proc StringRequest {textbody default args} { # Example call: # StringRequest "Which user (nickname) do you want to invite?" \ # "atte" {Cancel|} {Invite|write2irc 0 "/invite #tkirc $string"} global win set path ".req[incr win(reqcount)]" if {[RequestLevel $path]} { wm title $path " tkirc: Request " bind $path "grab release $path ; destroy $path" Frame $path.f1 -bd 1 -relief sunken pack $path.f1 -padx 2 -pady 2 -expand true -side top -fill both set newtextbody "" ; set snip 40 while {[set len [string length "$textbody"]]} { set space [string first " " "[string range "$textbody" $snip end]"] set space [expr $space+$snip-1] if {$len < $snip || $space == -1} { append newtextbody "$textbody" set textbody "" } else { append newtextbody "[string range "$textbody" 0 $space]\n" set textbody "[string range "$textbody" [incr space] end]" } } Label $path.f1.label -bd 0 -text "$newtextbody" pack $path.f1.label -side top -ipadx 6 -ipady 3 -pady 3 -expand true \ -fill both Frame $path.f2 -bd 1 -relief flat pack $path.f2 -padx 2 -pady 2 -side top -fill x Entry $path.f2.entry pack $path.f2.entry -side top -fill x $path.f2.entry insert 0 "$default" Focus $path.f2.entry Frame $path.f3 pack $path.f3 -ipadx 2 -ipady 2 -padx 2 -pady 2 -side top -fill x set i 0 foreach buttondef $args { set trenn [string first "|" "$buttondef"] set text " " append text [string range $buttondef 0 [expr $trenn - 1]] append text " " set action "" append action "[strreplace "[string range $buttondef [expr $trenn + 1] end]" {$string} "\[$path.f2.entry get\]"]" append action " ; grab release $path ; destroy $path" Button $path.f3.$i -text "$text" -command "$action" if {$i == 0} { pack $path.f3.$i -side right -pady 2 } else { pack $path.f3.$i -side left -pady 2 } incr i } } } # line2list: Hier werden normale Textzeilen in Listen umgewandelt, # mit denen Tcl/Tk zurechtkommt. proc line2list {line} { set newline "" set len [string length "$line"] for {set i 0} {$i < $len} {incr i} { set c "[string index "$line" $i]" switch -- "$c" { "\n" { append newline " " } "\t" { append newline " " } "\"" { append newline "\\\"" } "\\" { append newline "\\\\" } "\{" { append newline "\\\{" } "\}" { append newline "\\\}" } "\[" { append newline "\\\[" } "\]" { append newline "\\\]" } default { append newline "$c" } } } set i [string first " \\\"" " $newline"] set list "" while {$i != -1} { set j [string first "\\\" " "[string range "$newline" [expr $i+1] end] "] if {$j == -1} { break } if {$i == 0} { append list "\"" } else { append list "[string range "$newline" 0 [expr $i-1]]\"" } append list "[string range "$newline" [expr $i+2] [expr $i+$j]]\"" set newline "[string range "$newline" [expr $i+$j+3] end]" set i [string first " \\\"" " $newline"] } append list "$newline" return "$list" } # lIndex, lSearch, lLength und lRange dienen als Ersatz für lindex, # lsearch, llength und lrange, um mit Klammertexten klar zu kommen. proc lIndex {line num} { return "[lindex "[line2list "$line"]" $num]" } proc lSearch {line element} { return [lsearch -exact "[string tolower "$line"]" "[string tolower "$element"]"] } proc lineSearch {line element} { return [lsearch -exact "[string tolower "[line2list "$line"]"]" "[string tolower "$element"]"] } proc lLength {line} { return [llength "[line2list "$line"]"] } proc lRange {line left right} { return "[lrange "[line2list "$line"]" $left $right]" } # cutwords: Von der linken Seite der Zeile $line werden $num Worte # abgeschnitten. proc cutwords {line num} { set cut 0 if {$num > 0} { for {set i 0} {$i < $num} {incr i} { while {"[string index "$line" $cut]" == " "} { incr cut } set next [string first " " "[string range "$line" $cut end]"] if {$next == -1} { return "" } set cut [expr $cut+$next] } return "[string range "$line" [expr $cut+1] end]" } return "$line" } proc coloncut {line} { set i [string first ":" "$line"] if {$i != -1} { incr i return "[string range "$line" $i end]" } return "$line" } # leftwords: Das Ergebnis beinhaltet nur die linken $num Worte der # Zeile $line. proc leftwords {line num} { set cut 0 if {$num > 0} { for {set i 0} {$i < $num} {incr i} { while {"[string index "$line" $cut]" == " "} { incr cut } set next [string first " " "[string range "$line" $cut end]"] if {$next == -1} { return "$line" } set cut [expr $cut+$next] } return "[string range "$line" 0 [expr $cut-1]]" } return "" } # strcmp: Zwei String werden case-insensitiv (unabhängig von der # Groß- oder Kleinschreibung) verglichen. proc strcmp {string1 string2} { return [string compare "[string tolower "$string1"]" "[string tolower "$string2"]"] } # strmatch: Hier wird geschaut, ob der String $string zu dem Pattern # $pattern paßt. proc strmatch {pattern string} { return [string match "[string tolower "$pattern"]" "[string tolower "$string"]"] } # strreplace: Jedes Vorkommen des Strings $pre innerhalb des Strings # $line wird durch $post ersetzt. proc strreplace {line pre post} { set i [string first "[string tolower "$pre"]" "[string tolower "$line"]"] if {$i != -1} { set prelen [string length "$pre"] set postlen [string length "$post"] set newline "" set left 0 while {$i != -1} { append newline "[string range "$line" $left [expr $i-1]]$post" set line "[string range "$line" [expr $i+$prelen] end]" set i [string first "$pre" "$line"] } return "$newline$line" } return "$line" } # expand: Bestimmten Zeichen wie z.B. runde und eckige Klammern wird # ein "\" vorangestellt, damit Tcl keine Probleme damit bekommt. proc expand {line} { set slist { {\\} "\"" "\\{" "\\}" "\\[" "\\]" {\^} {\|} {\$} } set rlist { "\\\\\\" "\\\"" "\\\{" "\\\}" "\\\[" "\\\]" {\\^} {\\|} {\\$} } for {set i 0} {$i < [llength "$slist"]} {incr i} { regsub -all -- "[lindex "$slist" $i]" "$line" "[lindex "$rlist" $i]" line } return "$line" } # expand2: Diese Funktion wird z.B. für Kommandos wie /notify oder # /suspect benötigt. Das Zeichen ^ und geschweifte Klammern # werden dabei nicht mit einem / erweitert. proc expand2 {line} { # vorher: # set slist { {\\} "\"" "\\{" "\\}" "\\[" "\\]" {\|} } # set rlist { "\\\\\\" "\\\"" "\\\{" "\\\}" "\\\[" "\\\]" {\\|} } # nachher: set slist { "\\{" "\\}" "\\[" "\\]" {\|} } set rlist { "\\\{" "\\\}" "\\\[" "\\\]" {\\|} } for {set i 0} {$i < [llength "$slist"]} {incr i} { regsub -all -- "[lindex "$slist" $i]" "$line" "[lindex "$rlist" $i]" line } return "$line" } # expandescape: Das Escape-Zeichen, das tkirc benutzt, wird um eins # erweitert. proc expandescape {line} { global escape_sign return "[strreplace "$line" "$escape_sign" "$escape_sign$escape_sign"]" } # reduce: Die Auswirkungen von Prozedur "expand" werden rückgängig # gemacht. (Siehe auch dort!) proc reduce {line} { set slist {"\\\\" "\\\"" "\\\{" "\\\}" "\\\[" "\\\]" "\\\|" "\\\^"} set rlist {"\\" "\"" "\{" "\}" "\[" "\]" "\|" "\^"} for {set i 0} {$i < [llength "$slist"]} {incr i} { set j [string first "[lindex "$slist" $i]" "$line"] if {$j != -1} { set left 0 ; set newline "" while {$j != -1} { append newline "[string range "$line" $left [expr $j-1]][lindex "$rlist" $i]" set line "[string range "$line" [expr $j+2] end]" set j [string first "[lindex "$slist" $i]" "$line"] } set line "$newline$line" } } return "$line" } # cutEscCodes: Möglicherweise vorhandene Steuerzeichen werden aus dem # String $line herausgefiltert. proc cutEscapeCodes {line} { set newline "" for {set i 0} {$i < [string length "$line"]} {incr i} { set char "[string index "$line" $i]" if {"$char" > "\x1f"} { append newline "$char" } } return "$newline" } ############################################################################# # # Die Verwaltung von ircII-Verbindungen, DCC-Verbindungen, Fenstern, # Kanälen und Logdateien wird ähnlich gehandhabt. proc GETNUM {field} { global $field set count "$field" ; append count "(count)" set list "$field" ; append list "(list)" set i [set $count] while {1} { if {[lsearch -exact "[set $list]" "$i"] == -1} { set num $i lappend $list $num set $list "[lsort -increasing "[set $list]"]" break } incr i } incr $count return $num } set irc(count) 0 set irc(list) "" set irc(num) 0 proc ProduceIRC { } { global irc history queue set inum [GETNUM irc] foreach x "nick lastnick serv address crap mesg lastcrap lastmesg next,pattern next,towin next,tolog next,toall next,from next,to next,chatwin tojoin,chan tojoin,win wc,nicks wc,addresses receiving_list dcclist_header notifylist suspectlist" { set irc($inum,$x) "" } foreach x "startup this last next,direct next,filter next,tocrap notice_toall next,left next,right next,beep mode,i mode,s mode,w mode,r lag,start lag,stop" { set irc($inum,$x) 0 } foreach x "msg,list" { set history($inum,$x) "" } foreach x "msg,num" { set history($inum,$x) 0 } foreach x "command filter send who whois whowas" { set queue($inum,$x) "" } foreach x "whofilter whoisfilter whowasfilter" { set queue($inum,$x) 0 } return $inum } proc DeleteIRC {inum} { global irc history queue set i [lsearch -exact "$irc(list)" $inum] if {$i == -1} { return } set irc(list) "[lreplace "$irc(list)" $i $i]" foreach x "command filter send who whofilter whois whoisfilter whowas whowasfilter" { unset queue($inum,$x) } foreach x "msg,list msg,num" { unset history($inum,$x) } foreach x "nick lastnick serv address crap mesg lastcrap lastmesg next,pattern next,towin next,tolog next,toall notice_toall next,from next,to tojoin,chan tojoin,win wc,nicks wc,addresses receiving_list dcclist_header notifylist suspectlist startup this last next,direct next,filter next,tocrap next,left next,right next,chatwin next,beep mode,i mode,s mode,w mode,r lag,start lag,stop" { unset irc($inum,$x) } unset irc($inum) } set dcc(count) 0 set dcc(list) "" set dcc(num) 0 proc ProduceDCC { } { global dcc set dnum [GETNUM dcc] foreach x "irc type nick host port state starttime sent read file size" { set dcc($dnum,$x) "" } foreach x "" { set dcc($dnum,$x) 0 } return $dnum } proc DeleteDCC {dnum} { global dcc set i [lsearch -exact "$dcc(list)" $dnum] if {$i == -1} { return } set dcc(list) "[lreplace "$dcc(list)" $i $i]" foreach x "irc type nick host port state starttime sent read file size" { unset dcc($dnum,$x) } } proc SearchDCC {inum type nick file} { global dcc set withoutfile -1 foreach x "$dcc(list)" { if {$dcc($x,irc) == $inum} { if {[string compare "$dcc($x,type)" "$type"] == 0} { if {[strcmp "$dcc($x,nick)" "$nick"] == 0} { set withoutfile $x if {[strcmp "$dcc($x,file)" "$file"] == 0} { return $x } } } } } return $withoutfile } set win(list) "" proc ProduceWindow {inum args} { global win if {"$args" == ""} { for {set i 0} {$i <= [llength $win(list)]} {incr i} { if {[lsearch -exact "$win(list)" $i] == -1} { set wnum $i lappend win(list) $i set win(list) "[lsort -increasing "$win(list)"]" break } } } elseif {[string compare "$args" "hidden"] == 0} { for {set i 500} {$i <= [expr 500+10]} {incr i} { if {[lsearch -exact "$win(list)" $i] == -1} { set wnum $i lappend win(list) $i set win(list) "[lsort -increasing "$win(list)"]" break } } } foreach x "channels query history history2 popupnick" { set win($wnum,$x) "" } foreach x "visible lines hsize taghi touched mode,i mode,s mode,w mode,r" { set win($wnum,$x) 0 } foreach x "taglo" { set win($wnum,$x) 1 } set win($wnum,actual) "*" set win($wnum,irc) $inum return $wnum } proc DeleteWindow {wnum} { global win foreach x "channels query history history2 popupnick visible lines hsize taghi touched mode,i mode,s mode,w mode,r taglo actual irc" { unset win($wnum,$x) } set i [lsearch -exact "$win(list)" "$wnum"] if {$i != -1} { set win(list) "[lreplace "$win(list)" $i $i]" } } proc GetActual {wnum} { global win if [info exists win($wnum,actual)] { return "$win($wnum,actual)" } return "" } set chan(count) 0 set chan(list) "" proc ProduceChannel {inum channel} { global irc chan win banlist if {"[string index "$channel" 0]" == "!"} { # Hierbei handelt es sich um einen speziellen Kanal, wie # er z.B. im IRCnet verwendet wird. for {set i 0} {$i < [llength "$irc($inum,tojoin,chan)"]} {incr i} { if {[string match "!!*" "[lindex "$irc($inum,tojoin,chan)" $i]"]} { if {[string match "!*[string range "[lindex "$irc($inum,tojoin,chan)" $i]" 2 end]" "$channel"]} { set irc($inum,tojoin,chan) "[lreplace "$irc($inum,tojoin,chan)" $i $i "$channel"]" } } } } set i [lSearch "$irc($inum,tojoin,chan)" "$channel"] if {$i != -1} { # Es sollte ein bestimmtes Fenster genommen werden. while {$i != -1} { set num [lindex "$irc($inum,tojoin,win)" $i] set irc($inum,tojoin,chan) "[lreplace "$irc($inum,tojoin,chan)" $i $i]" set irc($inum,tojoin,win) "[lreplace "$irc($inum,tojoin,win)" $i $i]" set i [lSearch "$irc($inum,tojoin,chan)" "$channel"] } } else { # Der Kanal sollte gar nicht gejoint werden! *brummel* Das crapwindow # wird daher für diesen Kanal benutzt. set num $irc($inum,crap) } set cnum [GETNUM chan] set chan($cnum) "$channel" foreach x "nicks names newnames cnicks ctimes olist vlist addresses jointimes topic topicnick topicdate bancomments banpatterns bantimes banusers" { set chan($cnum,$x) "" } foreach x "o v b i m n p s t" { set chan($cnum,mode_$x) 0 } foreach x "k l" { set chan($cnum,mode_$x) "" } # raw ist für eventuelle raw-Logfiles foreach x "ucount" { set chan($cnum,$x) 0 } set chan($cnum,window) $num set chan($cnum,irc) $inum lappend win($num,channels) $cnum set win($num,actual) "$channel" lappend banlist(filter) "$channel" if {[regexp -- {^[^\+\-].*$} "$channel"]} { write2irc $inum "/quote mode $channel b" } UpdateInfos $num return $cnum } proc DeleteChannel {cnum} { global irc chan win set i [lsearch "$chan(list)" $cnum] if {$i == -1} { return } set chan(list) "[lreplace "$chan(list)" $i $i]" # Falls noch ein Fenster zu diesem Kanal besteht, muß es # evtl. aktualisiert werden. if {[info exists chan($cnum,window)]} { set wnum $chan($cnum,window) if {$wnum != -1 && [lsearch -exact "$win(list)" "$wnum"] != -1} { set i [lsearch -exact "$win($wnum,channels)" "$cnum"] if {$i != -1} { set win($wnum,channels) "[lreplace "$win($wnum,channels)" $i $i]" } if {[strcmp "$win($wnum,actual)" "$chan($cnum)"] == 0} { if {[llength "$win($wnum,channels)"] == 0} { set win($wnum,actual) "*" } else { set win($wnum,actual) "$chan([lindex "$win($wnum,channels)" 0])" } } UpdateInfos $wnum } } foreach inum "$irc(list)" { set i [lsearch -exact "$irc($inum,tojoin,chan)" "$chan($cnum)"] if {$i != -1} { set irc($inum,tojoin,chan) "[lreplace "$irc($inum,tojoin,chan)" $i $i]" set irc($inum,tojoin,win) "[lreplace "$irc($inum,tojoin,win)" $i $i]" } } # Auf die Namen der Ex-Kanäle wird evtl. noch im Rahmen der Netsplits # bzw. Netjoins zugegriffen. # unset chan($cnum) foreach x "nicks names newnames cnicks ctimes olist vlist addresses jointimes topic topicnick topicdate bancomments banpatterns bantimes banusers ucount window irc" { unset chan($cnum,$x) } foreach x "o v b i m n p s t k l" { unset chan($cnum,mode_$x) } } proc AddUserToChannel {inum cnum nick address v o} { global chan set prefix "" if {$o != 0} { set prefix "@" incr chan($cnum,mode_o) } elseif {$v != 0} { set prefix "+" incr chan($cnum,mode_v) } set chan($cnum,nicks) "[linsert "$chan($cnum,nicks)" 0 "$nick"]" set chan($cnum,names) "[linsert "$chan($cnum,names)" 0 "$prefix$nick"]" set chan($cnum,vlist) "[linsert "$chan($cnum,vlist)" 0 "$v"]" set chan($cnum,olist) "[linsert "$chan($cnum,olist)" 0 "$o"]" set chan($cnum,addresses) "[linsert "$chan($cnum,addresses)" 0 "$address"]" set chan($cnum,jointimes) "[linsert "$chan($cnum,jointimes)" 0 "[clock seconds]"]" lappend chan($cnum,cnicks) "$nick" lappend chan($cnum,ctimes) 0 set wnum "$chan($cnum,window)" if {$wnum != -1} { if {[strcmp "[GetActual $wnum]" "$chan($cnum)"] == 0} { InsertToUserList $wnum $cnum "$prefix$nick" } } DetectUserOnChannel $inum $cnum 0 notify join DetectUserOnChannel $inum $cnum 0 suspect join } proc RemoveUserFromChannel {inum cnum unum nick} { global chan DetectUserOnChannel $inum $cnum $unum notify leave DetectUserOnChannel $inum $cnum $unum suspect leave set i [lsearch -exact "$chan($cnum,cnicks)" "$nick"] if {$i != -1} { set chan($cnum,cnicks) "[lreplace "$chan($cnum,cnicks)" $i $i]" set chan($cnum,ctimes) "[lreplace "$chan($cnum,ctimes)" $i $i]" } set i $unum if {[lindex "$chan($cnum,olist)" $i]} { set chan($cnum,mode_o) [expr $chan($cnum,mode_o)-1] } elseif {[lindex "$chan($cnum,vlist)" $i]} { set chan($cnum,mode_v) [expr $chan($cnum,mode_v)-1] } set address "[lindex "$chan($cnum,addresses)" $i]" set chan($cnum,nicks) "[lreplace "$chan($cnum,nicks)" $i $i]" set chan($cnum,names) "[lreplace "$chan($cnum,names)" $i $i]" set chan($cnum,vlist) "[lreplace "$chan($cnum,vlist)" $i $i]" set chan($cnum,olist) "[lreplace "$chan($cnum,olist)" $i $i]" set chan($cnum,addresses) "[lreplace "$chan($cnum,addresses)" $i $i]" set chan($cnum,jointimes) "[lreplace "$chan($cnum,jointimes)" $i $i]" KeepUser $chan($cnum,irc) $nick $address global takeover set j [lsearch -exact "$chan($cnum,addresses)" "$address"] if {$j == -1} { set j [lsearch -exact "$takeover(tries)" "$cnum $address"] if {$j != -1} { set takeover(tries) "[lreplace "$takeover(tries)" $j $j]" } } set wnum "$chan($cnum,window)" if {$wnum != -1} { if {[strcmp "[GetActual $wnum]" "$chan($cnum)"] == 0} { DeleteFromUserList $wnum $cnum "$nick" } } } proc DetectUserOnChannel {inum cnum unum type event} { global chan irc margin $type raw set channel "$chan($cnum)" set nick "[lindex "$chan($cnum,nicks)" $unum]" set address "[lindex "$chan($cnum,addresses)" $unum]" if {[string compare "$raw(type)" "QUIT"] == 0 && "$address" == ""} { set address "$raw(address)" } set lochannel "[string tolower "$chan($cnum)"]" set loserver "[string tolower "$irc($inum,serv)"]" foreach nnum "[set [set type](list)]" { if {[string match "[set [set type]($nnum)]" "$lochannel:$loserver"]} { set lonuh "[string tolower "$nick!$address"]" set lopatterns "[string tolower "[set [set type]($nnum:patterns)]"]" set len [llength "$lopatterns"] ; set enum -1 for {set i 0} {$i < $len} {incr i} { if {[string match "[lindex "$lopatterns" $i]" "$lonuh"]} { set enum $i ; break } } if {$enum != -1} { set margin(text) "$type" foreach x "comment command" { set $x "[subst -novariables "[lindex "[set [set type]($nnum:[set x]s)]" $enum]"]" } if {"$comment" != ""} { set comment ": $comment" } switch -exact -- "$type:$event" { "notify:join" { write2crap $inum "--- $nick ($address) is here (on $channel)$comment" UpdateNotifyWindow $inum 1 $cnum "$nick" "$address" } "notify:leave" { write2crap $inum "--- $nick ($address) was here (on $channel)$comment" UpdateNotifyWindow $inum 0 $cnum "$nick" "$address" } "suspect:join" { write2crap $inum "--- $nick ($address) is suspect (on $channel)$comment" UpdateSuspectWindow $inum 1 $cnum "$nick" "$address" } "suspect:leave" { write2crap $inum "--- $nick ($address) was suspect (on $channel)$comment" UpdateSuspectWindow $inum 0 $cnum "$nick" "$address" } } if {"$event" == "join"} { foreach x "nick address channel" { set command "[strreplace "$command" "\$$x" "[expand "[set $x]"]"]" } if {[string match "/*" "$command"]} { # Sowohl Kommandos von tkirc... set command "[parsein $irc($inum,crap) "$command"]" # als auch Kommandos von ircII müssen beachtet werden. if {"$command" != ""} { write2irc $inum "$command" } } elseif {"$command" != ""} { if [catch {eval $command} error] { set margin(text) "error" write2crap $inum "--- $error" } } } } } } } # Die folgende Funktion ist ein Ueberbleibsel, das nur noch in # alten Skripts 'ctcp-support.tcl' verwendet wird. proc GetChannelWindow {channel} { global chan win on_args destlog set destlog "channel $channel" foreach x "$chan(list)" { if {[strcmp "$channel" "$chan($x)"] == 0} { if {[lsearch -exact "$win(list)" $chan($x,window)] != -1} { return $chan($x,window) } } } return -1 } proc GetQueryWindow {inum nick args} { global irc win destlog if {[string length "$nick"] == 0} { set destlog "crap" return $irc($inum,crap) } set destlog "query $nick" foreach x "$win(list)" { if {$inum == $win($x,irc) && [strcmp "$win($x,query)" "$nick"] == 0} { return $x } } if {[lsearch -exact "$args" "-new"] != -1} { set num [MainWindow $inum -2] set win($num,query) "$nick" UpdateTitle $num return $num } return $irc($inum,mesg) } set logs(count) 0 set logs(list) "" proc ProduceLog {source boundary} { global irc logs set losrc "[string tolower "$source"]" set lobnd "[string tolower "$boundary"]" set lo "$losrc:$lobnd" if {[info exists logs($lo)]} { # Dieses Log existiert bereits. return -1 } if {[string match "#*" "$lobnd"]} { set inum "[string range "$lobnd" 1 end]" if {[lsearch "$irc(list)" "$inum"] == -1} { # Diese Verbindung existiert nicht. return -2 } set lobnd "[string tolower "$irc([string range "$lobnd" 1 end],serv)"]" } # Jetzt müssen nur noch passende Pattern berücksichtigt werden. foreach x "[array names logs "$losrc:*"]" { set lobnd2 "[lindex "[split "$x" ":"]" 1]" if {[string match "$lobnd" "$lobnd2"] \ || [string match "$lobnd2" "$lobnd"]} { return -1 } } set lnum [GETNUM logs] set logs($lnum) "$lo" set logs($lo) "$lnum" set logs($lnum:source) "$source" set logs($lnum:boundary) "$boundary" foreach x "filename handle opendate" { set logs($lnum:$x) "" } foreach x "dateflag rawflag timeflag linecount" { set logs($lnum:$x) 0 } return $lnum } proc DeleteLog {lnum} { global logs chan set lo "$logs($lnum)" foreach x "source boundary filename handle opendate dateflag rawflag timeflag linecount" { unset logs($lnum:$x) } unset logs($lo) unset logs($lnum) set i [lsearch -exact "$logs(list)" "$lnum"] if {$i != -1} { set logs(list) "[lreplace "$logs(list)" $i $i]" } } set suspect(count) 0 set suspect(list) "" proc ProduceSuspect {channel server} { global suspect set lochannel "[string tolower "$channel"]" set loserver "[string tolower "$server"]" if {[info exists suspect($lochannel:$loserver)]} { # Dieses Paar aus Channel und Server existiert bereits. return -1 } set snum [GETNUM suspect] set suspect($snum) "$lochannel:$loserver" set suspect($lochannel:$loserver) "$snum" set suspect($snum:channels) "$channel" set suspect($snum:servers) "$server" foreach x "nicks patterns comments commands" { set suspect($snum:$x) "" } return $snum } proc DeleteSuspect {snum} { global suspect set lo "$suspect($snum)" foreach x "channels servers nicks patterns comments commands" { unset suspect($snum:$x) } unset suspect($lo) unset suspect($snum) set i [lsearch -exact "$suspect(list)" "$snum"] if {$i != -1} { set suspect(list) "[lreplace "$suspect(list)" $i $i]" } } set notify(count) 0 set notify(list) "" proc ProduceNotify {channel server} { global notify set lochannel "[string tolower "$channel"]" set loserver "[string tolower "$server"]" if {[info exists notify($lochannel:$loserver)]} { # Dieses Paar aus Channel und Server existiert bereits. return -1 } set nnum [GETNUM notify] set notify($nnum) "$lochannel:$loserver" set notify($lochannel:$loserver) "$nnum" set notify($nnum:channels) "$channel" set notify($nnum:servers) "$server" foreach x "nicks patterns comments commands" { set notify($nnum:$x) "" } return $nnum } proc DeleteNotify {nnum} { global notify set lo "$notify($nnum)" foreach x "channels servers nicks patterns comments commands" { unset notify($nnum:$x) } unset notify($lo) unset notify($nnum) set i [lsearch -exact "$notify(list)" "$nnum"] if {$i != -1} { set notify(list) "[lreplace "$notify(list)" $i $i]" } } ############################################################################# # # Dieser Abschnitt befaßt sich mit der Automatisierung der Baninfos. # Für jeden _bevorzugten_ Kanal werden die Baninfos beim Betreten # automatisch eingeladen und dementsprechend auch bei Veränderungen # der Bans bzw. deren Kommentaren abgespeichert. proc load_baninfos {inum cnum filename} { global chan if {![info exists chan($cnum,banpatterns)] \ || [set len [llength "$chan($cnum,banpatterns)"]] <= 0 || [catch {open "$filename" r} file]} { # Entweder existieren keine Bans zu diesem Kanal, oder die Datei # konnte (aus welchem Grund auch immer) nicht geöffnet werden. return 0 } set getrc [gets $file line] set line "[expand "$line"]" if {$getrc < 0 \ || [string match "### Baninfos for channel *" "$line"] == 0} { debug "--- File '$filename' doesn't have the right format for baninfos" } elseif {[strcmp "$chan($cnum)" "[lindex "$line" 4]"] != 0} { debug "--- File '$filename' doesn't have baninfos for channel $chan($cnum)" } else { while {[gets $file line] >= 0} { scan "$line" "%d %s %s :*" time user pattern set comment "[string range "[cutwords "$line" 3]" 1 end]" for {set i 0} {$i < $len} {incr i} { if {[string compare "$pattern" "[lindex "$chan($cnum,banpatterns)" $i]"] == 0 && "$comment" != ""} { if {$time > [lindex "$chan($cnum,bantimes)" $i] || [lindex "$chan($cnum,bantimes)" $i] == 0} { foreach x "time user pattern comment" { set chan($cnum,ban[set x]s) "[lreplace "$chan($cnum,ban[set x]s)" $i $i "[set $x]"]" } break } } } } debug "--- Baninfos for channel $chan($cnum) actualized" } close $file return 1 } proc save_baninfos {inum cnum filename args} { global chan irc if {![info exists chan($cnum,banpatterns)] \ || [set len [llength "$chan($cnum,banpatterns)"]] <= 0 || [catch {open "$filename" w} file]} { # Entweder existieren keine Bans zu diesem Kanal, oder die Datei # konnte (aus welchem Grund auch immer) nicht geöffnet werden. return 0 } puts $file "### Baninfos for channel $chan($cnum) on $irc($inum,serv)" for {set i 0} {$i < $len} {incr i} { puts $file "[lindex "$chan($cnum,bantimes)" $i] [lindex "$chan($cnum,banusers)" $i] [lindex "$chan($cnum,banpatterns)" $i] :[lindex "$chan($cnum,bancomments)" $i]" } debug "--- Baninfos for channel $chan($cnum) saved into file '$filename'" close $file return 1 } proc on_tkircstart_baninfos { } { # Alle Baninfos-Dateien, die in den letzten 4 Wochen nicht angerührt # wurden, werden beim Start von tkirc gelöscht. eval lappend files [glob -nocomplain -- "~/.tkirc2/.data/baninfos.*"] for {set i 0} {$i < [llength "$files"]} {incr i} { set now [clock seconds] if {[expr $now-[file atime "[lindex "$files" $i]"]] > [expr 28*24*60*60]} { catch {file delete -- "[lindex "$files" $i]"} } } } # 368 = RPL_ENDOFBANLIST proc on_368_baninfos { } { global baninfos irc on_args preferred_channels set inum $on_args(irc) set channel "[lindex "$on_args(list)" 3]" set cnum [ChannelNumber $inum "$channel"] if {$cnum != -1} { set i [lSearch "$preferred_channels" "$channel"] if {$i != -1} { set lo "[string tolower "$channel"]" load_baninfos $inum $cnum "~/.tkirc2/.data/baninfos-default.$lo" load_baninfos $inum $cnum "~/.tkirc2/.data/baninfos.$lo" } } } proc on_leave_baninfos { } { global baninfos chan irc on_args preferred_channels set inum $on_args(irc) set channel "$on_args(channel)" set cnum [ChannelNumber $inum "$channel"] if {$cnum != -1 \ && [string compare "$on_args(nick)" "$irc($inum,nick)"] == 0} { set i [lSearch "$preferred_channels" "$channel"] if {$i != -1} { set lo "[string tolower "$channel"]" save_baninfos $inum $cnum "~/.tkirc2/.data/baninfos.$lo" } } } proc on_modechange_baninfos { } { global baninfos chan irc on_args preferred_channels set inum $on_args(irc) set channel "$on_args(to)" set cnum [ChannelNumber $inum "$channel"] if {$cnum != -1 && [string match "*b" "$on_args(mode)"]} { set i [lSearch "$preferred_channels" "$channel"] if {$i != -1} { set lo "[string tolower "$channel"]" save_baninfos $inum $cnum "~/.tkirc2/.data/baninfos.$lo" } } } proc on_signoff_baninfos { } { global baninfos chan irc on_args preferred_channels set inum $on_args(irc) if {[string compare "$on_args(nick)" "$irc($inum,nick)"] == 0} { foreach x "$chan(list)" { set i [lSearch "$preferred_channels" "$chan($x)"] if {$i != -1 && $chan($x,irc) == $inum} { if {"$chan($x,banpatterns)" != ""} { set lo "[string tolower "$chan($x)"]" save_baninfos $inum $x "~/.tkirc2/.data/baninfos.$lo" } } } } } ############################################################################# # # Der folgende Abschnitt befaßt sich mit der Suspect-Liste. Da Bans für # Kanäle in der Regel nur begrenzt möglich sind, kann mit Hilfe der # Suspect-Liste auf bestimmte Adress-Pattern vielfältig _reagiert_ werden. # Paßt bei einem JOIN die Adresse des neuen Kanal-Besuchers zu einem Pattern # der Suspect-Liste können automatisch bestimmte Aktionen ausgeführt werden. # Dies kann z.B. von einer einfachen Warnung des tkirc-Benutzers bis hin zu # einem automatisch ausgeführten Ban+Kick führen. # # Zeilenformat: # set suspect(filename) "~/.tkirc2/.data/suspects" proc load_suspects { } { global suspect set filename "$suspect(filename)" if {[catch {open "$filename" r} file]} { return 0 } set getrc [gets $file line] set line "[expand "$line"]" if {$getrc > 0 && [string compare "### Suspects " "$line"] == 0} { while {[gets $file line] >= 0} { set list "[line2list "$line"]" set elements "nick pattern channel server comment command" for {set i 0} {$i < [llength "$elements"]} {incr i} { set [lindex "$elements" $i] "[lindex "$list" $i]" } set snum [ProduceSuspect "$channel" "$server"] if {$snum == -1} { # Dieser Eintrag aus Channel und Server existiert bereits. set snum $suspect([string tolower "$channel:$server"]) } for {set i 0} {$i < [llength "$elements"]} {incr i} { set element [lindex "$elements" $i] lappend suspect($snum:[set element]s) "[set $element]" } } debug "--- Suspects actualized" } close $file return 1 } proc save_suspects { } { global suspect set filename "$suspect(filename)" if {[catch {open "$filename" w} file]} { return 0 } puts $file "### Suspects " foreach snum "$suspect(list)" { set len [llength "$suspect($snum:patterns)"] for {set i 0} {$i < $len} {incr i} { foreach x "nicks patterns channels servers comments commands" { puts -nonewline $file "\"[lindex "$suspect($snum:$x)" $i]\" " } puts $file "" } } debug "--- Suspects saved" close $file return 1 } proc on_tkircstart_suspects { } { load_suspects } ############################################################################# # # Im folgenden wird sich mit der Notify-Handhabung auseinandergesetzt. Der # Befehl /notify wurde dabei dem Befehl /suspect angepaßt. # # Zeilenformat: # set notify(filename) "~/.tkirc2/.data/notifies" proc load_notifies { } { global notify set filename "$notify(filename)" if {[catch {open "$filename" r} file]} { return 0 } set getrc [gets $file line] set line "[expand "$line"]" if {$getrc > 0 && [string compare "### Notifies " "$line"] == 0} { while {[gets $file line] >= 0} { set list "[line2list "$line"]" set elements "nick pattern channel server comment command" for {set i 0} {$i < [llength "$elements"]} {incr i} { set [lindex "$elements" $i] "[lindex "$list" $i]" } set nnum [ProduceNotify "$channel" "$server"] if {$nnum == -1} { # Ein Notify-Eintrag für diesen Server existiert bereits. set nnum $notify([string tolower "$channel:$server"]) } for {set i 0} {$i < [llength "$elements"]} {incr i} { set element [lindex "$elements" $i] lappend notify($nnum:[set element]s) "[set $element]" } } debug "--- Notifies actualized" } close $file return 1 } proc save_notifies { } { global notify set filename "$notify(filename)" if {[catch {open "$filename" w} file]} { return 0 } puts $file "### Notifies " foreach nnum "$notify(list)" { set len [llength "$notify($nnum:patterns)"] for {set i 0} {$i < $len} {incr i} { foreach x "nicks patterns channels servers comments commands" { puts -nonewline $file "\"[lindex "$notify($nnum:$x)" $i]\" " } puts $file "" } } debug "--- Notifies saved" close $file return 1 } proc on_tkircstart_notifies { } { load_notifies } proc on_connect_notifies_and_suspects { } { global irc margin notify suspect on_args set inum $on_args(irc) write2irc $inum "/notify -" FilterLine $inum "*** Notify list cleared" set irc($inum,notifylist) "" set irc($inum,suspectlist) "" foreach nnum "$notify(list)" { for {set i 0} {$i < [llength "$notify($nnum:nicks)"]} {incr i} { set nick "[lindex "$notify($nnum:nicks)" $i]" if {![isPattern "$nick"] && [lSearch "$irc($inum,notifylist)" "$nick"] == -1} { lappend irc($inum,notifylist) "$nick" if {[lSearch "$irc($inum,suspectlist)" "$nick"] == -1} { FilterLine $inum "*** [expand "$nick"] added to the notification list" write2irc $inum "/notify $nick" } } } } foreach snum "$suspect(list)" { for {set i 0} {$i < [llength "$suspect($snum:nicks)"]} {incr i} { set nick "[lindex "$suspect($snum:nicks)" $i]" if {![isPattern "$nick"] && [lSearch "$irc($inum,suspectlist)" "$nick"] == -1} { lappend irc($inum,suspectlist) "$nick" if {[lSearch "$irc($inum,notifylist)" "$nick"] == -1} { FilterLine $inum "*** [expand "$nick"] added to the notification list" write2irc $inum "/notify $nick" } } } } } proc DetectUserOnIRC {inum nick type call} { global irc margin notify suspect set address "" if {$type == 0} { if {$call == 0} { # Die Adresse wird auch beim Signoff besorgt. set command "DetectUserOnIRC $inum [expand $nick] $type 1" AddToWhowasQueue "$nick" $irc($inum,crap) "$command" "" return } else { # Die vorhandene Addresse ist aktuell. set address "[AddressOfNick $inum $nick]" } } if {$type > 0} { if {$call == 0} { # Die Adresse muß besorgt werden. set command "DetectUserOnIRC $inum [expand $nick] $type 1" AddToWhoisQueue $inum "$nick" "" "$command" return } else { # Die vorhandene Addresse _sollte_ aktuell sein. set address "[AddressOfNick $inum $nick]" } } set server "$irc($inum,serv)" set lochannel "" set loserver "[string tolower "$server"]" foreach nnum "$notify(list)" { if {[string match "$notify($nnum)" "$lochannel:$loserver"]} { set lonuh "[string tolower "$nick!$address"]" set lopatterns "[string tolower "$notify($nnum:patterns)"]" set len [llength "$lopatterns"] ; set enum -1 for {set i 0} {$i < $len} {incr i} { if {[string match "[lindex "$lopatterns" $i]" "$lonuh"]} { if {"[lindex "$notify($nnum:channels)" $i]" == ""} { set enum $i ; break } } } if {$enum != -1} { set margin(text) "notify" foreach x "comment command" { set $x "[subst -nobackslashes "[lindex "$notify($nnum:[set x]s)" $enum]"]" } set num $irc($inum,crap) global show_time_on_each_line if {$show_time_on_each_line($num) != 0} { set time "" } else { set time " at [time]" } if {"$comment" != ""} { set comment ": $comment" } switch -exact -- "$type" { "1" { ExecOnCommands notify_signon $inum nick "$nick" address "$address" set margin(text) "notify" write2crap $inum "--- $nick ($address) is here (signon$time)$comment" } "0" { ExecOnCommands notify_signoff $inum nick "$nick" address "$address" set margin(text) "notify" write2crap $inum "--- $nick ($address) was here (signoff$time)$comment" } } UpdateNotifyWindow $inum $type -1 "$nick" "$address" if {$type == 1} { foreach x "nick address" { set command "[strreplace "$command" "\$$x" "[expand "[set $x]"]"]" } if {[string match "/*" "$command"]} { # Sowohl Kommandos von tkirc... set command "[parsein $irc($inum,crap) "$command"]" # als auch Kommandos von ircII müssen beachtet werden. if {"$command" != ""} { write2irc $inum "$command" } } elseif {"$command" != ""} { if [catch {eval $command} error] { set margin(text) "error" write2crap $inum "--- $error" } } } } } } foreach nnum "$suspect(list)" { if {[string match "$suspect($nnum)" "$lochannel:$loserver"]} { set lonuh "[string tolower "$nick!$address"]" set lopatterns "[string tolower "$suspect($nnum:patterns)"]" set len [llength "$lopatterns"] ; set enum -1 for {set i 0} {$i < $len} {incr i} { if {[string match "[lindex "$lopatterns" $i]" "$lonuh"]} { if {"[lindex "$suspect($nnum:channels)" $i]" == ""} { set enum $i ; break } } } if {$enum != -1} { set margin(text) "suspect" foreach x "comment command" { set $x "[subst -nobackslashes "[lindex "$suspect($nnum:[set x]s)" $enum]"]" } set num $irc($inum,crap) global show_time_on_each_line if {$show_time_on_each_line($num) != 0} { set time "" } else { set time " at [time]" } if {"$comment" != ""} { set comment ": $comment" } switch -exact -- "$type" { "1" { ExecOnCommands suspect_signon $inum nick "$nick" address "$address" set margin(text) "suspect" write2crap $inum "--- $nick ($address) is suspected (signon$time)$comment" } "0" { ExecOnCommands suspect_signoff $inum nick "$nick" address "$address" set margin(text) "suspect" write2crap $inum "--- $nick ($address) was suspected (signoff$time)$comment" } } UpdateSuspectWindow $inum $type -1 "$nick" "$address" if {$type == 1} { foreach x "nick address" { set command "[strreplace "$command" "\$$x" "[expand "[set $x]"]"]" } if {[string match "/*" "$command"]} { # Sowohl Kommandos von tkirc... set command "[parsein $irc($inum,crap) "$command"]" # als auch Kommandos von ircII müssen beachtet werden. if {"$command" != ""} { write2irc $inum "$command" } } elseif {"$command" != ""} { if [catch {eval $command} error] { set margin(text) "error" write2crap $inum "--- $error" } } } } } } } ############################################################################# # # proc SetChannelModes {cnum changes type address} { # type: 0 == Modes waren bereits gesetzt, 1 == Modes wurden gerade geändert global chan # vorzeichen (0 = -) (1 = +) set vorzeichen 1 ; set prefix "+" set pcnt 0 set flags "[lIndex "$changes" 0]" set parameter "[cutwords "$changes" 1]" for {set i 0} {$i < [string length "$flags"]} {incr i} { set flag "[string index "$flags" $i]" switch -exact -- "$flag" { "+" {set vorzeichen 1 ; set prefix "+"} "-" {set vorzeichen 0 ; set prefix "-"} } # on_commands nur beim Ändern eines Modes if {$type != 0} { switch -regexp -- "$flag" { "k|l|b|o|v" { ExecOnCommands modechange $chan($cnum,irc) to "$chan($cnum)" \ mode "$prefix$flag" argument "[lIndex "$parameter" $pcnt]" } "i|m|n|p|s|t" { ExecOnCommands modechange $chan($cnum,irc) to "$chan($cnum)" \ mode "$prefix$flag" argument "" } } } switch -regexp -- "$flag" { "k" { if {$vorzeichen != 0} { set chan($cnum,mode_k) "[lIndex "$parameter" $pcnt]" } else { set chan($cnum,mode_k) "" } incr pcnt } "l" { if {$vorzeichen != 0} { set chan($cnum,mode_l) "[lIndex "$parameter" $pcnt]" incr pcnt } else { set chan($cnum,mode_l) "" } } "b" { if {$vorzeichen != 0} { BanChannelUser $cnum [lIndex "$parameter" $pcnt] "$address" } else { UnbanChannelUser $cnum [lIndex "$parameter" $pcnt] } incr pcnt } "o" { ChannelUserOp $cnum [lIndex "$parameter" $pcnt] $vorzeichen incr pcnt } "v" { ChannelUserVoice $cnum [lIndex "$parameter" $pcnt] $vorzeichen incr pcnt } "i|m|n|p|s" { set chan($cnum,mode_$flag) $vorzeichen } "t" { set chan($cnum,mode_t) $vorzeichen } } } UpdateTitle $chan($cnum,window) UpdateTopic $chan($cnum,window) } proc SetUserModes {inum flags} { global irc win # vorzeichen (0 = -) (1 = +) set vorzeichen 1 ; set prefix "+" for {set i 0} {$i < [string length "$flags"]} {incr i} { set flag "[string index "$flags" $i]" switch -exact -- "$flag" { "+" {set vorzeichen 1 ; set prefix "+"} "-" {set vorzeichen 0 ; set prefix "-"} } switch -regexp -- "$flag" { "i|s|w|r" { set irc($inum,mode,$flag) $vorzeichen foreach w "$win(list)" { if {$win($w,irc) == $inum} { set win($w,mode,$flag) $vorzeichen } } ExecOnCommands modechange $inum nick "$irc($inum,nick)" address "$irc($inum,address)" to "$irc($inum,nick)" mode "$prefix$flag" argument "" } } } } proc ChangeUserMode {wnum mode} { global irc win if {$win($wnum,mode,$mode) != 0} { write2irc $win($wnum,irc) "/umode +$mode" set win($wnum,mode,$mode) 0 } else { write2irc $win($wnum,irc) "/umode -$mode" set win($wnum,mode,$mode) 1 } } proc ChannelModesWindow {num} { global chan irc win margin cmw_modes cmw_channel set inum $win($num,irc) set channel [GetActual $num] if {"$channel" != "*"} { set cnum [ChannelNumber $inum "$channel"] set cmw_channel $cnum foreach x "i k l m n p s t" { set cmw_modes($x) "$chan($cnum,mode_$x)" } if {[RequestLevel .channelmodes]} { # grab set .channelmodes wm title .channelmodes " tkirc: Set modes " bind .channelmodes "closewindow .channelmodes" Label .channelmodes.mid -text " Set modes of channel $channel: " pack .channelmodes.mid -side top -padx 2 -pady 2 set f .channelmodes.buttons Frame $f pack $f -side bottom -fill x -pady 2 Button $f.commit -text "Commit changes" \ -command "CommitChannelModeChanges ; closewindow .channelmodes" Button $f.cancel -text "Cancel" -command "closewindow .channelmodes" pack $f.commit -side left pack $f.cancel -side right set f .channelmodes.body Frame $f -borderwidth 1 -relief sunken Frame $f.left -borderwidth 0 foreach x {{i {invite only}} {p private} {s secret}} { Checkbutton $f.left.[lindex "$x" 0] -text [lindex "$x" 1] \ -variable cmw_modes([lindex "$x" 0]) pack $f.left.[lindex "$x" 0] -anchor w } Frame $f.left.k -borderwidth 0 pack $f.left.k -pady 2 Label $f.left.k.label -text " keyword:" pack $f.left.k.label -side left Entry $f.left.k.entry -width 8 $f.left.k.entry delete 0 end $f.left.k.entry insert end "$cmw_modes(k)" pack $f.left.k.entry -side left -fill x pack $f.left.k pack $f.left -side left -padx 2 Frame $f.right -borderwidth 0 foreach x {{n {no messages}} {m {moderated}} {t {topic limits}}} { Checkbutton $f.right.[lindex "$x" 0] -text [lindex "$x" 1] \ -variable cmw_modes([lindex "$x" 0]) pack $f.right.[lindex "$x" 0] -anchor w } Frame $f.right.l -borderwidth 0 pack $f.right.l -pady 2 Label $f.right.l.label -text " user limit:" pack $f.right.l.label -side left Entry $f.right.l.entry -width 8 $f.right.l.entry delete 0 end $f.right.l.entry insert end "$cmw_modes(l)" pack $f.right.l.entry -side left pack $f.right.l pack $f.right -side right -padx 2 pack $f -side top -expand true -fill x -padx 1 -pady 2 } } else { set margin(text) "error" print2text $num "--- You have no channel joined in this window" } } proc CommitChannelModeChanges { } { global chan cmw_modes cmw_channel set cnum $cmw_channel set inum $chan($cnum,irc) set plus "" ; set minus "" ; set parameters "" foreach x "i m n p s t" { if {$cmw_modes($x) > $chan($cnum,mode_$x)} { append plus "$x" } elseif {$cmw_modes($x) < $chan($cnum,mode_$x)} { append minus "$x" } } set cmw_modes(k) "[.channelmodes.body.left.k.entry get]" set cmw_modes(l) "[.channelmodes.body.right.l.entry get]" if {[strcmp "$cmw_modes(k)" "$chan($cnum,mode_k)"]} { if {[string length "$chan($cnum,mode_k)"]} { write2irc $inum "/mode $chan($cmw_channel) -k $chan($cnum,mode_k)" } if {[string length "$cmw_modes(k)"]} { append plus "k" append parameters " $cmw_modes(k)" } else { append minus "k" append parameters " $chan($cnum,mode_k)" } } if {[strcmp "$cmw_modes(l)" "$chan($cnum,mode_l)"]} { if {[string length "$cmw_modes(l)"]} { append plus "l" append parameters " $cmw_modes(l)" } else { append minus "l" append parameters " $cmw_modes(l)" } } if {"$plus$minus" != ""} { write2irc $inum "/mode $chan($cmw_channel) +$plus-$minus$parameters" } } ############# # WIDGETS # ############# proc closewindow {path} { grab release $path destroy $path } proc setWidgetColor {path} { global color foreach c "[array names color *back*]" { catch { $path config -$c $color($c) } } foreach c "[array names color *fore*]" { catch { $path config -$c $color($c) } } } proc Scale {path args} { global font if {[info exists font(scale)] && [string length "$font(scale)"]} { eval {scale $path} -font \{$font(scale)\} $args } else { eval {scale $path} $args } setWidgetColor $path } proc Button {path args} { global font if {[info exists font(button)] && [string length "$font(button)"]} { eval {button $path} -font \{$font(button)\} $args } else { eval {button $path} $args } setWidgetColor $path } proc Checkbutton {path args} { global font if {[info exists font(checkbutton)] && [string length "$font(checkbutton)"]} { eval {checkbutton $path} -font \{$font(checkbutton)\} $args } else { eval {checkbutton $path} $args } setWidgetColor $path } proc DefaultButton {path args} { Frame $path -relief sunken -borderwidth 1 eval Button $path.default $args pack $path.default } proc Entry {name args} { global default_entry_bindings entry_bindings font if {[info exists font(entry)] && [string length "$font(entry)"]} { eval {entry $name -relief sunken} -font \{$font(entry)\} $args } else { eval {entry $name -relief sunken} $args } foreach x "$default_entry_bindings" { bind $name [lindex "$x" 0] [lindex "$x" 1] } foreach x "$entry_bindings" { bind $name [lindex "$x" 0] [lindex "$x" 1] } setWidgetColor $name } proc Label {name args} { global font if {[info exists font(label)] && [string length "$font(label)"]} { eval {label $name} -font \{$font(label)\} $args } else { eval {label $name} $args } setWidgetColor $name } proc Listbox {name args} { global font if {[info exists font(listbox)] && [string length "$font(listbox)"]} { eval {listbox $name} -font \{$font(listbox)\} $args } else { eval {listbox $name} $args } setWidgetColor $name } proc Scrollbar {name args} { eval {scrollbar $name} $args setWidgetColor $name } proc Frame {name args} { eval {frame $name} $args setWidgetColor $name } proc Toplevel {name args} { if [catch {eval {toplevel $name} $args} err] { puts stderr "$err" raise $name return 0 } else { setWidgetColor $name return 1 } } proc RequestLevel {name} { return [Toplevel $name -class tkirc-request] } proc Menu {name args} { global font if {[info exists font(menu)] && [string length "$font(menu)"]} { eval {menu $name} -font \{$font(menu)\} $args } else { eval {menu $name} $args } setWidgetColor $name } proc Menubutton {name args} { global font if {[info exists font(menubutton)] && [string length "$font(menubutton)"]} { eval {menubutton $name} -font \{$font(menubutton)\} $args } else { eval {menubutton $name} $args } setWidgetColor $name } proc Radiobutton {path args} { global font if {[info exists font(radiobutton)] && [string length "$font(radiobutton)"]} { eval {radiobutton $path} -font \{$font(radiobutton)\} $args } else { eval {radiobutton $path} $args } setWidgetColor $path } proc Text {name args} { global font eval text $name -relief sunken -wrap word -setgrid 0 $args if {[info exists font(text)] && [string length "$font(text)"]} { $name configure -font "$font(text)" } bind $name "[bind Text ] ; break" bind $name {%W insert insert \017} bind $name {%W insert insert \037} bind $name {%W insert insert \026} setWidgetColor $name } proc EntryOneWordLeft {widget} { set insert "[$widget index insert]" set left "[string range "[$widget get]" 0 [expr $insert-1]]" set space "[string last " " "$left"]" if {$space == -1} { $widget icursor 0 } else { $widget icursor [expr $space+1] } } proc EntryOneWordRight {widget} { set insert "[$widget index insert]" set right "[string range "[$widget get]" $insert end]" set space "[string first " " "$right"]" if {$space == -1} { $widget icursor end } else { $widget icursor [expr $insert+$space] } } proc InsertFromClipboard {widget} { if {![catch {selection get -selection CLIPBOARD} result]} { $widget insert insert "$result" } } proc listbox_vs {path} { # vertical, single Frame $path -bd 0 Scrollbar $path.scroll -width 10 -orient vertical \ -command [list $path.view yview] Listbox $path.view -exportselection false -relief raised \ -yscrollcommand "$path.scroll set" pack $path.view -expand true -side left -fill both pack $path.scroll -side left -fill y } proc listview {name args} { global margin Frame $name eval {Text $name.text -yscroll [list $name.scroll set] \ -state disabled} $args Scrollbar $name.scroll -width 10 -orient vertical -command [list $name.text yview] pack $name.scroll -side right -fill y pack $name.text -side left -expand true -fill both return $name } proc TextPageUp {widget} { set top "[lindex [$widget yview] 0]" set bottom "[lindex [$widget yview] 1]" set diff [expr $bottom - $top] if {$top > 0} { $widget yview moveto [expr $top - $diff] } } proc TextPageDown {widget} { # set top "[lindex [$widget yview] 0]" set bottom "[lindex [$widget yview] 1]" # set diff [expr $bottom - $top] if {$bottom < 1} { $widget yview moveto $bottom } } proc textSearch {num string tag} { global win search_lastview search_laststring # Die gefundenen Texte einer alten Suche werden wieder normal # dargestellt. set w [GetWindowPath $num].body.left.traffic.text $w tag remove search 0.0 end if {$string == ""} { return } # Gefundene Texte werden hervorgehoben. set cur 1.0 while 1 { set cur [$w search -nocase -count length -- $string $cur end] if {$cur == ""} { break } $w tag add $tag $cur "$cur + $length char" set cur [$w index "$cur + $length char"] } set lostring "[string tolower "$string"]" set startview "[lindex [$w yview] 0]" set endview "[lindex [$w yview] 1]" set startnum [expr int($startview * $win($num,visible) + 1)] set endnum [expr int($endview * $win($num,visible))] set skipthisview 1 if {[strcmp "$search_laststring" "$string"]} { set skipthisview 0 } elseif {[expr [format "%.5g" $startview]-[format "%.5g" $search_lastview]] > 0.00001} { set skipthisview 0 } elseif {$search_lastview > $endview} { set skipthisview 0 } set search_laststring "$string" if {$skipthisview == 0} { # bereits sichtbaren Bereich durchsuchen for {set i $startnum} {$i <= $endnum} {incr i} { set loline "[string tolower "[$w get $i.0 [expr $i+1].0]"]" if {[string first "$lostring" "$loline"] != -1} { set search_lastview [format "%.5g" [expr double($i-1) / $win($num,visible)]] return } } } # Rest des Textes durchsuchen if {$endview != 1} { for {set i [expr $endnum+1]} {$i <= $win($num,visible)} {incr i} { set loline "[string tolower "[$w get $i.0 [expr $i+1].0]"]" if {[string first "$lostring" "$loline"] != -1} { set search_lastview [format "%.5g" [expr double($i-1) / $win($num,visible)]] $w yview moveto $search_lastview return } } } # Anfang des Textes durchsuchen for {set i 1} {$i < $startnum} {incr i} { set loline "[string tolower "[$w get $i.0 [expr $i+1].0]"]" if {[string first "$lostring" "$loline"] != -1} { set search_lastview [format "%.5g" [expr double($i-1) / $win($num,visible)]] $w yview moveto $search_lastview return } } # string nicht gefunden beep } ####################### # TRAFFIC FUNCTIONS # ####################### proc riddle_urls {wnum lnum snum line prestyle prestyletext} { global win margin style set inum $win($wnum,irc) set widget "[GetWindowPath $wnum].body.left.traffic.text" # URLs set i [string first "://" "$line"] if {$i != -1} { # '://' found while {$i != -1} { set rightURLfound 0 set prefix "[string trimleft "[lindex "[split "[string range "$line" 0 [expr $i-1]]" "\"\!\,\:\{\}\[\]\<\>\'\(\) "]" end]" "\t\n"]" foreach x "http ftp gopher telnet https wais nntp" { set xlen [string length "$x"] if {[strcmp "$prefix" "$x"] == 0} { set suffix "[lindex "[split "[string range "$line" [expr $i+3] end]" "\"\{\}\[\]\<\>\' "]" 0]" set suffix "[string trimright "$suffix" "!?.,"]" # Ggf. wird bei runden Klammern geschnitten. set url "$prefix://" while {"$suffix" != ""} { set auf [string first "(" "$suffix"] set zu [string first ")" "$suffix"] if {$zu == -1} { if {$auf != -1} { append url "[string range "$suffix" 0 [expr $auf-1]]" } else { append url "$suffix" } } elseif {$auf == -1} { if {$zu != -1} { append url "[string range "$suffix" 0 [expr $zu-1]]" } else { append url "$suffix" } } else { if {$zu < $auf} { append url "[string range "$suffix" 0 [expr $zu-1]]" } else { append url "[string range "$suffix" 0 $zu]" set suffix "[string range "$suffix" [expr $zu+1] end]" continue } } break } # Der Text vor dem URL muß noch eingefügt werden. set snum [riddle_msgids $wnum $lnum $snum "[string range "$line" 0 [expr $i-$xlen-1]]" $prestyle "$prestyletext"] set rightURLfound 1 set activebackground [getColor . -activebackground] set normalbackground [$widget tag cget $prestyle -background] if {"$normalbackground" == ""} { set normalbackground "[$widget cget -background]" } set normalforeground [$widget tag cget $prestyle -foreground] if {"$normalforeground" == ""} { set normalforeground "[$widget cget -foreground]" } set urlstyle [newStyle $wnum $wnum:$lnum:u[incr snum] "$prestyletext $style(url)"] set line "[string range "$line" [expr $i-$xlen+[string length "$url"]] end]" if {[strcmp "$url" "$prefix://"] == 0} { $widget insert end "$url" $prestyle } else { global urls set k [lsearch -exact "$urls(values)" "$url"] if {$k != -1} { foreach x "dates times values" { set urls($x) "[lreplace "$urls($x)" $k $k]" } if {[winfo exists .urls]} { multilistbox delete .urls.list $k } } lappend urls(dates) "[date]" lappend urls(times) "[time2]" lappend urls(values) "$url" if {[winfo exists .urls]} { multilistbox insert .urls.list end "[date]" "[time2]" "$url" } $widget insert end "$url" $urlstyle $widget tag bind $urlstyle "$widget tag configure $urlstyle -background $activebackground" $widget tag bind $urlstyle "$widget tag configure $urlstyle -background $normalbackground -foreground $normalforeground $style(url)" $widget tag bind $urlstyle "global selected_url ; set selected_url \{[strreplace "[expand "$url"]" "%" "%%"]\} ; ExecUrlAction" ExecOnCommands url_detect $win($wnum,irc) window "$wnum" \ url "[expand "$url"]" } break } } if {$rightURLfound != 0} { set i [string first "://" "$line"] } else { break } } } return [riddle_msgids $wnum $lnum $snum "$line" $prestyle "$prestyletext"] } proc riddle_msgids {wnum lnum snum line prestyle prestyletext} { global win margin style set inum $win($wnum,irc) set widget "[GetWindowPath $wnum].body.left.traffic.text" # MessageIDs if {[string first "@" "$line"] != -1} { set cutline "$line" set i [string first "<" "$cutline"] while {$i != -1} { $widget insert end "[string range "$cutline" 0 [expr $i-1]]" $prestyle set possible "[string range "$cutline" $i end]" set j [string first ">" "$possible"] if {$j != -1} { set possible "[string range "$possible" 0 $j]" if [regexp -- {^<[^ <>@]+@[^ <>@]+>$} "$possible"] { # dieser Teil ist eine MessageID set activebackground [getColor . -activebackground] set normalbackground [$widget tag cget $prestyle -background] if {"$normalbackground" == ""} { set normalbackground "[$widget cget -background]" } set normalforeground [$widget tag cget $prestyle -foreground] if {"$normalforeground" == ""} { set normalforeground "[$widget cget -foreground]" } set msgidstyle [newStyle $wnum $wnum:$lnum:m[incr snum] "$prestyletext $style(msgid)"] global msgids set k [lsearch -exact "$msgids(values)" "$possible"] if {$k != -1} { set msgids(values) "[lreplace "$msgids(values)" $k $k]" if {[winfo exists .msgids]} { multilistbox delete .msgids.list $k } } lappend msgids(dates) "[date]" lappend msgids(times) "[time2]" lappend msgids(values) "$possible" if {[winfo exists .msgids]} { multilistbox insert .msgids.list end "[date]" "[time2]" "$possible" } $widget insert end "$possible" $msgidstyle set cutline "[string range "$cutline" [expr $i+$j+1] end]" $widget tag bind $msgidstyle "$widget tag configure $msgidstyle -background $activebackground" $widget tag bind $msgidstyle "$widget tag configure $msgidstyle -background $normalbackground -foreground $normalforeground $style(msgid)" $widget tag bind $msgidstyle "global selected_msgid ; set selected_msgid \{[expand "$possible"]\} ; ExecMsgIDAction" ExecOnCommands msgid_detect $win($wnum,irc) window "$wnum" \ msgid "[expand "$possible"]" } else { # dieser Teil ist keine MessageID $widget insert end "$possible" $prestyle set cutline "[string range "$cutline" [expr $i+$j+1] end]" } } else { # kein '> ' vorhanden $widget insert end "[string trimright "$possible" " "]" $prestyle set cutline "" break } set i [string first "<" "$cutline"] } $widget insert end "$cutline" $prestyle return $snum } # no URLs and no MessageIDs in line $widget insert end "$line" $prestyle return $snum } proc riddletext {line} { set newline "" for {set i 0} {$i <= [string length "$line"]} {incr i} { set char "[string index "$line" $i]" if {"$char" > "\x1f"} { append newline "$char" } else { switch -- "$char" { "\x02" {} "\x0f" {} "\x11" {} "\x16" {} "\x1f" {} "\a" {} "\x03" { # mIRC-Farben set j [expr $i+1] if {[regexp {[0-9]} "[string index "$line" $j]"]} { incr i ; incr j if {[regexp {[0-9]} "[string index "$line" $j]"]} {incr i;incr j} if {[regexp {[0-9]} "[string index "$line" $j]"]} {incr i;incr j} if {[regexp {,[0-9]} "[string range "$line" $j [expr $j+1]]"]} { set i [incr j] ; incr j if {[regexp {[0-9]} "[string index "$line" $j]"]} {incr i;incr j} if {[regexp {[0-9]} "[string index "$line" $j]"]} {incr i;incr j} } } } default { append newline "$char" } } } } return "$newline" } proc print2text {wnum line args} { global away color irc margin win lines_max use_margin global style user_styles set bold 0 set invers 0 set underline 0 set italic 0 set ansi_forecolor "" ; set ansi_backcolor "" set mirc_forecolor "" ; set mirc_backcolor "" set beep_count 0 ; # Anzahl der entdeckten CTRL-Gs set style_count 0 ; # Anzahl der Styles dieser Zeile set len [string length "$line"] if {$len == 0 || [IsFakeWindow $wnum] || [WindowDoesNotExist $wnum]} { return } set path "[GetWindowPath $wnum]" set inum $win($wnum,irc) # Soll dieser Zeile ein Zeitstempel angehängt werden? if {[string match "*\x0f\x0f" "$line"]} { set add_linetime 1 set line "[string range "$line" 0 [expr $len-3]]" } else { set add_linetime 0 } if {[string compare "[wm state $path]" "iconic"] == 0} { global auto_popup if {$auto_popup($wnum) != 0} { wm deiconify $path } if {$win($wnum,touched) == 0} { set win($wnum,touched) 1 UpdateTitle $wnum } } elseif {$win($wnum,touched) != 0} { set win($wnum,touched) 0 UpdateTitle $wnum } set widget "$path.body.left.traffic.text" set end "[lindex "[$widget yview]" 1]" $widget configure -state normal write2log "window $wnum" $win($wnum,irc) "$line" global display_types if {$display_types($wnum) != 0} { if {[regexp -- {^[0-9][0-9][0-9]\ .*} "$line"]} { set line "\( [string range "$line" 0 2] \)\t[string range "$line" 4 end]" } elseif {[regexp -- {^(\*\*\*|\-\-\-)\ .*} "$line"]} { if {[string length "$margin(text)"]} { set line "\[ $margin(text) \]\t[string range "$line" 4 end]" set margin(text) "" } else { set line "[string range "$line" 0 2]\t[string range "$line" 4 end]" } } elseif {[regexp -- {^\+\+\+\ .*} "$line"]} { set line "+++\t[string range "$line" 4 end]" } } else { if {[regexp -- {^([0-9][0-9][0-9]|\*\*\*|\-\-\-|\+\+\+)\ .*} "$line"]} { set line "[string range "$line" 0 2]\t[string range "$line" 4 end]" } } set part "" set lnum [incr win($wnum,lines)] # Es wird überprüft, ob "user_styles" ein für diese Zeile gültiges # Element besitzt. set style1 style(user:-1) set style1text "$style(normal)" set loline "[string tolower "$line"]" for {set i 0} {$i < [llength "$user_styles"]} {incr i} { set regexpr "[lindex "[lindex "$user_styles" $i]" 0]" set regexpr "[strreplace "$regexpr" "\$me" "[expand "$irc($inum,nick)"]"]" if [regexp -- "[string tolower "$regexpr"]" "$loline"] { set tmp "[lindex "$user_styles" $i]" set style1 style(user:$i) set style1text "[lindex "$tmp" 1]" set command "[lindex "$tmp" 2]" set j [lsearch "$style1text" "-font"] if {$j == -1} { append style1text " -font \"[$widget cget -font]\"" } if {[string length "$command"] && "#" != "[string index "$command" 0]"} { eval $command } break } } # Der folgende Style entspricht laut "user_styles" den Anforderungen # des Benutzers. # set style1 [newStyle $wnum $wnum:$lnum:[incr style_count] "$style1text"] if {$win($wnum,visible) < 1} { # Es handelt sich hierbei um die erste Zeile. Daher darf vorher kein # Return ausgegeben werden. incr win($wnum,visible) } elseif {$win($wnum,visible) < [expr $lines_max]} { # Eine weitere Zeile soll geschrieben werden, und das Zeilenlimit des # Fensters wurde noch nicht erreicht. incr win($wnum,visible) $widget insert end "\n" } else { # Das Zeilenlimit des Fensters wurde bereits erreicht. Eine Zeile muß # daher mitsamt ihren Styles entfernt werden. set olnum [expr $lnum-$lines_max] foreach x "[array names style $wnum:$olnum:*]" { $widget tag delete style($x) unset style($x) } $widget delete 1.0 2.0 $widget insert end "\n" } # Es soll stets nur ein Zeitstempel an eine Zeile angefügt werden. # Bevorzugt wird dabei die Variable "show_time_on_each_line". global show_time_on_each_line if {$show_time_on_each_line($wnum) != 0} { set newstyle [newStyle $wnum $wnum:$lnum:[incr style_count] "$style1text $style(bold)"] $widget insert end "[time] " $newstyle } elseif {$add_linetime != 0} { append line "\x0f[linetime]" } # Die Popup-Menus von empfangenen, privaten Nachrichten erfahren eine # besondere Behandlung. if {"$args" != ""} { $widget insert end "[string range "$line" 0 [expr $irc($inum,next,left)-1]]" $style1 set newstyle [newStyle $wnum $wnum:$lnum:[incr style_count] "$style1text"] $widget tag bind $newstyle "$widget tag configure $newstyle -background #f0f0f0" $widget tag bind $newstyle "$widget tag configure $newstyle -background [$widget cget -background]" set nick "[expand "[string range "$line" $irc($inum,next,left) [expr $irc($inum,next,right)-1]]"]" $widget tag bind $newstyle "write2irc $inum \"/whois $nick\" ; break" $widget tag bind $newstyle "write2irc $inum \"/whois $nick $nick\" ; break" $widget tag bind $newstyle "write2irc $inum \"/ctcp $nick version\" ; break" $widget tag bind $newstyle "selected $wnum popup2 %X %Y $nick ; break" $widget insert end "[string range "$line" $irc($inum,next,left) [expr $irc($inum,next,right)-1]]" $newstyle set start $irc($inum,next,right) } else { set start 0 } set newstyle $style1 ; set newstyletext "$style1text" for {set i $start} {$i <= [string length "$line"]} {incr i} { set char "[string index "$line\x0f" $i]" if {"$char" > "\x1f" && "$char" != "\x7f"} { append part "$char" } else { if {[string length "$part"]} { set newstyle $style1 ; set newstyletext "$style1text" if {[expr $bold+$italic+$underline+$invers] != 0 || "$mirc_forecolor$mirc_backcolor$ansi_forecolor$ansi_backcolor" != ""} { foreach x "font background foreground" { set $x "[$widget tag cget $style1 -$x]" if {"[set $x]" == ""} { set $x "[$widget cget -$x]" } } if {$bold != 0} { append font " bold" } if {$italic != 0} { append font " italic" } if {$underline != 0} { append newstyletext " -underline 1" } if {$invers != 0} { append newstyletext " -background $foreground" append newstyletext " -foreground $background" } if {"$ansi_forecolor" != ""} { if {"$color(ansi)" == "full"} { append newstyletext " -foreground $ansi_forecolor" } elseif {"$color(ansi)" == "mono"} { append font " italic" } } elseif {"$mirc_forecolor" != ""} { if {"$color(mirc)" == "full"} { append newstyletext " -foreground $mirc_forecolor" } elseif {"$color(mirc)" == "mono"} { append font " italic" } } if {"$ansi_backcolor" != ""} { if {"$color(ansi)" == "full"} { append newstyletext " -background $ansi_backcolor" } elseif {"$color(ansi)" == "mono"} { append font " italic" } } elseif {"$mirc_backcolor" != ""} { if {"$color(mirc)" == "full"} { append newstyletext " -background $mirc_backcolor" } elseif {"$color(mirc)" == "mono"} { append font " italic" } } append newstyletext " -font \"$font\"" set newstyle [newStyle $wnum $wnum:$lnum:[incr style_count] "$newstyletext"] } set style_count [riddle_urls $wnum $lnum $style_count "$part" $newstyle "$newstyletext"] set part "" } if {"$char" == ""} { break } switch -- "$char" { "\x02" { set bold [expr $bold == 0] } "\x03" { # mIRC-Farben set j [expr $i+1] if {[regexp {[0-9]} "[string index "$line" $j]"]} { set colnum 0 ; set mirc_forecolor "" for {set k 0} {$k < 2} {incr k} { if {![isDigit "[string index "$line" $j]"]} { break } set colnum [expr $colnum*10+[string index "$line" $j]] incr i ; incr j } set colnum [expr $colnum%16] ; set ansi_forecolor "" set mirc_forecolor "[lindex "$color(mircvalues)" $colnum]" } if {[regexp {,[0-9]} "[string range "$line" $j [expr $j+1]]"]} { incr i ; incr j set colnum 0 ; set mirc_backcolor "" for {set k 0} {$k < 2} {incr k} { if {![isDigit "[string index "$line" $j]"]} { break } set colnum [expr $colnum*10+[string index "$line" $j]] incr i ; incr j } set colnum [expr $colnum%16] ; set ansi_backcolor "" set mirc_backcolor "[lindex "$color(mircvalues)" $colnum]" } } "\x0f" { set bold 0 ; set invers 0 ; set italic 0 ; set underline 0 set ansi_forecolor "" ; set ansi_backcolor "" set mirc_forecolor "" ; set mirc_backcolor "" } "\x11" { # PIRCH "fett" set italic [expr $italic == 0] } "\x16" { set invers [expr $invers == 0] set tmp "$ansi_backcolor" set ansi_backcolor "$ansi_forecolor" set ansi_forecolor "$tmp" set tmp "$mirc_backcolor" set mirc_backcolor "$mirc_forecolor" set mirc_forecolor "$tmp" } "\x1b" { # ANSI-Farben set j [expr $i+1] if {[regexp {\[([0-9]+;)*([0-9]+m)} "[string range "$line" $j end]"]} { # Die eckige Klammer wird uebersprungen. incr i ; incr j # Die einzelnen ANSI-Codes werden ausgewertet und umgesetzt. while {"[string index "$line" $j]" != "m"} { if {![isDigit "[string index "$line" $j]"]} { break } set colnum 0 for {set k 0} {$k < 2} {incr k} { if {![isDigit "[string index "$line" $j]"]} { break } set colnum [expr $colnum*10+[string index "$line" $j]] incr i ; incr j } if {$colnum >= 30 && $colnum <= 37} { set colnum [expr $colnum-30] set ansi_forecolor "[lindex "$color(ansivalues)" $colnum]" } elseif {$colnum >= 40 && $colnum <= 47} { set colnum [expr $colnum-40] set ansi_backcolor "[lindex "$color(ansivalues)" $colnum]" } else { switch -- "$colnum" { "0" - "00" { set bold 0 ; set invers 0 ; set italic 0 ; set underline 0 set ansi_forecolor "" ; set ansi_backcolor "" set mirc_forecolor "" ; set mirc_backcolor "" } "1" - "01" { set bold 1 } "4" - "04" { set underline 1 } "7" - "07" { set invers 1 set tmp_color $ansi_forecolor set ansi_forecolor $ansi_backcolor set ansi_backcolor $tmp_color } } } incr i ; incr j } } } "\x1f" { set underline [expr $underline == 0] } "\a" { global beeptext if [string length "$beeptext"] { set prefix "[string range "$line" 0 [expr $i-1]]" set suffix "[string range "$line" [expr $i+1] end]" set line "$prefix$beeptext$suffix" set i [expr $i-1] } if {$beep_count < 3} { if {[string length "$away"]} { global beep_on_ctrlG_when_away if {$beep_on_ctrlG_when_away != 0} { beep } } else { global beep_on_ctrlG_when_present if {$beep_on_ctrlG_when_present != 0} { beep } } incr beep_count } } default { append part "$char" } } } } $widget configure -state disabled if {$end == 1} { $widget yview end } # update idletasks } proc print2channels {cnums line} { global chan win margin set mtext "$margin(text)" set windows "" foreach x "$cnums" { set inum $chan($x,irc) # Existiert der Kanal? if {[lsearch -exact "$chan(list)" "$x"] != -1} { # Existiert das Fenster? if {"$chan($x,window)" != "" && [string length "$line"]} { if {[lsearch -exact "$win(list)" "$chan($x,window)"] != -1} { # Wurde diese Meldung evtl. schon dort ausgegeben? if {[lsearch -exact "$windows" "$chan($x,window)"] == -1} { set margin(text) "$mtext" # if {[string match "*\x0f\x0f" "$line"]} { # print2text $chan($x,window) "$line[linetime]" # } else { print2text $chan($x,window) "$line" # } lappend windows $chan($x,window) } } } write2log "channel $chan($x)" $inum "$line" } } } proc belated2channels {nows pres line} { # Diese Prozedur ist nur für Netsplits bzw. Netjoins notwendig. global chan win margin set mtext "$margin(text)" set windows "" foreach x "$pres" { # Existiert der Kanal? if {[lsearch -exact "$chan(list)" "$x"] != -1} { # Existiert das Fenster? if {"$chan($x,window)" != ""} { if {[lsearch -exact "$win(list)" "$chan($x,window)"] != -1} { # Diese Meldung wurde schon dort ausgegeben! lappend windows $chan($x,window) } } write2log "channel $chan($x)" $chan($x,irc) "$line" } } foreach x "$nows" { # Existiert der Kanal? if {[lsearch -exact "$chan(list)" "$x"] != -1} { # Existiert das Fenster? if {"$chan($x,window)" != ""} { if {[lsearch -exact "$win(list)" "$chan($x,window)"] != -1} { # Wurde diese Meldung evtl. schon dort ausgegeben? if {[lsearch -exact "$windows" "$chan($x,window)"] == -1} { set margin(text) "$mtext" print2text $chan($x,window) "$line" lappend windows $chan($x,window) } } } write2log "channel $chan($x)" $chan($x,irc) "$line" } } } proc entry2irc {num} { global win set entry "[GetWindowPath $num].cmdline" set line "[$entry get]" if {$win($num,touched) != 0} { set win($num,touched) 0 UpdateTitle $num } if {[string length "$line"] == 0} { return } # History und evtl. MsgHistory werden erweitert. AddToHistory $num "$line" if {[strmatch "/msg *" "$line"]} { AddToMsgHistory $num "[lIndex "$line" 1]" } send2tkirc $num "$line" # Die Kommandozeile wird gelöscht. if {[lsearch -exact "$win(list)" $num] != -1} { $entry delete 0 end } } proc entry2history {num} { set entry "[GetWindowPath $num].cmdline" set newline "[$entry get]" # Leere Eingaben werden nicht weiter bearbeitet. if {[string length "$newline"] == 0} { return } # History und evtl. MsgHistory werden erweitert. AddToHistory $num "$newline" if {[strmatch "/msg *" "$newline"]} { AddToMsgHistory $num "[lIndex "$newline" 1]" } $entry delete 0 end } ######################### # Internet Relay Chat # ######################### proc isOpOnChannel {cnum nick} { global chan set i [lSearch "$chan($cnum,nicks)" "$nick"] if {$i != -1} { return [lindex "$chan($cnum,olist)" $i] } return 0 } proc hasVoiceOnChannel {cnum nick} { global chan set i [lSearch "$chan($cnum,nicks)" "$nick"] if {$i != -1} { return [lindex "$chan($cnum,vlist)" $i] } return 0 } ##################### # FILE OPERATIONS # ##################### proc OpenFile {name access} { global margin if {[string match "r*" "$access"]} { if {[file exists $name] == 0} { set margin(text) "error" print2crap "--- File '$name' doesn't exist" return "" } if {[file readable $name] == 0} { set margin(text) "error" print2crap "--- File '$name' is not readable" return "" } } else { if {[file exists $name]} { if {[file owned $name] == 0} { set margin(text) "error" print2crap "--- File '$name' is not yours" return "" } if {[file writable $name] == 0} { set margin(text) "error" print2crap "--- File '$name' is not writable" return "" } } } if [catch {open $name $access} file] { set margin(text) "error" print2crap "--- File '$name' could not be opened" return "" } return "$file" } proc SaveBuffer {num tofile} { global margin path win if {[string length "$tofile"] == 0} { if [info exists path(save_buffer)] { catch {cd "$path(save_buffer)"} } FileRequest " Please select the file to save the \nbuffer in!" "Save" "SaveBuffer $num \:file" "" "" 0 return } set file "[OpenFile "$tofile" w]" if {[string length "$file"]} { set w [GetWindowPath $num].body.left.traffic.text for {set i 1} {$i <= $win($num,visible)} {incr i} { set line "[$w get $i.0 [expr $i+1].0]" puts -nonewline $file "$line" } close $file set margin(text) "note" print2crap "--- Buffer of window $num saved to file '$tofile'" } } proc LogChannel {num tofile} { global margin path win if {[string compare "*" "[GetActual $num]"] == 0} { set margin(text) "error" print2text $num "--- You have no channel joined in this window" } else { if {[string length "$tofile"] == 0} { if [info exists path(logs)] { catch {cd "$path(logs)"} } FileRequest " Please select the file to log channel '[GetActual $num]' in!" "Log" "LogChannel $num \:file" "" "" 0 } else { parsein $num "/log channel [GetActual $num] to \"$tofile\"" } } } proc FileSelect {win type} { # type: 0. scan home # 1. scan 'path' # 2. single click # 3. double click set dir "" switch -exact -- "$type" { {0} { set dir "." } {1} { set dir "[$win.dir.entry get]" if {[string length "$dir"] == 0} { set dir "." } if {![file isdirectory "$dir"]} { bell $win.list.entries delete 0 end return } } {2} { set sel "[$win.list.entries curselection]" if {[llength "$sel"] == 1} { set file "[$win.list.entries get $sel]" if [file isfile "$file"] { $win.file.entry delete 0 end $win.file.entry insert end "$file" } } return } {3} { set sel "[$win.list.entries curselection]" if {[llength "$sel"] == 1} { set dir "[$win.list.entries get $sel]" if {![string match " *" "$dir"]} { return } set dir "[string range "$dir" 2 end]" if {![file isdirectory "$dir"]} { return } } } } if {![file readable "$dir"]} { bell } else { # Es wird stets der volle Pfad ermittelt und benutzt. cd "$dir" ; set dir "[pwd]" $win.dir.entry delete 0 end $win.dir.entry insert end "$dir" $win.list.entries delete 0 end if {![catch {glob -nocomplain .* *} dirlist]} { foreach i "[lsort "$dirlist"]" { if [file isdirectory "$i"] { $win.list.entries insert end " $i/" } } foreach i "[lsort "$dirlist"]" { if {![file isdirectory "$i"]} { $win.list.entries insert end "$i" } } } } } proc FileAccept {win command} { global selected_file set path "[$win.dir.entry get]" if {[string length "$path"]} { if {"[$win.list.entries curselection]" == ""} { set file "[$win.file.entry get]" if {[string length "$file"]} { set selected_file "$path/$file" eval "[strreplace "$command" "\:file" "[expand "$selected_file"]"]" } } else { foreach sel "[$win.list.entries curselection]" { set file "[$win.list.entries get $sel]" if {[string length "$file"]} { set selected_file "$path/$file" eval "[strreplace "$command" "\:file" "[expand "$selected_file"]"]" } } } closewindow $win } } proc FileRequest {title ok command1 command2 filename extended} { global selected_file win set selected_file "" set command1 "[expand "$command1"]" # command2 darf nicht erweitert werden! set path ".file[incr win(reqcount)]" if {[RequestLevel $path]} { # grab set .file wm title $path " tkirc: File request " bind $path "closewindow $path" Label $path.reason -text "$title" -relief sunken -bd 1 pack $path.reason -fill x -ipady 5 -ipadx 5 -padx 2 -pady 5 Frame $path.dir pack $path.dir -fill x Label $path.dir.label -text " Directory: " pack $path.dir.label -side left Entry $path.dir.entry pack $path.dir.entry -side left -expand true -fill x bind $path.dir.entry "FileSelect $path 1" set f $path.buttons Frame $f pack $f -fill x -padx 2 -pady 2 -side bottom Button $f.ok -text "$ok" -command "FileAccept $path \"$command1\"" Button $f.cancel -text "Cancel" -command "closewindow $path; $command2" pack $f.ok -side left pack $f.cancel -side right Frame $path.file pack $path.file -fill x -side bottom Label $path.file.label -text " File name: " pack $path.file.label -side left Entry $path.file.entry -width 30 pack $path.file.entry -side left -expand true -fill x $path.file.entry insert end "$filename" # bind $path.file.entry "FileSelect $path 1" # Entry $path.selected # pack $path.selected -side bottom -fill x -pady 0 -ipady 0 # $path.selected insert end "$filename" set f $path Frame $f.list -bd 0 pack $f.list -expand true -fill both -pady 0 -ipady 0 if {$extended != 0} { Listbox $f.list.entries -width 12 -yscrollcommand "$f.list.scroll set" -exportselection false -relief raised -selectmode extended } else { Listbox $f.list.entries -width 12 -yscrollcommand "$f.list.scroll set" -exportselection false -relief raised } Scrollbar $f.list.scroll -width 10 -orient vertical -command [list $f.list.entries yview] pack $f.list.entries -expand true -side left -fill both pack $f.list.scroll -side left -fill y bind $f.list.entries "FileSelect $path 2" bind $f.list.entries "FileSelect $path 2" bind $f.list.entries "FileSelect $path 2" bind $f.list.entries "FileSelect $path 3" bind $path.file.entry "+$f.list.entries selection clear 0 end" Focus $path.file.entry } FileSelect $path 0 } ################## # MsgID Window # ################## proc ExecMsgIDAction { } { global on_msgclick selected_msgid set command "[strreplace "$on_msgclick" "\$msgid" "$selected_msgid"]" if {[string length "[info commands "[lindex "$command" 0]"]"]} { eval $command } else { eval exec -- $command & } } proc MsgIDShow { } { global msgids selected_msgid set i "[.msgids.list.frame0.list curselection]" if {"$i" != ""} { set selected_msgid "[expand "[lindex "$msgids(values)" $i]"]" ExecMsgIDAction } } proc MsgIDDelete { } { global msgids set i "[.msgids.list.frame0.list curselection]" if {"$i" != ""} { foreach x "dates times values" { set msgids($x) "[lreplace "$msgids($x)" $i $i]" } multilistbox delete .msgids.list $i } } proc MsgID2Clipboard { } { global msgids set i "[.msgids.list.frame0.list curselection]" if {"$i" != ""} { clipboard clear clipboard append -type STRING -- "[lindex "$msgids(values)" $i]" } } proc MsgIDClear { } { global msgids foreach x "dates times values" { set msgids($x) "" } multilistbox delete .msgids.list 0 end } proc MsgIDSave {tofile} { global margin msgids path if {[string length "$tofile"] == 0} { if [info exists path(save_msgids)] { catch {cd "$path(save_msgids)"} } FileRequest " Please select the file to save the \ndetected message IDs in!" "Save" "MsgIDSave \:file" "" "" 0 return } set file "[OpenFile "$tofile" a+]" if {[string length "$file"]} { set ulen [llength "$msgids(dates)"] for {set i 0} {$i < $ulen} {incr i} { puts $file "[lindex "$msgids(dates)" $i] [lindex "$msgids(times)" $i] [lindex "$msgids(values)" $i]" } close $file set margin(text) "note" print2crap "--- All message IDs saved to file '$tofile'" } } proc MsgIDWindow { } { global msgids if {[Toplevel .msgids -class tkirc]} { global geometry if {[info exists geometry(msgids)]} { wm geometry .msgids $geometry(msgids) } wm title .msgids " tkirc: detected messageIDs " bind .msgids "closewindow .msgids" set f .msgids.buttons Frame $f pack $f -fill x -pady 2 -side bottom Button $f.show -text "Show" -command "MsgIDShow" Button $f.delete -text "Delete" -command "MsgIDDelete" Button $f.clip -text "MsgID to clipboard" -command "MsgID2Clipboard" Button $f.clear -text "Clear list" -command "MsgIDClear" Button $f.save -text "Save list" -command "MsgIDSave {}" Button $f.exit -text "Close" -command "closewindow .msgids" pack $f.show $f.delete $f.clip -side left pack $f.exit $f.save $f.clear -side right multilistbox create .msgids.list -notitles {Date 9} {Time 9} {MessageID 60} multilistbox delete .msgids.list 0 end set ulen [llength "$msgids(dates)"] for {set i 0} {$i < $ulen} {incr i} { multilistbox insert .msgids.list $i "[lindex "$msgids(dates)" $i]" \ "[lindex "$msgids(times)" $i]" "[lindex "$msgids(values)" $i]" } pack .msgids.list -side left -expand true -fill both -ipadx 0 -padx 0 multilistbox bind .msgids.list "MsgIDShow" } } ############################################################## # 'showarticle()' can be used in 'action_on_msgid' # ############################################################## proc showarticle {host msgid} { set path ".art[clock seconds]" if {[Toplevel $path]} { wm title $path " tkirc: show article " bind $path "closewindow $path" Label $path.info -text " nntp-host: $host article: $msgid " -relief sunken -bd 1 pack $path.info -fill x -ipady 5 -ipadx 5 -padx 2 -pady 5 set f $path.buttons Frame $f pack $f -fill x -pady 2 -side bottom Button $f.save -text "Save" -command "savearticle $path {} [expand $msgid]" pack $f.save -side left Button $f.close -text "Close" -command "closewindow $path" pack $f.close -side right set f $path.list Frame $f -bd 0 eval {Text $f.text -yscroll [list $f.scroll set] -state normal} Scrollbar $f.scroll -width 10 -orient vertical -command [list $f.text yview] pack $f.scroll -side right -fill y pack $f.text -side left -expand true -fill both pack $f -expand true -fill both $path.list.text delete 0.0 end if [catch {socket "$host" 119} sock] { $path.list.text insert end "\nERROR: Can not open socket to host $host port 119." return } fconfigure $sock -blocking 0 puts $sock "mode reader\narticle $msgid\nquit" flush $sock fileevent $sock readable "getarticle $path $sock" } } proc getarticle {path sock} { if {[winfo exists $path]} { if {[gets $sock line] >= 0} { $path.list.text insert end "$line\n" } elseif [eof $sock] { $path.list.text configure -state disabled close $sock } } else { close $sock } update idletasks } proc savearticle {pathname tofile msgid} { global path if {[string length "$tofile"] == 0} { if [info exists path(save_article)] { catch {cd "$path(save_article)"} } FileRequest " Please select the file to save the \n article $msgid in!" "Save" "savearticle $pathname \:file [expand "$msgid"]" "" "" 0 return } set file "[OpenFile "$tofile" a]" if {[string length "$file"]} { set w $path.list.text puts -nonewline $file "[$w get 1.0 end]" close $file print2crap "+++ NNTP output ($msgid) saved to file '$tofile'" } } ################## # ON FUNCTIONS # ################## proc ExecOnCommands {type inum args} { global irc on_$type on_args set irc(num) $inum set on_args(irc) $inum set on_args(event) "$type" for {set i 0} {$i < [llength "$args"]} {incr i ; incr i} { set on_args([lindex "$args" $i]) "[lindex "$args" [expr $i+1]]" } foreach x "[lsort -ascii "[info commands "on_event*"]"]" { $x } foreach x "[lsort -ascii "[info globals "on_$type*"]"]" { global $x eval [set $x] } foreach x "[lsort -ascii "[info commands "on_$type*"]"]" { $x } } ################ # URL Window # ################ proc ExecUrlAction { } { global on_urlclick selected_url set command "[strreplace "$on_urlclick" "\$url" "$selected_url"]" if {[string length "[info commands "[lindex "$command" 0]"]"]} { eval $command } else { eval exec -- $command & } } proc URLShow { } { global urls selected_url set i "[.urls.list.frame0.list curselection]" if {"$i" != ""} { set selected_url "[expand "[lindex "$urls(values)" $i]"]" ExecUrlAction } } proc URLDelete { } { global urls set i "[.urls.list.frame0.list curselection]" if {"$i" != ""} { foreach x "dates times values" { set urls($x) "[lreplace "$urls($x)" $i $i]" } multilistbox delete .urls.list $i } } proc URL2Clipboard { } { global urls set i "[.urls.list.frame0.list curselection]" if {"$i" != ""} { clipboard clear clipboard append -type STRING -- "[lindex "$urls(values)" $i]" } } proc URLClear { } { global urls foreach x "dates times values" { set urls($x) "" } multilistbox delete .urls.list 0 end } proc URLSave {tofile} { global margin path urls if {[string length "$tofile"] == 0} { if [info exists path(save_urls)] { catch {cd "$path(save_urls)"} } FileRequest " Please select the file to save the \ndetected URLs in!" "Save" "URLSave \:file" "" "" 0 return } set file "[OpenFile "$tofile" a+]" if {[string length "$file"]} { set ulen [llength "$urls(dates)"] for {set i 0} {$i < $ulen} {incr i} { puts $file "[lindex "$urls(dates)" $i] [lindex "$urls(times)" $i] [lindex "$urls(values)" $i]" } close $file set margin(text) "note" print2crap "--- All URLs saved to file '$tofile'" } } proc URLWindow { } { global urls if {[Toplevel .urls -class tkirc]} { global geometry if {[info exists geometry(urls)]} { wm geometry .urls $geometry(urls) } wm title .urls " tkirc: detected URLs " bind .urls "closewindow .urls" set f .urls.buttons Frame $f pack $f -fill x -pady 2 -side bottom Button $f.show -text "Show" -command "URLShow" Button $f.delete -text "Delete" -command "URLDelete" Button $f.clip -text "URL to clipboard" -command "URL2Clipboard" Button $f.clear -text "Clear list" -command "URLClear" Button $f.save -text "Save list" -command "URLSave {}" Button $f.exit -text "Close" -command "closewindow .urls" pack $f.exit $f.save $f.clear -side right pack $f.show $f.delete $f.clip -side left multilistbox create .urls.list -notitles {Date 9} {Time 9} {URL 60} multilistbox delete .urls.list 0 end set ulen [llength "$urls(dates)"] for {set i 0} {$i < $ulen} {incr i} { multilistbox insert .urls.list $i "[lindex "$urls(dates)" $i]" \ "[lindex "$urls(times)" $i]" "[lindex "$urls(values)" $i]" } pack .urls.list -side left -expand true -fill both -ipadx 0 -padx 0 multilistbox bind .urls.list "URLShow" } } ################### # Notify Window # ################### proc UpdateNotifyWindow {inum type cnum nick address} { global chan irc notified # Mit dieser Prozedur werden im Notify-Fenster Eintraege geloescht # (type = 0) oder auch erzeugt (type = 1). # Ein Eintrag wird geloescht. set len [llength "$notified(inums)"] for {set i 0} {$i < $len} {incr i} { if {$inum == [lindex "$notified(inums)" $i] && $cnum == [lindex "$notified(cnums)" $i] && [strcmp "$nick" "[lindex "$notified(nicks)" $i]"] == 0} { foreach x "nicks addresses cnums inums" { set notified($x) "[lreplace "$notified($x)" $i $i]" } if {[winfo exists .notified]} { multilistbox delete .notified.list $i } } } if {$type == 1} { # Ein Eintrag wird erzeugt. set notified(nicks) "[linsert "$notified(nicks)" 0 "$nick"]" set notified(addresses) "[linsert "$notified(addresses)" 0 "$address"]" set notified(cnums) "[linsert "$notified(cnums)" 0 "$cnum"]" set notified(inums) "[linsert "$notified(inums)" 0 "$inum"]" if {$cnum < 0} { multilistbox insert .notified.list 0 "#$inum" "$nick" "$address" } else { multilistbox insert .notified.list 0 "#$inum" "$nick" "$address \[$chan($cnum)\]" } } } proc NotifyNickRemove { } { global notified set i "[.notified.list.frame0.list curselection]" if {"$i" != ""} { foreach x "inums cnums nicks addresses" { set notified($x) "[lreplace "$notified($x)" $i $i]" } multilistbox delete .notified.list $i } } proc NotifyClear { } { global notified foreach x "inums cnums nicks addresses" { set notified($x) "" } multilistbox delete .notified.list 0 end } proc NotifyNickSelected {button} { global irc notified set i "[.notified.list.frame0.list curselection]" if {"$i" != ""} { set crap $irc([lindex "$notified(inums)" $i],crap) set nick "[lindex "$notified(nicks)" $i]" switch -- "$button" { "1a" { send2tkirc $crap "/whois $nick" } "1b" { send2tkirc $crap "/whois $nick $nick" } "2" { send2tkirc $crap "/ctcp $nick version" } "3" { send2tkirc $crap "/chat $nick" } } } } proc NotifyWindow { } { global notified if {[Toplevel .notified -class tkirc]} { wm title .notified " tkirc: notified users " bind .notified "closewindow .notified" global geometry if {[info exists geometry(notified)]} { wm geometry .notified $geometry(notified) } Frame .notified.buttons ; pack .notified.buttons -side bottom \ -padx 5 -pady 2 -fill x Button .notified.buttons.remove -text "Remove" \ -command "NotifyNickRemove" Button .notified.buttons.clear -text "Clear list" \ -command "NotifyClear" Button .notified.buttons.close -text "Close" \ -command "closewindow .notified" pack .notified.buttons.close -side right pack .notified.buttons.remove -side left pack .notified.buttons.clear -side right multilistbox create .notified.list {ircII 3} {Nickname 13} {{Address [Channel]} 60} global on_reload_notified set on_reload_notified "if \{\[winfo exists .notified.list.frame0.label\]\} \{.notified.list.frame0.label configure -foreground #888888 ; .notified.list.frame0.list configure -foreground #888888 -selectforeground #888888\}" eval $on_reload_notified multilistbox delete .notified.list 0 end set ulen [llength "$notified(nicks)"] for {set i 0} {$i < $ulen} {incr i} { multilistbox insert .notified.list $i "#[lindex "$notified(inums)" $i]" "[lindex "$notified(nicks)" $i]" "[lindex "$notified(addresses)" $i]" } pack .notified.list -side left -expand true -fill both -ipadx 0 -padx 0 multilistbox bind .notified.list "NotifyNickSelected 1a" multilistbox bind .notified.list "NotifyNickSelected 1b" multilistbox bind .notified.list "NotifyNickSelected 2" multilistbox bind .notified.list "NotifyNickSelected 3" } } #################### # Suspect Window # #################### proc UpdateSuspectWindow {inum type cnum nick address} { global chan irc suspected # Mit dieser Prozedur werden im Suspect-Fenster Eintraege geloescht # (type = 0) oder auch erzeugt (type = 1). # Ein Eintrag wird geloescht. set len [llength "$suspected(inums)"] for {set i 0} {$i < $len} {incr i} { if {$inum == [lindex "$suspected(inums)" $i] && $cnum == [lindex "$suspected(cnums)" $i] && [strcmp "$nick" "[lindex "$suspected(nicks)" $i]"] == 0} { foreach x "nicks addresses cnums inums" { set suspected($x) "[lreplace "$suspected($x)" $i $i]" } if {[winfo exists .suspected]} { multilistbox delete .suspected.list $i } } } if {$type == 1} { # Ein Eintrag wird erzeugt. set suspected(nicks) "[linsert "$suspected(nicks)" 0 "$nick"]" set suspected(addrsses) "[linsert "$suspected(addresses)" 0 "$address"]" set suspected(cnums) "[linsert "$suspected(cnums)" 0 "$cnum"]" set suspected(inums) "[linsert "$suspected(inums)" 0 "$inum"]" if {$cnum < 0} { multilistbox insert .suspected.list 0 "#$inum" "$nick" "$address" } else { multilistbox insert .suspected.list 0 "#$inum" "$nick" "$address \[$chan($cnum)\]" } } } proc SuspectNickRemove { } { global suspected set i "[.suspected.list.frame0.list curselection]" if {"$i" != ""} { foreach x "inums cnums nicks addresses" { set suspected($x) "[lreplace "$suspected($x)" $i $i]" } multilistbox delete .suspected.list $i } } proc SuspectClear { } { global suspected foreach x "inums cnums nicks addresses" { set suspected($x) "" } multilistbox delete .suspected.list 0 end } proc SuspectNickSelected {button} { global irc suspected set i "[.suspected.list.frame0.list curselection]" if {"$i" != ""} { set crap $irc([lindex "$suspected(inums)" $i],crap) set nick "[lindex "$suspected(nicks)" $i]" switch -- "$button" { "1a" { send2tkirc $crap "/whois $nick" } "1b" { send2tkirc $crap "/whois $nick $nick" } "2" { send2tkirc $crap "/ctcp $nick version" } "3" { send2tkirc $crap "/chat $nick" } } } } proc SuspectWindow { } { global suspected if {[Toplevel .suspected -class tkirc]} { wm title .suspected " tkirc: suspected users " bind .suspected "closewindow .suspected" global geometry if {[info exists geometry(suspected)]} { wm geometry .suspected $geometry(suspected) } Frame .suspected.buttons ; pack .suspected.buttons -side bottom \ -padx 5 -pady 2 -fill x Button .suspected.buttons.remove -text "Remove" \ -command "SuspectNickRemove" Button .suspected.buttons.clear -text "Clear list" \ -command "SuspectClear" Button .suspected.buttons.close -text "Close" \ -command "closewindow .suspected" pack .suspected.buttons.close -side right pack .suspected.buttons.remove -side left pack .suspected.buttons.clear -side right multilistbox create .suspected.list {ircII 3} {Nickname 13} {{Address [Channel]} 60} global on_reload_suspected set on_reload_suspected "if \{\[winfo exists .suspected.list.frame0.label\]\} \{.suspected.list.frame0.label configure -foreground #888888 ; .suspected.list.frame0.list configure -foreground #888888 -selectforeground #888888\}" eval $on_reload_suspected multilistbox delete .suspected.list 0 end set ulen [llength "$suspected(nicks)"] for {set i 0} {$i < $ulen} {incr i} { multilistbox insert .suspected.list $i "#[lindex "$suspected(inums)" $i]" "[lindex "$suspected(nicks)" $i]" "[lindex "$suspected(addresses)" $i]" } pack .suspected.list -side left -expand true -fill both -ipadx 0 -padx 0 multilistbox bind .suspected.list "SuspectNickSelected 1a" multilistbox bind .suspected.list "SuspectNickSelected 1b" multilistbox bind .suspected.list "SuspectNickSelected 2" multilistbox bind .suspected.list "SuspectNickSelected 3" } } ################ # DCC Window # ################ proc DCCWindow {dnum} { global dcc set path .dcc$dnum if {![winfo exists $path]} { if {![Toplevel $path -class tkirc]} { return } global geometry if {[info exists geometry(dcc)]} { wm geometry $path $geometry(dcc) } wm title $path " DCC $dcc($dnum,type) (on #$dcc($dnum,irc))" bind $path "grab release $path ; destroy $path" Frame $path.left -bd 1 -relief flat Frame $path.right -bd 1 -relief flat pack $path.left $path.right -side left -ipadx 2 \ -expand true -fill x -padx 2 -anchor n if {[string compare "SEND" "$dcc($dnum,type)"] == 0} { Label $path.left.type -text "SEND to nick:" } elseif {[string compare "GET" "$dcc($dnum,type)"] == 0} { Label $path.left.type -text "GET from nick:" } Label $path.right.type -text "$dcc($dnum,nick)" Label $path.left.peer -text "Host,Port:" Label $path.right.peer -text "$dcc($dnum,host),$dcc($dnum,port)" Label $path.left.starttime -text "Started at:" Label $path.right.starttime Label $path.left.file -text "Filename:" Label $path.right.file -text "$dcc($dnum,file)" Label $path.left.size -text "Filesize:" if {[string compare "SEND" "$dcc($dnum,type)"] == 0} { Label $path.right.size -text "[file size "$dcc($dnum,file)"]" } else { Label $path.right.size -text "$dcc($dnum,size)" } if {[string compare "SEND" "$dcc($dnum,type)"] == 0} { Label $path.left.bytes -text "Bytes sent:" } elseif {[string compare "GET" "$dcc($dnum,type)"] == 0} { Label $path.left.bytes -text "Bytes read:" } Label $path.right.bytes pack $path.left.type $path.left.peer $path.left.starttime $path.left.file $path.left.size $path.left.bytes -anchor e pack $path.right.type $path.right.peer $path.right.starttime $path.right.file $path.right.size $path.right.bytes Button $path.right.cancel -text "Cancel" pack $path.right.cancel -anchor e bind $path.right.cancel "DCCWindowCancel $dnum ; break" } if {[string compare "SEND" "$dcc($dnum,type)"] == 0} { $path.right.bytes configure -text "$dcc($dnum,sent)" } elseif {[string compare "GET" "$dcc($dnum,type)"] == 0} { $path.right.bytes configure -text "$dcc($dnum,read)" } if {"$dcc($dnum,starttime)" != ""} { $path.right.starttime configure -text "[time2 $dcc($dnum,starttime)]" } } proc DCCWindowCancel {dnum} { global dcc if {[info exists dcc($dnum,irc)]} { write2irc $dcc($dnum,irc) "/dcc close $dcc($dnum,type) $dcc($dnum,nick) $dcc($dnum,file)" } set path .dcc$dnum if {[winfo exists $path]} { closewindow $path } } ################ # Lag Window # ################ set lag(interval) 60 set lag(colors) { #00ff00 #11ff00 #22ff00 #33ff00 #44ff00 #55ff00 #66ff00 #77ff00 #88ff00 #99ff00 #aaff00 #bbff00 #ccff00 #ddff00 #eeff00 #ffff00 #ffee00 #ffdd00 #ffcc00 #ffbb00 #ffaa00 #ff9900 #ff8800 #ff7700 #ff6600 #ff5500 #ff4400 #ff3300 #ff2200 #ff1100 #ff0000 } set lag(maximum) 10 proc LagWindow {wnum} { global irc win lag set inum $win($wnum,irc) if {![IsAlive $inum]} { return } set path .lags$inum if {![winfo exists $path]} { if {[Toplevel $path -class tkirc]} { global geometry if {[info exists geometry(lags$inum)]} { wm geometry $path [set geometry(lags$inum)] } elseif {[info exists geometry(lags)]} { wm geometry $path [set geometry(lags)] } wm title $path " Lag (#$inum)" bind $path "grab release $path ; destroy $path" Frame $path.level1 -bd 1 -relief flat Frame $path.level2 -bd 1 -relief flat pack $path.level1 $path.level2 -side top -ipadx 2 \ -expand true -fill x -padx 2 Label $path.level1.server -text "$irc($inum,serv)" pack $path.level1.server -side right -fill x -expand true update set lag(font) "[$path.level1.server cget -font]" set lag(height) [winfo height $path.level1.server] canvas $path.level1.light -relief flat -borderwidth 0 \ -width $lag(height) -height $lag(height) LagLight $inum pack $path.level1.light -side left bind $path.level1.light "global irc ; set irc($inum,lag,stop) 0 ; LagStart $inum" Label $path.level2.label -text "Lag in seconds:" pack $path.level2.label -side left canvas $path.level2.value -relief sunken -borderwidth 1 \ -height $lag(height) -width 125 pack $path.level2.value -side left -expand true -fill x set irc($inum,lag,stop) 0 ; LagStart $inum } } } proc LagLight {inum} { global irc lag # Dieses Warnlicht gibt an, ob eine Messung läuft oder nicht. if {[winfo exists .lags$inum.level1.light]} { set max [expr $lag(height)-5] if {[info exists irc($inum,lag,light)]} { .lags$inum.level1.light delete $irc($inum,lag,light) } if {$irc($inum,lag,stop) == -1} { set irc($inum,lag,light) "[.lags$inum.level1.light create rectangle 5 5 \ $max $max -outline black -fill [lindex "$lag(colors)" end]]" } else { set irc($inum,lag,light) "[.lags$inum.level1.light create rectangle 5 5 \ $max $max -outline black -fill [lindex "$lag(colors)" 0]]" } } } proc LagDraw {inum} { global irc lag if {[winfo exists .lags$inum]} { if {[string compare "$irc($inum,serv)" "[.lags$inum.level1.server cget -text]"] != 0} { .lags$inum.level1.server configure -text "$irc($inum,serv)" } if {$irc($inum,lag,stop) > 0} { set time $irc($inum,lag,stop) } else { set time [clock clicks] } set len [llength "$lag(colors)"] set value "[expr abs($time-$irc($inum,lag,start))/1000/1000.000]" set index [expr int($value*$len/$lag(maximum))] if {$index >= $len} { set color [lindex "$lag(colors)" end] } else { set color [lindex "$lag(colors)" $index] } update set width [expr [lindex "[split "[winfo geometry .lags$inum.level2.value]" "x"]" 0]-1] set halfwidth [expr $width/2] set now [expr $width*$value/$lag(maximum)] set clear [.lags$inum.level2.label cget -background] update if {[info exists irc($inum,lag,rectangle)]} { .lags$inum.level2.value delete $irc($inum,lag,rectangle) } set irc($inum,lag,rectangle) "[.lags$inum.level2.value create rectangle \ 1 1 $now $lag(height) -outline $color -fill $color]" if {[info exists irc($inum,lag,text)]} { .lags$inum.level2.value delete $irc($inum,lag,text) } if {"$irc($inum,serv)" == ""} { set irc($inum,lag,text) "[.lags$inum.level2.value create text \ $halfwidth .15c -text "- no server -" -anchor n \ -font "$lag(font)"]" } elseif {$irc($inum,startup) < 2} { set irc($inum,lag,text) "[.lags$inum.level2.value create text \ $halfwidth .15c -text "- not connected -" -anchor n \ -font "$lag(font)"]" } else { set irc($inum,lag,text) "[.lags$inum.level2.value create text \ $halfwidth .15c -text "$value" -anchor n \ -font "$lag(font)"]" } update LagLight $inum update } } proc LagStop {inum} { global irc if {![IsAlive $inum]} { return } if {$irc($inum,lag,stop) == -1} { # Messung wird gestoppt. set irc($inum,lag,stop) [clock clicks] LagDraw $inum } } proc LagStart {inum} { global irc lag update if {![IsAlive $inum]} { return } if {[winfo exists .lags$inum]} { if {$irc($inum,lag,stop) == -1} { # Messung läuft. LagDraw $inum } else { # Messung wird gestartet. set wait [expr $lag(interval)*1000000] set now [clock clicks] if {[expr $now-$irc($inum,lag,stop)] >= $wait \ || [expr $irc($inum,lag,stop)-$now] >= $wait} { set irc($inum,lag,start) $now set irc($inum,lag,stop) -1 LagLight $inum FilterLine $inum {\*\*\** PONG received from *} write2irc $inum "/quote ping $irc($inum,serv)" } } } } #################### # MENU FUNCTIONS # #################### proc About {num} { global ircII_version tkirc_version tcl_version tk_version date on_urlclick if {[Toplevel .about -class tkirc]} { # grab set .about wm title .about " tkirc: About " bind .about "grab release .about ; destroy .about" Frame .about.f1 pack .about.f1 -ipadx 2 -ipady 2 -padx 2 -pady 2 -side bottom -fill x DefaultButton .about.f1.ok -text "Close" -command "grab release .about ; destroy .about" pack .about.f1.ok -side right bind .about "grab release .about ; destroy .about" Button .about.f1.url -text "View homepage via web!" pack .about.f1.url -side left -ipadx 0 -ipady 0 -padx 2 -pady 2 set command "[strreplace "$on_urlclick" "\$url" "http://netsplit.de/tkirc2/"]" if {[string length "[info commands "[lindex "$command" 0]"]"]} { bind .about.f1.url "eval $command" } else { bind .about.f1.url "eval exec -- $command &" } Frame .about.f2 -bd 1 -relief sunken pack .about.f2 -padx 2 -pady 2 -ipady 1 -expand true -side top -fill x set newbody " tkirc $tkirc_version ($date) \n - Freely distributable! - \n\n © 1996-2001 Andreas 'atte' Gelhausen \n \n" Label .about.f2.label1 -bd 0 -text "$newbody" pack .about.f2.label1 -side top -expand true -ipady 2 set newbody "$ircII_version,\nTcl version $tcl_version, Tk version $tk_version" Label .about.f2.label2 -bd 0 -text "$newbody" pack .about.f2.label2 -side top -expand true -ipady 2 } } proc NickNotAvailable {inum nick} { global irc preferred_nicknames margin if {"$irc($inum,lastnick)" == ""} { if {[lLength "$preferred_nicknames"]} { set nicks [strreplace "$preferred_nicknames" "\\" ""] set i [lSearch "$nicks" "$nick"] incr i if {[lLength "$nicks"] > $i} { set irc($inum,nick) "[lIndex "$nicks" $i]" write2irc $inum "/nick $irc($inum,nick)" UpdateAllTitles } } else { set margin(text) "note" print2crap "--- tkirc automatically tries to give you a valid nickname. Please set the variable 'preferred_nicknames' in your tkircrc for the next time!" global irc ; set irc($inum,next,filter) 1 set comics {"micky" "goofy" "pluto" "donald" "daisy"} set secs [clock seconds] ; set len [llength "$comics"] write2irc $inum "/nick [lindex "$comics" [expr $secs%$len]][expr $secs%100]" UpdateAllTitles } } else { set irc($inum,nick) "$irc($inum,lastnick)" UpdateAllTitles } } proc KeepUser {inum nick address} { global irc set i [lSearch "$irc($inum,wc,nicks)" "$nick"] if {$i != -1} { set irc($inum,wc,nicks) "[lreplace "$irc($inum,wc,nicks)" $i $i "$nick"]" set irc($inum,wc,addresses) "[lreplace "$irc($inum,wc,addresses)" $i $i "$address"]" } else { set irc($inum,wc,nicks) "[linsert "$irc($inum,wc,nicks)" 0 "$nick"]" set irc($inum,wc,addresses) "[linsert "$irc($inum,wc,addresses)" 0 "$address"]" } if {[llength "$irc($inum,wc,nicks)"] > 50} { set irc($inum,wc,nicks) "[lrange "$irc($inum,wc,nicks)" 0 49]" set irc($inum,wc,addresses) "[lrange "$irc($inum,wc,addresses)" 0 49]" } } proc TakeOverTest {cnum address} { global ban chan irc win margin react_to_takeover takeover global takeover_users takeover_period alreadykicked if {!$react_to_takeover} { return } set secs [clock seconds] set at [string first "@" "$address"] if {$at == -1} { return } set wnum $chan($cnum,window) set inum $chan($cnum,irc) set channel "$chan($cnum)" set host "[string range "$address" [expr $at+1] end]" set count 0 ; set i 0 foreach x "$chan($cnum,addresses)" { set at [string first "@" "$x"] if {$at == -1} { continue } set y "[string range "$x" [expr $at+1] end]" if {[strcmp "$y" "$host"] == 0} { set period [expr $secs-[lindex "$chan($cnum,jointimes)" $i]] if {$period < $takeover_period} { incr count } } incr i } if {$count >= $takeover_users} { # wurde der TakeOver schon gemeldet? for {set i 0} {$i < [llength "$takeover(tries)"]} {incr i} { if {[strcmp "[lindex "$takeover(tries)" $i]" "$cnum $host"] == 0} { if {[expr [clock seconds]-[lindex "$takeover(times)" $i]] < 300} { # Nach 5 Minuten ist es bestimmt ein neuer Takeover! return } } } for {set i 0} {$i < 3} {incr i} { after [expr $i * 750] beep } lappend takeover(tries) "$cnum $host" lappend takeover(times) "[clock seconds]" if {[isOpOnChannel $cnum "$irc($inum,nick)"]} { set margin(text) "alert" if {$react_to_takeover == 666} { global takeover_star_patterns print2channels "$cnum" "--- Possible takeover detected on channel '$channel' from host '$host'. Sending ban and kicks..." foreach x "$takeover_star_patterns" { if [strmatch "$x" "$host"] { set host "*[string range "$host" [string first "." "$host"] end]" break } } write2irc $inum "/quote mode $channel +b *!*@$host" urgent set alreadykicked "" set bnum [incr win(reqcount)] set ban($bnum:channel) "$chan($cnum)" set ban($bnum:cnum) $cnum set ban($bnum:irc) $inum set ban($bnum:nick) "*" set ban($bnum:user) "*" set ban($bnum:hostlist) "[split "[lindex "[split "$address" "@"]" end]" "."]" set ban($bnum:address) "$address" KickWarScriptUser "$bnum" } else { print2channels "$cnum" "--- A user of '$host' possibly tries to take over channel '$channel'!" BanRequest $inum $cnum {} "$address" {} -takeover } } else { set margin(text) "alert" print2channels "$cnum" "--- A user of '$host' possibly tries to take over channel '$channel', but you are not a channel operator!" BanRequest $inum $cnum {} "$address" {} -takeover } } } proc AddressOfNick {inum args} { global chan irc if {"$args" == ""} { set nick "$inum" set inum $irc(num) } else { set nick "[lindex "$args" 0]" } foreach x "$chan(list)" { set i [UserNumber $inum $x "$nick"] if {$i != -1} { set address "[lindex "$chan($x,addresses)" $i]" if {[string length "$address"]} { return "$address" } } } set i [lSearch "$irc($inum,wc,nicks)" "$nick"] if {$i >= 0} { return "[lindex "$irc($inum,wc,addresses)" $i]" } return "" } ########## # KICK # ########## proc SelectedKickReason {path add} { set result "" $path.reasons.entry delete 0 end set num "[$path.reasons.list.view curselection]" if {"$num" != ""} { set num "[expr $num + $add]" append result "[$path.reasons.list.view get $num]" $path.reasons.list.view selection clear 0 end $path.reasons.list.view selection set $num set size [$path.reasons.list.view size] set top "[lindex "[$path.reasons.list.view yview]" 0]" set bottom "[lindex "[$path.reasons.list.view yview]" 1]" if {[expr $num.000/$size] > $bottom} { $path.reasons.list.view yview scroll +1 units } elseif {[expr $num.000/$size] < $top} { $path.reasons.list.view yview scroll -1 units } } $path.reasons.entry insert 0 "$result" } proc InitKickReasonList {path} { # f is the frame global preferred_kickreasons set f $path.reasons Entry $f.entry pack $f.entry -fill x -side bottom Focus $f.entry listbox_vs $f.list pack $f.list -expand true -fill both -pady 0 -ipady 0 for {set i 0} {$i < [llength "$preferred_kickreasons"]} {incr i} { $f.list.view insert end "[lindex "$preferred_kickreasons" $i]" } bind $f.list.view "SelectedKickReason $path +0" bind $f.list.view "SelectedKickReason $path +0" $f.list.view selection set 0 SelectedKickReason $path +0 bind $path "SelectedKickReason $path -1" bind $path "SelectedKickReason $path +1" } proc BanList_EntrySelected { } { global banlist chan set pattern "" ; set comment "" ; set date "" ; set user "" .banlist.edit.entries.comment configure -state normal .banlist.edit.entries.pattern delete 0 end .banlist.edit.entries.comment delete 0 end set num "[multilistbox curselection .banlist.list]" if {"$num" != ""} { append pattern "[multilistbox get .banlist.list 0 $num]" append comment "[multilistbox get .banlist.list 1 $num]" } .banlist.edit.entries.pattern insert 0 "$pattern" .banlist.edit.entries.comment insert 0 "$comment" set cnum [GetChannelNumber "$banlist(channel)"] if {$cnum != -1} { set j [lsearch -exact "$chan($cnum,banpatterns)" "$pattern"] if {$j != -1} { # Der Ban gilt bereits. Datum und Nick sind bekannt. set date "[lindex "$chan($cnum,bantimes)" $j]" if {"$date" == "0"} { set date "" } else { set date "[longdate $date]" } set user "[lindex "$chan($cnum,banusers)" $j]" if {"$user" == "!"} { set user "" } } } .banlist.edit.entries.date configure -text "$date" .banlist.edit.entries.user configure -text "$user" set j [lsearch -exact "$banlist(old)" "$pattern"] if {$j == -1} { # Der Ban gilt noch nicht für den Kanal. .banlist.edit.entries.comment configure -state disabled } } proc BanList_Undo { } { global banlist bancomments multilistbox delete .banlist.list 0 end for {set i 0} {$i < [llength "$banlist(old)"]} {incr i} { multilistbox insert .banlist.list end "[lindex "$banlist(old)" $i]" "[riddletext "[lindex "$bancomments(old)" $i]"]" } set banlist(new) "$banlist(old)" set bancomments(new) "$bancomments(old)" .banlist.edit.entries.pattern delete 0 end .banlist.edit.entries.comment delete 0 end .banlist.edit.entries.date configure -text "" .banlist.edit.entries.user configure -text "" } proc BanList_AddEntry { } { global banlist bancomments multilistbox delete .banlist.list 0 end set j [lsearch -exact "$banlist(new)" "[.banlist.edit.entries.pattern get]"] if {$j == -1} { lappend banlist(new) "[.banlist.edit.entries.pattern get]" lappend bancomments(new) "" } else { set bancomments(new) "[lreplace "$bancomments(new)" $j $j "[.banlist.edit.entries.comment get]"]" } for {set i 0} {$i < [llength "$banlist(new)"]} {incr i} { multilistbox insert .banlist.list end "[lindex "$banlist(new)" $i]" "[riddletext "[lindex "$bancomments(new)" $i]"]" } .banlist.edit.entries.pattern delete 0 end .banlist.edit.entries.comment delete 0 end .banlist.edit.entries.date configure -text "" .banlist.edit.entries.user configure -text "" } proc BanList_RemoveEntry { } { global banlist bancomments set num "[multilistbox curselection .banlist.list]" if {"$num" != ""} { multilistbox delete .banlist.list $num set banlist(new) "[lreplace "$banlist(new)" $num $num]" set bancomments(new) "[lreplace "$bancomments(new)" $num $num]" } .banlist.edit.entries.pattern delete 0 end .banlist.edit.entries.comment delete 0 end .banlist.edit.entries.date configure -text "" .banlist.edit.entries.user configure -text "" } proc BanList_CommitChanges {num} { global banlist bancomments chan win set inum $win($num,irc) set cnum [GetChannelNumber "$banlist(channel)"] for {set i 0} {$i < [llength "$banlist(new)"]} {incr i} { set j [lsearch -exact "$chan($cnum,banpatterns)" "[lindex "$banlist(new)" $i]"] if {$j != -1} { set chan($cnum,bancomments) "[lreplace "$chan($cnum,bancomments)" $j $j "[lindex "$bancomments(new)" $i]"]" } } set flags "" ; set params "" ; set count 0 for {set i 0} {$i < [llength "$banlist(old)"]} {incr i} { set j [lsearch -exact "$banlist(new)" "[lindex "$banlist(old)" $i]"] if {$j == -1} { append flags "-b" append params " [lindex "$banlist(old)" $i]" incr count if {$count >= 3} { write2irc $inum "/quote mode $banlist(channel) $flags$params" queued set flags "" ; set params "" ; set count 0 } } else { set banlist(new) "[lreplace "$banlist(new)" $j $j]" set bancomments(new) "[lreplace "$bancomments(new)" $j $j]" } } for {set i 0} {$i < [llength "$banlist(new)"]} {incr i} { append flags "+b" append params " [lindex "$banlist(new)" $i]" incr count if {$count >= 3} { write2irc $inum "/quote mode $banlist(channel) $flags$params" queued set flags "" ; set params "" ; set count 0 } } if {$count > 0} { write2irc $inum "/quote mode $banlist(channel) $flags$params" queued } } proc BanListWindow {num} { global chan banlist bancomments if {[winfo exists .banlist]} { # This window is already open. beep ; return } set channel [GetActual $num] set banlist(channel) "$channel" if {"$channel" != "*"} { set cnum [GetChannelNumber "$channel"] set banlist(old) "$chan($cnum,banpatterns)" set banlist(new) "$banlist(old)" set bancomments(old) "$chan($cnum,bancomments)" set bancomments(new) "$bancomments(old)" if {[RequestLevel .banlist]} { # grab set .banlist wm title .banlist " tkirc: Edit banlist of channel $channel" bind .banlist "closewindow .banlist" set f .banlist.buttons Frame $f pack $f -side bottom -fill x -pady 2 Button $f.commit -text "Commit changes" -command "BanList_CommitChanges $num ; closewindow .banlist" Button $f.cancel -text "Cancel" -command "closewindow .banlist" pack $f.cancel $f.commit -side right Button $f.undo -text "Undo" -command "BanList_Undo" Button $f.remove -text "Remove" -command "BanList_RemoveEntry" pack $f.undo $f.remove -side left set frame .banlist.edit Frame $frame ; pack $frame -fill x -padx 2 -pady 2 -side bottom set frame .banlist.edit.labels Frame $frame ; pack $frame -side left Label $frame.pattern -text "Banpattern:" pack $frame.pattern -anchor e -pady 1 Label $frame.comment -text "Comment:" pack $frame.comment -anchor e -pady 1 Label $frame.date -text "Date,Time:" pack $frame.date -anchor e -pady 1 Label $frame.user -text "Banned by:" pack $frame.user -anchor e -pady 1 set frame .banlist.edit.entries Frame $frame ; pack $frame -fill x -expand true -side right Entry $frame.pattern ; pack $frame.pattern -fill x Entry $frame.comment ; pack $frame.comment -fill x Label $frame.date -bd 1 -relief sunken -anchor w pack $frame.date -fill x -padx 1 -pady 1 Label $frame.user -bd 1 -relief sunken -anchor w pack $frame.user -fill x -padx 1 -pady 1 multilistbox create .banlist.list {Banpattern 30} {Comment 30} multilistbox delete .banlist.list 0 end pack .banlist.list -side left -expand true -fill both -ipadx 0 -padx 0 Focus $frame.pattern bind $frame.pattern "BanList_AddEntry" bind $frame.comment "BanList_AddEntry" BanList_Undo multilistbox bind .banlist.list "+BanList_EntrySelected" multilistbox bind .banlist.list "+BanList_EntrySelected" multilistbox bind .banlist.list "+BanList_EntrySelected" } } } ############# # WINDOWS # ############# proc HandleKey {num key} { switch -- "$key" { "c" { selected $num chat } "o" { selected $num op } "d" { selected $num deop } "v" { selected $num voice } "e" { selected $num unvoice } "w" { selected $num who } "i" { selected $num whois } "b" { selected $num ban } "k" { selected $num kick } "q" { selected $num query} "y" { parsein $num /query } "t" { GetTopic $num } } } proc HandleFakeNetjoin {irc time} { global pjoin margin raw chan linetype if {$pjoin(state) != 0 && $time == $pjoin(time)} { # Die folgende Zeile wurde nur zur Vorsicht eingefügt. set pjoin(state) 0 set linetype 0 # Die Anzeige des möglichen Netjoins muß noch nachgeliefert werden. set original "$raw(line)" for {set i 0} {$i < [llength "$pjoin(channels)"]} {incr i} { set cnum [lindex "$pjoin(channels)" $i] if {[info exists chan($cnum,window)]} { set j $chan($cnum,window) if {$j != -1} { global hide_joins if {$hide_joins($j) == 0} { set raw(line) "$pjoin(nick)!$pjoin(address) JOIN :$chan($cnum)" set margin(text) "join" print2channels "$cnum" "*** $pjoin(nick) ($pjoin(address)) has joined channel $chan($cnum)[lindex "$pjoin(modetexts)" $i]\x0f\x0f" } } } } set raw(line) "$original" } } proc HandleNetjoins {inum cnum nick address modetext} { global join pjoin chan margin split psplit # if {$psplit(state) != 0 && [strcmp "$psplit(nick)" "$nick"] == 0} { # HandleFakeNetsplit $inum $psplit(time) # } set thistime [clock seconds] # Wurde dieser User von einem Netsplit erfaßt? for {set i $split(count)} {$i > 0} {set i [expr $i-1]} { set splitnum [expr $i-1] if {[expr $thistime - $split($splitnum,time)] < 1800} { set j [lsearch -exact "$split($splitnum,nicks)" "$nick"] if {$j != -1} { set split($splitnum,nicks) "[lreplace "$split($splitnum,nicks)" $j $j]" if {[lsearch -exact "$split($splitnum,channels)" "$cnum"] != -1} { # Nick und Kanal stimmen. ==> User gehört möglicherweise zum # Netsplit $num. set message "$split($splitnum,message)" break } } } } if {$i == 0} { # Dieser Nick ist nicht von einem Netsplit erfaßt worden. Der User # kann aber mit einem Netjoin aufgetaucht sein. Aus diesem Grund wird # pjoin(state) nicht angerührt. TakeOverTest $cnum "$address" set j $chan($cnum,window) if {$j != -1} { global hide_joins if {$hide_joins($j) == 0} { set margin(text) "join" print2channels $cnum "*** $nick ($address) has joined channel $chan($cnum)$modetext\x0f\x0f" } } } else { if {$join(count) > 0} { # Es gab bereits Netjoins, die erkannt wurden. set last [expr $join(count)-1] for {set i $last} {$i >= 0} {set i [expr $i-1]} { if {[expr $thistime-$join($i,time)] < 90} { if {$join($i,splitnum) == $splitnum} { break } } else { set i -1 break } } if {$i >= 0} { # Dieser User muß zum letzten Netjoin zugeordnet werden. lappend join($i,nicks) "$nick" lappend join($i,addresses) "$address" lappend join($i,channels) $cnum if {[lsearch -exact "$join($i,channels)" $cnum] == -1} { # Der Netjoin wurde in diesem Kanal noch nicht angezeigt. set time "[clock format $join($i,time) -format "%H:%M:%S"]" set margin(text) "netjoin" belated2channels "$cnum" "$join($i,channels)" "--- Netjoin at $time ($message)" } return } } if {$pjoin(state) != 0} { if {$splitnum == $pjoin(splitnum)} { if {[string compare "$nick" "$pjoin(nick)"] != 0} { # Der Netjoin wurde bestätigt. set num $join(count) incr join(count) set join($num,inum) $pjoin(inum) set join($num,time) $pjoin(time) set join($num,splitnum) "$pjoin(splitnum)" set join($num,channels) "[concat $pjoin(channels) $cnum]" set join($num,nicks) "[concat $pjoin(nick) $nick]" set join($num,addresses) "[concat $pjoin(address) $address]" set join($num,modetexts) "[concat $pjoin(modetexts) "$modetext"]" set pjoin(state) 0 # Der Netjoin wird angezeigt. set margin(text) "netjoin" print2channels "$join($num,channels)" "--- Netjoin at [clock format $join($num,time) -format "%H:%M:%S"] ($message)" } else { # Der gleiche Nick wie eben! lappend pjoin(channels) $cnum lappend pjoin(modetexts) "$modetext" } return } else { HandleFakeNetjoin $inum $pjoin(time) } } # Der aktuelle Join muß als möglicher Netjoin eingestuft # werden und wird noch später behandelt. set pjoin(inum) $inum set pjoin(time) $thistime set pjoin(splitnum) $splitnum set pjoin(nick) "$nick" set pjoin(channels) "[list $cnum]" set pjoin(address) "$address" set pjoin(modetexts) "[list "$modetext"]" set pjoin(state) 1 after 4200 HandleFakeNetjoin $inum $thistime } } proc HandleFakeNetsplit {inum time} { global psplit margin raw chan linetype if {$psplit(state) != 0 && $time == $psplit(time)} { # Die folgende Zeile wurde nur zur Vorsicht eingefügt. set psplit(state) 0 set linetype 0 # Die Anzeige des möglichen Netsplits muß noch nachgeliefert werden. set tmp "" foreach x "$psplit(channels)" { if {[info exists chan($x,window)]} { set i $chan($x,window) if {$i != -1} { global hide_signoffs if {$hide_signoffs($i) == 0} { lappend tmp $x } } } } if {"$tmp" != ""} { set original "$raw(line)" set raw(line) "$psplit(nick)!$psplit(address) QUIT :$psplit(message)" set margin(text) "signoff" print2channels "$tmp" "*** $psplit(nick) has signed off ($psplit(message)\x0f)\x0f\x0f" set raw(line) "$original" } } } proc HandleNetsplits {inum nick address message} { global split psplit chan margin join pjoin # if {$pjoin(state) != 0 && [strcmp "$pjoin(nick)" "$nick"] == 0} { # HandleFakeNetjoin $inum $pjoin(time) # } set thistime [clock seconds] set channels "" foreach cnum "$chan(list)" { set unum [UserNumber $inum $cnum "$nick"] if {$unum != -1} { # Der Benutzer wird gelöscht, ohne eine Ausgabe zu machen. RemoveUserFromChannel $inum $cnum $unum "$nick" # Die Kanalnummern werden evtl. noch gebraucht. lappend channels $cnum } } if {$split(count) > 0} { # Es gab bereits Netsplits, die erkannt wurden. set last [expr $split(count)-1] set i $last # Evtl. müssen hier noch weitere Netsplits berücksichtigt werden. if {[expr $thistime-$split($i,time)] < 90 \ && [string compare "$split($i,message)" "$message"] == 0 \ && [lsearch -exact "$split($i,nicks)" "$nick"] == -1} { # Dieser User muß dem Netsplit $i zugeordnet werden. lappend split($i,nicks) "$nick" lappend split($i,addresses) "$address" # Es muß sichergestellt werden, daß der Netsplit in allen # relevanten Kanälen dargestellt wird. set tmp "" foreach cnum "$channels" { if {[lsearch -exact "$split($i,channels)" $cnum] == -1} { lappend tmp $cnum } } if {"$tmp" != ""} { set time "[clock format $split($i,time) -format "%H:%M:%S"]" set margin(text) "netsplit" belated2channels "$tmp" "$split($i,channels)" "--- Netsplit at $time ($message)" set split($i,channels) "[concat $split($i,channels) $tmp]" } return } } if {$psplit(state) != 0} { if {[string compare "$message" "$psplit(message)"] == 0} { # Der Netsplit wurde bestätigt. set num $split(count) incr split(count) set split($num,inum) $inum set split($num,time) $psplit(time) set split($num,message) "$psplit(message)" set split($num,channels) "[concat $psplit(channels) $channels]" set split($num,nicks) "[concat $psplit(nick) $nick]" set split($num,addresses) "[concat $psplit(address) $address]" set psplit(state) 0 # Der Netsplit wird angezeigt. set time "[clock format $split($num,time) -format "%H:%M:%S"]" set margin(text) "netsplit" print2channels "$split($num,channels)" "--- Netsplit at $time ($message)" return } else { HandleFakeNetsplit $inum $psplit(time) } } # Der aktuelle Signoff muß als möglicher Netsplit eingestuft # werden und wird noch später behandelt. set psplit(inum) $inum set psplit(time) $thistime set psplit(message) "$message" set psplit(nick) "$nick" set psplit(address) "$address" set psplit(channels) "$channels" set psplit(state) 1 after 4200 HandleFakeNetsplit $inum $thistime } proc StripAddressPrefix {address} { if [regexp -- {^(\~|\+|\^|=|-).*} "$address"] { return "[string range "$address" 1 end]" } return "$address" } proc TrimNick {user} { return "[string trimleft "$user" "@+"]" } proc RenameUser {inum old new} { global ban chan kick win margin history set address "[AddressOfNick $inum $old]" # Gibt es geöffnete BanRequests, die geändert werden müssen? foreach x "[array names ban *:nick]" { set bnum [lindex "[split "$x" ":"]" 0] if {$ban($bnum:irc) == $inum} { if {[string compare "$old" "$ban($bnum:nick)"] == 0} { set ban($bnum:nick) "$new" set path ".ban$bnum" if {[winfo exists $path]} { wm title $path " tkirc: Ban-Kick '$new'" $path.top configure -text "Please select the pattern to ban user $ban($bnum:nick)\n($ban($bnum:address)) from channel $ban($bnum:channel):" set a $path.body.address if {"[$a.nick cget -text]" != "*"} { $a.nick configure -text "$new" } } } } } # Gibt es geöffnete KickRequests, die geändert werden müssen? foreach x "[array names kick *:nicks]" { set knum [lindex "[split "$x" ":"]" 0] set i [lsearch -exact "$kick($knum:nicks)" "$old"] if {$i != -1} { set kick($knum:nicks) "[lreplace "$kick($knum:nicks)" $i $i "$new"]" } } # Ggf. werden die Query-Einträge geändert. foreach wnum "$win(list)" { if {$win($wnum,irc) == $inum} { if {[strcmp "$old" "$win($wnum,query)"] == 0} { set win($wnum,query) "$new" UpdateTitle $wnum } } } # Befindet sich der Nick in der Message-History? set i [lsearch -exact "$history($inum,msg,list)" "$old"] if {$i != -1} { set history($inum,msg,list) "[lreplace "$history($inum,msg,list)" $i $i "$new"]" } set channels "" foreach cnum "$chan(list)" { if {$chan($cnum,irc) == $inum} { set i [lsearch -exact "$chan($cnum,cnicks)" "$old"] if {$i != -1} { set chan($cnum,cnicks) "[lreplace "$chan($cnum,cnicks)" $i $i "$new"]" } } set unum [UserNumber $inum $cnum "$old"] if {$unum != -1} { DetectUserOnChannel $inum $cnum $unum notify leave DetectUserOnChannel $inum $cnum $unum suspect leave set chan($cnum,nicks) "[lreplace "$chan($cnum,nicks)" $unum $unum "$new"]" if {[lindex "$chan($cnum,olist)" $unum]} { set prefix "@" } elseif {[lindex "$chan($cnum,vlist)" $unum]} { set prefix "+" } else { set prefix "" } set chan($cnum,names) "[lreplace "$chan($cnum,names)" $unum $unum "$prefix$new"]" DetectUserOnChannel $inum $cnum $unum notify join DetectUserOnChannel $inum $cnum $unum suspect join set num $chan($cnum,window) if {$num != -1 && $num < 500} { # 500 für ein Schwindel-Fenster if {[strcmp "[GetActual $num]" "$chan($cnum)"] == 0} { set path "[GetWindowPath $num]" set selected [$path.body.right.list.users selection includes $unum] DeleteFromUserList $num $cnum "$old" set j [InsertToUserList $num $cnum "$prefix$new"] if {$selected != 0} { $path.body.right.list.users selection set $unum } } lappend channels $cnum } } } set margin(text) "nick" print2channels "$channels" "*** $old is now known as $new\x0f\x0f" } proc ChannelUserOp {cnum user plus} { global chan win set i [UserNumber $chan($cnum,irc) $cnum "$user"] if {$i != -1 && [expr [lindex "$chan($cnum,olist)" $i] + $plus] == 1} { # Der User existiert, und das Vorzeichen hat sich geändert. if {$plus != 0} { incr chan($cnum,mode_o) if {[lindex "$chan($cnum,vlist)" $i]} { set chan($cnum,mode_v) [expr $chan($cnum,mode_v)-1] } } else { if {[lindex "$chan($cnum,vlist)" $i]} { incr chan($cnum,mode_v) } set chan($cnum,mode_o) [expr $chan($cnum,mode_o)-1] } set chan($cnum,olist) "[lreplace "$chan($cnum,olist)" $i $i "$plus"]" if {$plus != 0} { set prefix "@" } elseif {[hasVoiceOnChannel $cnum "$user"]} { set prefix "+" } else { set prefix "" } set chan($cnum,names) "[lreplace "$chan($cnum,names)" $i $i "$prefix$user"]" set wnum $chan($cnum,window) if {$wnum != -1} { if {[strcmp "[GetActual $wnum]" "$chan($cnum)"] == 0} { set path "[GetWindowPath $wnum]" set selected [$path.body.right.list.users selection includes $i] DeleteFromUserList $wnum $cnum "$user" set j [InsertToUserList $wnum $cnum "$prefix$user"] if {$selected != 0} { $path.body.right.list.users selection set $i } } } } } proc ChannelUserVoice {cnum user plus} { global chan win set i [UserNumber $chan($cnum,irc) $cnum "$user"] if {$i != -1 && [expr [lindex "$chan($cnum,vlist)" $i] + $plus] == 1} { # Der User existiert, und das Vorzeichen hat sich geändert. if {[lindex "$chan($cnum,olist)" $i] == 0} { if {$plus != 0} { incr chan($cnum,mode_v) } else { set chan($cnum,mode_v) [expr $chan($cnum,mode_v)-1] } } set chan($cnum,vlist) "[lreplace "$chan($cnum,vlist)" $i $i "$plus"]" if {[lindex "$chan($cnum,olist)" $i]} { set prefix "@" } elseif {$plus != 0} { set prefix "+" } else { set prefix "" } set chan($cnum,names) "[lreplace "$chan($cnum,names)" $i $i "$prefix$user"]" set wnum $chan($cnum,window) if {$wnum != -1} { if {[strcmp "[GetActual $wnum]" "$chan($cnum)"] == 0} { set path "[GetWindowPath $wnum]" set selected [$path.body.right.list.users selection includes $i] DeleteFromUserList $wnum $cnum "$user" InsertToUserList $wnum $cnum "$prefix$user" if {$selected != 0} { $path.body.right.list.users selection set $i } } } } } proc UnbanChannelUser {cnum address} { global chan set i [lSearch "$chan($cnum,banpatterns)" "$address"] if {$i != -1} { set chan($cnum,banpatterns) "[lreplace "$chan($cnum,banpatterns)" $i $i]" set chan($cnum,bantimes) "[lreplace "$chan($cnum,bantimes)" $i $i]" set chan($cnum,banusers) "[lreplace "$chan($cnum,banusers)" $i $i]" set chan($cnum,bancomments) "[lreplace "$chan($cnum,bancomments)" $i $i]" set chan($cnum,mode_b) [expr $chan($cnum,mode_b)-1] } if {[winfo exists .banlist]} { global banlist bancomments if {[strcmp "$banlist(channel)" "$chan($cnum)"] == 0} { set i [lSearch "$banlist(new)" "$address"] if {$i != -1} { multilistbox delete .banlist.list $i set banlist(new) "[lreplace "$banlist(new)" $i $i]" set bancomments(new) "[lreplace "$bancomments(new)" $i $i]" } set i [lSearch "$banlist(old)" "$address"] if {$i != -1} { set banlist(old) "[lreplace "$banlist(old)" $i $i]" set bancomments(old) "[lreplace "$bancomments(old)" $i $i]" } } } } proc BanChannelUser {cnum pattern user} { global chan if {"$user" == "!"} { set place end set time 0 } else { set place end set time [clock seconds] } set comment "" if {$cnum != -1} { set i [lSearch "$chan($cnum,banpatterns)" "$pattern"] if {$i == -1} { foreach x "comment pattern time user" { set chan($cnum,ban[set x]s) "[linsert "$chan($cnum,ban[set x]s)" $place "[set $x]"]" } incr chan($cnum,mode_b) } } if {[winfo exists .banlist]} { global banlist bancomments if {[strcmp "$banlist(channel)" "$chan($cnum)"] == 0} { if {[lSearch "$banlist(new)" "$pattern"] == -1} { multilistbox insert .banlist.list $place "$pattern" set banlist(new) "[linsert "$banlist(new)" $place "$pattern"]" set bancomments(new) "[linsert "$bancomments(new)" $place ""]" } if {[lSearch "$banlist(old)" "$pattern"] == -1} { set banlist(old) "[linsert "$banlist(old)" $place "$pattern"]" set bancomments(old) "[linsert "$bancomments(old)" $place ""]" } } } } ####################################################################### # COMPLETION OF NICKNAMES OR CERTAIN WORDS AND REPLACING OF ALIASES # ####################################################################### proc CompleteOrReplace {num} { global chan win nickname margin global nick_completion_mode nick_completion_suffix global nick_completion_prefer_number nick_completion_prefer_period set path "[GetWindowPath $num]" set inum $win($num,irc) set oldline "[$path.cmdline get]" set insert "[$path.cmdline index insert]" set left "[string range "$oldline" 0 [expr $insert-1]]" set right "[string range "$oldline" $insert end]" set lastspace [string last " " "$left"] if {$lastspace != -1} { # space found set pattern "[string range "$left" [expr $lastspace+1] end]" } else { # no space, add colon and space set pattern "$left" } set last [expr [string length "$pattern"] - 1] set channel "[GetActual $num]" if {"$channel" != "*"} { set cnum [ChannelNumber $inum "$channel"] if {$nick_completion_mode > 1} { for {set i 0} {$i < [llength "$chan($cnum,ctimes)"]} {incr i} { if {[expr [clock seconds]-[lindex "$chan($cnum,ctimes)" $i]] > $nick_completion_prefer_period} { break } } set nicks2prefer $i } else { set nicks2prefer $nick_completion_prefer_number } set matches "" for {set i 0} {$i < $nicks2prefer} {incr i} { if {[string length "$pattern"] == 0} { # Wenn kein Buchstabe angegeben wird, dann wird der letzte # Gesprächspartner genommen. lappend matches 0 break } set x "[lindex "$chan($cnum,cnicks)" $i]" if {[strcmp "$pattern" "[string range "$x" 0 $last]"] == 0} { if {[strcmp "$x" "$nickname"]} { lappend matches $i } } } if {[llength "$matches"] != 1} { # Kein Nickname konnte bis jetzt eindeutig bestimmt werden. if {[string length "$pattern"] == 0} { beep return } set len [llength "$chan($cnum,cnicks)"] for {set i $nicks2prefer} {$i < $len} {incr i} { set x "[lindex "$chan($cnum,cnicks)" $i]" if {[strcmp "$pattern" "[string range "$x" 0 $last]"] == 0} { if {[strcmp "$x" "$nickname"]} { lappend matches $i } } } } set len [llength "$matches"] if {$len == 1} { set x "[lindex "$chan($cnum,cnicks)" $matches]" if {$lastspace != -1} { $path.cmdline delete $lastspace $insert $path.cmdline insert $lastspace " [expandescape "$x"]" } else { $path.cmdline delete 0 $insert $path.cmdline insert $lastspace "[expandescape "$x"]$nick_completion_suffix" } set i [lsearch -exact "$chan($cnum,cnicks)" "$x"] if {$i != -1} { set chan($cnum,cnicks) "[lreplace "$chan($cnum,cnicks)" $i $i]" set chan($cnum,ctimes) "[lreplace "$chan($cnum,ctimes)" $i $i]" set chan($cnum,cnicks) "[linsert "$chan($cnum,cnicks)" 0 "$x"]" set chan($cnum,ctimes) "[linsert "$chan($cnum,ctimes)" 0 [clock seconds]]" } return } elseif {$len > 1} { # Mehrere Nicks passen. beep set cmpnick "[lindex "$chan($cnum,cnicks)" [lindex "$matches" 0]]" # Der getippte Nick soll so weit wie möglich (bis i-1) # erweitert werden. set equal 42 foreach x "$matches" { set nick "[lindex "$chan($cnum,cnicks)" $x]" for {set i 0} {$i < [string length "$nick"]} {incr i} { set char1 "[string tolower "[string index "$nick" $i]"]" set char2 "[string tolower "[string index "$cmpnick" $i]"]" if {"$char1" != "$char2"} { break } } if {$i < $equal} { set equal $i } } if {$lastspace != -1} { $path.cmdline delete $lastspace $insert $path.cmdline insert $lastspace " [expandescape "[string range "$cmpnick" 0 [expr $equal-1]]"]" } else { $path.cmdline delete 0 $insert $path.cmdline insert $lastspace "[expandescape "[string range "$cmpnick" 0 [expr $equal-1]]"]" } set text "" foreach x "$matches" { append text "[lindex "$chan($cnum,cnicks)" $x] " } set margin(text) "note" print2text $num "--- Matching nicknames: $text" return } } if {[string length "$pattern"]} { global words_to_complete foreach x "$words_to_complete" { if {[strcmp "$pattern" "[string range "$x" 0 $last]"] == 0} { if {$lastspace != -1} { $path.cmdline delete $lastspace $insert $path.cmdline insert $lastspace " $x" } else { $path.cmdline delete 0 $insert $path.cmdline insert $lastspace "$x" } return } } global tab_aliases set len [llength "$tab_aliases"] for {set i 0} {$i < $len} {incr i} { set entry "[lindex "$tab_aliases" $i]" if {[strcmp "$pattern" "[lindex "$entry" 0]"] == 0} { if {$lastspace != -1} { $path.cmdline delete $lastspace $insert $path.cmdline insert $lastspace " [lindex "$entry" 1]" } else { $path.cmdline delete 0 $insert $path.cmdline insert $lastspace "[lindex "$entry" 1]" } return } } } beep } ###################################################################### # MULTIPLE-SERVER-EXCHANGE # ###################################################################### proc irc2text {inum} { global irc win queue on_args destlog global commandqueue raw lines_all global crapwindow messagewindow nickname server # The following 4 lines help to support old scripts. set crapwindow $irc($inum,crap) set messagewindow $irc($inum,mesg) set nickname $irc($inum,nick) set server $irc($inum,serv) set irc(num) $inum if {[gets $irc($inum) line] >= 0} { incr lines_all update idletasks foreach v "[array names on_args *]" { unset on_args($v) } set on_args(irc) $inum set irc($inum,notice_toall) 0 global cooked margin next set cooked(line) "" debug "in ($inum): $line" if {"[string index "$line" 0]" == "~"} { # ~raw global raw ; set raw(line) "[string range "$line" 5 end]" set destlog "crap" set on_args(window) $irc($inum,crap) set margin(text) "" foreach x "filter direct tocrap left right beep" { set irc($inum,next,$x) 0 } foreach x "pattern towin tolog chatwin from to" { set irc($inum,next,$x) "" } set line "[parseraw $inum "$line"]" set raw(lasttype) "$raw(type)" if {[string length "$line"] == 0} { return } } elseif {"[string index "$line" 0]" == "%"} { set destlog "crap" set on_args(window) $irc($inum,crap) set margin(text) "" set irc($inum,next,filter) 0 ; set irc($inum,next,tocrap) 0 set line "[parseons $inum "$line"]" if {[string length "$line"] == 0} { return } append line "\x0f\x0f" } elseif {"$irc($inum,receiving_list)" != ""} { switch -exact -- "$irc($inum,receiving_list)" { "dcc_list" { global dcc set list "[line2list "$line"]" switch -exact -- "[string toupper "[lindex "[split "$line" " "]" 0]"]" { TYPE { set irc($inum,dcclist_header) "$line" } SEND { set dnum [SearchDCC $inum SEND "[lindex "$list" 1]" ""] set old 1 if {$dnum != -1} { set old [string length "$dcc($dnum,state)"] set dcc($dnum,file) "[lindex "$list" end]" } set left [string first "Sent" "$irc($inum,dcclist_header)"] set right [expr $left-1+[string first " " "[string range "$line" $left end]"]] if {$left != -1} { set dcc($dnum,sent) "[string range "$line" $left $right]" } if {!$old || [winfo exists .dcc$dnum]} { set dcc($dnum,state) "running" DCCWindow $dnum } } GET { set dnum [SearchDCC $inum GET "[lindex "$list" 1]" ""] set old 1 if {$dnum != -1} { set old [string length "$dcc($dnum,state)"] set dcc($dnum,file) "[lindex "$list" end]" } set left [string first "Read" "$irc($inum,dcclist_header)"] set right [expr $left-1+[string first " " "[string range "$line" $left end]"]] if {$left != -1} { set dcc($dnum,read) "[string range "$line" $left $right]" } if {!$old || [winfo exists .dcc$dnum]} { set dcc($dnum,state) "running" DCCWindow $dnum } } } } } return } else { # Evtl schon durch parseraw() bearbeitete Zeilen werden # hier herausgefiltert oder direkt ins CRAP geschickt. if {$irc($inum,next,direct) != 0} { if {$irc($inum,next,filter) != 0} { set irc($inum,next,filter) 0 return } if {[string match "$irc($inum,next,pattern)" "$line"]} { # Handelt es sich um eine öffentliche oder eine # private Message? if {[string length "$irc($inum,next,to)"]} { # Falls es das Fenster nicht mehr gibt, wird diese # Message nicht dargestellt. if {[WindowNumber $inum "$irc($inum,next,to)"] == -1} { return } set destlog "channel $irc($inum,next,to)" print2text $on_args(window) "$irc($inum,next,towin)\x0f\x0f" } else { # Soll ein Chat-Fenster geöffnet werden? global away send_away_notice san if {[string length "$away"] && $send_away_notice == 1 \ && "[string index "$irc($inum,next,towin)" 0]" != "+"} { # Keine Away-Notice beim Empfang von privaten Notices! set i [lsearch -exact "$san(nicks)" "$irc($inum,next,from)"] if {$i == -1} { lappend san(nicks) "$irc($inum,next,from)" lappend san(times) "[clock seconds]" send2tkirc $irc($inum,crap) "/notice [expandescape "$irc($inum,next,from) $irc($inum,nick) is away: $san(message)"]" } elseif {[expr [clock seconds]-[lindex "$san(times)" $i]] > 900} { set san(times) "[lreplace "$san(times)" $i $i [clock seconds]]" send2tkirc $irc($inum,crap) "/notice [expandescape "$irc($inum,next,from) $irc($inum,nick) is away: $san(message)"]" } } set on_args(window) [GetQueryWindow $inum $irc($inum,next,from) $irc($inum,next,chatwin)] set destlog "query $irc($inum,next,from)" # Die Message wird ausgegeben. print2text $on_args(window) "$irc($inum,next,towin)\x0f\x0f" hilitenick } set irc($inum,notice_toall) 1 write2log "$destlog" $inum "$irc($inum,next,tolog)" set irc($inum,notice_toall) 0 set irc($inum,next,toall) "" # Evtl. muß gepiept werden. =:^) if {$irc($inum,next,beep) != 0} { beep } set irc($inum,next,direct) 0 return } else { set destlog "crap" set on_args(window) $irc($inum,crap) } } else { set destlog "crap" set on_args(window) $irc($inum,crap) } if {$irc($inum,next,filter) != 0} { set irc($inum,next,filter) 0 return } if {$irc($inum,next,tocrap) != 0} { set irc($inum,next,tocrap) 0 write2crap $inum "$line" return } if [regexp -- {^\*\*\*\ .*} "$line"] { set line "[parse3stars $inum "[string range "$line" 4 end]"]" } } if {[string length "$line"]} { set loline "[string tolower "$line"]" # scanning commandqueue (pattern/command) set len [llength "$commandqueue"] foreach x "margin(text)" { set bak_$x "[set $x]" } for {set i 0} {$i < $len} {incr i;incr i} { if {[strmatch "[lindex "$commandqueue" $i]" "$loline"]} { set command "[lindex "$commandqueue" [expr $i+1]]" if {[string length "$command"]} { eval $command } set commandqueue "[lreplace "$commandqueue" $i [expr $i+1]]" break } } foreach x "margin(text)" { set $x "[set bak_$x]" } # scanning queue to filter lines (pattern/timestamp) for {set i 0} {$i < [llength "$queue($inum,filter)"]} {incr i;incr i} { if {[string match "[lindex "$queue($inum,filter)" $i]" "$loline"]} { set queue($inum,filter) "[lreplace "$queue($inum,filter)" $i [expr $i+1]]" return } set date "[lindex "$queue($inum,filter)" [expr $i+1]]" if {"$date" == ""} { write2crap $inum "BUG: queue($inum,filter)=\"$queue($inum,filter)\", i=$i" } else { if {[expr [clock seconds]-[lindex "$queue($inum,filter)" [expr $i+1]]] > 120} { set queue($inum,filter) "[lreplace "$queue($inum,filter)" $i [expr $i+1]]" set i [expr $i-2] } } } if {[lsearch -exact "$win(list)" $on_args(window)] != -1} { print2text $on_args(window) "$line" } write2log "$destlog" $inum "$line" } else { } } elseif [eof $irc($inum)] { catch {close $irc($inum)} result set margin(text) "error" write2crap $inum "--- $result. Please restart tkirc!" } else { # NEVER } set cooked(line) "" } proc write2irc {inum line args} { global irc queue if {[lsearch "$irc(list)" $inum] != -1} { if {"$irc($inum)" != "" && "$line" != ""} { debug "out ($inum,$args): $line" if {[lsearch "$args" "urgent"] != -1} { set queue($inum,send) "[linsert "$queue($inum,send)" 0 "$line"]" } elseif {[lsearch "$args" "queued"] != -1} { lappend queue($inum,send) "$line" } else { puts $irc($inum) "$line\n" flush $irc($inum) } } } } proc write2crap {inum line} { global irc write2log "crap" $inum "$line" print2text $irc($inum,crap) "$line" } proc write2windows {inum line} { global win foreach wnum "$win(list)" { if {[string match "$inum" "$win($wnum,irc)"]} { write2log "window $wnum" $win($wnum,irc) "$line" print2text $wnum "$line" } } } proc write2log {source inum line} { global logs irc raw margin set esc_codes_filtered 0 set losrc "[string tolower "$source"]" set loserv "[string tolower "$irc($inum,serv)"]" foreach lnum "$logs(list)" { set splity "[split "$logs($lnum)" ":"]" if {[string compare "$losrc" "[lindex "$splity" 0]"] == 0} { if {[string compare "[lindex "$splity" 1]" "#$inum"] == 0 \ || [string match "[lindex "$splity" 1]" "$loserv"]} { if {[string compare "all" "$losrc"] == 0 \ && $irc($inum,notice_toall) != 0 \ && [string length "$irc($inum,next,toall)"] > 0} { # Im IrcLog.all werden die Kanalnamen bei öffentlichen # PRIVMSGs und NOTICEs mitgelogt. set line "$irc($inum,next,toall)" } # Escape-Codes werden herausgefiltert, sofern das nicht bereits # gemacht wurde. if {!$esc_codes_filtered} { set oldline "$line" ; set line "" set len [string length "$oldline"] for {set i 0} {$i < $len} {incr i} { set char "[string index "$oldline" $i]" if {"$char" > "\x1f"} { append line "$char" } elseif {"$char" == "\x09"} { append line " " } } set esc_codes_filtered 1 } # Das Logfile wird ggf. neu angelegt/geöffnet. set handle "$logs($lnum:handle)" set filename "$logs($lnum:filename)" if {![file exists "$filename"]} { if [catch {close $handle} err] { debug "--- Failed to close handle '$handle'!" } if [catch {open $filename a+} handle] { set margin(text) "error" write2crap $inum "--- $handle" DeleteLog $lnum return } else { set logs($lnum:handle) "$handle" set logs($lnum:opendate) "[longdate]" set logs($lnum:linecount) 0 puts $handle "\nLogfile reopened for $logs($lnum:source) on $logs($lnum:boundary) at: [longdate]" flush $logs($lnum:handle) # set oldmargintext "$margin(text)" # # Der eigentlich Text des Margins muß gerettet werden. # set margin(text) "log" # write2crap $inum "--- Logfile '$logs($lnum:filename)' reopened for $logs($lnum:source) on $logs($lnum:boundary)" # set margin(text) "$oldmargintext" } } # Bei Bedarf wird ein Datum an das vordere Ende der Zeile angefügt. set prefix "" if {$logs($lnum:dateflag) != 0} { append prefix "[date] " } if {$logs($lnum:timeflag) != 0} { append prefix "[time2] " } # Die doppelte Öffnungsmeldung von crap- und all-Logfiles # wird mit den folgenden Zeilen verhindert. if {[incr logs($lnum:linecount)] == 1} { if {[string compare "crap" "$losrc"] == 0 \ || [string compare "all" "$losrc"] == 0} { continue } } # Die aktuelle Zeile wird ins Logfile geschrieben. Zeilen für # CRAP- und WINDOW-Logs können nicht mit der Option '-raw' # gelogt werden. if {!$logs($lnum:rawflag) || [string compare "crap" "$losrc"] == 0 \ || [string match "window *" "$losrc"]} { puts $handle "$prefix$line" flush $handle } else { if {[string length "$raw(line)"]} { puts $handle "$prefix$raw(line)" flush $handle } } if {[string compare "all" "$losrc"] == 0} { set raw(line) "" } } } } if {[string match "query *" "$source"]} { write2log "messages" $inum "$line" } if {[regexp -- "^(channel .*|crap|query .*)$" "$source"]} { write2log "all" $inum "$line" } } proc send2tkirc {num line args} { global irc win margin set inum $win($num,irc) if {"$inum" == ""} { # Die Pipe zum ircII ist nicht mehr vorhanden. return } if {[lsearch -exact "$win(list)" $num] == -1} { # Da das angegebene Fenster nicht mehr vorhanden ist, wird # die Ausgabe ins crapwindow umgeleitet. set num $irc($inum,crap) } set actual "[GetActual $num]" if {"$actual" != "*" && "$actual" != ""} { debug "out ($inum): /join [GetActual $num]" puts $irc($inum) "/join [GetActual $num]" } set maxchars 225 set header "" foreach x "[split "$line" "\n"]" { if {"$header" == "" && "[string index "$line" 0]" == "/"} { # Zeile enthält Kommando. switch -glob -- "[string tolower "$x"]" { "/msg *" { set header "/msg [lIndex "$x" 1] " set x "[cutwords "$x" 2]" } "/notice *" { set header "/notice [lIndex "$x" 1] " set x "[cutwords "$x" 2]" } "/onotice *" { set header "/onotice [lIndex "$x" 1] " set x "[cutwords "$x" 2]" } "/me *" { set header "/me " set x "[cutwords "$x" 1]" } "/describe *" { set header "/describe [lIndex "$x" 1] " set x "[cutwords "$x" 2]" } default { # Kommando (außer msg und notice) write2irc $inum "[parsecl $num "[string range "$line" 0 $maxchars]"]" $args return } } } else { # Zeile enthält kein Kommando. if {"$win($num,query)" == ""} { # Kein Query vorhanden. if {[strcmp "*" "[GetActual $num]"] == 0} { # Kein aktueller Kanal vorhanden. set margin(text) "error" print2text $num "--- You have no channel joined in this window" return } else { # Aktueller Kanal ist vorhanden, daher muß evtl. die Liste # der Nickname-Completion aktualisiert werden. if {[string match "*:" "[lIndex "$x" 0]"]} { set cnum [ChannelNumber $inum "[GetActual $num]"] global chan set nick "[string trim "[lIndex "$x" 0]" " :"]" if [strcmp "$nick" "*"] { set i [lsearch -exact "$chan($cnum,cnicks)" "$nick"] if {$i != -1} { set chan($cnum,cnicks) "[lreplace "$chan($cnum,cnicks)" $i $i]" set chan($cnum,ctimes) "[lreplace "$chan($cnum,ctimes)" $i $i]" set chan($cnum,cnicks) "[linsert "$chan($cnum,cnicks)" 0 "$nick"]" set chan($cnum,ctimes) "[linsert "$chan($cnum,ctimes)" 0 "[clock seconds]"]" } } } } } else { # Query vorhanden. set header "/msg [expandescape "$win($num,query)"] " } } # Falls kein Header existiert, ist Vorsicht geboten! if {"$header" == ""} { set header "/say " } # Hier wird verhindert, daß getippte Zeilen, die zu lang # geraten sind, Probleme bereiten! while {[string length "$x"] > $maxchars} { set cutnum [string last " " "[string range "$x" 0 $maxchars]"] if {$cutnum == -1} { set cutnum $maxchars } write2irc $inum "[parsecl $num "$header[string range "$x" 0 $cutnum]..."]" $args set x "[string range "$x" [expr $cutnum+1] end]" } write2irc $inum "[parsecl $num "$header$x"]" $args } } proc UserNumber {inum cnum nick} { global chan if {$cnum != -1 && $chan($cnum,irc) == $inum} { return [lSearch "$chan($cnum,nicks)" "$nick"] } return -1 } proc ChannelNumber {inum channel} { global chan foreach x "$chan(list)" { if {$chan($x,irc) == $inum && [strcmp "$channel" "$chan($x)"] == 0} { return "$x" } } return -1 } proc WindowNumber {inum args} { global chan destlog on_args set destlog "" set on_args(window) -1 if {"$args" != ""} { set cnum -1 foreach x "$args" { # Das obige foreach wird benutzt, um überflüssige \ zu entfernen. foreach y "$chan(list)" { if {$chan($y,irc) == $inum && [strcmp "$x" "$chan($y)"] == 0} { set cnum $y } } } } else { set cnum $inum } if {$cnum != -1} { set destlog "channel $chan($cnum)" set on_args(window) $chan($cnum,window) } return $on_args(window) } proc InitClient {inum} { FilterLine $inum {\*\*\*?Value of DISPLAY set to OFF} write2irc $inum "/set DISPLAY off" # ircII write2irc $inum "/set SHOW_NUMERICS on" write2irc $inum "/set NOVICE off" write2irc $inum "/set NO_CTCP_FLOOD on" write2irc $inum "/set EIGHT_BIT_CHARACTERS ON" write2irc $inum "/set SHOW_CHANNEL_NAMES OFF" write2irc $inum "/set VERBOSE_CTCP ON" # EPIC write2irc $inum "/set AUTO_NEW_NICK OFF" # Events via /ON write2irc $inum {/on #-raw_irc 0 "*" if ([$1]!=[PING]) {if ([$1]!=[303]) {echo ~raw $0-}}} write2irc $inum {/on #^send_public 0 * echo %send_public $0-} write2irc $inum {/on #^send_action 0 * echo %send_action $0-} write2irc $inum {/on #^send_msg 0 * echo %send_msg $0-} write2irc $inum {/on #^send_notice 0 * echo %send_notice $0-} write2irc $inum {/on #^dcc_chat 0 * echo %dcc_chat $0-} write2irc $inum {/on #^send_dcc_chat 0 * echo %send_dcc_chat $0-} write2irc $inum {/on #^notify_signon 0 * echo %notify_signon $0-} write2irc $inum {/on #^notify_signoff 0 * echo %notify_signoff $0-} foreach x "join leave signoff topic nickname mode kick" { write2irc $inum "/on #^$x 0 * -" } write2irc $inum {/alias get_dcclist if ("$1"=="list") {echo %dcc_list_start;dcc list;echo %dcc_list_stop}} write2irc $inum {/alias squery ${K}${K}quote squery $0 :$1-} write2irc $inum {/alias servlist ${K}${K}quote servlist $*} write2irc $inum {/alias noteserv ${K}${K}quote squery noteserv :$*} write2irc $inum {/alias umode mode $N} FilterLine $inum {\*\*\*?Value of DISPLAY set to ON} write2irc $inum "/set DISPLAY on" global margin ; set margin(text) "init" write2crap $inum "--- ircII for usage with tkirc initialized" } proc SetClientInformation {inum} { global tkirc_version date tcl_version tk_version FilterLine $inum {\*\*\*?Value of CLIENT_INFORMATION *} if {$tcl_version == $tk_version} { write2irc $inum "/set client_information tkirc $tkirc_version ($date) Tcl/Tk $tcl_version : http://netsplit.de/tkirc2/" } else { write2irc $inum "/set client_information tkirc $tkirc_version ($date) Tcl $tcl_version/Tk $tk_version : http://netsplit.de/tkirc2/" } } proc OpenIRC {nick serv} { global ircII_version irc ircrc ircpath # Frühe Versionen des ircII unterstützen die Option -q nicht. Aus diesem # Grund wird die Versionsnummer überprüft und ggf. ein wenig getrickst. set result [catch {open "|$ircpath -v" r+} fd] if {!$result} { if {[gets $fd ircII_version] >= 0} { set verbose "[lindex "$ircII_version" 2]" if {[regexp -- {^[0-9]+\.[0-9]+\..*$} "$verbose"]} { set verbose "[split "$verbose" "."]" if {[expr [lindex "$verbose" 0].[lindex "$verbose" 1]] < 2.8} { set ircrc -1 } } } catch {close $fd} } if {$ircrc < 0} { set result [catch {open "|$ircpath -d -l /dev/null $nick $serv" r+} fd] } elseif {$ircrc == 0} { set result [catch {open "|$ircpath -d -q $nick $serv" r+} fd] } else { set result [catch {open "|$ircpath -d $nick $serv" r+} fd] } if {$result != 0} { # ircII konnte nicht erfolgreich aufgerufen werden. puts stdout "Error executing \"$ircpath -d -q $nick $serv\" - $fd" return -1 } fconfigure $fd -blocking 0 set inum [ProduceIRC] set irc($inum) $fd set irc($inum,nick) $nick set irc($inum,serv) $serv InitClient $inum return $inum } proc SetupIRC {inum} { global irc tcl_version tk_version if {[llength "$irc(list)"] <= 1 && $irc($inum,startup) < 1} { ExecOnCommands tkircstart $inum set irc($inum,startup) 1 } if {$irc($inum,startup) < 2} { ExecOnCommands ircIIstart $inum set irc($inum,startup) 2 } if [eof $irc($inum)] { catch {close $irc($inum)} exit } fileevent $irc($inum) readable "irc2text $inum" } proc CloseIRC {inum message} { global irc # Der Server wird gegebenenfalls mit einer Signoff-Message verlassen. if {"$irc($inum,serv)" != ""} { set len [string length "$message"] if {$len == 0} { set message "ircII+tkirc2" } ExecOnCommands signoff $inum window "$irc($inum,mesg)" nick "$irc($inum,nick)" address "[AddressOfNick $inum "$irc($inum,nick)"]" message "$message" catch {write2irc $inum "/signoff $message"} } # Falls ein Lag-Fenster für diesen ircII geöffnet wurde, # wird es geschlossen. set path .lags$inum if {[winfo exists $path]} { grab release $path ; destroy $path } # ircII wird beendet. catch {close $irc($inum)} DeleteIRC $inum notified_clear $inum all suspected_clear $inum all if {$irc(num) == $inum && [llength "$irc(list)"]} { set irc(num) [lindex "$irc(list)" 0] } } ##################### # TRAFFIC PARSING # ##################### proc parsecl {num line} { global escape_sign irc win set irc(num) $win($num,irc) # change shortcuts to control chars if necessary set esc [string first "$escape_sign" "$line"] if {$esc != -1} { set newline "[string range "$line" 0 [expr $esc-1]]" for {set i $esc} {$i < [string length "$line"]} {incr i} { set char "[string index "$line" $i]" if {"$char" == "$escape_sign"} { switch -- "[string index "$line" [expr $i+1]]" { "b" { append newline "\x02" ; incr i } "r" { append newline "\x16" ; incr i } "u" { append newline "\x1f" ; incr i } "o" { append newline "\x0f" ; incr i } "g" { append newline "\a" ; incr i } "c" { set z "" set j $i for {set k 0} {$k < 2} {incr k} { set char2 "[string index "$line" [expr $k + $j + 2]]" if {[regexp -- {[0-9]} "$char2"]} { append z "$char2" incr i } else { break } } incr i if {"$z" != ""} { append newline "\x1b\[" append newline "$z" append newline "m" } } "x" { set z "" set j $i for {set k 0} {$k < 2} {incr k} { set char2 "[string index "$line" [expr $k + $j + 2]]" if {[regexp -- {[0-9a-fA-F]} "$char2"]} { append z "$char2" incr i } else { break } } if {[string length "$z"]} { eval append newline \\x$z } incr i } default { if {"$escape_sign" == "[string index "$line" [expr $i+1]]"} { append newline "$escape_sign" ; incr i } } } } else { append newline "$char" } } set line "$newline" } parsein $num "$line" } proc enough_parameters {wnum min list} { if {[llength "$list"] < $min} { global margin set hicommand "[string range "[lindex "$list" 0]" 1 end]" set margin(text) "error" print2text $wnum "--- Not enough parameters. Please try /HELP $hicommand" return 0 } return 1 } proc get_channel {wnum index list} { set channel "[lindex "$list" $index]" if {[string compare "$channel" "*"] == 0} { set channel "[GetActual $wnum]" if {[string compare "$channel" "*"] == 0} { global margin set margin(text) "error" print2text $wnum "--- You have no channel joined in this window" return "" } } return "$channel" } proc parsein {num line} { global irc chan win margin if {[WindowDoesNotExist $num]} { return } set inum $win($num,irc) set command "" set margin(text) "" if {[string first " \:file " "[string tolower "$line "]"] != -1} { FileRequest " Please select the file to execute command \n '$line'!" "Continue" "send2tkirc $num \"[expandescape "[expand "$line"]"]\"" "" "" 0 return "" } # commands if {"[string index "$line" 0]" == "/"} { set list "[line2list "$line"]" switch -regexp -- "[string tolower "[lindex "$list" 0]"]" { "^/away$" { global away send_away_notice san automatic_away set automatic_away 0 if {$send_away_notice == 1} { if {[llength "$list"] > 1} { set san(nicks) "" set san(times) "" set san(message) "[cutwords "$line" 1]" set away " (away)" set margin(text) "away" write2crap $inum "*** You have been marked as being away" } else { set away "" set margin(text) "away" write2crap $inum "*** You are no longer marked as being away" } UpdateAllTitles return "" } } "^/bancomment$" { if {[enough_parameters $num 4 "$list"]} { if {"[set channel "[get_channel $num 1 "$list"]"]" == ""} { return "" } set cnum [ChannelNumber $inum "$channel"] if {[info exists chan($cnum,bancomments)]} { set len [lLength "$chan($cnum,bancomments)"] set comnum "[lindex "$list" 2]" for {set i 1} {$i <= [lLength "$chan($cnum,bancomments)"]} {incr i} { set j [expr $i-1] if {[strcmp "$i" "$comnum"] == 0} { set chan($cnum,bancomments) "[lreplace "$chan($cnum,bancomments)" $j $j "[cutwords "$line" 3]"]" set margin(text) "note" write2crap $inum "--- $channel: Comment of ban number $i changed" } elseif {[strcmp "[lIndex "$chan($cnum,banpatterns)" $j]" "$comnum"] == 0} { set chan($cnum,bancomments) "[lreplace "$chan($cnum,bancomments)" $j $j "[cutwords "$line" 3]"]" set margin(text) "note" write2crap $inum "--- $channel: Comment of ban number $i changed" } } } else { set margin(text) "failure" write2crap $inum "--- There are no baninfos for channel $channel" } } return "" } "^/baninfos$" { if {[enough_parameters $num 2 "$list"]} { if {"[set channel "[get_channel $num 1 "$list"]"]" == ""} { return "" } set cnum [ChannelNumber $inum "$channel"] if {[info exists chan($cnum,banpatterns)]} { set len [lLength "$chan($cnum,banpatterns)"] if {$len != 0} { set margin(text) "baninfos" write2crap $inum "--- Baninfos of channel $channel:" for {set i 0} {$i < $len} {incr i} { set address "[lindex "$chan($cnum,banusers)" $i]" set pattern "[lindex "$chan($cnum,banpatterns)" $i]" set comment "[lindex "$chan($cnum,bancomments)" $i]" set time "[lindex "$chan($cnum,bantimes)" $i]" if {"$time" == "0"} { set time "00.00.00 00:00:00" } else { set time "[longdate $time]" } set j [string first "!" "$address"] if {$j == 0 || [string length "$address"] < 2} { set user "" } else { set user "[string range "$address" 0 [expr $j-1]]" } set margin(text) "baninfos" write2crap $inum "[format "--- %2d. $time %-9s %s" "[expr $i+1]" "$user" "$pattern ($comment\x0f)"]" } } else { set margin(text) "baninfos" write2crap $inum "--- There are no baninfos for channel $channel" } } else { set margin(text) "baninfos" write2crap $inum "--- There are no baninfos for channel $channel" } } return "" } "^/bannick$" { if {[enough_parameters $num 2 "$list"]} { set channel "[GetActual $num]" set cnum [ChannelNumber $inum "$channel"] if {$cnum != -1} { BanRequest $inum $cnum "[lindex "$list" 1]" {} {} } } return "" } "^/banrequest$" { if {[enough_parameters $num 3 "$list"]} { if {"[set channel "[get_channel $num 1 "$list"]"]" == ""} { return "" } set cnum [ChannelNumber $inum "$channel"] if {$cnum != -1} { BanRequest $inum $cnum "[lindex "$list" 2]" "" "[cutwords "$line" 3]" } } return "" } "^/chat$" { if {[enough_parameters $num 2 "$list"]} { set wnum [MainWindow $inum -2] set win($wnum,query) [lindex "$list" 1] UpdateTitle $wnum } return "" } "^/clear$" { ClearMainWindow $num return "" } "^/clearall$" { foreach x "$win(list)" { ClearMainWindow $x } return "" } "^/close$" { CloseMainWindow $num return "" } "^/closelog$" { global logs set len [llength "$list"] set source "" ; set boundary "#$inum" for {set i 1} {$i < $len} {incr i} { set lo "[string tolower "[lindex "$list" $i]"]" switch -exact -- "$lo" { all - crap - messages { set source "$lo" } channel - query - window { set tmp "[lindex "$list" [incr i]]" if {"$tmp" == ""} { set margin(text) "error" write2crap $inum "--- Not enough parameters. Please try /HELP CLOSELOG" return "" } set source "$lo $tmp" } on { set boundary "[lindex "$list" [incr i]]" if {"$boundary" == ""} { set margin(text) "error" write2crap $inum "--- Not enough parameters. Please try /HELP CLOSELOG" return "" } } default { set margin(text) "error" write2crap $inum "--- Unknown CLOSELOG option: [lindex "$list" $i]" return "" } } } if {"$source" == ""} { set margin(text) "error" write2crap $inum "--- Not enough parameters. Please try /HELP CLOSELOG" return "" } set lo "[string tolower "$source:$boundary"]" if {[info exists logs($lo)]} { set lnum "$logs($lo)" set filename "$logs($lnum:filename)" puts $logs($lnum:handle) "Logfile closed for $source on $boundary at: [longdate]" close $logs($lnum:handle) DeleteLog $lnum set margin(text) "log" write2crap $inum "--- Logfile '$filename' closed" return "" } set margin(text) "error" write2crap $inum "--- CLOSELOG's parameters do not match any log" return "" } "^/dchat$" { if {[enough_parameters $num 2 "$list"]} { set wnum [MainWindow $inum -2] set win($wnum,query) =[lindex "$list" 1] UpdateTitle $wnum write2irc $inum "/dcc chat [lindex "$list" 1]" } return "" } "^/echo$" { if {[llength "$list"] > 1} { print2text $num "[cutwords "$line" 1]" } return "" } "^/init$" { InitClient $inum return "" } "^/(j|join)$" { foreach x "[split "[lindex "$list" 1]" ","]" { lappend irc($inum,tojoin,chan) "$x" lappend irc($inum,tojoin,win) "$num" write2irc $inum "/quote join $x [cutwords "$line" 2]" set cnum [ChannelNumber $inum "$x"] if {[set wnum [WindowNumber $cnum]] != -1} { parse3stars $inum "you are now talking to channel $x" } } return "" } "^/kick$" { global kickreason_limit set len [string length "[cutwords "$line" 3]"] if {$len > $kickreason_limit} { beep set margin(text) "error" print2text $num "--- Kick-reason has $len chars, but kickreason_limit is set to $kickreason_limit." } else { write2irc $inum "$line" queued } return "" } "^/kickrequest$" { if {[enough_parameters $num 3 "$list"]} { if {"[set channel "[get_channel $num 1 "$list"]"]" == ""} { return "" } set cnum [ChannelNumber $inum "$channel"] if {$cnum != -1} { KickRequest $inum $cnum "[lindex "$list" 2]" "[cutwords "$line" 3]" } } return "" } "^/lags$" { LagWindow $num return "" } "^/(leave|part)$" { # to support leave messages with ircII < 2.9 if {[llength "$list"] > 2} { global leavetext_limit set len [string length "[cutwords "$line" 2]"] if {$len > $leavetext_limit} { beep set margin(text) "error" print2text $num "--- Leave-text has $len chars, but leavetext_limit is set to $leavetext_limit." return "" } if {[strcmp "[lindex "$list" 1]" "*"]} { set line "/quote part [lindex "$list" 1] :[cutwords "$line" 2]" } else { set line "/quote part [GetActual $num] :[cutwords "$line" 2]" } } elseif {[llength "$list"] == 1} { if {"[GetActual $num]" != "*"} { set line "/quote part [GetActual $num] :" } else { set margin(text) "error" print2text $num "--- You have no channel joined in this window" return "" } } } "^/list$" { if {[llength "$list"] == 1 \ || "[lindex "$list" 1]" == "*" && [llength "$chan(list)"] == 0} { set margin(text) "warning" print2text $num "--- If you really want to do that, use '/really list [string trim "[string range "$line" 5 end]" " "]', but this command makes a lot of traffic and it could take a VERY LONG while!" return "" } } "^/log$" { global logs if {[set len [llength "$list"]] == 1} { set margin(text) "log" ; set i 0 if {[llength "$logs(list)"] == 0} { write2crap $inum "--- No opened logfiles found" } else { write2crap $inum "--- Following logfiles are currently opened:" foreach x "$logs(list)" { set margin(text) "log" write2crap $inum "[format "--- %2d. %s on %s to %s" "[incr i]" "$logs($x:source)" "$logs($x:boundary)" "$logs($x:filename)"]" } } return "" } set source "" ; set filename "" ; set boundary "#$inum" set dateflag 0 ; set rawflag 0 ; set timeflag 0 ; set suffix "" for {set i 1} {$i < $len} {incr i} { set lo "[string tolower "[lindex "$list" $i]"]" switch -exact -- "$lo" { -date { set dateflag 1 } -raw { set rawflag 1 } -time { set timeflag 1 } all - crap - messages { set source "$lo" set suffix ".$lo" } channel - query - window { set tmp "[lindex "$list" [incr i]]" if {"$tmp" == ""} { set margin(text) "error" write2crap $inum "--- Not enough parameters. Please try /HELP LOG" return "" } if {[string compare "$tmp" "*"] == 0} { if {[string compare "[GetActual $num]" "*"]} { set tmp "[GetActual $num]" } else { set margin(text) "error" print2text $num "--- You have no channel joined in this window" return "" } } set source "$lo $tmp" if {[string compare "$lo" "window"] == 0} { set suffix ".window[string tolower "$tmp"]" } else { set suffix ".[string tolower "$tmp"]" } } on { set boundary "[lindex "$list" [incr i]]" if {"$boundary" == ""} { set margin(text) "error" write2crap $inum "--- Not enough parameters. Please try /HELP LOG" return "" } } to { set filename "[lindex "$list" [incr i]]" } default { set margin(text) "error" write2crap $inum "--- Unknown LOG option: [lindex "$list" $i]" return "" } } } # Falls kein Filename angegeben wurde, wird von tkirc # selbständig einer gewählt. if {"$filename" == ""} { set filename "~/.tkirc2/IrcLog$suffix" } if {"$source" == ""} { set margin(text) "error" write2crap $inum "--- Not enough parameters. Please try /HELP LOG" return "" } # Nachdem alle Optionen überprüft wurden, wird versucht, das # Logfile zu öffnen. if [catch {open $filename a+} handle] { set margin(text) "error" write2crap $inum "--- $handle" } elseif {[set lnum [ProduceLog "$source" "$boundary"]] < 0} { close $handle set margin(text) "error" if {$lnum == -1} { write2crap $inum "--- A logfile for $source on $boundary was already opened" } else { write2crap $inum "--- A logfile for $source on $boundary could not be opened" } } else { foreach x "source boundary filename handle dateflag rawflag timeflag" { set logs($lnum:$x) "[set $x]" } set logs($lnum:opendate) "[longdate]" puts $handle "\nLogfile opened for $logs($lnum:source) on $logs($lnum:boundary) at: [longdate]" flush $handle set margin(text) "log" write2crap $inum "--- Logfile '$filename' opened for $source on $boundary" } return "" } "^/me$" { if {"$win($num,query)" != ""} { if {"[string index "$win($num,query)" 0]" == "="} { return "/msg $win($num,query) $irc($inum,nick) [cutwords "$line" 1]" } else { return "/describe $win($num,query) [cutwords "$line" 1]" } } if {"[GetActual $num]" != "*"} { return "/describe [GetActual $num] [cutwords "$line" 1]" } set margin(text) "error" print2text $num "--- No target, neither channel nor query in this window" return "" } "^/mode$" { return "/mode [string trimleft "[cutwords "$line" 1]" " "]" } "^/msgids$" { MsgIDWindow return "" } "^/names$" { if {[llength "$list"] == 1 \ || "[lindex "$list" 1]" == "*" && [llength "$chan(list)"] == 0} { set margin(text) "warning" print2text $num "--- If you really want to do that, use '/really names [string trim "[string range "$line" 6 end]" " "]', but this command makes a lot of traffic and it could take a VERY LONG while!" return "" } } "^/newwin$" { MainWindow $inum -1 return "" } "^/notified$" { NotifyWindow return "" } "^/notify$" { global notify set elements "nick pattern channel server comment command" set defaults "{} {} {} {*} {} {}" for {set i 0} {$i < [llength "$elements"]} {incr i} { set [lindex "$elements" $i] "[lindex "$defaults" $i]" } if {"[lindex "$list" 1]" == "-"} { # Irgendetwas soll geloescht werden. if {[llength "$list"] == 2} { # Die ganze Liste wir geloescht. foreach nnum "$notify(list)" { for {set i 0} {$i < [llength "$notify($nnum:nicks)"]} {incr i} { DetectUserOnIRC $inum "[lindex "$notify($nnum:nicks)" $i]" -1 0 } DeleteNotify $nnum } set margin(text) "notify" write2crap $inum "--- Notify list cleared" save_notifies return "" } # Ein einzelnes Element soll geloscht werden. set remove 1 } else { # Ein Element wird hinzugefuegt. set remove 0 } for {set i [expr 1 + $remove]} {$i < [llength "$list"]} {incr i} { switch -exact -- "[lindex "$list" $i]" { -channel - -server - -comment - -command { set option [string trimleft "[lindex "$list" $i]" "-"] set $option "[expand2 "[lindex "$list" [incr i]]"]" continue } } if {$i == [expr 1 + $remove]} { set az [string first "!" "[lindex "$list" $i]"] if {$az != -1} { # nick and address set right [expr $az-1] set address "[string range "[lindex "$list" $i]" [incr az] end]" } else { # nick only set right end set address "" } set nick "[string range "[lindex "$list" $i]" 0 $right]" if {"$address" == ""} { set address "*" } if {[regexp -- {^[0-9]+$} "[lindex "$list" $i]"]} { # numeric set pattern "[lindex "$list" $i]" } else { # no numeric set pattern "$nick!$address" } continue } set margin(text) "error" write2crap $inum "--- Unknown NOTIFY option: [lindex "$list" $i]" return "" } if {"$pattern" == ""} { set margin(text) "notify" ; set i 0 if {[llength "$notify(list)"] == 0} { write2crap $inum "--- No entries in the notification list found" } else { write2crap $inum "--- List of notifies:" ; set k 0 foreach nnum "$notify(list)" { set len [llength "$notify($nnum:patterns)"] for {set i 0} {$i < $len} {incr i} { set opttext "" for {set j 2} {$j < [llength "$elements"]} {incr j} { set index "[lindex "$elements" $j]s" set ov "[lindex "$notify($nnum:$index)" $i]" if {"$ov" != "[lindex "$defaults" $j]"} { append opttext " -[lindex "$elements" $j] \"$ov\x0f\"" } } set margin(text) "notify" write2crap $inum "[format "--- %2d. %s%s" "[incr k]" "[lindex "$notify($nnum:patterns)" $i]" "$opttext"]" } } } } else { for {set j 2} {$j < 4} {incr j} { set ov "[set [lindex "$elements" $j]]" append opttext " -[lindex "$elements" $j] \"$ov\x0f\"" } set opttext " ([string trimleft "$opttext" " "])" set already_exists 0 ; set is_numeric 0 ; set enum -1 if {[info exists notify([string tolower "$channel:$server"])]} { set nnum $notify([string tolower "$channel:$server"]) set enum [lSearch "$notify($nnum:patterns)" "$pattern"] if {$enum != -1} { set already_exists 1 } } if {$enum == -1 && [regexp -- {^[0-9]+$} "$pattern"]} { set is_numeric 1 set enum [expr [string trimleft "$pattern" "-"] - 1] foreach nnum "$notify(list)" { if {$enum < [llength "$notify($nnum:patterns)"]} { set pattern "[lindex "$notify($nnum:patterns)" $enum]" set tmp "[split "$pattern" "!"]" set nick "[lindex "$tmp" 0]" set address "[lindex "$tmp" 1]" set already_exists 1 break } else { set enum [expr $enum-[llength "$notify($nnum:patterns)"]] } } } if {[isPattern "$nick"] && ([isPattern "$channel"] || "$channel" == "")} { set margin(text) "error" write2crap $inum "--- Please select a more specific pattern!" } elseif {$remove == 0} { # add if {$already_exists != 0} { # replace for {set i 0} {$i < [llength "$elements"]} {incr i} { set element [lindex "$elements" $i] set notify($nnum:[set element]s) "[lreplace "$notify($nnum:[set element]s)" $enum $enum "[set $element]"]" } set margin(text) "notify" write2crap $inum "--- $pattern replaced in the notification list$opttext" } else { set nnum [ProduceNotify "$channel" "$server"] if {$nnum == -1} { # Ein Notify für diesen Server existiert bereits. set nnum $notify([string tolower "$channel:$server"]) } for {set i 0} {$i < [llength "$elements"]} {incr i} { set element [lindex "$elements" $i] lappend notify($nnum:[set element]s) "[set $element]" } set margin(text) "notify" write2crap $inum "--- $pattern added to the notification list$opttext" } if {"$channel" == "" && ![isPattern "$nick"]} { if {[lSearch "$irc($inum,notifylist)" "$nick"] == -1} { lappend irc($inum,notifylist) "$nick" if {[lSearch "$irc($inum,suspectlist)" "$nick"] == -1} { FilterLine $inum "*** [expand "$nick"] added to the notification list" write2irc $inum "/notify $nick" } } } save_notifies } else { # remove if {$already_exists != 0} { DetectUserOnIRC $inum "$nick" -1 0 for {set i 0} {$i < [llength "$elements"]} {incr i} { set element [lindex "$elements" $i] set notify($nnum:[set element]s) "[lreplace "$notify($nnum:[set element]s)" $enum $enum]" } if {[llength "$notify($nnum:patterns)"] == 0} { DeleteNotify $nnum } if {![isPattern "$nick"]} { set i [lSearch "$irc($inum,notifylist)" "$nick"] if {$i != -1} { set irc($inum,notifylist) "[lreplace "$irc($inum,notifylist)" $i $i]" set i [lSearch "$irc($inum,notifylist)" "$nick"] if {$i == -1} { set i [lSearch "$irc($inum,suspectlist)" "$nick"] if {$i == -1} { FilterLine $inum "*** [expand $nick] removed from notification list" write2irc $inum "/notify -$nick" } } } } set margin(text) "notify" write2crap $inum "--- $pattern removed from the notification list$opttext" save_notifies } else { set margin(text) "error" if {$is_numeric != 0} { set enum [string trimleft "$pattern" "-"] write2crap $inum "--- Element number $enum does not exist on the notification list" } else { write2crap $inum "--- $pattern is not on the notification list$opttext" } } } } return "" } "^/onotice" { if {[enough_parameters $num 2 "$list"]} { return "/quote notice @[lindex "$list" 1] :[cutwords "$line" 2]" } return "" } "^/query$" { set win($num,query) "[lindex "$list" 1]" UpdateTitle $num return "" } "^/(sign|signoff)$" { if {[llength "$list"] < 2} { Exit $inum "" } else { Exit $inum "[cutwords "$line" 1]" } } "^/suspected$" { SuspectWindow return "" } "^/(bye|exit|quit)$" { if {[llength "$list"] < 2} { Exit -1 "" } else { Exit -1 "[cutwords "$line" 1]" } } "^/really$" { if {[enough_parameters $num 2 "$list"]} { return "/[cutwords "$line" 1]" } return "" } "^/savebuffer$" { if {[enough_parameters $num 2 "$list"]} { SaveBuffer $num "[lindex "$list" 1]" } return "" } "^/search$" { if {[enough_parameters $num 2 "$list"]} { textSearch $num "[cutwords "$line" 1]" search } return "" } "^/servers$" { ServersWindow $inum return "" } "^/set$" { if {[llength "$list"] > 1} { set x [lindex "$list" 1] set value "[cutwords "$line" 2]" if {"[string index "$x" 0]" == "-"} { set state -1 set x "[string range "$x" 1 end]" } elseif {"[string index "$x" 0]" == "+"} { set state 1 set x "[string range "$x" 1 end]" } else { set state 0 } switch -exact -- "[string tolower "$x"]" { log - logfile { set margin(text) "error" write2crap $inum "--- ircII's [string toupper "$x"] is not supported. Please try /HELP LOG" return "" } } if [strmatch "*(*)" "$x"] { # x is array if [catch {global [string range "$x" 0 [expr [string first "(" "$x"]-1]]} y] { set margin(text) "error" write2crap $inum "--- $y" return "" } } else { # x is a normal variable if [catch {global $x} y] { set margin(text) "error" write2crap $inum "--- $y" return "" } } if [info exists "$x"] { # Eine Tcl/Tk-Variable dieses Namens existiert. if {$state < 0} { # Der Wert dieser Variablen soll gelöscht werden. if [catch {set $x ""} y] { set margin(text) "error" write2crap $inum "--- $y " } else { write2crap $inum "*** Value of $x set to " } } else { if {[string length "$value"]} { # Die Variable erhält einen neuen Wert. switch -exact -- "$x" { escape_sign { if {[string length "$value"] > 1} { set margin(text) "error" write2crap $inum "--- Value for $x is too long" return "" } } crapwindow { global win if {[lsearch -exact "$win(list)" "$value"] == -1} { set margin(text) "error" write2crap $inum "--- Window $value does not exist" } elseif {$win($value,irc) != $inum} { set margin(text) "error" write2crap $inum "--- Window $value does not belong to this connection" } else { set crapwindow "$value" set irc($inum,crap) "$value" UpdateAllInfos } return "" } messagewindow { global win if {[lsearch -exact "$win(list)" "$value"] == -1} { set margin(text) "error" write2crap $inum "--- Window $value does not exist" } elseif {$win($value,irc) != $inum} { set margin(text) "error" write2crap $inum "--- Window $value does not belong to this connection" } else { set messagewindow "$value" set irc($inum,mesg) "$value" UpdateAllInfos } return "" } } if [catch {set $x "$value"} y] { set margin(text) "error" write2crap $inum "--- $y " } else { write2crap $inum "*** Value of $x set to $value" } } else { # Der Wert dieser Variablen wird nur abgefragt. if [catch {set $x} y] { set margin(text) "error" write2crap $inum "--- $y " } else { write2crap $inum "*** Current value of $x is [set $x]" } } } return "" } elseif {$state > 0} { # Eine Tcl/Tk-Variable dieses Namens existiert nicht, soll # aber erzeugt werden. if [catch {set $x "$value"} y] { set margin(text) "error" write2crap $inum "--- $y " } else { write2crap $inum "*** Value of $x set to $value" } return "" } } } "^/splits$" { global split join starttime if {$split(count) != 0} { if {$split(count) < 11} { write2crap $inum "--- Detected $split(count) netsplit(s) since $starttime:" set from 0 } else { write2crap $inum "--- Last 10 detected netsplits:" set from [expr $split(count)-10] } for {set i $from} {$i < $split(count)} {incr i} { write2crap $inum "[format "--- %13s %s (%s)" "[expr $i+1]. splitted" "[longdate $split($i,time)]" "$split($i,message)"]" set thisjoins 0 if {$join(count) != 0} { for {set j 0} {$j < $join(count)} {incr j} { if {$join($j,splitnum) == $i} { write2crap $inum "[format "--- %13s %s" "joined " "[longdate $join($j,time)]"]" incr thisjoins } } } if {$thisjoins == 0} { if {[expr [clock seconds]-$split($i,time)] > 1800} { write2crap $inum "--- timed out after 30 minutes" } } } } else { set margin(text) "note" write2crap $inum "--- No netsplits detected since $starttime" } return "" } "^/suspect$" { global suspect set elements "nick pattern channel server comment command" set defaults "{} {} {} {*} {} {}" for {set i 0} {$i < [llength "$elements"]} {incr i} { set [lindex "$elements" $i] "[lindex "$defaults" $i]" } if {"[lindex "$list" 1]" == "-"} { # Irgendetwas soll geloescht werden. if {[llength "$list"] == 2} { # Die ganze Liste wir geloescht. foreach nnum "$suspect(list)" { for {set i 0} {$i < [llength "$suspect($nnum:nicks)"]} {incr i} { DetectUserOnIRC $inum "[lindex "$suspect($nnum:nicks)" $i]" -1 0 } DeleteSuspect $nnum } set margin(text) "suspect" write2crap $inum "--- Suspect list cleared" save_suspects return "" } # Ein einzelnes Element soll geloscht werden. set remove 1 } else { # Ein Element wird hinzugefuegt. set remove 0 } for {set i [expr 1 + $remove]} {$i < [llength "$list"]} {incr i} { switch -exact -- "[lindex "$list" $i]" { -channel - -server - -comment - -command { set option [string trimleft "[lindex "$list" $i]" "-"] set $option "[expand2 "[lindex "$list" [incr i]]"]" continue } } if {$i == [expr 1 + $remove]} { set az [string first "!" "[lindex "$list" $i]"] if {$az != -1} { # nick and address set right [expr $az-1] set address "[string range "[lindex "$list" $i]" [incr az] end]" } else { # nick only set right end set address "" } set nick "[string range "[lindex "$list" $i]" 0 $right]" if {"$address" == ""} { set address "*" } if {[regexp -- {^[0-9]+$} "[lindex "$list" $i]"]} { # numeric set pattern "[lindex "$list" $i]" } else { # no numeric set pattern "$nick!$address" } continue } set margin(text) "error" write2crap $inum "--- Unknown SUSPECT option: [lindex "$list" $i]" return "" } if {"$pattern" == ""} { set margin(text) "suspect" ; set i 0 if {[llength "$suspect(list)"] == 0} { write2crap $inum "--- No entries in the suspect list found" } else { write2crap $inum "--- List of suspects:" ; set k 0 foreach nnum "$suspect(list)" { set len [llength "$suspect($nnum:patterns)"] for {set i 0} {$i < $len} {incr i} { set opttext "" for {set j 2} {$j < [llength "$elements"]} {incr j} { set index "[lindex "$elements" $j]s" set ov "[lindex "$suspect($nnum:$index)" $i]" if {"$ov" != "[lindex "$defaults" $j]"} { append opttext " -[lindex "$elements" $j] \"$ov\x0f\"" } } set margin(text) "suspect" write2crap $inum "[format "--- %2d. %s%s" "[incr k]" "[lindex "$suspect($nnum:patterns)" $i]" "$opttext"]" } } } } else { for {set j 2} {$j < 4} {incr j} { set ov "[set [lindex "$elements" $j]]" append opttext " -[lindex "$elements" $j] \"$ov\x0f\"" } set opttext " ([string trimleft "$opttext" " "])" set already_exists 0 ; set is_numeric 0 ; set enum -1 if {[info exists suspect([string tolower "$channel:$server"])]} { set nnum $suspect([string tolower "$channel:$server"]) set enum [lSearch "$suspect($nnum:patterns)" "$pattern"] if {$enum != -1} { set already_exists 1 } } if {$enum == -1 && [regexp -- {^[0-9]+$} "$pattern"]} { set is_numeric 1 set enum [expr [string trimleft "$pattern" "-"] - 1] foreach nnum "$suspect(list)" { if {$enum < [llength "$suspect($nnum:patterns)"]} { set pattern "[lindex "$suspect($nnum:patterns)" $enum]" set tmp "[split "$pattern" "!"]" set nick "[lindex "$tmp" 0]" set address "[lindex "$tmp" 1]" set already_exists 1 break } else { set enum [expr $enum-[llength "$suspect($nnum:patterns)"]] } } } if {[isPattern "$nick"] && ([isPattern "$channel"] || "$channel" == "")} { set margin(text) "error" write2crap $inum "--- Please select a more specific pattern!" } elseif {$remove == 0} { # add if {$already_exists != 0} { # replace for {set i 0} {$i < [llength "$elements"]} {incr i} { set element [lindex "$elements" $i] set suspect($nnum:[set element]s) "[lreplace "$suspect($nnum:[set element]s)" $enum $enum "[set $element]"]" } set margin(text) "suspect" write2crap $inum "--- $pattern replaced in the suspect list$opttext" } else { set nnum [ProduceSuspect "$channel" "$server"] if {$nnum == -1} { # Ein Suspect für diesen Server existiert bereits. set nnum $suspect([string tolower "$channel:$server"]) } for {set i 0} {$i < [llength "$elements"]} {incr i} { set element [lindex "$elements" $i] lappend suspect($nnum:[set element]s) "[set $element]" } set margin(text) "suspect" write2crap $inum "--- $pattern added to the suspect list$opttext" } if {"$channel" == "" && ![isPattern "$nick"]} { if {[lSearch "$irc($inum,suspectlist)" "$nick"] == -1} { lappend irc($inum,suspectlist) "$nick" if {[lSearch "$irc($inum,notifylist)" "$nick"] == -1} { FilterLine $inum "*** [expand "$nick"] added to the notification list" write2irc $inum "/notify $nick" } } } save_suspects } else { # remove if {$already_exists != 0} { DetectUserOnIRC $inum "$nick" -1 0 for {set i 0} {$i < [llength "$elements"]} {incr i} { set element [lindex "$elements" $i] set suspect($nnum:[set element]s) "[lreplace "$suspect($nnum:[set element]s)" $enum $enum]" } if {[llength "$suspect($nnum:patterns)"] == 0} { DeleteSuspect $nnum } if {![isPattern "$nick"]} { set i [lSearch "$irc($inum,suspectlist)" "$nick"] if {$i != -1} { set irc($inum,suspectlist) "[lreplace "$irc($inum,suspectlist)" $i $i]" set i [lSearch "$irc($inum,suspectlist)" "$nick"] if {$i == -1} { set i [lSearch "$irc($inum,notifylist)" "$nick"] if {$i == -1} { FilterLine $inum "*** [expand $nick] removed from notification list" write2irc $inum "/notify -$nick" } } } } set margin(text) "suspect" write2crap $inum "--- $pattern removed from the suspect list$opttext" save_suspects } else { set margin(text) "error" if {$is_numeric != 0} { set enum [string trimleft "$pattern" "-"] write2crap $inum "--- Element number $enum does not exist on the suspect list" } else { write2crap $inum "--- $pattern is not on the suspect list$opttext" } } } } return "" } "^/takeovers$" { global react_to_takeover takeover starttime chan if {$react_to_takeover != 0} { set count [llength "$takeover(times)"] if {$count != 0} { write2crap $inum "--- Detected $count (possible) takeover(s) since $starttime:" for {set i 0} {$i < $count} {incr i} { set x "[lindex "$takeover(tries)" $i]" write2crap $inum "[format "--- %2s. %s %-12s %s" "[expr $i+1]" "[longdate [lindex "$takeover(times)" $i]]" "$chan([lindex "$x" 0])" "[lindex "$x" 1]"]" } } else { set margin(text) "note" write2crap $inum "--- No (possible) takeovers detected since $starttime" } } else { set margin(text) "note" write2crap $inum "--- tkirc doesn't try to detect takeovers, because value of 'react_to_takeover' is 0." } return "" } "^/topic$" { global topic_limit set len [string length "[cutwords "$line" 2]"] if {$len > $topic_limit} { beep set margin(text) "error" print2text $num "--- Topic has $len chars, but topic_limit is set to $topic_limit." return "" } } "^/unset$" { if {[enough_parameters $num 2 "$list"]} { set x [lindex "$list" 1] if [strmatch "*(*)" "$x"] { # x is array global [string range "$x" 0 [expr [string first "(" "$x"]-1]] } else { # x is a normal variable if [catch {global $x} y] { set margin(text) "error" write2crap $inum "--- $y" return "" } } if [info exists "$x"] { if [catch {unset $x} y] { set margin(text) "error" write2crap $inum "--- $y " } else { write2crap $inum "*** tkirc's variable $x has been unset" } } } return "" } "^/urls$" { URLWindow return "" } "^/who$" { if {[llength "$list"] == 1 \ || "[lindex "$list" 1]" == "*" && [llength "$chan(list)"] == 0} { set margin(text) "warning" print2text $num "--- If you really want to do that, use '/really who [string trim "[string range "$line" 4 end]" " "]', but this command makes a lot of traffic and it could take a VERY LONG while!" return "" } } "^/window$" { switch -regexp -- "[string tolower "[lindex "$list" 1]"]" { "^create$" { MainWindow $inum -1 return "" } "^delete$" { CloseMainWindow $num return "" } "^server$" { set nick $irc($inum,nick) PartMainWindow $num # Der alte IRC muß eventuell geschlossen werden. if {$irc($inum,mesg) == $num || $irc($inum,crap) == $num} { # Das war das letzte Fenster für diesen Server. CloseIRC $inum "" } # Neuen IRC zuweisen set inum2 [OpenIRC $nick [lindex "$list" 2]] if {$inum2 != -1} { set irc($inum2,crap) $num set irc($inum2,mesg) $num set win($num,irc) $inum2 SetupIRC $inum2 } UpdateAllTitles return "" } default { } } } "^/(wj|wjoin)$" { if {[enough_parameters $num 2 "$list"]} { foreach x "[split "[lindex "$list" 1]" ","]" { set wnum [MainWindow $inum -4] lappend irc($inum,tojoin,chan) "$x" lappend irc($inum,tojoin,win) "$wnum" write2irc $inum "/quote join $x [cutwords "$line" 2]" } } return "" } "^/(lastlog)$" { set margin(text) "error" write2crap $inum "--- Command [string toupper "[lindex "$list" 0]"] is not supported by tkirc." return "" } default { set command "[lindex "$list" 0]" # maybe a user defined command foreach x "[info commands "on_command_*"]" { set y "[string range "$x" 11 end]" if {[strcmp "/$y" "$command"] == 0} { global on_args set on_args(window) $num on_command_$y $num "[cutwords "$line" 1]" return "" } } } } } return "$line" } proc parse3stars {inum line} { global irc dcc chan win away margin global on_args react_to_netsplits lastOPjoin set loline "[string tolower "$line"]" switch -glob -- "$loline" { "you are now talking to channel *" { set cnum [ChannelNumber $inum "[set channel "[lIndex "$line" end]"]"] if {[set wnum [WindowNumber $cnum]] == -1} { return "" } set i [lSearch "$irc($inum,tojoin,chan)" "$channel"] if {$i != -1} { set num [lindex "$irc($inum,tojoin,win)" $i] set irc($inum,tojoin,chan) "[lreplace "$irc($inum,tojoin,chan)" $i $i]" set irc($inum,tojoin,win) "[lreplace "$irc($inum,tojoin,win)" $i $i]" # Soll mit dem neuen Fenster nur mitgehorcht werden? if {![IsFakeWindow $num]} { # Der Kanal bekommt ein neues Fenster zugewiesen. set chan($cnum,window) $num # Wird mit dem alten Fenster nur mitgehorcht? if {![IsFakeWindow $wnum]} { # Das alte Fenster muß aktualisiert werden. set j [lsearch -exact "$win($wnum,channels)" "$cnum"] if {$j != -1} { set win($wnum,channels) "[lreplace "$win($wnum,channels)" $j $j]" } if {[llength "$win($wnum,channels)"] == 0} { set win($wnum,actual) "*" } else { set win($wnum,actual) "$chan([lindex "$win($wnum,channels)" 0])" } UpdateInfos $wnum } } # Das alte und das neue Fenster werden nun aktualisiert. lappend win($num,channels) "$cnum" set win($num,actual) "$channel" UpdateInfos $num } else { # Ist der Kanal aktuell? if {[strcmp "$win($wnum,actual)" "$channel"]} { set win($wnum,actual) "$channel" UpdateInfos $wnum } } return "" } "* flooding detected from *" { set margin(text) "flood" } "* been kicked off channel *" { # Diese Meldung wird herausgefiltert wegen eines Fehlers von ircII. return "" } "you have specified an illegal nickname" { # Diese Meldung wird herausgefiltert wegen eines Fehlers von ircII. return "" } "ctcp *" { set margin(text) "ctcp" } "unknown ctcp *" { set margin(text) "ctcp" } "users on *" { # Wo gehört diese Meldung hin? set channel "[string trimright "[lIndex "$line" 2]" ":"]" if {[WindowNumber $inum "$channel"] == -1} { return "" } } "*use /server to *" { Disconnected $inum } "connection closed from *" { Disconnected $inum } "disconnecting from server *" { Disconnected $inum } "connecting to port * of server change.this.to.a.server" { ServersWindow $inum } "*dcc *" { set list "[line2list "$line"]" # DCC connections set margin(text) "dcc" switch -glob -- "$loline" { "dcc chat (*) request received from *" { set i [lsearch -exact "$list" "received"] if {$i != -1} { set i [expr $i+2] set from "[lindex "$list" $i]" global request_on_dcc_chat if {$request_on_dcc_chat != 0} { request "Do you want to accept DCC CHAT request from $from?" "Close|send2tkirc $irc($inum,crap) \"[expand "/dcc close chat $from"]\"" "Accept|send2tkirc $irc($inum,crap) \"[expand "/dchat $from"]\"" return "" } else { return "--- DCC CHAT request received from $from. Choose '/dchat $from' to establish the connection." } } } "sent dcc chat request to *" { set to [lindex "$list" 5] set on_args(window) [GetQueryWindow $inum =$to] } "dcc chat (chat) request received*" { set to [lindex "$list" 6] set on_args(window) [GetQueryWindow $inum =$to] } "dcc chat connection * established" { # with [,] established set four "[lindex "$list" 4]" set i [string last "\[" "$four"] if {$i == -1} { set to $four } else { set to [string range "$four" 0 [expr $i-1]] } set on_args(window) [GetQueryWindow $inum =$to] } "dcc chat connection to *" { # DCC CHAT connection to lost: * set to "[lindex "$list" 4]" set on_args(window) [GetQueryWindow $inum =$to] set win($on_args(window),query) "" UpdateTitle $on_args(window) } "dcc chat:* closed" { # DCC chat: to closed set to "[lindex "$list" 3]" set on_args(window) [GetQueryWindow $inum =$to] set win($on_args(window),query) "" UpdateTitle $on_args(window) } "no active dcc chat:chat connection for *" { set to [lindex "$list" 6] set on_args(window) [GetQueryWindow $inum =$to] } "dcc send (*) request received from *" { set i [lsearch -exact "$list" "received"] if {$i != -1} { set i [expr $i+2] set dnum [ProduceDCC] set dcc($dnum,irc) $inum set dcc($dnum,type) "GET" set dcc($dnum,nick) "[lindex "$list" $i]" set dcc($dnum,file) "[string trim "[lindex "$list" 2]" "()"]" set dcc($dnum,size) "[string trim "[lindex "$list" 3]" "()"]" if {![regexp -- {^[0-9]+$} "$dcc($dnum,size)"]} { set dcc($dnum,size) "- unknown -" } global path request_on_dcc_send if {$request_on_dcc_send != 0} { if [info exists path(dcc_get)] { catch {cd "$path(dcc_get)"} } FileRequest "Please select the new filename for file\n'$dcc($dnum,file)', if you want to get it\nfrom $dcc($dnum,nick) via DCC!" "DCC GET" "write2irc $inum \"[expand "/dcc rename $dcc($dnum,nick) $dcc($dnum,file) :file"]\";write2irc $inum \"[expand "/dcc get $dcc($dnum,nick) :file"]\"" "write2irc $inum \"[expand "/dcc close get $dcc($dnum,nick) $dcc($dnum,file)"]\"" "$dcc($dnum,file)" 0 } } } "dcc get connection with * established" { set to "[lindex "$list" 4]" set i "[string last "\[" "$to"]" set j "[string last "," "$to"]" if {$j == -1} { set j [expr [string length "$to"]-2] } set nick "[string range "$to" 0 [expr $i-1]]" set dnum -1 foreach x "$dcc(list)" { if {$dcc($x,irc) == $inum} { if {[string compare "$dcc($x,type)" "GET"] == 0} { if {[strcmp "$dcc($x,nick)" "$nick"] == 0} { if {[string length "$dcc($x,starttime)"] == 0} { set dnum $x break } } } } } if {$dnum != -1} { set to "[lindex "$list" 4]" set i "[string last "\[" "$to"]" set j "[string last "," "$to"]" if {$j == -1} { set j [expr [string length "$to"]-2] } set dcc($dnum,host) "[string range "$to" [expr $i+1] [expr $j-1]]" set dcc($dnum,port) "[string trimright "[string range "$to" [expr $j+1] end]" "\]"]" if {![regexp -- {^[0-9]+$} "$dcc($dnum,port)"]} { set dcc($dnum,port) "- unknown -" } set dcc($dnum,starttime) "[clock seconds]" after 500 [list write2irc $dcc($dnum,irc) "/get_dcclist"] } } "dcc get:* completed *" - "dcc get:* closed" { set dnum [SearchDCC $inum GET "[lindex "$list" 3]" "[string range "[lindex "$list" 1]" 4 end]"] if {$dnum != -1} { if {[file exists "$dcc($dnum,file)"]} { if {$dcc($dnum,size) == [file size "$dcc($dnum,file)"]} { set dcc($dnum,read) "- all done ([lindex "$list" 5] [lindex "$list" 6]) -" } else { set dcc($dnum,read) "- break ([file size "$dcc($dnum,file)"]) -" } } if {[winfo exists .dcc$dnum]} { DCCWindow $dnum } DeleteDCC $dnum } } "sent dcc send request to *" { } "dcc send connection * established" { set to "[lindex "$list" 4]" set i "[string last "\[" "$to"]" set j "[string last "," "$to"]" if {$j == -1} { set j [expr [string length "$to"]-2] } set dnum [ProduceDCC] set dcc($dnum,irc) $inum set dcc($dnum,type) "[lindex "$list" 1]" set dcc($dnum,nick) "[string range "$to" 0 [expr $i-1]]" set dcc($dnum,host) "[string range "$to" [expr $i+1] [expr $j-1]]" set dcc($dnum,port) "[string trimright "[string range "$to" [expr $j+1] end]" "\]"]" if {![regexp -- {^[0-9]+$} "$dcc($dnum,port)"]} { set dcc($dnum,port) "- unknown -" } set dcc($dnum,starttime) "[clock seconds]" after 500 [list write2irc $inum "/get_dcclist"] } "dcc send:* completed *" { set dnum [SearchDCC $inum SEND "[lindex "$list" 3]" "[string range "[lindex "$list" 1]" 5 end]"] if {$dnum != -1} { set dcc($dnum,sent) "- all done ([lindex "$list" 5] [lindex "$list" 6]) -" if {[winfo exists .dcc$dnum]} { DCCWindow $dnum } DeleteDCC $dnum } } "dcc send:* closed" { set dnum [SearchDCC $inum SEND "[lindex "$list" 3]" "[string range "[lindex "$list" 1]" 5 end]"] if {$dnum != -1} { set dcc($dnum,sent) "- break ($dcc($dnum,sent)) -" if {[winfo exists .dcc$dnum]} { DCCWindow $dnum } DeleteDCC $dnum } } default { set margin(text) "" } } } "file * from * renamed to *" { set list "[line2list "$line"]" set dnum [SearchDCC $inum GET "[lindex "$list" 3]" "[lindex "$list" 1]"] if {$dnum != -1} { set dcc($dnum,file) "[lindex "$list" end]" } set margin(text) "dcc" } } return "*** $line" } proc AddAddressToNick {inum nick address} { global irc chan set count 0 set address "$address" foreach x "$chan(list)" { set i [UserNumber $inum $x "$nick"] if {$i != -1} { set chan($x,addresses) "[lreplace "$chan($x,addresses)" $i $i "$address"]" incr count } } if {$count == 0} { KeepUser $inum $nick $address } } proc parseraw {inum line} { global irc queue linetype raw cooked on_args psplit pjoin set linetype 0 set raw(line) "[string range "$line" 5 end]" set raw(dp) [string first ":" "$raw(line)"] set raw(list) "[line2list "$raw(line)"]" set raw(type) "[lindex "$raw(list)" 1]" set one "[lindex "$raw(list)" 0]" set az [string first "!" "$one"] if {$az != -1} { set raw(nick) "[string range "$one" 0 [expr $az-1]]" set raw(address) "[string range "$one" [expr $az+1] end]" } else { set raw(nick) "" set raw(address) "$one" } set on_args(nick) "$raw(nick)" set on_args(address) "$raw(address)" if {[string length "$raw(type)"] == 3} { # NUMERICS global on_$raw(type) if {[info exists raw_$raw(type)] && [string length "[set raw_$raw(type)]"]} { eval [set raw_$raw(type)] } foreach x "[lsort -ascii "[info commands "on_$raw(type)*"]"]" { set on_args(line) "$raw(line)" set on_args(list) "$raw(list)" $x } global raw_$raw(type) if {[string length "[info commands "raw_$raw(type)"]"]} { set on_args(line) "$raw(line)" raw_$raw(type) $inum } else { switch -regexp -- "$raw(type)" { {^(301|312|313|317|319)} { # RPL_AWAY, RPL_WHOISUSER and other replies if {$queue($inum,whoisfilter) != 0 || $queue($inum,whowasfilter) != 0} { set irc($inum,next,filter) 1 } } {^(305|306)} { # RPL_UNAWAY, RPL_NOWAWAY global san away automatic_away set san(nicks) "" set san(times) "" if {$raw(type) == 305} { set away "" } else { if {$automatic_away != 0} { set away " (autoaway)" } else { set away " (away)" } } UpdateAllTitles set automatic_away 0 set irc($inum,next,filter) 1 set cooked(line) "$raw(type) [string range "[cutwords "$raw(line)" 3]" 1 end]" } {^(001|002|003|004)} { set irc($inum,startup) 2 if {[string compare "$irc($inum,nick)" "[lindex "$raw(list)" 2]"] \ || [string compare "$irc($inum,serv)" "$raw(address)"]} { Disconnected $inum -noupdate set irc($inum,nick) "[lindex "$raw(list)" 2]" set irc($inum,serv) "$raw(address)" UpdateAllTitles } } {^(251|252|254|255)} { if {$irc($inum,startup) < 3} { SetClientInformation $inum notified_clear $inum all suspected_clear $inum all ExecOnCommands connect $inum InitIdleTime set irc($inum,startup) 3 } } {^408} { # ERR_NOSUCHSERVICE } {^421} { # ERR_UNKNOWNCOMMAND } {^(401|403|405|406|432|433|436|437|442|471|473|474)} { global chan win # ERR_NOSUCHNICK, ERR_NOSUCHCHANNEL, ERR_TOOMANYCHANNELS, # ERR_WASNOSUCHNICK, ERR_ERRONEUSNICKNAME, ERR_NICKNAMEINUSE, # ERR_NICKCOLLISION, Nick/channel is temporarily unavailable, # ERR_NOTONCHANNEL, ERR_CHANNELISFULL, ERR_INVITEONLYCHAN, # ERR_BANNEDFROMCHAN set i [expr [string first "$raw(type)" "$line"]+3] # Im folgenden wird darauf geachtet, ob evtl. in der # empfangenen Zeile der Zielnick fehlt. if {[string compare " " "[string range "$line" $i [incr i]]"]} { set tmp "[lindex "$raw(list)" 3]" set reason "[string range "[cutwords "$line" 5]" 1 end]" } else { set tmp "[lindex "$raw(list)" 2]" set reason "[string range "[cutwords "$line" 4]" 1 end]" } if {[strcmp "$irc($inum,nick)" "$tmp"] == 0} { NickNotAvailable $inum "$tmp" } else { # Ggf. müssen die Tojoin-Listen korrigiert werden. set i [lSearch "$irc($inum,tojoin,chan)" "$tmp"] if {$i != -1} { set irc($inum,tojoin,chan) "[lreplace "$irc($inum,tojoin,chan)" $i $i]" set irc($inum,tojoin,win) "[lreplace "$irc($inum,tojoin,win)" $i $i]" } # Dieser Kanal kann nicht gejoint worden sein. if {$raw(type) == 403} { set cnum [ChannelNumber $inum "$tmp"] if {$cnum != -1} { DeleteChannel $cnum } } # ircII scheint einige Nummern zu unterdrücken. ?:^| set cooked(line) "$raw(type) $tmp: $reason" set irc($inum,next,filter) 1 # Steht der Nick evtl. noch im Notify-Window? UpdateNotifyWindow $inum 0 -1 "$tmp" "" UpdateSuspectWindow $inum 0 -1 "$tmp" "" # Sollte diese Fehlermeldung von tkirc ausgelöst worden sein, # muß sie unterdrückt werden. if {[llength "$queue($inum,whois)"] > 0} { set entry "[lindex "$queue($inum,whois)" 0]" if {[strcmp "[lindex "$entry" 0]" "$tmp"] == 0} { set queue($inum,whois) "[lreplace "$queue($inum,whois)" 0 0]" if {[llength "$queue($inum,whois)"] > 0} { # nächstes 'whois' losschicken write2irc $inum "/whois [lindex "[lindex "$queue($inum,whois)" 0]" 0]" } set irc($inum,next,filter) 1 } } if {[llength "$queue($inum,whowas)"] > 0} { set entry "[lindex "$queue($inum,whowas)" 0]" if {[strcmp "[lindex "$entry" 0]" "$tmp"] == 0} { set queue($inum,whowas) "[lreplace "$queue($inum,whowas)" 0 0]" if {[llength "$queue($inum,whowas)"] > 0} { # nächstes 'whowas' losschicken write2irc $inum "/whowas [lindex "[lindex "$queue($inum,whowas)" 0]" 0]" } set irc($inum,next,filter) 1 } } } } {^475} { # ERR_BADCHANNELKEY set channel "[lindex "$raw(list)" 3]" set echannel "[expand "$channel"]" StringRequest "You need the correct password to join channel '$channel'!" "" "Cancel|" "Join|write2irc $inum \"/quote join $echannel \$string\"" return "" } } } } else { # ALPHABETICS if {$psplit(state) != 0 && [string compare "$raw(nick)" "$psplit(nick)"] == 0} { HandleFakeNetsplit $inum $psplit(time) } if {$pjoin(state) != 0 && [string compare "$raw(nick)" "$pjoin(nick)"] == 0} { HandleFakeNetjoin $inum $pjoin(time) } if {[string length "[info commands "raw_$raw(type)"]"]} { set on_args(line) "$raw(line)" raw_$raw(type) $inum } } return "$cooked(line)" } proc raw_005 {inum} { global irc raw # fu-berlin.de 005 oswald :Try server irc.gmd.de, port 6667 if {[strmatch "$irc($inum,serv) 005 $irc($inum,nick) :Try server *, port *" "$raw(line)"]} { write2irc $inum "/server [string trimright "[lindex "$raw(list)" 5]" ","] [lindex "$raw(list)" 7]" } } proc raw_221 {inum} { global raw SetUserModes $inum "[lindex "$raw(list)" 3]" } proc raw_311 {inum} { global irc queue raw # RPL_WHOISUSER set nick [lindex "$raw(list)" 3] AddAddressToNick $inum "$nick" "[lindex "$raw(list)" 4]@[lindex "$raw(list)" 5]" set queue($inum,whoisfilter) 0 if {[llength "$queue($inum,whois)"] > 0} { set entry "[lindex "$queue($inum,whois)" 0]" if {[strcmp "[lindex "$entry" 0]" "$nick"] == 0} { set queue($inum,whoisfilter) 1 set command "[lindex "$entry" 2]" if {"[AddressOfNick $inum "$nick"]" != "@" && [string length "$command"]} { eval $command } set irc($inum,next,filter) 1 } } } proc raw_314 {inum} { global irc queue raw # RPL_WHOWASUSER if {$queue($inum,whowasfilter) == 0} { set nick [lindex "$raw(list)" 3] AddAddressToNick $inum "$nick" "[lindex "$raw(list)" 4]@[lindex "$raw(list)" 5]" if {[llength "$queue($inum,whowas)"] > 0} { set entry "[lindex "$queue($inum,whowas)" 0]" if {[strcmp "[lindex "$entry" 0]" "$nick"] == 0} { set queue($inum,whowasfilter) 1 set command "[lindex "$entry" 2]" if {"[AddressOfNick $inum "$nick"]" != "@" && [string length "$command"]} { eval $command } set irc($inum,next,filter) 1 } } } else { set irc($inum,next,filter) 1 } } proc raw_315 {inum} { global irc queue raw cooked margin # RPL_ENDOFWHO if {$queue($inum,whofilter) != 0} { set entry "[lindex "$queue($inum,who)" 0]" if {[string length "[lindex "$entry" 2]"]} { set margin(text) "[lindex "$entry" 1]" write2crap $inum "[lindex "$entry" 2]" } set queue($inum,who) "[lreplace "$queue($inum,who)" 0 0]" if {[llength "$queue($inum,who)"] > 0} { # nächstes 'who' losschicken FilterLine $inum "Channel * Nickname *" write2irc $inum "/who [lindex "[lindex "$queue($inum,who)" 0]" 0]" } set queue($inum,whofilter) 0 } elseif {"$raw(lasttype)" != "352"} { set cooked(line) "*** [string range "$raw(line)" [expr $raw(dp)+1] end]" } } proc raw_318 {inum} { global irc queue raw # RPL_ENDOFWHOIS if {$queue($inum,whoisfilter) != 0} { set queue($inum,whois) "[lreplace "$queue($inum,whois)" 0 0]" if {[llength "$queue($inum,whois)"] > 0} { # nächstes 'whois' losschicken write2irc $inum "/whois [lindex "[lindex "$queue($inum,whois)" 0]" 0]" } set queue($inum,whoisfilter) 0 } } proc raw_322 {inum} { global irc # RPL_LIST set irc($inum,next,tocrap) 1 } proc raw_324 {inum} { global irc raw # RPL_CHANNELMODEIS set cnum [ChannelNumber $inum "[set channel "[lindex "$raw(list)" 3]"]"] if {[set wnum [WindowNumber $cnum]] == -1} { return } SetChannelModes $cnum "[cutwords "$raw(line)" 4]" 0 "" } proc raw_329 {inum} { global irc raw cooked margin # RPL_CREATIONTIME set margin(text) "extra" set channel [lindex "$raw(list)" 3] if {[WindowNumber $inum "$channel"] == -1} { return } set irc($inum,next,filter) 1 set cooked(line) "*** Channel $channel was created [clock format [lindex "$raw(list)" 4] -format "on %y-%m-%d at %H:%M:%S"]" } proc raw_331 {inum} { global irc raw cooked margin chan # RPL_NOTOPIC set margin(text) "topic" set cnum [ChannelNumber $inum "[set channel "[lindex "$raw(list)" 3]"]"] if {[set wnum [WindowNumber $cnum]] == -1} { return } set chan($cnum,topic) "" UpdateTopic $wnum set irc($inum,next,filter) 1 set cooked(line) "*** $channel: No topic is set." } proc raw_332 {inum} { global irc raw cooked margin chan # RPL_TOPIC set margin(text) "topic" set cnum [ChannelNumber $inum "[set channel "[lindex "$raw(list)" 3]"]"] if {[set wnum [WindowNumber $cnum]] == -1} { return } set chan($cnum,topic) "[string range "[cutwords "$raw(line)" 4]" 1 end]" UpdateTopic $wnum set irc($inum,next,filter) 1 set cooked(line) "*** Topic for $channel: $chan($cnum,topic)" } proc raw_333 {inum} { global irc raw cooked margin # RPL_TOPICWHOTIME set margin(text) "extra" set channel [lindex "$raw(list)" 3] if {[WindowNumber $inum "$channel"] == -1} { return } set irc($inum,next,filter) 1 if {"[lindex "$raw(list)" end]" != "0"} { set cooked(line) "*** Topic was set by [lindex "$raw(list)" 4] [clock format [lindex "$raw(list)" 5] -format "on %y-%m-%d at %H:%M:%S"]" } } proc raw_352 {inum} { global irc queue raw cooked # RPL_WHOREPLY set channel [lindex "$raw(list)" 3] set queue($inum,whofilter) 0 if {[llength "$queue($inum,who)"] > 0} { set entry "[lindex "$queue($inum,who)" 0]" if {[strcmp "[lindex "$entry" 0]" "$channel"] == 0} { AddAddressToNick $inum "[lindex "$raw(list)" 7]" "[lindex "$raw(list)" 4]@[lindex "$raw(list)" 5]" set queue($inum,whofilter) 1 set irc($inum,next,filter) 1 } } } proc raw_353 {inum} { global irc raw chan # RPL_NAMREPLY set cnum [ChannelNumber $inum "[set channel "[lindex "$raw(list)" 4]"]"] if {[set wnum [WindowNumber $cnum]] == -1} { return } # Die Liste der Kanalbenutzer wird erst vollständig empfangen, bevor # sie ausgewertet wird. if {$chan($cnum,ucount) == 0} { set chan($cnum,newnames) "" set chan($cnum,ucount) 1 } set i [string last ":" "$raw(line)"] ; incr i append chan($cnum,newnames) "[string range "$raw(line)" $i end] " } proc raw_366 {inum} { global irc raw chan win # RPL_ENDOFNAMES set cnum [ChannelNumber $inum "[set channel "[lindex "$raw(list)" 3]"]"] if {$cnum != -1} { # Nachdem die Liste der Kanalbenutzer vollständig empfangen wurde, # wird sie ausgewertet. set length_before [string length "$chan($cnum,names)"] set chan($cnum,ucount) 0 set chan($cnum,nicks) "" set chan($cnum,names) "" set chan($cnum,mode_o) 0 set chan($cnum,mode_v) 0 foreach x "[expand "$chan($cnum,newnames)"]" { lappend chan($cnum,nicks) "[TrimNick "$x"]" lappend chan($cnum,names) "$x" if {"[string index "$x" 0]" == "+"} { incr chan($cnum,mode_v) lappend chan($cnum,vlist) "1" } else { lappend chan($cnum,vlist) "0" } if {"[string index "$x" 0]" == "@"} { incr chan($cnum,mode_o) lappend chan($cnum,olist) "1" } else { lappend chan($cnum,olist) "0" } lappend chan($cnum,addresses) "" lappend chan($cnum,jointimes) "0" lappend chan($cnum,ctimes) 0 } set chan($cnum,cnicks) "$chan($cnum,nicks)" if {$length_before == 0} { AddAddressToNick $inum "$irc($inum,nick)" "$irc($inum,address)" ExecOnCommands join $inum channel "$channel" nick "$irc($inum,nick)" address "$irc($inum,address)" set unum [UserNumber $inum $cnum "$irc($inum,nick)"] DetectUserOnChannel $inum $cnum $unum notify join DetectUserOnChannel $inum $cnum $unum suspect join } set wnum [WindowNumber $cnum] if {$wnum != -1} { # Da für diesen Kanal auch ein Fenster existiert, muß die # Anzeige aktualisiert werden. if {[strcmp "$channel" "$win($wnum,actual)"] == 0} { FillUserList $wnum $cnum } UpdateInfos $wnum global raw ; set raw(line) "*** Users on $chan($cnum):[string trimright "$chan($cnum,newnames)" " "]" write2log "$chan($cnum)" $inum "$raw(line)" } } if {"$raw(lasttype)" != "353"} { write2crap $inum "*** [string range "$raw(line)" [expr $raw(dp)+1] end]" } } proc raw_367 {inum} { global irc raw banlist # RPL_BANLIST set channel "[lindex "$raw(list)" 3]" BanChannelUser [ChannelNumber $inum "$channel"] "[lindex "$raw(list)" 4]" "!" if {[lSearch "$banlist(filter)" "$channel"] != -1} { set irc($inum,next,filter) 1 } else { # if {[winfo exists .banlist]} { # if {[strcmp "$banlist(channel)" "$channel"] == 0} { # set irc($inum,next,filter) 1 # return # } # } set irc($inum,next,tocrap) 1 } } proc raw_368 {inum} { global irc raw cooked banlist on_args # RPL_ENDOFBANLIST set channel "[lindex "$raw(list)" 3]" set i [lSearch "$banlist(filter)" "$channel"] if {$i != -1} { set banlist(filter) "[lreplace "$banlist(filter)" $i $i]" if {[WindowNumber $inum "$channel"] != -1} { UpdateInfos $on_args(window) } } elseif {"$raw(lasttype)" != "367"} { set cooked(line) "*** [string range "$raw(line)" [expr $raw(dp)+1] end]" } } proc raw_369 {inum} { global irc queue raw # RPL_ENDOFWHOWAS if {$queue($inum,whowasfilter) != 0} { set queue($inum,whowas) "[lreplace "$queue($inum,whowas)" 0 0]" if {[llength "$queue($inum,whowas)"] > 0} { # nächstes 'whowas' losschicken write2irc $inum "/whowas [lindex "[lindex "$queue($inum,whowas)" 0]" 0]" } set queue($inum,whowasfilter) 0 } } proc raw_219 {inum} { global irc raw cooked if {"$raw(lasttype)" != "244"} { set cooked(line) "*** [string range "$raw(line)" [expr $raw(dp)+1] end]" } } proc raw_323 {inum} { global irc raw cooked if {"$raw(lasttype)" != "322"} { set cooked(line) "*** [string range "$raw(line)" [expr $raw(dp)+1] end]" } } proc raw_365 {inum} { global irc raw cooked if {"$raw(lasttype)" != "364"} { set cooked(line) "*** [string range "$raw(line)" [expr $raw(dp)+1] end]" } } proc raw_374 {inum} { global irc raw cooked if {"$raw(lasttype)" != "371"} { set cooked(line) "*** [string range "$raw(line)" [expr $raw(dp)+1] end]" } } proc raw_PONG {inum} { LagStop $inum } proc raw_ERROR {inum} { global irc raw margin set last "[string range "[cutwords "$raw(line)" 2]" 1 end]" ExecOnCommands error $inum message "$last" set margin(text) "error" write2crap $inum "--- $last" Disconnected $inum set irc($inum,next,filter) 1 } proc raw_JOIN {inum} { global irc raw cooked chan win margin set channel "[lindex "$raw(list)" 2]" if {"[string index "$channel" 0]" == ":"} { set channel "[string range "$channel" 1 end]" } # Nun muß überprüft werden, ob gleichzeitig ein Channelop-Status # mitgeliefert wurde. set modetext "" ; set omode 0 ; set vmode 0 set i [string last "\a" "$channel"] if {$i != -1} { set modetext "[string range "$channel" [expr $i+1] end]" if {[strmatch "*o*" "$modetext"]} { set omode 1 } if {[strmatch "*v*" "$modetext"]} { set vmode 1 } if {[string length "$modetext"]} { set modetext " (+$modetext)" } set channel "[string range "$channel" 0 [expr $i-1]]" } if {[strcmp "$raw(nick)" "$irc($inum,nick)"] == 0} { # /me besucht den Kanal. set cnum [ChannelNumber $inum "$channel"] if {$cnum != -1} { # Beim Reconnect etc. muß der Kanal neu angelegt werden. set wnum $chan($cnum,window) DeleteChannel $cnum lappend irc($inum,tojoin,chan) "$channel" lappend irc($inum,tojoin,win) $wnum } set cnum [ProduceChannel $inum "$channel"] if {$cnum == -1} { return } global banlist if {[winfo exists .banlist]} { # Enable commit-button of banlist-editor if {$cnum == [ChannelNumber $inum "$banlist(channel)"]} { .banlist.buttons.commit configure -state normal } } } else { # Jemand anderes besucht den Kanal. set cnum [ChannelNumber $inum "$channel"] if {[set wnum [WindowNumber $cnum]] == -1} { return } AddUserToChannel $inum $cnum "$raw(nick)" "$raw(address)" $vmode $omode UpdateInfos $wnum } # Das 'on_join' wird hier nur unterstützt, wenn jemand # anderes den Kanal betritt. Beim eigenen Betreten des # Kanals wird auf die Userliste gewartet. if {[strcmp "$raw(nick)" "$irc($inum,nick)"]} { ExecOnCommands join $inum channel "$channel" } else { set irc($inum,address) "$raw(address)" } set line "" global react_to_netsplits if {$react_to_netsplits != 0} { HandleNetjoins $inum $cnum "$raw(nick)" "$raw(address)" "$modetext" } else { TakeOverTest $cnum "$raw(address)" # Soll die Join-Meldung ausgegeben werden? global hide_joins if {$hide_joins($wnum) == 0} { set margin(text) "join" set cooked(line) "*** $raw(nick) ($raw(address)) has joined channel $channel$modetext\x0f\x0f" } } } proc raw_PART {inum} { global irc raw cooked margin chan set channel "[lindex "$raw(list)" 2]" set last "[string range "[cutwords "$raw(line)" 3]" 1 end]" ExecOnCommands leave $inum channel "$channel" message "$last" set cnum [ChannelNumber $inum "$channel"] if {[set wnum [WindowNumber $cnum]] == -1} { return } if {[strcmp "$raw(nick)" "$irc($inum,nick)"] == 0} { # /me verläßt den Kanal. set unum [UserNumber $inum $cnum "$raw(nick)"] if {$unum != -1} { RemoveUserFromChannel $inum $cnum $unum $raw(nick) } global banlist if {[winfo exists .banlist]} { # Disable commit-button of banlist-editor if {$cnum == [ChannelNumber $inum "$banlist(channel)"]} { .banlist.buttons.commit configure -state disabled } } DeleteChannel $cnum } else { # Jemand anderes verläßt den Kanal. set unum [UserNumber $inum $cnum "$raw(nick)"] if {$unum != -1} { global channelhop_period set period [expr [clock seconds]-[lindex "$chan($cnum,jointimes)" $unum]] if {$period >= 0 && $period <= $channelhop_period} { # Ist in der letzten Zeit (channelhop_period) ein Netjoin # aufgetreten, dann wird 'on_channelhop' nicht aufgerufen! global join if {$join(count) > 0} { set num [expr $join(count)-1] if {[expr [clock seconds] - $join($num,time)] > $channelhop_period} { ExecOnCommands channelhop $inum channel "$channel" period $period } } else { ExecOnCommands channelhop $inum channel "$channel" period $period } } RemoveUserFromChannel $inum $cnum $unum $raw(nick) } } # Soll die Leave-Meldung ausgegeben werden? global hide_leaves if {$hide_leaves($wnum) == 0} { set margin(text) "leave" set cooked(line) "*** $raw(nick) ($raw(address)) has left channel $channel" if {[string length "$last"] && [string compare "$raw(nick)" "$last"]} { append cooked(line) " ($last\x0f)\x0f\x0f" } else { append cooked(line) "\x0f\x0f" } } } proc raw_QUIT {inum} { global irc raw cooked chan win react_to_netsplits margin set last "[string range "[cutwords "$raw(line)" 2]" 1 end]" ExecOnCommands signoff $inum message "$last" if {$react_to_netsplits != 0 && [regexp -- {^([^ .]+\.)+[^ .]+ ([^ .]+\.)+[^ .]+$} "$last"]} { HandleNetsplits $inum "$raw(nick)" "$raw(address)" "$last" } else { set channels "" foreach cnum "$chan(list)" { set unum [UserNumber $inum $cnum "$raw(nick)"] if {$unum != -1} { # Soll die Signoff-Meldung ausgegeben werden? set j $chan($cnum,window) if {$j != -1} { global hide_signoffs if {$hide_signoffs($j) == 0} { lappend channels $cnum } } RemoveUserFromChannel $inum $cnum $unum $raw(nick) } } set margin(text) "signoff" print2channels "$channels" "*** $raw(nick) has signed off ($last\x0f)\x0f\x0f" } } proc raw_PRIVMSG {inum} { global irc raw cooked linetype on_args margin away win chan set to "[lindex "$raw(list)" 2]" set last "[string range "[cutwords "$raw(line)" 3]" 1 end]" set irc($inum,notice_toall) 0 set irc($inum,next,toall) "" # Das Zielfenster wird ermittelt. if {[strcmp "$to" "$irc($inum,nick)"]} { set linetype 0 if {[WindowNumber $inum "$to"] == -1 && [IsChannel "$to"]} { debug "PRIVMSG: '$raw(line)'" set irc($inum,next,filter) 1 return } } else { set linetype 1 set on_args(window) [GetQueryWindow $inum $raw(nick)] } # Kommt die Privmsg evtl. direkt vom Server? if {"$raw(nick)" == ""} { ExecOnCommands servermessage $inum to "$to" rest "$last" set irc($inum,next,filter) 1 if {[strcmp "$irc($inum,nick)" "$to"] == 0} { # Dies ist eine private Message vom Server. set margin(text) "server" } elseif {[IsChannel "$to"]} { # Die Message ist für einen Kanal bestimmt. set margin(text) "[string tolower "$to"]" } else { # Ob diese Art von Messages benutzt werden, ist nicht bekannt. set margin(text) "[string tolower "$to"]" set irc($inum,next,filter) 0 } if {[string match {\*\*\* *} "$last"]} { set last "[string range "$last" 4 end]" } set cooked(line) "*** $last\x0f\x0f" return } # Hier werden mögliche CTCP-Kommandos herausgefiltert, die dem # Benutzer allerdings nicht alle einzeln angezeigt werden. Es # werden bis zu 4 CTCP-Kommandos in einer Zeile berücksichtigt. set together "" set ctcps_within_message 0 for {set l 0} {$l < 4} {incr l} { set left [string first "\x01" "$last"] if {$left == -1} { break } incr left set right [string first "\x01" "[string range "$last" $left end]"] if {$right == -1} { break } incr ctcps_within_message if {$l == 1} { FilterLine $inum "[expand "*CTCP $command from *"]" append together "$ctcpline " } set right [expr $right+$left-1] set ctcpline "[string range "$last" $left $right]" set command "[lIndex "$ctcpline" 0]" set parameters "[cutwords "$ctcpline" 1]" set last "[string range "$last" 0 [expr $left-2]][string range "$last" [expr $right+2] end]" if {$l > 0} { FilterLine $inum "[expand "*CTCP $command from *"]" append together "; $ctcpline " } # Der Client soll evtl. nicht auf beliebig viele CTCP-Kommandos # antworten, um nicht vom Server wegen "Excess flood" rausgeschmissen # zu werden. CTCPs und INVITEs werden ggf. abgestellt. global react_to_ctcp_flood if {$l == 0 && [strcmp "$command" "ACTION"] && [strcmp "$command" "DCC"] && [strcmp "0" "$react_to_ctcp_flood"]} { global ctcp_count ctcp_list global host_flood_ignore_period global_flood_ignore_period set add2count 1 if {$ctcp_count < 5} { # Flood-Protection für einzelne Hosts: set new_ctcp_list "" set at [string first "@" "$raw(address)"] set host "[string range "$raw(address)" [expr $at+1] end]" set newadd 0 set len [llength "$ctcp_list"] for {set i 0} {$i < $len} {incr i} { set x "[lindex "$ctcp_list" $i]" if {[expr [clock seconds]-[lindex "$x" 1]] < [lindex "$x" 3]} { if {[string compare "$host" "[lindex "$x" 0]"] == 0} { set newadd 1 set time "[lindex "$x" 1]" set valid 30 set count [lindex "$x" 2] if {$count == 2} { ignore $inum "$host" set margin(text) "note" write2crap $inum "--- Flood protection activated for host '$host' ($host_flood_ignore_period seconds)" after [expr $host_flood_ignore_period * 1000] "unignore $inum \"$host\" ; global margin ; set margin(text) \"note\" ; write2crap $inum \"--- Flood protection deactivated for host '$host'\"" set valid [expr $host_flood_ignore_period] set time "[clock seconds]" } elseif {$count > 2} { set irc($inum,next,filter) 1 set add2count 0 set valid [expr $host_flood_ignore_period] } lappend new_ctcp_list "$host $time [expr $count+1] $valid" } else { lappend new_ctcp_list "$x" } } } set ctcp_list "$new_ctcp_list" if {$newadd == 0} { lappend ctcp_list "$host [clock seconds] 1 30" } } elseif {$ctcp_count == 5} { # Flood-Protection für alle eingehenden CTCPs: set ctcp_count 105 ignore $inum "*" set margin(text) "note" write2crap $inum "--- Global flood protection activated ($global_flood_ignore_period seconds)" after [expr $global_flood_ignore_period * 1000] "global ctcp_count ; set ctcp_count 1 ; unignore $inum \"*\" ; global margin ; set margin(text) \"note\" ; write2crap $inum \"--- Global flood protection deactivated\"" } elseif {$ctcp_count > 5} { # Eingehende CTCPs werden ab jetzt nur noch herausgefiltert. set irc($inum,next,filter) 1 return } if {$add2count != 0} { incr ctcp_count after 60000 {global ctcp_count ; set ctcp_count [expr $ctcp_count-1]} } else { # Die Flood-Protection wurde für einen Host aktiviert. return } } set upcommand "[string toupper "$command"]" switch -regexp -- "$upcommand" { {^ACTION} { set irc($inum,next,direct) 1 if {$linetype != 0} { ExecOnCommands privaction $inum rest "$parameters" set irc($inum,next,from) "$raw(nick)" set irc($inum,next,towin) "** $raw(nick)\t$parameters" set irc($inum,next,right) [expr [set irc($inum,next,left) 3]+[string length "$raw(nick)"]] set irc($inum,next,pattern) "\*> [expand "$raw(nick)"]*" if {[string length "$away"]} { global show_address_on_message_when_away if {$show_address_on_message_when_away != 0} { set irc($inum,next,towin) "** $raw(nick)!$raw(address)\t$parameters" } } else { global show_address_on_message_when_present if {$show_address_on_message_when_present != 0} { set irc($inum,next,towin) "** $raw(nick)!$raw(address)\t$parameters" } } global show_address_on_message_in_logfile if {$show_address_on_message_in_logfile != 0} { set irc($inum,next,tolog) "** $raw(nick)!$raw(address) $parameters" } else { set irc($inum,next,tolog) "$irc($inum,next,towin)" } if {[string length "$away"]} { global beep_on_private_when_away if {$beep_on_private_when_away != 0} { set irc($inum,next,beep) 1 } } else { global beep_on_private_when_present if {$beep_on_private_when_present != 0} { set irc($inum,next,beep) 1 } } } else { ExecOnCommands pubaction $inum to "$to" rest "$parameters" set irc($inum,next,to) "$to" set irc($inum,next,pattern) "\* [expand "$raw(nick)"]*" # Wenn sich der Kanal im Modus "no messages" befindet, wird # nicht weiter überprüft, ob der Benutzer auf dem Kanal ist. set cnum [ChannelNumber $inum "$to"] if {$cnum != -1} { if {$chan($cnum,mode_n) != 0 \ || [UserNumber $inum $cnum "$raw(nick)"] != -1} { global show_only_background_channels if {[llength "$win($on_args(window),channels)"] < 2 \ || $show_only_background_channels && [strcmp "$win($on_args(window),actual)" "$to"] == 0} { set irc($inum,next,towin) "* $raw(nick)\t$parameters" } else { set irc($inum,next,towin) "* $raw(nick)+$to\t$parameters" } set irc($inum,next,tolog) "* $raw(nick)\t$parameters" set irc($inum,next,toall) "* $raw(nick)+$to\t$parameters" } else { set irc($inum,next,towin) "* $raw(nick)»$to\t$parameters" set irc($inum,next,tolog) "$irc($inum,next,towin)" set irc($inum,next,toall) "$irc($inum,next,towin)" } } if {[string length "$away"]} { global beep_on_public_when_away if {$beep_on_public_when_away != 0} { set irc($inum,next,beep) 1 } } else { global beep_on_public_when_present if {$beep_on_public_when_present != 0} { set irc($inum,next,beep) 1 } } } break } {^DCC} { ExecOnCommands dcc $inum command "[lIndex "$parameters" 0]" rest "[cutwords "$parameters" 1]" } default { ExecOnCommands ctcprequest $inum command "$upcommand" to "$to" rest "$parameters" } } } if {"$together" != ""} { set margin(text) "ctcp" if {$linetype != 0} { write2crap $inum "--- MULTI-CTCP from $raw(nick): $together\x0f\x0f" } else { write2crap $inum "--- MULTI-CTCP from $raw(nick) to $to: $together\x0f\x0f" } } if {$ctcps_within_message != 0 && "$last" == ""} { return } # Dann muß die Privmsg für mich oder einen Kanal bestimmt sein. set irc($inum,next,direct) 1 if {$linetype != 0} { set irc($inum,next,from) "$raw(nick)" AddToMsgHistory $irc($inum,crap) "[expandescape "$raw(nick)"]" if {[strcmp "$irc($inum,nick)" "$raw(nick)"]} { if {[string length "$away"]} { global chat_window_on_message_when_away if {$chat_window_on_message_when_away != 0} { set irc($inum,next,chatwin) "-new" } } else { global chat_window_on_message_when_present if {$chat_window_on_message_when_present != 0} { set irc($inum,next,chatwin) "-new" } } } set irc($inum,next,towin) "*$raw(nick)*\t$last" set irc($inum,next,right) [expr [set irc($inum,next,left) 1]+[string length "$raw(nick)"]] set irc($inum,next,pattern) "?[expand "$raw(nick)"]*" if {[string length "$away"]} { global show_address_on_message_when_away if {$show_address_on_message_when_away != 0} { set irc($inum,next,towin) "*$raw(nick)!$raw(address)*\t$last" } } else { global show_address_on_message_when_present if {$show_address_on_message_when_present != 0} { set irc($inum,next,towin) "*$raw(nick)!$raw(address)*\t$last" } } global show_address_on_message_in_logfile if {$show_address_on_message_in_logfile != 0} { set irc($inum,next,tolog) "*$raw(nick)!$raw(address)* $last" } else { set irc($inum,next,tolog) "$irc($inum,next,towin)" } if {[string length "$away"]} { global beep_on_private_when_away if {$beep_on_private_when_away != 0} { set irc($inum,next,beep) 1 } } else { global beep_on_private_when_present if {$beep_on_private_when_present != 0} { set irc($inum,next,beep) 1 } } ExecOnCommands privmessage $inum to "$irc($inum,nick)" rest "$last" } else { set irc($inum,next,to) "$to" set irc($inum,next,pattern) "?[expand "$raw(nick)"]*" # Wenn sich der Kanal im Modus "no messages" befindet, wird # nicht weiter überprüft, ob der Benutzer auf dem Kanal ist. set cnum [ChannelNumber $inum "$to"] if {$cnum != -1} { if {$chan($cnum,mode_n) != 0 \ || [UserNumber $inum $cnum "$raw(nick)"] != -1} { global show_only_background_channels if {[llength "$win($on_args(window),channels)"] < 2 \ || $show_only_background_channels && [strcmp "$win($on_args(window),actual)" "$to"] == 0} { set irc($inum,next,towin) "<$raw(nick)>\t$last" } else { set irc($inum,next,towin) "<$raw(nick)+$to>\t$last" } set irc($inum,next,tolog) "<$raw(nick)>\t$last" set irc($inum,next,toall) "<$raw(nick)+$to>\t$last" } else { set irc($inum,next,towin) "<$raw(nick)»$to>\t$last" set irc($inum,next,tolog) "$irc($inum,next,towin)" set irc($inum,next,toall) "$irc($inum,next,towin)" } } if {[string length "$away"]} { global beep_on_public_when_away if {$beep_on_public_when_away != 0} { set irc($inum,next,beep) 1 } } else { global beep_on_public_when_present if {$beep_on_public_when_present != 0} { set irc($inum,next,beep) 1 } } ExecOnCommands pubmessage $inum to "$to" rest "$last" } } proc raw_NOTICE {inum} { global irc raw cooked linetype on_args margin away win chan set to "[lindex "$raw(list)" 2]" set last "[string range "[cutwords "$raw(line)" 3]" 1 end]" set irc($inum,next,toall) "" # Das Zielfenster wird ermittelt. if {[strcmp "$to" "$irc($inum,nick)"]} { set linetype 0 if {"[string index "$to" 0]" == "@"} { set to "[string range "$to" 1 end]" set onotice "@" } else { set onotice "" } if {[WindowNumber $inum "$to"] == -1 && [IsChannel "$to"]} { debug "NOTICE: '$raw(line)'" set irc($inum,next,filter) 1 return } } else { set linetype 1 ; set onotice "" set on_args(window) [GetQueryWindow $inum "$raw(nick)"] } # Kommt die Notice evtl. direkt vom Server? if {"$raw(nick)" == ""} { ExecOnCommands servernotice $inum to "$to" rest "$last" set irc($inum,next,filter) 1 if {[strcmp "$irc($inum,nick)" "$to"] == 0} { # Dies ist eine private Notice vom Server. set margin(text) "server" if {[string match "NoteServ@*" "$raw(address)"]} { # Es handelt sich um eine Notice vom NoteServ. set margin(text) "noteserv" } } elseif {[IsChannel "$to"]} { # Die Notice ist für einen Kanal bestimmt. set margin(text) "[string tolower "$to"]" } else { # Die Notice kann z.B. eine AUTH-Notice sein. set margin(text) "[string tolower "$to"]" set irc($inum,next,filter) 0 } if {[string match {\*\*\* *} "$last"]} { set last "[string range "$last" 4 end]" } set cooked(line) "*** $last\x0f\x0f" return } # Hier werden mögliche CTCP-Replies herausgefiltert, die dem # Benutzer allerdings nicht alle einzeln angezeigt werden. Es # werden bis zu 4 CTCP-Replies in einer Zeile berücksichtigt. set together "" set ctcps_within_message 0 for {set l 0} {$l < 4} {incr l} { set left [string first "\x01" "$last"] if {$left == -1} { break } incr left set right [string first "\x01" "[string range "$last" $left end]"] if {$right == -1} { break } incr ctcps_within_message if {$l == 1} { FilterLine $inum "[expand "*CTCP $command reply from *"]" # Die folgende Zeile sorgt dafür, daß eine durch ircII fehlerhaft # erzeugte Message (beim multiplen CTCP-Reply) herausgefiltert wird. FilterLine $inum "[expand "-$raw(nick)*\x01"]" append together "$ctcpline " } set right [expr $right+$left-1] set ctcpline "[string range "$last" $left $right]" set command "[lIndex "$ctcpline" 0]" set parameters "[cutwords "$ctcpline" 1]" set last "[string range "$last" 0 [expr $left-2]][string range "$last" [expr $right+2] end]" if {$l > 0} { FilterLine $inum "[expand "*CTCP $command reply from *"]" append together "; $ctcpline " } set upcommand "[string toupper "$command"]" ExecOnCommands ctcpreply $inum command "$upcommand" to "$to" rest "$parameters" } if {"$together" != ""} { set margin(text) "ctcp" if {$linetype != 0} { print2crap "--- MULTI-CTCP reply from $raw(nick): $together\x0f\x0f" } else { print2crap "--- MULTI-CTCP reply from $raw(nick) to $to: $together\x0f\x0f" } } if {$ctcps_within_message != 0 && "$last" == ""} { return } # Dann muß die Notice für mich oder einen Kanal bestimmt sein. set irc($inum,next,direct) 1 if {$linetype != 0} { set irc($inum,next,from) "$raw(nick)" AddToMsgHistory $irc($inum,crap) "[expandescape "$raw(nick)"]" if {[strcmp "$irc($inum,nick)" "$raw(nick)"]} { if {[string length "$away"]} { global chat_window_on_notice_when_away if {$chat_window_on_notice_when_away != 0} { set irc($inum,next,chatwin) "-new" } } else { global chat_window_on_notice_when_present if {$chat_window_on_notice_when_present != 0} { set irc($inum,next,chatwin) "-new" } } } set irc($inum,next,towin) "+$raw(nick)+\t$last" set irc($inum,next,right) [expr [set irc($inum,next,left) 1]+[string length "$raw(nick)"]] set irc($inum,next,pattern) "-[expand "$raw(nick)"]*" if {[string length "$away"]} { global show_address_on_notice_when_away if {$show_address_on_notice_when_away != 0} { set irc($inum,next,towin) "+$raw(nick)!$raw(address)+\t$last" } } else { global show_address_on_notice_when_present if {$show_address_on_notice_when_present != 0} { set irc($inum,next,towin) "+$raw(nick)!$raw(address)+\t$last" } } global show_address_on_notice_in_logfile if {$show_address_on_notice_in_logfile != 0} { set irc($inum,next,tolog) "+$raw(nick)!$raw(address)+ $last" } else { set irc($inum,next,tolog) "$irc($inum,next,towin)" } if {[string length "$away"]} { global beep_on_private_when_away if {$beep_on_private_when_away != 0} { set irc($inum,next,beep) 1 } } else { global beep_on_private_when_present if {$beep_on_private_when_present != 0} { set irc($inum,next,beep) 1 } } ExecOnCommands privnotice $inum to "$irc($inum,nick)" rest "$last" } else { set irc($inum,next,to) "$to" set irc($inum,next,pattern) "-[expand "$raw(nick)"]*" # Wenn sich der Kanal im Modus "no messages" befindet, wird # nicht weiter überprüft, ob der Benutzer auf dem Kanal ist. set cnum [ChannelNumber $inum "$to"] if {$cnum != -1} { if {$chan($cnum,mode_n) != 0 \ || [UserNumber $inum $cnum "$raw(nick)"] != -1} { global show_only_background_channels if {[llength "$win($on_args(window),channels)"] < 2 \ || $show_only_background_channels && [strcmp "$win($on_args(window),actual)" "$to"] == 0} { if {"$onotice" == ""} { set irc($inum,next,towin) "-$raw(nick)-\t$last" } else { set irc($inum,next,tolog) "-$raw(nick)+$onotice$to-\t$last" } } else { set irc($inum,next,towin) "-$raw(nick)+$onotice$to-\t$last" } if {"$onotice" == ""} { set irc($inum,next,tolog) "-$raw(nick)-\t$last" } else { set irc($inum,next,tolog) "-$raw(nick)+$onotice$to-\t$last" } set irc($inum,next,toall) "-$raw(nick)+$onotice$to-\t$last" } else { set irc($inum,next,towin) "-$raw(nick)»$onotice$to-\t$last" set irc($inum,next,tolog) "$irc($inum,next,towin)" set irc($inum,next,toall) "$irc($inum,next,towin)" } } if {[string length "$away"]} { global beep_on_public_when_away if {$beep_on_public_when_away != 0} { set irc($inum,next,beep) 1 } } else { global beep_on_public_when_present if {$beep_on_public_when_present != 0} { set irc($inum,next,beep) 1 } } ExecOnCommands pubnotice $inum to "$to" rest "$last" } } proc raw_WALLOPS {inum} { global irc raw cooked margin set to "[lindex "$raw(list)" 2]" set last "[coloncut "$raw(line)"]" set margin(text) "wallops" set irc($inum,next,filter) 1 set cooked(line) "*** ![lindex "$raw(list)" 0]! $last" } proc raw_TOPIC {inum} { global irc raw cooked chan margin set cnum [ChannelNumber $inum "[set channel "[lindex "$raw(list)" 2]"]"] if {[set wnum [WindowNumber $cnum]] == -1} { return } set last "[string range "[cutwords "$raw(line)" 3]" 1 end]" set chan($cnum,topic) "$last" set chan($cnum,topicnick) "$raw(nick)" set chan($cnum,topicdate) "[clock seconds]" UpdateTopic $wnum ExecOnCommands topic $inum channel "$channel" topic "$last" set margin(text) "topic" set cooked(line) "*** $raw(nick) has changed the topic on channel $channel to $last\x0f\x0f" } proc raw_NICK {inum} { global irc raw set last "[string range "[cutwords "$raw(line)" 2]" 1 end]" RenameUser $inum "$raw(nick)" "$last" if {[strcmp "$raw(nick)" "$irc($inum,nick)"] == 0} { set irc($inum,lastnick) "$irc($inum,nick)" set irc($inum,nick) "$last" UpdateAllInfos } ExecOnCommands nick $inum newnick "$last" } proc raw_KICK {inum} { global irc raw margin chan set cnum [ChannelNumber $inum "[set channel "[lindex "$raw(list)" 2]"]"] if {[set wnum [WindowNumber $cnum]] == -1} { return } set victim "[lindex "$raw(list)" 3]" set last "[string range "[cutwords "$raw(line)" 4]" 1 end]" if {[strcmp "$irc($inum,nick)" "$victim"]} { set margin(text) "kick" print2channels $cnum "*** $victim has been kicked off channel $channel by $raw(nick) ($last\x0f)\x0f\x0f" # Hier wird einem Kick möglicherweise vorhergehenden Ban die # Kickmeldung als Kommentar zugefügt. set unum [UserNumber $inum $cnum "$victim"] if {$unum != -1} { set address "[lindex "$chan($cnum,addresses)" $unum]" if {[string length "$address"]} { set len [llength "$chan($cnum,banpatterns)"] for {set j 0} {$j < $len} {incr j} { if {[strmatch "[lindex "$chan($cnum,banpatterns)" $j]" "$victim!$address"] && [expr [clock seconds]-[lindex "$chan($cnum,bantimes)" $j]] < 10} { set chan($cnum,bancomments) "[lreplace "$chan($cnum,bancomments)" $j $j "$last"]" if {[winfo exists .banlist]} { global banlist bancomments if {[strcmp "$banlist(channel)" "$chan($cnum)"] == 0} { set k [lsearch -exact "$banlist(new)" "[lindex "$chan($cnum,banpatterns)" $j]"] if {$k != -1} { multilistbox delete .banlist.list $k multilistbox insert .banlist.list $k "[lindex "$chan($cnum,banpatterns)" $j]" "[riddletext "$last"]" set bancomments(new) "[lreplace "$bancomments(new)" $k $k "$last"]" } set k [lsearch -exact "$banlist(old)" "[lindex "$chan($cnum,banpatterns)" $j]"] if {$k != -1} { set bancomments(old) "[lreplace "$bancomments(old)" $k $k "$last"]" } } } break } } } RemoveUserFromChannel $inum $cnum $unum $victim } } else { set margin(text) "kick" print2channels $cnum "*** You have been kicked off channel $channel by $raw(nick) ($last\x0f)\x0f\x0f" DeleteChannel $cnum global request_on_kick if {$request_on_kick != 0} { request "Do you want to rejoin channel $channel?" "Cancel|" "Join|send2tkirc $wnum \"[expandescape "[expand "/join $channel"]"]\"" } } ExecOnCommands kick $inum channel "$channel" victim "$victim" message "$last" } proc raw_MODE {inum} { global irc raw cooked margin if {[strcmp "$irc($inum,nick)" "[lindex "$raw(list)" 2]"]} { set cnum [ChannelNumber $inum "[set channel "[lindex "$raw(list)" 2]"]"] if {[set wnum [WindowNumber $cnum]] == -1} { return } set modes "[cutwords "$raw(line)" 3]" SetChannelModes $cnum "$modes" 1 "$raw(nick)!$raw(address)" UpdateInfos $wnum set margin(text) "mode" set tmp "*** Mode change \"$modes\" on channel $channel by" if {[string length "$raw(nick)"]} { set cooked(line) "$tmp $raw(nick)\x0f\x0f" } else { set cooked(line) "$tmp $raw(address)\x0f\x0f" } } else { set modes "[string range "[cutwords "$raw(line)" 3]" 1 end]" SetUserModes $inum "$modes" set margin(text) "mode" set tmp "*** Mode change \"$modes\" for user $irc($inum,nick) by" set cooked(line) "$tmp $raw(address)\x0f\x0f" } } proc raw_INVITE {inum} { global irc raw cooked away margin if {[strcmp "$irc($inum,nick)" "[lindex "$raw(list)" 2]"] == 0} { if {[string length "$away"]} { global beep_on_invite_when_away if {$beep_on_invite_when_away != 0} { beep } } else { global beep_on_invite_when_present if {$beep_on_invite_when_present != 0} { beep } } set last "[string range "[cutwords "$raw(line)" 3]" 1 end]" ExecOnCommands invite $inum channel "$last" global request_on_invite if {$request_on_invite != 0} { request "$raw(nick) ($raw(address)) invites you to channel $last. Do you want to join that channel?" "Cancel|" "Join|send2tkirc $irc($inum,crap) \"[expandescape "[expand "/wjoin $last"]"]\"" } set margin(text) "invite" set irc($inum,next,filter) 1 set cooked(line) "*** $raw(nick) ($raw(address)) invites you to channel $last\x0f\x0f" } } proc parseons {inum line} { global irc raw win channel away destlog margin on_args linetype set linetype 0 set nick "$irc($inum,nick)" # Eigene Hilfsinformationen durch '/on' set list "[line2list "$line"]" set type "[string range "[lindex "$list" 0]" 1 end]" switch -exact -- "$type" { {send_public} { set to [lindex "$list" 1] set destlog "channel $to" set last "[cutwords "$line" 2]" set raw(line) "$nick!$irc($inum,address) PRIVMSG $to :$last" ExecOnCommands pubmessage $inum nick "$irc($inum,nick)" address "$irc($inum,address)" to "$to" rest "$last" if {[WindowNumber $inum "$to"] == -1} { set on_args(window) $irc($inum,mesg) return "<$nick»$to>\t$last" } else { global show_only_background_channels if {[llength "$win($on_args(window),channels)"] < 2 \ || $show_only_background_channels && [strcmp "$win($on_args(window),actual)" "$to"] == 0} { set irc($inum,notice_toall) 1 set irc($inum,next,toall) "<$nick+$to>\t$last" return "<$nick>\t$last" } else { return "<$nick+$to>\t$last" } } } {send_msg} { set linetype 1 set to [lindex "$list" 1] set destlog "query $to" set last "[cutwords "$line" 2]" set raw(line) "$nick!$irc($inum,address) PRIVMSG $to :$last" ExecOnCommands privmessage $inum nick "$irc($inum,nick)" address "$irc($inum,address)" to "$to" rest "$last" set on_args(window) [GetQueryWindow $inum $to] return "*»$to*\t$last" } {send_dcc_chat} { set linetype 1 set to [lindex "$list" 1] set destlog "query $to" set last "[cutwords "$line" 2]" set on_args(window) [GetQueryWindow $inum =$to] return "=»$to=\t$last" } {dcc_chat} { set linetype 1 set from [lindex "$list" 1] set destlog "query $from" set last "[cutwords "$line" 2]" set on_args(window) [GetQueryWindow $inum =$from] if {[string length "$away"]} { global beep_on_private_when_away if {$beep_on_private_when_away != 0} { set irc($inum,next,beep) 1 } } else { global beep_on_private_when_present if {$beep_on_private_when_present != 0} { set irc($inum,next,beep) 1 } } return "=$from=\t$last" } {send_action} { set to [lindex "$list" 1] set last "[cutwords "$line" 2]" set raw(line) "$nick!$irc($inum,address) PRIVMSG $to :\x01\ACTION $last\x01" if [IsChannel "$to"] { set destlog "channel $to" ExecOnCommands pubaction $inum nick "$irc($inum,nick)" address "$irc($inum,address)" to "$to" rest "$last" if {[WindowNumber $inum "$to"] == -1} { set on_args(window) $irc($inum,mesg) return "* $nick»$to\t$last" } else { global show_only_background_channels if {[llength "$win($on_args(window),channels)"] < 2 \ || $show_only_background_channels && [strcmp "$win($on_args(window),actual)" "$to"] == 0} { set irc($inum,notice_toall) 1 set irc($inum,next,toall) "* $nick+$to\t$last" return "* $nick\t$last" } else { return "* $nick+$to\t$last" } } } else { set destlog "query $to" ExecOnCommands privaction $inum nick "$irc($inum,nick)" address "$irc($inum,address)" to "$to" rest "$last" set linetype 1 set on_args(window) [GetQueryWindow $inum $to] return "**»$to\t$nick $last" } } {send_notice} { set to [lindex "$list" 1] set last "[cutwords "$line" 2]" set raw(line) "$nick!$irc($inum,address) NOTICE $to :$last" if [IsChannel "$to"] { set destlog "channel $to" ExecOnCommands pubnotice $inum nick "$irc($inum,nick)" address "$irc($inum,address)" to "$to" rest "$last" if {[WindowNumber $inum "$to"] == -1} { set on_args(window) $irc($inum,mesg) return "-$nick»$to-\t$last" } else { global show_only_background_channels if {[llength "$win($on_args(window),channels)"] < 2 \ || $show_only_background_channels && [strcmp "$win($on_args(window),actual)" "$to"] == 0} { set irc($inum,notice_toall) 1 set irc($inum,next,toall) "-$nick+$to-\t$last" return "-$nick-\t$last" } else { return "-$nick+$to-\t$last" } } } else { set destlog "query $to" ExecOnCommands privnotice $inum nick "$irc($inum,nick)" address "$irc($inum,address)" to "$to" rest "$last" set on_args(window) [GetQueryWindow $inum $to] return "+»$to+\t$last" } } {disconnect} { Disconnected $inum } {notify_signon} { DetectUserOnIRC $inum [lindex "$list" 1] 1 0 return "" } {notify_signoff} { DetectUserOnIRC $inum [lindex "$list" 1] 0 0 return "" } {dcc_list_start} { set irc($inum,receiving_list) "dcc_list" return "" } {dcc_list_stop} { set irc($inum,receiving_list) "" return "" } } return "$line" } ################## # Main Windows # ################## proc UpdateInfos {num} { global irc chan win CHANNEL_NAME_WIDTH if {[IsFakeWindow $num] || [WindowDoesNotExist $num]} { return } set path "[GetWindowPath $num]" set inum $win($num,irc) set cnum [ChannelNumber $inum "[set channel [GetActual $num]]"] set serv "$irc($win($num,irc),serv)" # Bei einem Disconnect wird der Kanalname auf "*" gesetzt. if {"$serv" == "" && "$channel" != "*" || $cnum == -1} { set win($num,actual) "*" set channel "*" } set len [expr $CHANNEL_NAME_WIDTH-2] if {[strcmp "$channel" "[$path.body.right.top.channel cget -text]"]} { # Der dargestellte Kanalname muß aktualisiert werden. if {[string length "$channel"] > $CHANNEL_NAME_WIDTH} { $path.body.right.top.channel configure -text "[string range "$channel" 0 [expr $len-1]]»" } else { $path.body.right.top.channel configure -text "$channel" } $path.body.right.list.users delete 0 end $path.body.right.top.count configure -text "-" if {"$channel" != "*"} { FillUserList $num $cnum } } if {"$channel" != "*"} { foreach x "t s p n m i" { if {$chan($cnum,mode_$x) != 0} { $path.menu.$x configure -fg #111111 -text "$x" } else { $path.menu.$x configure -fg #888888 -text "$x" } } $path.menu.o configure -text "o=$chan($cnum,mode_o)" -fg #111111 $path.menu.v configure -text "v=$chan($cnum,mode_v)" -fg #111111 $path.menu.b configure -text "b=$chan($cnum,mode_b)" -fg #111111 foreach x "l k" { if {"$chan($cnum,mode_$x)" != ""} { $path.menu.$x configure -fg #111111 -text "$x" } else { $path.menu.$x configure -fg #888888 -text "$x" } } } else { PrintModeChars $num "" } UpdateTopic $num UpdateTitle $num # update list of joined channels set f $path.body.right.top.channel $f configure -menu "" -underline -1 $f.menu delete 0 end set count 0 set win($num,channels) "" foreach x "$chan(list)" { if {$num == $chan($x,window)} { $f.menu add command -label "$chan($x)"\ -command "write2irc $win($num,irc) \"[expand "/join $chan($x)"]\"" lappend win($num,channels) "$x" incr count } } if {$count > 1} { $f configure -menu $f.menu -underline 0 } } proc UpdateAllInfos { } { global win foreach x "$win(list)" { UpdateInfos $x } } proc UpdateTitle {num} { global irc chan win away if {[IsFakeWindow $num] || [WindowDoesNotExist $num]} { return } set path "[GetWindowPath $num]" set inum $win($num,irc) set nick "$irc($inum,nick)" set serv "$irc($inum,serv)" set actual -1 set ochannels "" foreach x "$win($num,channels)" { if {[strcmp "$chan($x)" "$win($num,actual)"] == 0} { set actual "$x" } else { if {"$ochannels" == ""} { append ochannels "$chan($x)" } else { append ochannels ",$chan($x)" } } } set query "$win($num,query)" set title " $num" set icontitle "tkirc\($num" if {$irc($inum,mesg) == $num} { append title "m" append icontitle "m" } if {$irc($inum,crap) == $num} { append title "c" append icontitle "c" } set pre "" if {$actual != -1} { if {[isOpOnChannel $actual "$nick"]} { set pre "@" } elseif {[hasVoiceOnChannel $actual "$nick"]} { set pre "+" } } append title " : " append icontitle "\)" if {[string length "$serv"]} { append title "$serv (#$inum)" } else { append title " (#$inum)" } append title " : $pre$nick" if {"$query" != ""} { append title " \[Query: $query\]" } if {$actual != -1} { append title "$away on $chan($actual)" if {"$ochannels" != ""} { append title " ($ochannels)" } } else { append title "$away on *" } wm title $path " $title " if {$win($num,touched) != 0} { set icontitle " + $icontitle + " } else { set icontitle " - $icontitle - " } wm iconname $path "$icontitle" } proc UpdateAllTitles { } { global win foreach x "$win(list)" { UpdateTitle $x } } proc UpdateTopic {num} { global irc chan win if {[IsFakeWindow $num] || [WindowDoesNotExist $num]} { return } set path "[GetWindowPath $num]" set inum $win($num,irc) set cnum [ChannelNumber $inum "[set channel [GetActual $num]]"] if {[string compare "$path.body.left.topic.entry" "[focus]"] == 0} { return } if {"$channel" == "*"} { if {[string length "[$path.body.left.topic.entry get]"]} { $path.body.left.topic.entry configure -state normal $path.body.left.topic.entry delete 0 end $path.body.left.topic.entry configure -state disabled } } else { set topic "[cutEscapeCodes "$chan($cnum,topic)"]" if {[string compare "$topic" "[$path.body.left.topic.entry get]"]} { $path.body.left.topic.entry configure -state normal $path.body.left.topic.entry delete 0 end $path.body.left.topic.entry insert 0 "$topic" } if {[isOpOnChannel $cnum "$irc($inum,nick)"] || $chan($cnum,mode_t) == 0} { $path.body.left.topic.entry configure -state normal } else { $path.body.left.topic.entry configure -state disabled } } } proc PrintModeChars {num text} { global win if {[IsFakeWindow $num] || [WindowDoesNotExist $num]} { return } set path "[GetWindowPath $num]" set nochannel "no channel" set flags "o v b k l i m n p s t" if {[string length "$text"]} { for {set i 0} {$i < 10} {incr i} { $path.menu.[lindex "$flags" $i] configure -fg #111111 -text "" } $path.menu.[lindex "$flags" 10] configure -fg #111111 -text "$text" } else { for {set i 0} {$i < [llength "$flags"]} {incr i} { $path.menu.[lindex "$flags" $i] configure -fg #111111 -text "[string index "$nochannel" $i]" } } } global huibu if {![info exists huibu]} { set huibu 0 } proc huibu {type} { global win huibu if {$type == 0} { set huibu 0 return } elseif {$type == 1} { if {$huibu == 0} { set huibu 1 } else { return } } set huibulist { "Call the police!" "N e r v o u s ?" "T e n s e ?" "T i r e d ?" "Do not disturb!" "Leave IRC!" "Go home!" } if {$huibu != 0} { set len [llength "$win(list)"] if {$len > 0} { set num [lindex "$win(list)" [expr [clock seconds]%$len]] PrintModeChars $num "[lindex "$huibulist" [expr [clock seconds]%[llength "$huibulist"]]] " after 2500 "UpdateInfos $num" } after [expr 60000*42+1000] "huibu 2" } } proc IsChannel {channel} { return [regexp -- {^(\#|&|\+|\!).*} "$channel"] } proc IsAlive {inum} { global irc if {[lsearch -exact "$irc(list)" $inum] != -1} { return 1 } return 0 } proc IsFakeWindow {num} { global win if {$num >= 500} { return 1 } return 0 } proc WindowDoesNotExist {num} { global win if {[lsearch -exact "$win(list)" "$num"] == -1} { return 1 } elseif {![winfo exists [GetWindowPath $num]]} { return 1 } return 0 } proc GetWindowPath {num} { return ".win$num" } proc UseMargin {wnum} { set widget [GetWindowPath $wnum].body.left.traffic.text set end "[lindex "[$widget yview]" 1]" redrawMargin $wnum if {$end == 1} { $widget yview end } } proc InitMenu {num} { global irc win set inum $win($num,irc) set path "[GetWindowPath $num]" Frame $path.menu -bd 1 # Project set f $path.menu.project Menubutton $f -text "Project" -menu $f.menu -bd 0 -underline 0 Menu $f.menu $f.menu add command -label "About" -command "About $num" $f.menu add separator $f.menu add command -label "Set message window" \ -command "set irc($inum,mesg) $num ; UpdateAllTitles" $f.menu add command -label "Set crap window" \ -command "set irc($inum,crap) $num ; UpdateAllTitles" $f.menu add cascade -label "Open window" -menu $f.menu.windows Menu $f.menu.windows $f.menu.windows add command -label "normal traffic" \ -command "global win ; MainWindow \$win($num,irc) -1" $f.menu.windows add command -label "notified users" \ -command "NotifyWindow" $f.menu.windows add command -label "suspected users" \ -command "SuspectWindow" $f.menu.windows add command -label "lag times" \ -command "LagWindow $num" $f.menu.windows add command -label "detected messageIDs" \ -command "MsgIDWindow" $f.menu.windows add command -label "detected URLs" \ -command "URLWindow" $f.menu add separator $f.menu add cascade -label "Clear" -menu $f.menu.clear Menu $f.menu.clear $f.menu.clear add command -label "this window" \ -command "ClearMainWindow $num" $f.menu.clear add command -label "all windows" \ -command {global win ; foreach x "$win(list)" {ClearMainWindow $x}} $f.menu add command -label "Reload tkircrc" \ -command "ReloadTKircRC {} ; RefreshMainWindows" $f.menu add command -label "Save buffer..." \ -command "SaveBuffer $num {}" $f.menu add cascade -label "Log" -menu $f.menu.log Menu $f.menu.log $f.menu.log add command -label "list" \ -command "send2tkirc $num {/log}" $f.menu.log add separator $f.menu.log add command -label "crap..." \ -command "send2tkirc $num {/log crap to :file}" $f.menu.log add command -label "messages..." \ -command "send2tkirc $num {/log messages to :file}" $f.menu.log add command -label "this window..." \ -command "send2tkirc $num {/log window $num to :file}" $f.menu.log add command -label "this connection..." \ -command "send2tkirc $num \"/log all to :file\"" $f.menu add separator $f.menu add command -label "New server..." -command "ServersWindow -1" $f.menu add command -label "Change server..." -command "ServersWindow $inum" $f.menu add command -label "Disconnect" -command "send2tkirc $num {/disconnect}" $f.menu add separator $f.menu add command -label "Close" -command "CloseMainWindow $num" $f.menu add cascade -label "Signoff with message" -menu $f.menu.quit Menu $f.menu.quit $f.menu add command -label "Exit" -command "Exit -1 {}" pack $f -side left -pady 0 -ipady 0 # Prefs set f $path.menu.prefs Menubutton $f -text "Prefs" -menu $f.menu -bd 0 -underline 1 Menu $f.menu $f.menu add cascade -label "Beep" -menu $f.menu.beep Menu $f.menu.beep $f.menu.beep add cascade -label "on private" -menu $f.menu.beep.priv Menu $f.menu.beep.priv $f.menu.beep.priv add checkbutton -label "when present" \ -variable beep_on_private_when_present $f.menu.beep.priv add checkbutton -label "when away" \ -variable beep_on_private_when_away $f.menu.beep add cascade -label "on public" -menu $f.menu.beep.pub Menu $f.menu.beep.pub $f.menu.beep.pub add checkbutton -label "when present" \ -variable beep_on_public_when_present $f.menu.beep.pub add checkbutton -label "when away" \ -variable beep_on_public_when_away $f.menu.beep add cascade -label "on invite" -menu $f.menu.beep.inv Menu $f.menu.beep.inv $f.menu.beep.inv add checkbutton -label "when present" \ -variable beep_on_invite_when_present $f.menu.beep.inv add checkbutton -label "when away" \ -variable beep_on_invite_when_away $f.menu.beep add cascade -label "on ctrl-g" -menu $f.menu.beep.ctrlG Menu $f.menu.beep.ctrlG $f.menu.beep.ctrlG add checkbutton -label "when present" \ -variable beep_on_ctrlG_when_present $f.menu.beep.ctrlG add checkbutton -label "when away" \ -variable beep_on_ctrlG_when_away $f.menu add cascade -label "Show address" -menu $f.menu.show Menu $f.menu.show $f.menu.show add cascade -label "on message" -menu $f.menu.show.mes Menu $f.menu.show.mes $f.menu.show.mes add checkbutton -label "when present" \ -variable show_address_on_message_when_present $f.menu.show.mes add checkbutton -label "when away" \ -variable show_address_on_message_when_away $f.menu.show.mes add checkbutton -label "in logfile" \ -variable show_address_on_message_in_logfile $f.menu.show add cascade -label "on notice" -menu $f.menu.show.not Menu $f.menu.show.not $f.menu.show.not add checkbutton -label "when present" \ -variable show_address_on_notice_when_present $f.menu.show.not add checkbutton -label "when away" \ -variable show_address_on_notice_when_away $f.menu.show.not add checkbutton -label "in logfile" \ -variable show_address_on_notice_in_logfile $f.menu add cascade -label "Show time" -menu $f.menu.time Menu $f.menu.time $f.menu.time add cascade -label "on private" -menu $f.menu.time.priv Menu $f.menu.time.priv $f.menu.time.priv add checkbutton -label "when present" \ -variable show_time_on_private_when_present $f.menu.time.priv add checkbutton -label "when away" \ -variable show_time_on_private_when_away $f.menu.time add cascade -label "on public" -menu $f.menu.time.pub Menu $f.menu.time.pub $f.menu.time.pub add checkbutton -label "when present" \ -variable show_time_on_public_when_present $f.menu.time.pub add checkbutton -label "when away" \ -variable show_time_on_public_when_away $f.menu.time add separator $f.menu.time add checkbutton -label "on each line" \ -variable show_time_on_each_line($num) $f.menu add cascade -label "Chat window" -menu $f.menu.chat Menu $f.menu.chat $f.menu.chat add cascade -label "on message" -menu $f.menu.chat.mes Menu $f.menu.chat.mes $f.menu.chat.mes add checkbutton -label "when present" \ -variable chat_window_on_message_when_present $f.menu.chat.mes add checkbutton -label "when away" \ -variable chat_window_on_message_when_away $f.menu.chat add cascade -label "on notice" -menu $f.menu.chat.not Menu $f.menu.chat.not $f.menu.chat.not add checkbutton -label "when present" \ -variable chat_window_on_notice_when_present $f.menu.chat.not add checkbutton -label "when away" \ -variable chat_window_on_notice_when_away $f.menu add cascade -label "Request window" -menu $f.menu.request Menu $f.menu.request $f.menu.request add checkbutton -label " on dcc chat" \ -variable request_on_dcc_chat $f.menu.request add checkbutton -label " on dcc send" \ -variable request_on_dcc_send $f.menu.request add checkbutton -label " on invite" \ -variable request_on_invite $f.menu.request add checkbutton -label " on kick" \ -variable request_on_kick $f.menu add cascade -label "Use active window" -menu $f.menu.active Menu $f.menu.active $f.menu.active add checkbutton -label " for crap" \ -variable crap_to_active_window $f.menu.active add checkbutton -label " for messages" \ -variable messages_to_active_window $f.menu add separator $f.menu add cascade -label "Set colors" -menu $f.menu.color Menu $f.menu.color ; global color foreach x "$color(options)" { set y "[string trimleft "$x" "-"]" $f.menu.color add command -label "$y... " -command "chooseColor $x" } $f.menu.color add separator $f.menu.color add cascade -label "ANSI colors" -menu $f.menu.ansi Menu $f.menu.ansi $f.menu.ansi add radiobutton -label "off" -variable color(ansi) $f.menu.ansi add radiobutton -label "mono" -variable color(ansi) $f.menu.ansi add radiobutton -label "full" -variable color(ansi) $f.menu.color add cascade -label "mIRC colors" -menu $f.menu.mirc Menu $f.menu.mirc $f.menu.mirc add radiobutton -label "off" -variable color(mirc) $f.menu.mirc add radiobutton -label "mono" -variable color(mirc) $f.menu.mirc add radiobutton -label "full" -variable color(mirc) $f.menu.color add separator $f.menu.color add command -label "default colors" -command "setDefaultColors" $f.menu add cascade -label "Set fonts" -menu $f.menu.font Menu $f.menu.font ; global font foreach x "[lsort "[array names font _*_]"]" { set class "[string trim "$x" "_"]" set index "[string tolower "$class"]" $f.menu.font add command -label "$index... " -command "chooseFont $class" } $f.menu.font add separator $f.menu.font add command -label "default fonts" -command "setDefaultFonts" $f.menu add checkbutton -label "Silence" -variable silence $f.menu add separator $f.menu add cascade -label "Hide" -menu $f.menu.hide Menu $f.menu.hide $f.menu.hide add checkbutton -label " joins" \ -variable hide_joins($num) $f.menu.hide add checkbutton -label " leaves" \ -variable hide_leaves($num) $f.menu.hide add checkbutton -label " signoffs" \ -variable hide_signoffs($num) $f.menu add cascade -label "Show" -menu $f.menu.show2 Menu $f.menu.show2 $f.menu.show2 add checkbutton -label " commandline" \ -command "AddOrRemoveCmdLine $num" -variable show_commandline($num) $f.menu.show2 add checkbutton -label " topic" \ -command "AddOrRemoveTopic $num" -variable show_topic($num) $f.menu.show2 add checkbutton -label " userlist" \ -command "AddOrRemoveUserList $num" -variable show_userlist($num) $f.menu add cascade -label "Margin" -menu $f.menu.margin Menu $f.menu.margin $f.menu.margin add checkbutton -label " use margin" \ -command "UseMargin $num" -variable use_margin($num) $f.menu.margin add checkbutton -label " display types" \ -variable display_types($num) $f.menu add cascade -label "Sort userlist" -menu $f.menu.sortul Menu $f.menu.sortul $f.menu.sortul add checkbutton -label " alphabeticly" \ -variable sort_userlist_alphabeticly($num) -command "FillUserList $num -1" $f.menu.sortul add checkbutton -label " by channelmodes" \ -variable sort_userlist_by_channelmodes($num) -command "FillUserList $num -1" $f.menu add checkbutton -label "Auto popup" -variable auto_popup($num) $f.menu add separator $f.menu add command -label "Save preferences..." -command "savePrefs $num {}" pack $f -side left -pady 0 -ipady 0 # User set f $path.menu.user Menubutton $f -text "User" -menu $f.menu -bd 0 -underline 0 Menu $f.menu $f.menu add cascade -label "ctcp" -menu $f.menu.ctcp Menu $f.menu.ctcp $f.menu.ctcp add command -label "clientinfo" \ -command "selected $num ctcp clientinfo" $f.menu.ctcp add command -label "finger" \ -command "selected $num ctcp finger" $f.menu.ctcp add command -label "ping" \ -command "selected $num ctcp ping \[clock seconds\]" $f.menu.ctcp add command -label "time" \ -command "selected $num ctcp time" $f.menu.ctcp add command -label "userinfo" \ -command "selected $num ctcp userinfo" $f.menu.ctcp add command -label "version" \ -command "selected $num ctcp version" $f.menu add cascade -label "dcc" -menu $f.menu.dcc Menu $f.menu.dcc $f.menu.dcc add command -label "list" \ -command "global win ; write2irc \$win($num,irc) {/dcc list}" $f.menu.dcc add separator $f.menu.dcc add command -label "chat" -command "selected $num dchat" $f.menu.dcc add command -label "send..." -command "selected $num dsend" $f.menu add command -label "chat" -command "selected $num chat" \ -accelerator alt+c $f.menu add command -label "who" -command "selected $num who" \ -accelerator alt+w $f.menu add command -label "whois" -command "selected $num whois" \ -accelerator alt+i $f.menu add command -label "query" -command "selected $num query" \ -accelerator alt+q $f.menu add command -label "unquery" -command "parsein $num /query" \ -accelerator alt+y $f.menu add command -label "op" -command "selected $num op" \ -accelerator alt+o $f.menu add command -label "deop" -command "selected $num deop" \ -accelerator alt+d $f.menu add command -label "give voice" -command "selected $num voice" \ -accelerator alt+v $f.menu add command -label "remove voice " -command "selected $num unvoice" \ -accelerator alt+e $f.menu add command -label "ignore" -command "selected $num ignore" $f.menu add command -label "unignore" -command "selected $num unignore" $f.menu add command -label "ban..." -command "selected $num ban" \ -accelerator alt+b $f.menu add command -label "kick..." -command "selected $num kick" \ -accelerator alt+k pack $f -side left -pady 0 -ipady 0 # Popup für den Nickname von privaten Messages/Notices set f $path.menu.popup Menubutton $f -text "User" -menu $f.menu -bd 0 -underline 0 Menu $f.menu -tearoff 0 $f.menu add separator $f.menu add cascade -label "ctcp" -menu $f.menu.ctcp Menu $f.menu.ctcp -tearoff 0 $f.menu.ctcp add separator $f.menu.ctcp add command -label "clientinfo" \ -command "selected $num clientinfo" $f.menu.ctcp add command -label "finger" \ -command "selected $num finger" $f.menu.ctcp add command -label "ping" \ -command "selected $num ping \[clock seconds\]" $f.menu.ctcp add command -label "time" \ -command "selected $num time" $f.menu.ctcp add command -label "userinfo" \ -command "selected $num userinfo" $f.menu.ctcp add command -label "version" \ -command "selected $num version" $f.menu add cascade -label "dcc" -menu $f.menu.dcc Menu $f.menu.dcc -tearoff 0 $f.menu.dcc add separator $f.menu.dcc add command -label "chat" -command "selected $num dchat" $f.menu.dcc add command -label "list" \ -command "global win ; write2irc \$win($num,irc) {/dcc list}" $f.menu.dcc add command -label "send..." -command "selected $num dsend" $f.menu add command -label "chat" -command "selected $num chat" $f.menu add command -label "who" -command "selected $num who" $f.menu add command -label "whois" -command "selected $num whois" $f.menu add command -label "ignore" -command "selected $num ignore" # Channel set f $path.menu.channel Menubutton $f -text "Channel" -menu $f.menu -bd 0 -underline 1 Menu $f.menu $f.menu add cascade -label "join" -menu $f.menu.join Menu $f.menu.join $f.menu add cascade -label "wjoin" -menu $f.menu.wjoin Menu $f.menu.wjoin $f.menu add command -label "leave" -command "send2tkirc $num {/leave *}" $f.menu add cascade -label "part with msg" -menu $f.menu.part Menu $f.menu.part $f.menu add command -label "rejoin" -command "RejoinChannel $num" $f.menu add command -label "baninfos" -command "send2tkirc $num {/baninfos *}" $f.menu add command -label "invite..." -command "InviteToChannel $num" $f.menu add command -label "log..." -command "LogChannel $num {}" $f.menu add command -label "set modes..." -command "ChannelModesWindow $num" $f.menu add command -label "edit banlist..." -command "BanListWindow $num" $f.menu add cascade -label "set topic" -menu $f.menu.topic Menu $f.menu.topic pack $f -side left -pady 0 -ipady 0 # Personal set f $path.menu.personal Menubutton $f -text "Personal" -menu $f.menu -bd 0 -underline 5 Menu $f.menu $f.menu add cascade -label "set mode" -menu $f.menu.mode Menu $f.menu.mode $f.menu.mode add checkbutton -label restricted \ -variable win($num,mode,r) -state disabled foreach x "{i {invisible}} {w wallops} {s {server notices}}" { $f.menu.mode add checkbutton -label [lindex "$x" 1] \ -command "ChangeUserMode $num [lindex "$x" 0]" \ -variable win($num,mode,[lindex "$x" 0]) } $f.menu add cascade -label "set nickname" -menu $f.menu.nick Menu $f.menu.nick $f.menu add cascade -label "mark away" -menu $f.menu.away Menu $f.menu.away $f.menu add command -label "unmark away" -command "send2tkirc 0 \"/away\"" pack $f -side left -pady 0 -ipady 0 # Server set f $path.menu.server Menubutton $f -text "Server" -menu $f.menu -bd 0 -underline 0 Menu $f.menu $f.menu add command -label "connections" -command "send2tkirc $num {/trace} ; FilterLine $inum \{262?* End of TRACE\}" $f.menu add command -label "date" -command "send2tkirc $num {/date}" $f.menu add command -label "info" -command "send2tkirc $num {/quote info}" $f.menu add command -label "lusers" -command "send2tkirc $num {/lusers}" $f.menu add command -label "motd" -command "send2tkirc $num {/motd}" $f.menu add command -label "uptime" -command "send2tkirc $num {/stats u}" $f.menu add command -label "version" -command "send2tkirc $num {/quote version}" $f.menu add command -label "change server..." -command "ServersWindow $inum" $f.menu add command -label "disconnect" -command "send2tkirc $num {/disconnect}" pack $f -side left -pady 0 -ipady 0 set f $path.menu.private Menubutton $f -text "Private" -menu $f.menu -bd 0 -underline 0 Menu $f.menu pack $f -side left -pady 0 -ipady 0 # Channel modes foreach x "t s p n m i l k b v o" { Label $path.menu.$x pack $path.menu.$x -side right } PrintModeChars $num "" pack $path.menu -fill x } proc RefreshMenu {num} { global preferred_channels preferred_awayreasons global preferred_signoffmessages preferred_partmessages global preferred_topics preferred_nicknames global on_args set path "[GetWindowPath $num]" # Project set f $path.menu.project $f.menu.quit delete 0 end foreach x "$preferred_signoffmessages" { $f.menu.quit add command -label "$x" \ -command "global win ; Exit \$win($num,irc) \"$x\"" } $f.menu.quit add separator $f.menu.quit add command -label "other..." -command "LeaveServer $num" # Prefs # User # Channel set f $path.menu.channel $f.menu.join delete 0 end foreach x "$preferred_channels" { $f.menu.join add command -label "$x" \ -command "send2tkirc $num \"[expandescape "[expand "/join $x"]"]\"" } $f.menu.join add separator $f.menu.join add command -label "other..." -command "JoinChannel $num" $f.menu.wjoin delete 0 end foreach x "$preferred_channels" { $f.menu.wjoin add command -label "$x" \ -command "send2tkirc $num \"[expandescape "[expand "/wjoin $x"]"]\"" } $f.menu.wjoin add separator $f.menu.wjoin add command -label "other..." -command "WJoinChannel $num" set f $path.menu.channel $f.menu.part delete 0 end foreach x "$preferred_partmessages" { $f.menu.part add command -label "$x" \ -command "LeaveChannel $num $x" } $f.menu.part add separator $f.menu.part add command -label "other..." -command "LeaveChannel $num" $f.menu.topic delete 0 end foreach x "$preferred_topics" { $f.menu.topic add command -label "$x" \ -command "send2tkirc $num \"[expandescape "[expand "/topic * $x"]"]\"" } $f.menu.topic add separator $f.menu.topic add command -label "other..." -command "SetTopic $num" # Personal set f $path.menu.personal $f.menu.nick delete 0 end for {set i 0} {$i < [llength "$preferred_nicknames"]} {incr i} { set x "[lindex "$preferred_nicknames" $i]" $f.menu.nick add command -label "$x"\ -command "send2tkirc $num \"/nick [expandescape "[expand "$x"]"]\"" } $f.menu.nick add separator $f.menu.nick add command -label "other..." -command "SetNick $num" $f.menu.away delete 0 end foreach x "$preferred_awayreasons" { $f.menu.away add command -label "$x"\ -command "send2tkirc $num \"/away [expandescape "[expand "$x"]"]\"" } $f.menu.away add separator $f.menu.away add command -label "other..." -command "SetAway $num" # Server # Private menus set f $path.menu.private if [winfo exists $f] { pack forget $f ; destroy $f } Menubutton $f -text "Private" -menu $f.menu -bd 0 -underline 0 Menu $f.menu pack $f -side left -pady 0 -ipady 0 foreach x "[lsort "[info commands "on_menucreate*"]"]" { set on_args(path) "$path.menu" set on_args(window) $num $x } } proc GetTopic {wnum} { global chan margin win set inum $win($wnum,irc) set cnum [ChannelNumber $inum "$win($wnum,actual)"] if {$cnum != -1} { set margin(text) "topic" print2text $wnum "*** Topic for $chan($cnum): $chan($cnum,topic)" if {"$chan($cnum,topicnick)" != ""} { set margin(text) "extra" print2text $wnum "[clock format $chan($cnum,topicdate) -format "*** Topic was set by $chan($cnum,topicnick) on %y-%m-%d at %H:%M:%S"]" } } } proc SendTopic {num} { global margin escape_sign if {[strcmp "*" "[GetActual $num]"]} { set path "[GetWindowPath $num]" set topic "[$path.body.left.topic.entry get]" global topic_limit set len [string length "[strreplace "$topic" "$escape_sign" ""]"] if {$len > $topic_limit} { beep set margin(text) "error" print2text $num "--- Topic has $len chars, but topic_limit is set to $topic_limit." Focus $path.body.left.topic.entry } else { send2tkirc $num "/topic [expandescape "[GetActual $num]"] $topic" Focus $path.cmdline } } } proc InitTopic {num} { set f "[GetWindowPath $num].body.left.topic" Frame $f Menubutton $f.label -text " Topic: " -bd 0 -underline 1 Entry $f.entry -bd 0 -state disabled pack $f.label -side left bind $f.label "GetTopic $num" pack $f.entry -side left -expand true -fill x bind $f.entry "SendTopic $num" bind $f.entry "UpdateTopic $num" } proc AddOrRemoveTopic {num} { set path "[GetWindowPath $num]" set widget "$path.body.left.traffic.text" set end "[lindex "[$widget yview]" 1]" global show_topic if {$show_topic($num) != 0} { pack forget $path.body.left.traffic pack $path.body.left.topic -fill x pack $path.body.left.traffic -expand true -fill both \ -padx 0 -ipadx 0 if {$end == 1} { # after 150 $widget yview end $widget yview end } } else { pack forget $path.body.left.topic } } proc InitCmdLine {num} { set f "[GetWindowPath $num]" Entry $f.cmdline bind $f.cmdline "+entry2irc $num" bind $f.cmdline "entry2history $num" bind $f.cmdline "HistoryUp $num" bind $f.cmdline "HistoryDown $num" bind $f.cmdline "CompleteOrReplace $num ; $f.cmdline xview insert" bind $f.cmdline "MsgHistoryUp $num" bind $f.cmdline "MsgHistoryUp $num" } proc AddOrRemoveCmdLine {num} { set path "[GetWindowPath $num]" set widget "$path.body.left.traffic.text" set end "[lindex "[$widget yview]" 1]" global show_commandline if {$show_commandline($num) != 0} { pack forget $path.body pack $path.cmdline -side bottom -fill x pack $path.body -expand true -fill both Focus $path.cmdline if {$end == 1} { # after 150 $widget yview end $widget yview end } } else { pack forget $path.cmdline } } proc InitUserList {num} { if {[IsFakeWindow $num] || [WindowDoesNotExist $num]} { return } set frame "[GetWindowPath $num].body.right" Frame $frame -bd 1 -relief sunken Frame $frame.top -bd 0 pack $frame.top -fill x -pady 0 -ipady 0 Menubutton $frame.top.channel -text "[GetActual $num]" -bd 0 \ -menu "" Menu $frame.top.channel.menu pack $frame.top.channel -fill x -side left -pady 0 -ipady 0 Label $frame.top.count -text "-" -relief sunken -bd 0 pack $frame.top.count -side right -pady 0 -ipady 0 Frame $frame.list -bd 0 pack $frame.list -expand true -fill both -pady 0 -ipady 0 Listbox $frame.list.users -width 13 -yscrollcommand "$frame.list.scroll set" -exportselection false -relief raised -selectmode extended Scrollbar $frame.list.scroll -width 10 -orient vertical -command [list $frame.list.users yview] pack $frame.list.users -expand true -side left -fill both pack $frame.list.scroll -side left -fill y bind $frame.list.users \ "selected $num whois nounselect" bind $frame.list.users \ "selected $num whois double nounselect" bind $frame.list.users "selected $num ctcp version" bind $frame.list.users "selected $num popup %X %Y ; break" } proc AddOrRemoveUserList {num} { if {[IsFakeWindow $num] || [WindowDoesNotExist $num]} { return } set path "[GetWindowPath $num]" set widget "$path.body.left.traffic.text" set end "[lindex "[$widget yview]" 1]" global show_userlist if {$show_userlist($num) != 0} { pack forget $path.body.left pack $path.body.right -side right -fill y pack $path.body.left -side left -expand true -fill both if {$end == 1} { # after 150 $widget yview end $widget yview end } } else { pack forget $path.body.right } } proc FillUserList {num cnum} { global irc chan win if {[IsFakeWindow $num] || [WindowDoesNotExist $num]} { return } set path "[GetWindowPath $num]" set inum $win($num,irc) if {$cnum == -1} { set cnum [ChannelNumber $inum "$win($num,actual)"] if {$cnum == -1} { return } } set len [llength "$chan($cnum,nicks)"] $path.body.right.list.users delete 0 end global sort_userlist_alphabeticly sort_userlist_by_channelmodes switch -- "$sort_userlist_alphabeticly($num)$sort_userlist_by_channelmodes($num)" { "00" { for {set i 0} {$i < $len} {incr i} { $path.body.right.list.users insert end "[lindex "$chan($cnum,names)" $i]" } } "01" { for {set i 0} {$i < $len} {incr i} { if {[lindex "$chan($cnum,olist)" $i]} { $path.body.right.list.users insert end "[lindex "$chan($cnum,names)" $i]" } } for {set i 0} {$i < $len} {incr i} { if {[lindex "$chan($cnum,vlist)" $i] && ![lindex "$chan($cnum,olist)" $i]} { $path.body.right.list.users insert end "[lindex "$chan($cnum,names)" $i]" } } for {set i 0} {$i < $len} {incr i} { if {![lindex "$chan($cnum,vlist)" $i] && ![lindex "$chan($cnum,olist)" $i]} { $path.body.right.list.users insert end "[lindex "$chan($cnum,names)" $i]" } } } "10" { set tmp "" for {set i 0} {$i < $len} {incr i} { if {[lindex "$chan($cnum,olist)" $i]} { lappend tmp "[lindex "$chan($cnum,nicks)" $i]@" } elseif {[lindex "$chan($cnum,vlist)" $i]} { lappend tmp "[lindex "$chan($cnum,nicks)" $i]+" } else { lappend tmp "[lindex "$chan($cnum,nicks)" $i]" } } set tmp "[lsort -command "strcmp" "$tmp"]" for {set i 0} {$i < $len} {incr i} { set user "[lindex "$tmp" $i]" if {[string first "@" "$user"] != -1} { $path.body.right.list.users insert end "@[string trimright "$user" "@"]" } elseif {[string first "+" "$user"] != -1} { $path.body.right.list.users insert end "+[string trimright "$user" "+"]" } else { $path.body.right.list.users insert end "$user" } } } "11" { set tmp "[lsort -command "strcmp" "$chan($cnum,names)"]" set i $chan($cnum,mode_v) while {"[string index "[lindex "$tmp" $i]" 0]" == "@"} { $path.body.right.list.users insert end "[lindex "$tmp" $i]" incr i } for {set k 0} {$k < $chan($cnum,mode_v)} {incr k} { $path.body.right.list.users insert end "[lindex "$tmp" $k]" } for {set k $i} {$k < $len} {incr k} { $path.body.right.list.users insert end "[lindex "$tmp" $k]" } } } $path.body.right.top.count configure -text "$len" } proc DeleteFromUserList {num cnum nick} { if {[IsFakeWindow $num] || [WindowDoesNotExist $num]} { return } set path "[GetWindowPath $num]" set tmp "[$path.body.right.list.users get 0 end]" $path.body.right.top.count configure -text "[expr [llength "$tmp"]-1]" set i [lsearch -exact "$tmp" "$nick"] if {$i == -1} { set i [lsearch -exact "$tmp" "@$nick"] if {$i == -1} { set i [lsearch -exact "$tmp" "+$nick"] } } if {$i != -1} { $path.body.right.list.users delete $i } } proc InsertToUserList {num cnum nick} { global chan if {[IsFakeWindow $num] || [WindowDoesNotExist $num]} { return } set rc -1 set path "[GetWindowPath $num]" set tmp "[$path.body.right.list.users get 0 end]" set len [llength "$chan($cnum,nicks)"] global sort_userlist_alphabeticly sort_userlist_by_channelmodes switch -- "$sort_userlist_alphabeticly($num)$sort_userlist_by_channelmodes($num)" { "00" { set i [lsearch -exact "$chan($cnum,names)" "$nick"] if {$i != -1} { $path.body.right.list.users insert $i "$nick" set rc $i } } "01" { set i [lsearch -exact "$chan($cnum,names)" "$nick"] if {$i != -1} { if {"[string index "$nick" 0]" == "@"} { set sub 0 for {set j 0} {$j < $i} {incr j} { if {[lindex "$chan($cnum,olist)" $j] == 0} { # -o überspringen! incr sub } } $path.body.right.list.users insert [expr $i-$sub] "$nick" set rc [expr $i-$sub] } elseif {"[string index "$nick" 0]" == "+"} { set sub 0 ; set j 0 while {$j < $i} { if {[lindex "$chan($cnum,olist)" $j] == 0 && [lindex "$chan($cnum,vlist)" $j] == 0} { # -o-v überspringen! incr sub } incr j } set add 0 ; incr j while {$j < [llength "$chan($cnum,olist)"]} { if {[lindex "$chan($cnum,olist)" $j] == 1} { # +o vorlassen! incr add } incr j } $path.body.right.list.users insert [expr $i-$sub+$add] "$nick" set rc [expr $i-$sub+$add] } else { set add 0 ; set j [expr $i+1] while {$j < [llength "$chan($cnum,olist)"]} { if {[lindex "$chan($cnum,olist)" $j] == 1 || [lindex "$chan($cnum,vlist)" $j] == 1} { # +o und +v vorlassen! incr add } incr j } $path.body.right.list.users insert [expr $i+$add] "$nick" set rc [expr $i+$add] } } } "10" { set tmp "[lsort -command "strcmp" "$chan($cnum,nicks)"]" set i [lsearch -exact "$tmp" "[TrimNick "$nick"]"] if {$i != -1} { $path.body.right.list.users insert $i "$nick" set rc $i } } "11" { set tmp "[lsort -command "strcmp" "$chan($cnum,names)"]" set i [lsearch -exact "$tmp" "$nick"] if {$i != -1} { if {"[string index "$nick" 0]" == "@"} { $path.body.right.list.users insert [expr $i-$chan($cnum,mode_v)] "$nick" set rc [expr $i-$chan($cnum,mode_v)] } elseif {"[string index "$nick" 0]" == "+"} { $path.body.right.list.users insert [expr $i+$chan($cnum,mode_o)] "$nick" set rc [expr $i+$chan($cnum,mode_o)] } else { $path.body.right.list.users insert $i "$nick" set rc $i } } } } $path.body.right.top.count configure -text "$len" return $rc } proc RefreshMainWindows { } { global irc win foreach x "$win(list)" { MainWindow $win($x,irc) $x } } proc PartMainWindow {num} { # DCC CHATs und Queries werden beendet, und alle Kanäle dieses # Fensters werden verlassen. global irc chan win set inum $win($num,irc) if {[string length "$win($num,query)"]} { if {"[string index "$win($num,query)" 0]" == "="} { write2irc $inum "/dcc close chat [string range "$win($num,query)" 1 end]" } else { set win($num,query) "" } } foreach x "$win($num,channels)" { # Wird der Kanal evtl. noch in anderen Fenstern verfolgt? foreach y "$win(list)" { if {$num != $y} { # Hierbei handelt es sich nicht um das gleiche Fenster. if {$inum == $win($y,irc)} { # Beide Server gehören zum gleichen Server. if {[lsearch "$win($y,channels)" $x] != -1} { # Der Kanal wird auch in diesem Fenster verfolgt. set chan($x,window) $y set x -1 break } } } } if {$x != -1} { # Der Kanal kann verlassen werden. write2irc $inum "/quote part $chan($x) :" DeleteChannel $x } } # Das Message- und das Crap-Fenster müssen evtl. neu gewählt werden. # Fenster mit einer ID > 500 sind Schwindel-Fenster! if {$irc($inum,mesg) == $num} { foreach x "$win(list)" { if {$x < 500 && $x != $num && $win($x,irc) == $inum} { set irc($inum,mesg) $x } } } if {$irc($inum,crap) == $num} { foreach x "$win(list)" { if {$x < 500 && $x != $num && $win($x,irc) == $inum} { set irc($inum,crap) $x } } } } proc CloseMainWindow {num} { global irc chan win set inum $win($num,irc) set i 0 foreach x "$win(list)" { if {$win($x,irc) == $inum} { incr i } } if {[llength "$win(list)"] <= 1} { # Das war das letzte Fenster von tkirc Exit -1 {} } elseif {$i <= 1} { # Das war nur das letzte Fenster für diesen Server. CloseIRC $inum "" } else { # Da der zugrundeliegende ircII nicht beendet wurde, werden # nur die Kanäle verlassen, die in diesem Fenster angezeigt # wurden. PartMainWindow $num } set path "[GetWindowPath $num]" destroy $path DeleteWindow $num UpdateAllTitles } proc ClearMainWindow {wnum} { global style win if {[IsFakeWindow $wnum] || [WindowDoesNotExist $wnum]} { return } set widget "[GetWindowPath $wnum].body.left.traffic.text" set win($wnum,visible) 0 set win($wnum,lines) 0 $widget configure -state normal $widget delete 0.0 end $widget configure -state disabled update foreach x "[array names style $wnum:*]" { $widget tag delete style($x) unset style($x) } } proc MainWindow {inum args} { global irc win margin margin_size geometry style if {"$args" == ""} { set type "$inum" set inum $irc(num) } else { set type "$args" } # type: -1 opens a window (prefs will be noticed) # type: -2 opens a window without topic and userlist, but commandline # type: -3 opens a window without topic, userlist and commandline # type: -4 opens a window with topic, userlist and commandline # type: -5 opens a fake-window e.g. for &servers # type: >-1 redraws an existent window set num $type if {[IsFakeWindow $num]} { return } if {$num < 0} { # Initialize variables if {$num == -5} { set num [ProduceWindow $inum hidden] } else { set num [ProduceWindow $inum] } if {"$irc($inum,crap)" == ""} { set irc($inum,crap) $num } if {"$irc($inum,mesg)" == ""} { set irc($inum,mesg) $num } } else { # Just refresh window } foreach x "geometry hide_joins hide_leaves hide_signoffs show_commandline show_time_on_each_line show_topic show_userlist use_margin display_types margin_size sort_userlist_alphabeticly sort_userlist_by_channelmodes auto_popup" { global $x if {![info exists $x\($num)]} { set $x\($num) [set $x\(*)] } } if {$type == -5} { return $num } switch -- "$type" { "-2" { set show_topic($num) 0 set show_userlist($num) 0 set show_commandline($num) 1 } "-3" { set show_topic($num) 0 set show_userlist($num) 0 set show_commandline($num) 0 } "-4" { set show_topic($num) 1 set show_userlist($num) 1 set show_commandline($num) 1 } } set path "[GetWindowPath $num]" if {$type < 0} { Toplevel $path -class tkirc -takefocus 0 wm geometry $path $geometry($num) wm protocol $path WM_DELETE_WINDOW "CloseMainWindow $num" bind $path "set win($num,touched) 0 ; UpdateTitle $num" foreach x "c o d v e w i b k q y t" { bind $path "HandleKey $num $x ; break" bind $path "HandleKey $num $x ; break" } bind all "" bind all "" bind all "" InitCmdLine $num InitMenu $num # body set f $path.body ; Frame $f pack $f -expand true -fill both Frame $f.left -bd 1 -relief sunken pack $f.left -side left -expand true -fill both listview $f.left.traffic ; redrawMargin $num pack $f.left.traffic -expand true -fill both -padx 0 -ipadx 0 # bind $f.left.traffic.text "[subst -nocommands {if {![catch {selection get}]} {$path.cmdline insert insert \"\[selection get\]\"}}]" bind $path "$f.left.traffic.text yview 0" bind $path "$f.left.traffic.text yview end" bind $path "TextPageUp $f.left.traffic.text" bind $path "TextPageDown $f.left.traffic.text" bind $path "EnterWindow $num ; SetFocus $num" InitStyles $num InitTopic $num InitUserList $num } else { InitStyles $num } RefreshMenu $num AddOrRemoveCmdLine $num AddOrRemoveUserList $num AddOrRemoveTopic $num if {"$inum" != "-"} { UpdateInfos $num } return $num } proc SetFocus {wnum} { set path "[GetWindowPath $wnum]" focus $path.cmdline bind $path "EnterWindow $wnum" } proc EnterWindow {wnum} { global crap_to_active_window messages_to_active_window global irc win set inum $win($wnum,irc) set update "" if {$crap_to_active_window != 0} { if {$irc($inum,crap) != $wnum} { if {"$irc($inum,lastcrap)" == ""} { set irc($inum,lastcrap) $irc($inum,crap) } # if {[lsearch "$update" "$irc($inum,crap)"] == -1} { lappend update $irc($inum,crap) # } set irc($inum,crap) $wnum if {[lsearch "$update" "$irc($inum,crap)"] == -1} { lappend update $irc($inum,crap) } } } if {$messages_to_active_window != 0} { if {$irc($inum,mesg) != $wnum} { if {"$irc($inum,lastmesg)" == ""} { set irc($inum,lastmesg) $irc($inum,mesg) } if {[lsearch "$update" "$irc($inum,mesg)"] == -1} { lappend update $irc($inum,mesg) } set irc($inum,mesg) $wnum if {[lsearch "$update" "$irc($inum,mesg)"] == -1} { lappend update $irc($inum,mesg) } } } foreach wnum "$update" { UpdateTitle $wnum } } proc Disconnected {inum args} { global away irc chan win queue debug "DISCONNECTED" if {"$irc($inum,serv)" != ""} { ExecOnCommands disconnect $inum window $irc($inum,crap) set tmp_names "" set tmp_windows "" foreach x "$chan(list)" { if {$chan($x,irc) == $inum} { lappend tmp_names "$chan($x)" lappend tmp_windows "$chan($x,window)" DeleteChannel $x } } ExecOnCommands signoff $inum window "$irc($inum,mesg)" nick "$irc($inum,nick)" address "[AddressOfNick $inum "$irc($inum,nick)"]" message "" foreach flag "i s w r" { set irc($inum,mode,$flag) 0 foreach w "$win(list)" { if {$win($w,irc) == $inum} { set win($w,mode,$flag) 0 } } } set irc($inum,tojoin,chan) "$tmp_names" set irc($inum,tojoin,win) "$tmp_windows" set irc($inum,serv) "" set irc($inum,lastnick) "" set irc($inum,startup) 1 set queue($inum,send) "" set away "" if {[lsearch "$args" "-noupdate"] == -1} { UpdateAllInfos } } } proc Exit {inum message} { global irc logs win if {$inum == -1 || [llength "$irc(list)"] <= 1} { foreach x "$irc(list)" { CloseIRC $x "$message" } foreach lnum "$logs(list)" { puts $logs($lnum:handle) "Logfile closed for $logs($lnum:source) on $logs($lnum:boundary) at: [longdate]" catch {close $logs($lnum:handle)} } exit } else { foreach x "$win(list)" { if {$win($x,irc) == $inum} { DeleteWindow $x set path "[GetWindowPath $x]" destroy $path if {[lsearch "$irc(list)" $inum] != -1} { CloseIRC $inum "$message" } } } } } ################################### # Operations For Menu "Project" # ################################### proc LeaveServer {num} { global irc win set inum $win($num,irc) if {"$irc($inum,serv)" != ""} { StringRequest "Which message do you want to use to leave server '$irc($inum,serv)'?" "" "Cancel|" "Signoff|send2tkirc $num \"/signoff \[expandescape \"\$string\"\]\"" } } ################################### # Operations For Menu "Channel" # ################################### proc JoinChannel {num} { global irc win set inum $win($num,irc) if {"$irc($inum,serv)" != ""} { StringRequest "Which channel do you want to join?" "" "Cancel|" "Join|send2tkirc $num \"/join \[expandescape \"\$string\"\]\"" } } proc WJoinChannel {num} { global irc win set inum $win($num,irc) if {"$irc($inum,serv)" != ""} { StringRequest "Which channel do you want to join?" "" "Cancel|" "Join|send2tkirc $num \"/wjoin \[expandescape \"\$string\"\]\"" } } proc LeaveChannel {num args} { global irc win set inum $win($num,irc) set channel "[GetActual $num]" set echannel "[expand "$channel"]" if {"$irc($inum,serv)" != "" && "$channel" != "*"} { if {"$args" == ""} { StringRequest "Which message do you want to use to leave channel '$channel'?" "" "Cancel|" "Part|write2irc $inum \"/quote part $echannel :\$string\"" } else { write2irc $inum "/quote part $channel :$args" } } } proc RejoinChannel {num} { global irc win commandqueue set inum $win($num,irc) set channel [GetActual $num] if {"$channel" != "*"} { lappend commandqueue "[expand "\*\*\*?$irc($inum,nick) (*) has left channel $channel*"]" lappend commandqueue "send2tkirc $num \"[expandescape "[expand "/join $channel"]"]\"" write2irc $inum "/quote part $channel :" } } proc InviteToChannel {num} { global irc win set inum $win($num,irc) set channel [GetActual $num] if {"$irc($inum,serv)" != "" && "$channel" != "*"} { StringRequest "Which user (nickname) do you want to invite to channel $channel?" "" "Cancel|" "Invite|write2irc $inum \"/invite \$string [expand $channel]\"" } } proc SetTopic {num} { global irc win set inum $win($num,irc) set channel "[GetActual $num]" set echannel "[expand "$channel"]" if {"$irc($inum,serv)" != "" && "$channel" != "*"} { StringRequest "Which topic do you want to set for channel '$channel'?" "" "Cancel|" "Set topic|write2irc $inum \"/topic $echannel \$string\"" } } #################################### # Operations For Menu "Personal" # #################################### proc SetNick {num} { global irc win set inum $win($num,irc) if {"$irc($inum,serv)" != ""} { StringRequest "Which nickname do you want to have on server '$irc($inum,serv)'?" "" "Cancel|" "Set nickname|write2irc $inum \"/nick \$string\"" } } proc SetAway {num} { global irc win set inum $win($num,irc) if {"$irc($inum,serv)" != ""} { StringRequest "Which away-reason do you want to set?" "" "Cancel|" "Mark away|write2irc $inum \"/away \$string\"" } } ########################## # Idle Time Management # ########################## proc InitIdleTime { } { global irc secs margin set secs(idle) [clock seconds] global auto_unmark_away away send_away_notice automatic_away if {"$away" != ""} { if {$auto_unmark_away > 1 \ || $auto_unmark_away == 1 && "$away" == " (autoaway)"} { if {$send_away_notice != 0} { set away "" set margin(text) "away" print2crap "*** You are no longer marked as being away" UpdateAllTitles } elseif {$automatic_away != 1} { set automatic_away 1 foreach x "$irc(list)" { write2irc $x "/away" } } } } } proc Secondly { } { global irc dcc queue secs margin global crap_to_active_window messages_to_active_window win set active "[focus]" set update "" foreach inum "$irc(list)" { set anum -1 if {"$irc($inum,lastcrap)$irc($inum,lastmesg)" != ""} { foreach wnum "$win(list)" { if {$inum == $win($wnum,irc) && ![IsFakeWindow $wnum]} { if {[string match ".win$wnum*" "$active"]} { set anum $wnum ; break } } } if {$anum == -1} { # Kein Fenster dieser Verbindung ist aktiv. if {"$irc($inum,lastcrap)" != ""} { if {[lsearch "$update" "$irc($inum,crap)"] == -1} { lappend update $irc($inum,crap) } set irc($inum,crap) $irc($inum,lastcrap) set irc($inum,lastcrap) "" if {[lsearch "$update" "$irc($inum,crap)"] == -1} { lappend update $irc($inum,crap) } } if {"$irc($inum,lastmesg)" != ""} { if {[lsearch "$update" "$irc($inum,mesg)"] == -1} { lappend update $irc($inum,mesg) } set irc($inum,mesg) $irc($inum,lastmesg) set irc($inum,lastmesg) "" if {[lsearch "$update" "$irc($inum,mesg)"] == -1} { lappend update $irc($inum,mesg) } } } } } foreach wnum "$update" { UpdateTitle $wnum } global auto_mark_away auto_away_period auto_away_text away san global send_away_notice automatic_away if {$auto_mark_away != 0 && "$away" == ""} { set i [expr $auto_away_period + $secs(idle)] if {[clock seconds] >= $i && $i > $secs(lastview)} { if {$send_away_notice != 0} { set san(nicks) "" set san(times) "" set san(message) "$auto_away_text" set away " (autoaway)" foreach x "$irc(list)" { set margin(text) "away" write2crap $x "*** You automatically have been marked as being away" } UpdateAllTitles } else { set automatic_away 1 foreach x "$irc(list)" { write2irc $x "/away $auto_away_text" } } ExecOnCommands auto_away $inum } } foreach x "$irc(list)" { if {[info exists queue($x,send)]} { if {[llength "$queue($x,send)"]} { write2irc $x "[lindex "$queue($x,send)" 0]" set queue($x,send) "[lreplace "$queue($x,send)" 0 0]" } # if {$irc($x,lag,stop) == -1} { # Eine Messung läuft. if {"$irc($x,serv)" != ""} { LagStart $x } else { LagStop $x } # } } } set lastx "" foreach x "$irc(list)" { foreach y "$dcc(list)" { if {$dcc($y,irc) == $x} { if {[winfo exists .dcc$y] && "$lastx" != "$x"} { # Mindestens ein DCC-Fenster ist für diesen ircII geöffnet. write2irc $x "/get_dcclist" set lastx "$x" } } } } set secs(lastview) [clock seconds] after 1000 Secondly } ############## # Takeover # ############## proc ignore {inum host} { FilterLine $inum {\*\*\*?Ignoring CTCPS from *} FilterLine $inum {\*\*\*?Ignoring INVITES from *} write2irc $inum "/ignore *@$host ctcp invites" } proc unignore {inum host} { FilterLine $inum {\*\*\*?Not ignoring CTCPS from *} FilterLine $inum {\*\*\*?Not ignoring INVITES from *} write2irc $inum "/ignore *@$host -ctcp -invites" } ############ # Queues # ############ set commandqueue "" proc FilterLine {inum pattern} { global queue lappend queue($inum,filter) "[string tolower "$pattern"]" [clock seconds] } proc AddToWhoQueue {channel num margintext message} { global irc win queue set inum $win($num,irc) lappend tmp "$channel" "$margintext" "$message" lappend queue($inum,who) "$tmp" if {[llength "$queue($inum,who)"] <= 1} { FilterLine $inum "Channel * Nickname *" write2irc $inum "/who $channel" } } proc AddToWhoisQueue {inum nick message command} { global irc win queue margin set num $irc($inum,crap) lappend tmp "$nick" $num "$command" lappend queue($inum,whois) "$tmp" if {[string length "$message"]} { set margin(text) "note" print2text $num "--- $message" } if {[llength "$queue($inum,whois)"] <= 1} { write2irc $inum "/whois $nick" } } proc AddToWhowasQueue {nick num command message} { global irc win queue margin set inum $win($num,irc) lappend tmp "$nick" "$num" "$command" lappend queue($inum,whowas) "$tmp" if {[string length "$message"]} { set margin(text) "note" print2text $num "--- $message" } if {[llength "$queue($inum,whowas)"] <= 1} { write2irc $inum "/whowas $nick" } } ##################### # Message history # ##################### proc AddToMsgHistory {num nick} { global win history set inum $win($num,irc) set i [lsearch -exact "$history($inum,msg,list)" "$nick"] if {$i != -1} { set history($inum,msg,list) "[lreplace "$history($inum,msg,list)" $i $i]" } lappend history($inum,msg,list) "$nick" if {[llength "$history($inum,msg,list)"] > $history(msg,max)} { set history($inum,msg,list) "[lreplace "$history($inum,msg,list)" 0 0]" } set history($inum,msg,num) "[llength "$history($inum,msg,list)"]" } proc MsgHistoryUp {num} { global win history set inum $win($num,irc) set win($num,hsize) 0 set path "[GetWindowPath $num]" $path.cmdline delete 0 end if {$history($inum,msg,num) > 0} { set history($inum,msg,num) [expr $history($inum,msg,num) - 1] $path.cmdline insert 0 "/msg [lindex "$history($inum,msg,list)" $history($inum,msg,num)] " } else { set history($inum,msg,num) [llength "$history($inum,msg,list)"] } } ######################### # Commandline history # ######################### proc AddToHistory {num line} { global win history_max set len [llength "$win($num,history)"] if {[string compare "$line" "[lindex "$win($num,history)" [expr $len-1]]"]} { lappend win($num,history) "$line" if {[expr $len+1] > $history_max} { set win($num,history) "[lreplace "$win($num,history)" 0 0]" } } set win($num,hsize) "[llength "$win($num,history)"]" } proc HistoryUp {num} { global win history set inum $win($num,irc) set history($inum,msg,num) [llength "$history($inum,msg,list)"] set path "[GetWindowPath $num]" if {$win($num,hsize) == [llength "$win($num,history)"]} { set win($num,history2) "[$path.cmdline get]" } $path.cmdline delete 0 end if {$win($num,hsize) > 0} { set win($num,hsize) [expr $win($num,hsize) - 1] $path.cmdline insert 0 "[lindex "$win($num,history)" $win($num,hsize)]" } else { set win($num,hsize) [llength "$win($num,history)"] $path.cmdline insert 0 "$win($num,history2)" } # $path.cmdline icursor 0 } proc HistoryDown {num} { global win history set inum $win($num,irc) set history($inum,msg,num) [llength "$history($inum,msg,list)"] set path "[GetWindowPath $num]" if {$win($num,hsize) == [llength "$win($num,history)"]} { set win($num,history2) "[$path.cmdline get]" } $path.cmdline delete 0 end if {$win($num,hsize) < [llength "$win($num,history)"]} { incr win($num,hsize) } else { set win($num,hsize) 0 } if {$win($num,hsize) == [llength "$win($num,history)"]} { $path.cmdline insert 0 "$win($num,history2)" } else { $path.cmdline insert 0 "[lindex "$win($num,history)" $win($num,hsize)]" } # $path.cmdline icursor 0 } ############################### # Window to select a server # ############################### proc ServersWindow {inum} { global default_servers preferred_servers on_urlclick if {[RequestLevel .servers]} { global geometry on_url_click if {[info exists geometry(servers)]} { wm geometry .servers $geometry(servers) } wm title .servers " tkirc: Servers " bind .servers "ServerCanceled $inum" wm protocol .servers WM_DELETE_WINDOW "ServerCanceled $inum" set frame .servers.buttons Frame $frame ; pack $frame -side bottom -fill x -pady 2 Button $frame.close -text "Cancel" -command "ServerCanceled $inum" pack $frame.close -side right -padx 2 -pady 2 DefaultButton $frame.connect -text "Connect" -command "ServerConfirmed $inum" pack $frame.connect -side right -padx 2 -pady 2 bind .servers "ServerConfirmed $inum" Button $frame.url -text "View networks via web!" pack $frame.url -side left -ipadx 0 -ipady 0 -padx 2 -pady 2 set command "[strreplace "$on_urlclick" "\$url" "http://netsplit.de/networks/"]" if {[string length "[info commands "[lindex "$command" 0]"]"]} { bind $frame.url "eval $command" } else { bind $frame.url "eval exec -- $command &" } Entry .servers.entry pack .servers.entry -fill x -padx 2 -pady 2 -side bottom Focus .servers.entry multilistbox create .servers.list {Comment 32} {Hostname 32} {Port 5} multilistbox delete .servers.list 0 end set slen [llength "$default_servers"] for {set i [expr $slen-1]} {$i >= 0} {set i [expr $i-1]} { set x "[lindex "$default_servers" $i]" set comment "[lindex "$x" 2]" multilistbox insert .servers.list 0 \ "$comment" "[lindex "$x" 0]" "[lindex "$x" 1]" } set slen [llength "$preferred_servers"] for {set i [expr $slen-1]} {$i >= 0} {set i [expr $i-1]} { set x "[lindex "$preferred_servers" $i]" set comment "[lindex "$x" 2]" multilistbox insert .servers.list 0 \ "$comment" "[lindex "$x" 0]" "[lindex "$x" 1]" } pack .servers.list -side left -expand true -fill both -ipadx 0 -padx 0 multilistbox bind .servers.list "+ServerSelected $inum" multilistbox bind .servers.list "+ServerSelected $inum" multilistbox bind .servers.list "+ServerSelected $inum" multilistbox bind .servers.list "+ServerConfirmed $inum" } } proc ServerSelected {inum} { .servers.entry delete 0 end set selected "[multilistbox curselection .servers.list]" if {"$selected" != ""} { .servers.entry insert end "[multilistbox get .servers.list 1 $selected] [multilistbox get .servers.list 2 $selected]" } } proc ServerCanceled {inum} { global irc closewindow .servers if {[llength "$irc(list)"] == 0} { Exit -1 {} } } proc ServerConfirmed {inum} { global arguments set toconnect "[.servers.entry get]" if {"$toconnect" != ""} { # Wenn ein bestimmter Portnummer gewünscht wird, muß das Format # geändert werden. if {[llength "$toconnect"] == 2} { set toconnect "[lindex "$toconnect" 0]:[lindex "$toconnect" 1]" } if {$inum == -1} { # Es ist noch kein ircII aufgerufen worden. set server "$toconnect" set arguments "[expand "[lindex "$arguments" 0] $toconnect"]" set inum [eval OpenIRC $arguments] if {$inum != -1 && "[MainWindow $inum -1]" != ""} { SetupIRC $inum } } else { # Der zugrundeliegende ircII bekommt einen neuen Server zugewiesen. write2irc $inum "/server $toconnect" } closewindow .servers } else { beep } } #################################### # Old procedures for old scripts # #################################### proc send2irc {line args} { global irc set inum $irc(num) write2irc $inum "$line" $args } proc print2crap {line} { global irc set inum $irc(num) write2log "crap" $inum "$line" print2text $irc($inum,crap) "$line" } proc GetChannelNumber {channel} { global irc chan set inum $irc(num) foreach x "$chan(list)" { if {$chan($x,irc) == $inum && [strcmp "$channel" "$chan($x)"] == 0} { return "$x" } } return -1 } proc AddToFilterQueue {pattern} { global irc queue lappend queue($irc(num),filter) "[string tolower "$pattern"]" [clock seconds] } proc GetPathFromNum {num} { return [GetWindowPath $num] } proc UserNumOfChannel {cnum nick} { global chan if {$cnum != -1} { return [lsearch -exact "$chan($cnum,nicks)" "$nick"] } return -1 } ###################################################################### # MAIN # ###################################################################### global tcl_version tk_version starttime if {[info exists starttime] == 0} { # Das Programm wurde gerade gestartet. Nachdem die Versionen von Tcl/Tk # überprüft werden, werden ein paar Standardeinstellungen vorgenommen. if {$tcl_version < 8.0} { puts stdout "Error: Version of Tcl is lower than 8.0" exit } if {$tk_version < 8.0} { puts stdout "Error: Version of Tk is lower than 8.0" exit } foreach x "env(IRCNICK) env(USER) env(LOGNAME)" { if [info exists $x] { set nickname "[set $x]" break } } catch {fconfigure stdout -blocking 0} set secs(idle) [set secs(lastview) [set secs(start) [clock seconds]]] set starttime "[clock format $secs(start) -format "%y-%m-%d %H:%M:%S"]" Secondly after [expr 60000*42] "huibu 1" # Das versteckte Hauptfenster und die Widgets werden vorbereitet. wm geometry . 1x1+0+0 wm overrideredirect . 1 bind Listbox "[bind Listbox ];break" bind Listbox "[bind Listbox ];break" bind Listbox "[bind Listbox ];break" bind Listbox "[bind Listbox ];break" bind Listbox "[bind Listbox ];break" # Für tkirc bestimmte Argumente werden herausgefiltert, und der Rest # wird ircII übergeben. set arguments "" set tkircrc "" set newircpath "" set quiet 0 set ircrc 0 set ask4server 0 set len [llength "$argv"] for {set i 0} {$i < $len} {incr i} { set x "[lindex "$argv" $i]" switch -- "$x" { "-x" { # Option '-x' dient zur Auswahl des ircII-Pfades. incr i set newircpath "[lindex "$argv" $i]" } "-t" { # Option '-t' dient zur Auswahl eines tkircrc-Pfades. incr i set tkircrc "[lindex "$argv" $i]" } "-q" { # Das tkircrc soll nicht beim Start eingeladen werden. set quiet 1 } "-r" { # Das File .ircrc soll berücksichtigt werden. set ircrc 1 } "-a" { # Der Server soll via GUI gewählt werden. set ask4server 1 } default { append arguments "$x " } } } if {$quiet == 0} { setDefaults ReloadTKircRC "$tkircrc" } else { setDefaults } if {[string length "$newircpath"]} { set ircpath "$newircpath" } set arguments "[expand "$arguments"]" if {[llength "$arguments"] < 1} { if {[llength "$preferred_nicknames"]} { set nickname "[lindex "$preferred_nicknames" 0]" append arguments " $nickname " } } else { set nickname "[lindex "$arguments" 0]" } if {$ask4server != 0} { ServersWindow -1 } else { if {[llength "$arguments"] < 2} { if {[llength "$ircserver"]} { set server "$ircserver" append arguments " $server " } } else { set server "[lindex "$arguments" 1]" } set inum [OpenIRC $nickname $server] if {$inum != -1 && "[MainWindow $inum -1]" != ""} { SetupIRC $inum } } } else { # Eine neue Version des Programmes wurde gerade nachgeladen. foreach x "$irc(list)" { SetClientInformation $x } }