# Emacs, this is -*- Mode: Tcl -*-
#
# This file includes some examples, how you can write your own 
# tkirc-commands, set your own menu-entries and/or react to normal
# IRC events like JOIN, KICK, ...
#
# Last modified:    2000-08-19 (atte)


#############################################################################
#                                                                           #
#  Copyright (C) 1996-2000  Andreas Gelhausen <atte@netsplit.de>            #
#                                                                           #
#  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                 #
#                                                                           #
#############################################################################


#############################################################################
#                                                                           #
# First: The following examples are written in Tcl. You need to learn       #
#        Tcl to understand them.                                            #
#                                                                           #
#     tkirc tries to load all files with names matching "*.tcl" from        #
#     directory "~/.tkirc2/autoload/" during startup and by selecting       #
#     "Reload tkircrc" from menu. So you are able to write scripts          #
#     for tkirc without editing your tkircrc. Each script can be placed     #
#     into "~/.tkirc2/autoload/" as "<scriptname>.tcl".                     #
#                                                                           #
#############################################################################


#  #   # ##### #   # #   #  ####
#  ## ## #     ##  # #   # #
#  # # # ###   # # # #   #  ###
#  #   # #     #  ## #   #     #
#  #   # ##### #   #  ###  ####


# Each procedure that has a name matching "on_menucreate_*" will 
# automatically be executed when tkirc sets up its menu. For example 
# you can add your own entries to menu "Private" like the following
# procedure "on_menu_create_example", but be aware that different
# menu-entries need different suffixes within their names!

proc on_menucreate_example { } {
  global on_args
  $on_args(path).private.menu add checkbutton -label "example 1" \
    -variable example_1 -command "print2text $on_args(window) \"+++ You've selected 'example 1' within window $on_args(window). -- Value of variable 'example_1' is '\$example_1'.\""
  $on_args(path).private.menu add command -label "example 2" \
      -command "print2text $on_args(window) \"+++ You've selected 'example 2' within window $on_args(window). -- tkirc was started at \$starttime.\""
  $on_args(path).private.menu add separator
}

proc on_menucreate_listen { } {
  global on_args

  $on_args(path).private.menu add cascade -label "listen to" \
      -menu $on_args(path).private.menu.lstn
  Menu $on_args(path).private.menu.lstn
  foreach x "&channel &errors &hash &kills &local &notices &numerics &servers" {
    $on_args(path).private.menu.lstn add command -label "$x" \
	-command "on_command_listen $on_args(window) $x"
  }
  $on_args(path).private.menu add separator
}


#   ###   ###  #   # #   #  ###  #   # ####   ####
#  #   # #   # ## ## ## ## #   # ##  # #   # #
#  #     #   # # # # # # # ##### # # # #   #  ###
#  #   # #   # #   # #   # #   # #  ## #   #     #
#   ###   ###  #   # #   # #   # #   # ####  ####


# Each procedure that has a name matching "on_command_*" will automatically
# used as a command. The procedure's suffix is used as command's name.
# Here you see an example how the following procedure "on_command_rot13"
# can be used from tkirc's commandline:
#          "/rot13 Hg qrfvag iverf, gnzra rfg ynhqnaqn ibyhagnf!"

proc on_command_rot13 {window arguments} {
  set abc "abcdefghijklmnopqrstuvwxyz"
  set ABC "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  global crapwindow

  set len [lLength "$arguments"]
  if {$len < 1} {
    print2text $crapwindow "+++ Usage: /rot13 <message>"
    return
  }
  set newline ""
  for {set i 0} {$i < [string length "$arguments"]} {incr i} {
    set char "[string index "$arguments" $i]"
    set j [string first "$char" "$abc"]
    if {$j != -1} {
      append newline "[string index "$abc" [expr ($j+13)%26]]"
      continue
    }
    set j [string first "$char" "$ABC"]
    if {$j != -1} {
      append newline "[string index "$ABC" [expr ($j+13)%26]]"
      continue
    }
    append newline "$char"
  }
  print2text $window "+++ rot13: $newline"
}

proc on_command_listen {window arguments} {
  global crapwindow

  set len [lLength "$arguments"]
  if {$len < 1} {
    global crapwindow
    print2text $crapwindow "+++ Usage: /listen <channel1>\[,<channel2>\[...\]\]"
    print2text $crapwindow "+++ Channels for server messages: &channel, &errors, &hash, &kills, &local, &notices, &numerics, &servers"
    return
  } else {
    set wnum [MainWindow -3]
    foreach x "[split "$arguments" ","]" {
      send2tkirc $wnum "/join $x"
    }
  }
}

proc on_command_kf {window arguments} {
  # "kf" means "kick fast". =:^)
  global crapwindow

  set random_kick_messages {
    "Go away!" "CU" "Adios" "Uuuiii" "You're ^bout^b!" "Strike!"
  }

  set len [lLength "$arguments"]
  if {$len < 1} {
    print2text $crapwindow "+++ Usage: /kf <nick> \[<message>\]"
  } elseif {$len == 1} {
    send2tkirc $window "/kick * $arguments [lindex "$random_kick_messages" [expr [clock seconds] % [llength "$random_kick_messages"]]]"
  } else {
    send2tkirc $window "/kick * $arguments"
  }
}

proc on_command_tcl {window arguments} {
  # This command allows you to execute Tcl-commands from your 
  # commandline.
  if [catch {uplevel 0 $arguments} result] {
    print2text $window "+++ Executing '$arguments' failed with: $result"
  } else {
    print2text $window "+++ Executing '$arguments' yields '$result'"
  }
}

proc on_command_where {window arguments} {
  # The joined channels will be searched for a certain nick or users
  # with matching addresses. Notice that tkirc only automatically
  # know the address of those users which have joined later than you.
  global crapwindow chan

  if {[lLength "$arguments"] != 1} {
    print2text $crapwindow "+++ Usage: /where \[<nick>|<addresspattern>\]"
    return
  }
  if {[string first "." "$arguments"] == -1} {
    # Nick
    set where ""
    foreach x "$chan(list)" {
      set j [lsearch "$chan($x,nicks)" "[expand "$arguments"]"]
      if {$j != -1} {
	append where "$chan($x) "
      }
    }
    if {[llength "$chan(list)"]} {
      if {"$where" == ""} {
	send2irc "/whois $arguments"
      } else {
	print2crap "+++ $arguments is on: $where"
      }
    } else {
      send2irc "/whois $arguments"
    }
  } else {
    # Addresspattern
    set done ""
    set i 0
    foreach x "$chan(list)" {
      set alen [llength "$chan($x,addresses)"]
      for {set j 0} {$j < $alen} {incr j} {
	if [strmatch "$arguments" "[lindex "$chan($x,addresses)" $j]"] {
	  # Die Adresse paßt.
	  set nick "[lindex "$chan($x,nicks)" $j]"
	  set enick "[expand "$nick"]"
	  if {[lsearch "$done" "$enick"] != -1} {
	    continue
	  }
	  append done "$enick "
	  set where "$chan($x)"
	  foreach y "[lrange "$chan(list)" [expr $i+1] end]" {
	    if {[lsearch "$chan($y,nicks)" "$enick"] != -1} {
	      append where " $chan($y)"
	    }
	  }
	  print2text $crapwindow "+++ $nick ([lindex "$chan($x,addresses)" $j]) is on: $where"
	}
      }
      incr i
    }
  }
}


#      #  ###  #   #   ##### #   # ##### #   # #####  ####
#     #  #   # ##  #   #     #   # #     ##  #   #   #
#    #   #   # # # #   ###   #   # ###   # # #   #    ###
#   #    #   # #  ##   #      # #  #     #  ##   #       #
#  #      ###  #   #   #####   #   ##### #   #   #   ####


# The following procedures shows you, how to react to normal IRC
# events like ircII's command /ON does it. These procedures ('on_xxx_*()')
# will be executed at different IRC events ('xxx'). Now you are able to 
# create your own scripts for tkirc.

global print_event_examples
set print_event_examples 0

# Replace the "0" above to "1" and you will see many example-messages
# in your crap-window. =:^)

proc on_join_example { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='join', nick='$on_args(nick)', address='$on_args(address)', channel='$on_args(channel)'"
}

proc on_leave_example { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='leave', nick='$on_args(nick)', address='$on_args(address)', channel='$on_args(channel)', message='$on_args(message)'"
}

proc on_signoff_example { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='signoff', nick='$on_args(nick)' address='$on_args(address)', message='$on_args(message)'"
}

proc on_disconnect_example { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='disconnect', line='$on_args(irc)'"
}

proc on_topic_example { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='topic', nick='$on_args(nick)', address='$on_args(address)', channel='$on_args(channel)', topic='$on_args(topic)'"
}

proc on_modechange_example { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='modechange', nick='$on_args(nick)', address='$on_args(address)', to='$on_args(to)', mode='$on_args(mode)', argument='$on_args(argument)'"
}

proc on_nick_example { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='nick', nick='$on_args(nick)', address='$on_args(address)', newnick='$on_args(newnick)'"
}

proc on_kick_example { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='kick', nick='$on_args(nick)', address='$on_args(address)', victim='$on_args(victim)', channel='$on_args(channel)', message='$on_args(message)'"
}

proc on_ctcprequest_example { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='ctcprequest', nick='$on_args(nick)', address='$on_args(address)', command='$on_args(command)', to='$on_args(to)', rest='$on_args(rest)'"
}

proc on_ctcpreply_example { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='ctcpreply', nick='$on_args(nick)', address='$on_args(address)', command='$on_args(command)', rest='$on_args(rest)'"
}

proc on_dcc_example { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='dcc', nick='$on_args(nick)', address='$on_args(address)', command='$on_args(command)', rest='$on_args(rest)'"
}

proc on_privaction_example { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='privaction', nick='$on_args(nick)', address='$on_args(address)', to='$on_args(to)', rest='$on_args(rest)'"
}

proc on_pubaction_example { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='pubaction', nick='$on_args(nick)', address='$on_args(address)', to='$on_args(to)', rest='$on_args(rest)'"
}

proc on_privmessage_example { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='privmessage', nick='$on_args(nick)', address='$on_args(address)', to='$on_args(to)', rest='$on_args(rest)'"
}

proc on_pubmessage_example { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='pubmessage', nick='$on_args(nick)', address='$on_args(address)', to='$on_args(to)', rest='$on_args(rest)'"
}

proc on_servermessage_example { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='servermessage', to='$on_args(to)', address='$on_args(address)', rest='$on_args(rest)'"
}

proc on_privnotice_example { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='privnotice', nick='$on_args(nick)', address='$on_args(address)', to='$on_args(to)', rest='$on_args(rest)'"
}

proc on_pubnotice_example { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='pubnotice', nick='$on_args(nick)', address='$on_args(address)', to='$on_args(to)', rest='$on_args(rest)'"
}

proc on_servernotice_example { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='servernotice', to='$on_args(to)', address='$on_args(address)', rest='$on_args(rest)'"
}

proc on_invite_example { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='invite', nick='$on_args(nick)', address='$on_args(address)', channel='$on_args(channel)'"
}

proc on_error_example { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='error', message='$on_args(message)'"
}

proc on_notify_signon_example { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='notify_signon', nick='$on_args(nick)', address='$on_args(address)'"
}

proc on_notify_signoff_example { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='notify_signoff', nick='$on_args(nick)', address='$on_args(address)'"
}

proc on_url_detect_example { } {
  global irc on_args

  # Do NOT use one of tkirc's print-procedures here to prevent
  # infinite loops! (print2crap, print2text, etc.)

#  exec echo "[longdate]  $on_args(url)" >> ~/.tkirc2/IrcLog.urls
}

proc on_msgid_detect_example { } {
  global irc on_args

  # Do NOT use one of tkirc's print-procedures here to prevent
  # infinite loops! (print2crap, print2text, etc.)

#  exec echo "[longdate]  $on_args(msgid)" >> ~/.tkirc2/IrcLog.msgids
}

# If someone joins and leaves a channel within <channelhop_period> seconds,
# the procedure 'on_channelhop' will be executed.
set channelhop_period 20

proc on_channelhop { } {
  global irc margin on_args print_event_examples
  if {!$print_event_examples} { return }

  set margin(text) "example"
  write2crap $on_args(irc) "*** event='channelhop', nick='$on_args(nick)', address='$on_args(address)', channel='$on_args(channel)', period='$on_args(period)'"
}
