# This is used to set the section name used for the documentation in the file.
# It is placed here to make it easy to change the name of the file without
# having to change all of the documentation references.  It also makes it easy
# to move items to different files.
set doc_section Global
set doc_type Global

# Since the doc command is used to document itself as well as the rest of this
# file, it is created first.  Immediately following its definition is where it
# documents itself.
proc doc { command args } {
    switch $command {
	"add" {
	    if { [llength $args]!=2 } {
		error "Invalid number of arguments for doc add."
	    }
	    set ::doc(/[lindex $args 0]) [lindex $args 1]
	}
	"remove" {
	    set item [lindex $args 0]
	    if { [string index $item 0]!="/" } {
		set item "/$item"
	    }
	    foreach item [array names ::doc $item] {
		unset ::doc($item)
	    }
	}
	"show" {
	    if { [winfo exists .doc] } {
		raise .doc
	    } else {
		toplevel .doc
		wm title .doc "Documentation System"
		wm geometry .doc 600x400

		# Create the tree and text box

		Tree:create .doc.tree -width 150 -height 300 -yscrollcommand {.doc.tree_yscroll set}
		scrollbar .doc.tree_yscroll -orient vertical -command {.doc.tree yview}
		set items ""
		foreach item [array names ::doc] {
		    if {[array names ::Tree .doc.tree:[file dirname $item]:children]!="" && [lsearch -exact $::Tree(.doc.tree:[file dirname $item]:children) [file tail $item]]>=0} {
			continue
		    }
		    Tree:newitem .doc.tree $item
		}
		set bindcode {
		    set lbl [Tree:labelat %W %x %y]
		    if { $lbl=="" } { break }
		    Tree:setselection %W $lbl
		    .doc.text configure -state normal
		    .doc.text delete 0.0 end
		    if { [array names ::doc $lbl]!="" } {
			.doc.text insert end "*** [string range $lbl 1 end] ***\n\n"
			.doc.text insert end $::doc($lbl)
		    } else {
			foreach item [lsort [array names ::doc $lbl/*]] {
			    .doc.text insert end "*** [string range $item 1 end] ***\n\n"
			    .doc.text insert end $::doc($item)\n\n\n
			}
		    }
		    .doc.text configure -state disabled
		}
		.doc.tree bind x <1> $bindcode
		.doc.tree bind x <B1-Motion> $bindcode

		# Create the find box thingy

		frame .doc.find -relief sunken -borderwidth 1
		pack [entry .doc.find.entry] -side left -fill x -expand 1
		.doc.find.entry insert 0 "Find currently unsupported.  Would you like to add support for it?"
		pack [button .doc.find.find -text "Find"] -side left
		pack [button .doc.find.findnext -text "Find Next"] -side left
		pack [checkbutton .doc.find.backwards -text "Backwards"] -side left
		pack [checkbutton .doc.find.case -text "Case Sensitive"] -side left
		pack [checkbutton .doc.find.regexp -text "Regexp"] -side left
		focus .doc.find.entry
		# FIXME Add in keystroke support to the next and checkbuttons
		# as well as the entry box. Make pgup/pgdn/up/down move the
		# text box.  Make ESC & ctrl-f4 close the box.

		# Pack everything
		pack .doc.find -fill x -side bottom
		pack .doc.tree -side left -fill y -padx 2 -pady 2
		pack .doc.tree_yscroll -side left -fill y
		pack [text .doc.text -background white -wrap word -yscrollcommand {.doc.text_yscroll set} -state disabled -width 10] -fill both -expand 1 -side left
		pack [scrollbar .doc.text_yscroll -orient vertical -command {.doc.text yview}] -fill y -expand 1
	    }

	    # Load up the appropriate sections

	    if { ![llength $args] || [lindex $args 0]=="" } {
		set args "{{How To/Use Help}}"
	    }
	    .doc.text configure -state normal
	    .doc.text delete 0.0 end
	    foreach item [lindex $args 0] {
		if { [string index $item 0]!="/" } {
		    set item "/$item"
		}
		if [info exists ::doc($item)] {
		    .doc.text insert end "*** [string range $item 1 end] ***\n\n"
		    .doc.text insert end $::doc($item)\n\n\n
		}
	    }
	    .doc.text configure -state disabled
	}
	default {
	    error "Invalid subcommand.  Valid alternatives: add"
	}
    }
}

doc add "Procedures ($doc_type)/$doc_section/doc" "doc add <pathname> <text>
doc remove <pathname mask>
doc show \[<section(s)>]

The doc command is used to insert your documention into QuIRC's Documentation System.  It is really quite simple to use and you should make use of it if you add anything to QuIRC.

pathname
    A pathname similar to a directory path, usually a list of words seperated by the / character.  It is used to indicate to QuIRC where the documentation goes.  There are a few standards for this.  In most cases, the first item in the pathname is the type of item you're documenting, be it 'Variables', 'Procedures', 'Aliases', or 'Events'.  The second item is usually the name of the script you're documenting, for example 'Info' for info.tcl.  Case matters, so be careful to keep it the same.  The third item is usually the name of the item, such as 'dict' for the /dict alias.  Be sure to keep in mind that the help system may assume the data is of this form and perform seaches and lookups based on that.

text
    The text for the doc should not contain newlines to wrap lines (but it can contain newlines to seperate paragraphs).

pathname mask
    A mask (possibly including *) that matches pathnames.

sections(s)
    A optional list of sections to display.

The add command simply adds items into the documentation system.

The remove command removes items or sections from the documentation.  You should make use of this when scripts are unloaded.

The show command brings up the documentation window for use.  When a section has children but does not have documentation associated with itself, displaying that section will cause the documentation for all of its children to be displayed.  This is useful to do things such as list all available aliases.

Here are some examples:

doc Aliases/Info/dict {/dict <word>

Use this command to look up words in 8 online dictionaries.}

doc remove */Info/*

doc show Aliases/Info/dict"

# This is just a quick doc note about what this file is.
doc add "Scripts ($doc_type)/$doc_section" "~/.quirc/global.tcl

This file contains most of the tcl that is loaded globally.  For server specific tcl, see server.tcl"


# ALIASES

# /abort
doc add "Aliases ($doc_type)/$doc_section/abort" "/abort

Exits QuIRC."

alias abort {
    exit
}

# /alias
doc add "Aliases ($doc_type)/$doc_section/alias" "/alias <name> <script>

Creates an alias in the dynamic namespace.  It creates wrapper code so that if the alias is executed from a server as opposed to globally, it will run as if it were a server specific alias.  Here is a simple example that allows you to use /new_cd to activate /cd:

    /alias /new_cd /cd \$arg

or

    /alias new_cd /cd \$arg

script can be as complicated as you wish, there is no need to limit it to something as simple as in the examples."

alias alias {
    set name [lindex [split $arg " "] 0]
    if { [string index $name 0]=="/" } {
	set name [string range $name 1 end]
    }
    set script [join [lrange [split $arg " "] 1 end]]
    if { $arg==" " || $arg=="" } {
	echo " \0030,4 SCRIPT \003 Dynamic Aliases:"
	set aliaslist ""
	foreach command [info commands ::dynamic::alias_*] {
	    lappend aliaslist [string range [lindex [split $command ":"] 4] 6 end]
	}
	echo " \0030,4 SCRIPT \003 [join $aliaslist]"
    } else {
	if { [string index $name 0]=="-" } {
	    set name [string range $name 1 end]
	    if { [string index $name 0]=="/" } {
		set name [string range $name 1 end]
	    }
	    rename ::dynamic::alias_$name ""
	    echo " \0030,4 SCRIPT \003 Removing alias $name from ::dynamic namespace."
	} else {
	    proc ::dynamic::alias_$name { arg } "
                set server -1
                if { \[info level]==1 } {
                    if { \[currentindex]!=-1 } {
	                set server \[currentindex]
                    }
                } else {
	            if { \[info level] > 2 } {
                        set server \[lindex \[split \[info level -2] \"::\"] 2]
	                if {!\[regexp \"\\\[0-9]+\" \$server]} {set server -1}
                    }
                }
                if { \$server==-1 } {
	            $script
                } else {
                    while { \[info commands \[set procname ::\${server}::internal::evalserver_\[expr rand()]]]!=\"\" } {}
                    proc \$procname { arg } {
                        $script
                    }
                    \$procname \$arg
                    rename \$procname \"\"
                }
            "
	    echo " \0030,4 SCRIPT \003 Creating alias $name in ::dynamic namespace."
	}
    }
}

# /append
doc add "Aliases ($doc_type)/$doc_section/append" "/append <variable> \[<value>]

Appends onto the list given by variable (in the dynamic namespace) the given value.  If no value is given, shows the joined contents of the variable."

alias append {
    set args [split $arg]
    set data [join [lrange [split $arg " "] 1 end]]
    if { ![llength $args] } {
	error "Usage: /append <variable> [<value>]"
    }
    if { [llength $args]>=2 } {
	echo " \0030,6 SET \003\0032 [lindex $args 0] \003set to:\0032 [join [lappend ::dynamic::[lindex $args 0] $data]]"
    } else {
	echo " \0030,6 SET \003\0032 [lindex $args 0] \003is set to:\0032 [join [set ::dynamic::[lindex $args 0]]]"
    }
}

# /beep
doc add "Aliases ($doc_type)/$doc_section/beep" "/beep

Rings the bell."

alias beep {
    bell
}

# /bye
doc add "Aliases ($doc_type)/$doc_section/bye" "/bye \[<message>]

Exits the client sending quit message given to all the current servers.  The quit message does not always arrive at the servers, sometimes the socket is closed too soon."

alias bye {
    if { $arg!="" } {
	foreach server [servers] {
	    evalserver $server "
                set ::${server}::intentional_disconnect 1
                quote \"QUIT :$arg\"
            "
	}
    }
    exit
}

# /cd
doc add "Aliases ($doc_type)/$doc_section/cd" "/cd \[<dir>]

Changes or displays the current working directory of the client."

alias cd {
    if { $arg=="" } {
	echo " \0030,14 DIR \003 Current: [pwd]"
    } else {
	cd $arg
	echo " \0030,14 DIR \003 Changed to: $arg"
    }
}

# /chartable
doc add "Aliases ($doc_type)/$doc_section/chartable" "/chartable

Displays a table of the first 256 characters (starting at 32)."

alias chartable {
    set data ""
    for { set n 32 } { $n < 256 } { incr n } {
	if { [expr $n%4==0] && $data!="" } {
	    echo [string range $data 0 [expr [string length $data]-2]]
	    set data ""
	}
	append data "'[to_char $n]'=$n\t"
    }
    echo [string range $data 0 [expr [string length $data]-2]]
}

# /clear
doc add "Aliases ($doc_type)/$doc_section/clear" "/clear

Clears the text from the current window."

alias clear {
    [currentwindow].text configure -state normal
    [currentwindow].text delete 0.0 end
    for { set n 0 } { $n < $::dynamic::blank_lines_before_text } { incr n } {
	[currentwindow].text insert end \n
    }
    [currentwindow].text configure -state disabled
    [currentwindow].text yview moveto 1
}

# /clearall
doc add "Aliases ($doc_type)/$doc_section/clearall" "/clearall

Clears the text from the all windows.  This does not clear the text from the /rawview window.  Use /clearrawview to do that."

alias clearall {
    foreach window [windows] {
	$window.text configure -state normal
	$window.text delete 0.0 end
	for { set n 0 } { $n < $::dynamic::blank_lines_before_text } { incr n } {
	    $window.text insert end \n
	}
	$window.text configure -state disabled
	$window.text yview moveto 1
    }
}

# /clearrawview
doc add "Aliases ($doc_type)/$doc_section/clearrawview" "/clearrawview

Clears all text from the /rawview window."

alias clearrawview {
    .raw.text delete 0.0 end
}

# /config
doc add "Aliases ($doc_type)/$doc_section/config" "/config

Runs the main configuration dialog."

alias config {
    config
}

# /doc
doc add "Aliases ($doc_type)/$doc_section/doc" "/doc \[<alias>|<item>]

If no arguments are specified, the documentation for the documentation system will be displayed.

You can specify various items such as:

    /alias
    procname
    event_name

Basically it just searches for the given item in the last level of the documentation trees.  For example, it searches Aliases/*/hi when you do /doc /hi.  If you do /doc hi, it will search for */hi.  The search is case sensitive."

alias doc {
    if { [string index $arg 0]=="/" } {
	set items ""
	foreach item [array names ::doc "/Aliases (Server)/*[string tolower $arg]"] {
	    lappend items $item
	}
	foreach item [array names ::doc "/Aliases (Global)/*[string tolower $arg]"] {
	    lappend items $item
	}
	doc show $items
    } else {
	set items ""
	foreach item [array names ::doc */$arg] {
	    lappend items $item
	}
	doc show $items
    }
}

# /eval
doc add "Aliases ($doc_type)/$doc_section/eval" "/eval <tcl script>

Evaluates the given tcl script in the global namespace if in the Main Status window, otherwise it evaluates in the namespace of the current server.  The results are echoed to the current window."

alias eval {
    if { [currentwindow]==".main" } {
	uplevel "#0" "echo \[eval {$arg}]"
    } else {
	evalserver [currentindex] "echo \[eval {$arg}]"
    }
}

# /evalglobal
doc add "Aliases ($doc_type)/$doc_section/evalglobal" "/evalglobal <tcl script>

Evalutates the given tcl script in the global namespace.  The results are echoed to the current window."

alias evalglobal {
    uplevel "#0" "echo \[eval {$arg}]"
}

# /evalglobalnr
doc add "Aliases ($doc_type)/$doc_section/evalglobalnr" "/evalglobalnr <tcl script>

Evalutates the given tcl script in the global namespace.  The results are not echoed."

alias evalglobalnr {
    uplevel "#0" "eval {$arg}"
}

# /evalnr
doc add "Aliases ($doc_type)/$doc_section/evalnr" "/evalnr <tcl script>

Evaluates the given tcl script in the global namespace if in the Main Status window, otherwise it evaluates in the namespace of the current server.  The results are not echoed."

alias evalnr {
    if { [currentwindow]==".main" } {
	uplevel "#0" "eval {$arg}"
    } else {
	evalserver [currentindex] "eval {$arg}"
    }
}

# /exec
doc add "Aliases ($doc_type)/$doc_section/exec" "/exec \[-o] <shell command>

Runs the given command.  If -o is specified, it send the result to the current session.  If -o is specified, the command is not run in the background.  Be careful not to freeze QuIRC by running a process that doesn't exit quickly.  You can kill off the child process to return control to QuIRC if such an event occurs."

alias exec {
    set arg [getopts $arg o]
    if { $o } {
	say [eval "exec [split $arg { }]"]
    } else {
	eval "exec [split $arg { }] &"
    }
}

# /load
doc add "Aliases ($doc_type)/$doc_section/load" "/load <script>

Loads the given script either into the global namespace if the Main Status window is presently active, or into the regular script namespace of the active server."

alias load {
    if { [currentindex]=="-1" } {
	scriptglobal $arg
    } else {
	evalserver [currentindex] "script $arg"
    }
}

# /loadglobal
doc add "Aliases ($doc_type)/$doc_section/loadglobal" "/loadglobal <script>

Loads the given script into the global namespace.  Note that there are no provisions in place for easily unloading globally loaded scripts."

alias loadglobal {
    scriptglobal $arg
}

# /newserver
doc add "Aliases ($doc_type)/$doc_section/newserver" "/newserver \[<server>\[:\[<port>]\[:<password>]]]

Starts a new server using the given server, port, and password data."

alias newserver {
    eval "newserver [split $arg]"
}

# /rawview
doc add "Aliases ($doc_type)/$doc_section/rawview" "/rawview

Allows you to view the output to and from the server."

alias rawview {
    raise .raw
}

# /remove
doc add "Aliases ($doc_type)/$doc_section/remove" "/remove <variable> <value>

Removes from the list given by variable (in the dynamic namespace) the given value."

alias remove {
    set args [split $arg " "]
    if { [llength $args]<2 } {
	error "Usage: /remove <variable> <value>"
    }
    set data [join [lrange $args 1 end]]
    set index [lsearch -exact [set ::dynamic::[lindex $args 0]] $data]
    if { $index==-1 } {
	error "$data not found in variable ::dynamic::[lindex $args 0]"
    }
    set ::dynamic::[lindex $args 0] [lreplace [set ::dynamic::[lindex $args 0]] $index $index]
    echo " \0030,6 SET \003\0032 [lindex $args 0] \003set to:\0032 [join [set ::dynamic::[lindex $args 0]]]"
}

# /search
doc add "Aliases ($doc_type)/$doc_section/search" "/search \[-forwards] \[-regexp] \[-case] \[-reset] <text>

Searches for the text using the given options.  By default, it searches backwards for an case insensitive match.  The forwards option causes it to search forwards.  The regexp option causes it to interpret text as a regular expression.  Case causes it to not ignore case.  If you want the search to start from the end (or beginning with -backwards), you can use -reset.  If you want to search for the next item, simply perform the exact same search again."

alias search {
    set newarg [getopts $arg forwards reset regexp case]
    set options ""
    if { !$forwards } { append options " -backwards" }
    if { $regexp } { append options " -regexp" }
    if { !$case } { append options " -nocase" }
    # Check for a previous search
    if { [info vars ::internal::search_pathname]=="" ||
	 $::internal::search_pathname!=[currentwindow] ||
	 [info vars ::internal::search_arg]=="" ||
	 $::internal::search_arg!=$arg ||
	 $reset
     } {
	set ::internal::search_pathname [currentwindow]
	set ::internal::search_arg $arg
	if { $forwards } {
	    set ::internal::search_index 0.0
	} else {
	    set ::internal::search_index end
	}
    }
    set arg $newarg
    set result [eval "[currentwindow].text search $options -- [escape $arg] $::internal::search_index"]
    if { $result=="" } {
	unset ::internal::search_pathname
	unset ::internal::search_index
    } else {
	[currentwindow].text see $result
	set sr [split $result "."]
	if { $forwards } {
	    set ::internal::search_index [lindex $sr 0].[expr [lindex $sr 1]+1]
	} else {
	    set ::internal::search_index [lindex $sr 0].[expr [lindex $sr 1]-1]
	}
    }
}

# /server
doc add "Aliases ($doc_type)/$doc_section/server" "/server \[<server>\[:\[<port>]\[:<password>]]]

Reconnects to the given server taking the place of the existing server.  If no server is current, it will start a new server."

alias server {
    if { [currentindex]==-1 } {
	newserver $arg
    } else {
	::template::server [currentindex] $arg
    }
}

# /set
doc add "Aliases ($doc_type)/$doc_section/set" "/set \[-|+]\[<variable>] \[<value>]

Stores value in the given variable in the dynamic namespace.  If no value is given, it will print the contents of the variable.  If no arguments at all are given, it will show a sorted list of all variables and their values.  If the variable is prefixed with -, it will set the variable to empty.  If the variable is prefixed with +, it will be appended to.  Set allows wildcards for the displaying of variables."

alias set {
    set args [split $arg " "]
    set data [join [lrange [split $arg " "] 1 end]]
    set glob [lindex $args 0]
    if { [lindex $args 0]=="" } {
	foreach var [lsort [info vars ::dynamic::*]] {
	    if { [array exists $var] } {
		foreach name [lsort [array names $var]] {
		    fdisplay SET_DISPLAY [string range $var 11 end]($name) [set ${var}($name)]
		}
	    } else {
		fdisplay SET_DISPLAY [string range $var 11 end] [set $var]
	    }
	}
    } else {
	if { $data!="" || [string index [lindex $args 0] 0]=="-" || ([string index [lindex $args 0] 0]=="+" && $data!="") } {
	    if { [string index [lindex $args 0] 0]=="-" } {
		set ::dynamic::[string range [lindex $args 0] 1 end] ""
		fdisplay SET_CLEARED [string range [lindex $args 0] 1 end]
	    } elseif { [string index [lindex $args 0] 0]=="+" } {
		set varname [string range [lindex $args 0] 1 end]
		set ::dynamic::$varname "[set ::dynamic::$varname]$data"
		fdisplay SET_APPENDED $varname [set ::dynamic::$varname]
	    } else {
		set ::dynamic::[lindex $args 0] $data
		fdisplay SET_CHANGED [lindex $args 0] $data
	    }
	} else {
	    foreach variable [lsort [info vars ::dynamic::[lindex $args 0]]] {
		if { [array exists $variable] } {
		    foreach key [lsort [array names $variable]] {
			fdisplay SET_DISPLAY [string range $variable 11 end]($key) [set ${variable}($key)]
		    }
		} else {
		    fdisplay SET_DISPLAY [string range $variable 11 end] [set $variable]
		}
	    }
	}
    }
}

# /store
doc add "Aliases ($doc_type)/$doc_section/store" "/store \[-geometry|-size]

Saves the data stored in the dynamic namespaces into dynamic.tcl.  If -geometry is specified, then the current size and position of the QuIRC window will be saved.  If -size is specified, then only the size will be stored.  The old dynamic.tcl will be backed up as dynamic.tcl~."

alias store {
    foreach a [split $arg] {
	switch -- $a {
	    "-geometry" {
		echo " \0030,4 SCRIPT \003 Setting default_geometry to [wm geometry .]"
		set ::dynamic::default_geometry [wm geometry .]
	    }
	    "-size" {
		echo " \0030,4 SCRIPT \003 Setting default_geometry to [lindex [split [wm geometry .] "+"] 0]"
		set ::dynamic::default_geometry [lindex [split [wm geometry .] "+"] 0]
	    }
	    default {
		error "usage: /store \[-geometry|-size]"
		return
	    }
	}
    }
    if { [file exists $::env(HOME)/.quirc/dynamic.tcl] } {
	file copy -force "$::env(HOME)/.quirc/dynamic.tcl" "$::env(HOME)/.quirc/dynamic.tcl~"
    }
    set of [open $::env(HOME)/.quirc/dynamic.tcl "WRONLY CREAT TRUNC"]
    foreach var [info vars ::dynamic::*] {
	if { ![string match ::dynamic::theme_* $var] } {
	    if { ![array exists $var] } {
		puts $of "set $var [escape [set $var]]"
	    } else {
		puts $of "array set $var {[array get $var]}"
	    }
	}
    }
    foreach command [info commands ::dynamic::alias_*] {
	set procname [lindex [split $command ":"] 4]
	puts $of "proc $procname { [info args $command] } { [info body $command] }"
    }
    close $of
    echo " \0030,4 SCRIPT \003 Storing ::dynamic namespace to ~/.quirc/dynamic.tcl"
}

# /unset
doc add "Aliases ($doc_type)/$doc_section/unset" "/unset <variable> \[<variable> ...]

Stores value in the given variable in the dynamic namespace.  If no value is given, it will print the contents of the variable.  If no arguments at all are given, it will show available variables."

alias unset {
    if { $arg=="" } {
	set varlist ""
	foreach var [info vars ::dynamic::*] {
	    lappend varlist [string range $var 11 end]
	}
	echo " \0030,6 SET \003 Available variables: $varlist"
    } else {
	foreach var [split $arg " "] {
	    unset ::dynamic::$var
	    echo " \0030,6 SET \003\0032 $var \003unset."
	}
    }
}

# EVENTS

# event_client_start
doc add "Events ($doc_type, Script)/$doc_section/event_client_start" "event_client_start

In the default version, it checks if there is an array called auto_start, set by commands such as:

    /set auto_start(irc.server1.net) /join #Channel1,#Channel2
    /set auto_start(irc.server2.net) /join #Channel3 Key

It will start the servers specified and run the given script.  The script should be valid TCL script and can contain semi-colons to seperate multiple commands.  If the array doesn't exist, newserver will be run with the default server and port settings.  The server set in the auto_start array can have the same format as /newserver allows."

proc event_client_start {} {
    if { [array exists ::dynamic::auto_start] } {
	foreach server [array names ::dynamic::auto_start] {
	    set ::[newserver $server]::auto_start [set ::dynamic::auto_start($server)]
	}
    } else {
	newserver
    }
}

# event_echo
doc add "Events ($doc_type, Script)/$doc_section/event_echo" "event_echo <message> <pathname> <new>

This event handler performs windowlist nick highlighting, scrollback size limiting, URL highlighting, and timestamping."

proc event_echo { message pathname new } {
    # Highligting on nick
    if { $::dynamic::windowlist_nick_highlight } {
        if { $pathname != ".main" } {
	    set nick [evalserver [serverindex $pathname] mynick]
	    regsub -all {\W} $nick {\\&} escnick
	    # Lowercase them so we match different cases
	    set lcmess [string tolower $message]
	    set escnick [string tolower $escnick]
	    # Crazy regexp to try and match nicks only when they're not part of
	    # other words.
	    set expr {[^][`{}a-z0-9_^-]}
	    if { [regexp "($expr|^)${escnick}($expr|\$)" $lcmess] } {
		# Add in the special coloring for the nick highlighting.  This
		# doesn't really need to be done here, but here it is anyways.
                windowlist_addcolor special 2000 $::dynamic::theme_windowlist_specialforeground $::dynamic::theme_windowlist_specialbackground

		windowlist_colorize $pathname special
            }
        }
    }

    # Scrollback size limiting
    if { $::dynamic::scrollback_length } {
	if { [$pathname.text index end] >
	     [expr $::dynamic::scrollback_length+$::dynamic::blank_lines_before_text+1]} {
	    $pathname.text configure -state normal
	    set bl [expr $::dynamic::blank_lines_before_text+2]
	    $pathname.text delete $bl.0 [expr $bl+1].0
	}
    }

    # URL highlighting
    if { $::dynamic::url_highlighting } {
	set messagetags [URLparse $message $pathname]
    } else {
	set messagetags [gettags $message]
    }

    # Timestamp system
    if { [info tclversion]>=8.3 || $::dynamic::timestamp } {
	set timestamp [addtag [gettags "[clock format [clock seconds] -format $::dynamic::timestamp_format] " $pathname] timestamp]
	echotags [concat [gettags \n] $timestamp $messagetags] $pathname $new
    } else {
	echotags [concat [gettags \n] $messagetags] $pathname $new
    }
    return ""
}

# event_first_time
doc add "Events ($doc_type, Script)/$doc_section/event_first_time" "event_first_time

The default action is to simply run the basic configurator."

proc event_first_time {} {
    basicconfig
}

# event_windowchanged
doc add "Events ($doc_type, Script)/$doc_section/event_windowchanged" "event_windowchanged <old_pathname> <old_name> <old_server> <old_index> <pathname> <name> <server> <index>

Changes the server lag indicator to match the visible server.  Updates the title for query windows."

proc event_windowchanged { oldpathname oldname oldserver oldindex pathname name server index } {
    if { [winfo exists .buttonbar.lag] } {
	if { $server==-1 } {
	    .buttonbar.lag configure -text ""
	} else {
	    if { [info vars ::${server}::lagtext]!="" } {
		.buttonbar.lag configure -text [set ::${server}::lagtext]
	    } else {
		.buttonbar.lag configure -text ""
	    }
	}
    }
    if { [string match ".query*" $pathname] } {
	evalserver $server "
	    if { \[userhost [escape $name]]==\"\" } {
                title $pathname \"QuIRC - [escape $name]\"
            } else {
                title $pathname \"QuIRC - [escape $name] (\[userhost [escape $name]])\"
            }
	"
    }
}

# PROCEDURES

# active_set
doc add "Procedures ($doc_type)/$doc_section/active_set" "active_set <name> <value>

This procedure is to be used when setting variables within the ::dynamic namespace.  It sets the variable ::dynamic::<name> to the given <value>.  Once it has set the value, it checks to see if there is a script available to be run (from \"config command\") and runs it."

proc active_set { name value } {
    set ::dynamic::$name $value
    if { [info exists ::config::command($name)] } {
	uplevel #0 $::config::command($name)
    }
}


# addtag
doc add "Procedures ($doc_type)/$doc_section/addtag" "addtag <taglist> <tag>

Adds a given tag to all the elements of the tag list (as returned by gettags)."

proc addtag { taglist tag } {
    set result ""
    for { set n 1 } { $n < [llength $taglist] } { incr n 2 } {
	lappend result [lindex $taglist [expr $n-1]]
	set templist [list [lindex $taglist $n]]
	lappend templist $tag
	lappend result $templist
    }
    if { [expr [llength $taglist]%2] } {
	lappend result [lindex $taglist [expr $n-1]]
    }
    return $result
}

# arraysplit
doc add "Procedures ($doc_type)/$doc_section/arraysplit" "arraysplit <array name> <string to split>

Splits the given string on spaces.  Each item is placed into the array name given."

proc arraysplit { arrayname argument } {
    upvar $arrayname an
    set args [split $argument " "]
    for { set n 0 } { $n < [llength $args] } { incr n } {
	set an($n) [lindex $args $n]
    }
}

# condis
doc add "Procedures ($doc_type)/$doc_section/condis" "condis \[<text>] \[<command>]

This proc is used to set the text and script for the connect/disconnect button.  This is the global portion.  See condis later in the file for more details."

proc condis { {text ""} {command ""} } {
    ::template::condis -1 $text $command
}

# config
doc add "Procedures ($doc_type)/$doc_section/config" "config type <varname> <type> \[arguments]
    type is: enum, boolean, list
config default <varname> <value>
config type_default <type> <default>
config command <varname> <code>
    Gets run when the variable is set."

# Could add regexp mask(s) to check for for valid input when "setting."
proc config { args } {
    if { ![llength $args] } {
	# No arguments, display config dialog.

	if [winfo exists .config] {
	    raise .config
	    return
	}
	
	toplevel .config

	::config::refresh ""

	wm geometry .config 600x400
    } else {
	switch -- [lindex $args 0] {
	    "type" {
		# FIXME - Check for invalid number of arguments error
		set ::config::type([lindex $args 1]) [lindex $args 2]
	    }
	    "type_default" {
		# FIXME - Check for invalid number of arguments error
		set ::config::type_default([lindex $args 1]) [lindex $args 2]
	    }
	    "default" {
		set ::config::default([lindex $args 1]) [lindex $args 2]
	    }
	    "command" {
		set ::config::command([lindex $args 1]) [lindex $args 2]
	    }
	    default {
		error "Invalid config subcommand."
	    }
	}
    }
}

# evalserver
doc add "Procedures ($doc_type)/$doc_section/evalserver" "evalserver <index> <script>

Makes the given script run under the server given by index.  Is equivalent to: namespace eval ::<index> <script>"

proc evalserver { index script } {
    return [namespace eval ::$index $script]
}

# fact
doc add "Procedures ($doc_type)/$doc_section/fact" "fact <number>

A function that calculates the factorial of a number using recursion.  If you need it to calculate large imprecise factorials, use a floating point number (31 is the integer limit, 170.0 is the float limit)."

proc fact { n } {
    if { $n<2 } {
	return 1
    } else {
	return [expr $n*[fact [expr $n-1]]]
    }
}

# from_char
doc add "Procedures ($doc_type)/$doc_section/from_char" "from_char <char>

Returns the character code value of the given character."

proc from_char { char } {
    scan $char %c value
    return $value
}

# getopts
doc add "Procedures ($doc_type)/$doc_section/getopts" "getopts <text> \[<argument> \[<argument> ...]]

Parses text for the given arguments.  Arguments are either single item lists, in which case you can specify the argument as either -option or just option.  Or, if you have a list of more than one, you need to indicate which items are options and which, if any, is the variable to store the parameter given to that argument.  getopts returns the text with the arguments parsed out.  Extra whitespace is returned as part of the data itself.  (Should this be changed?  If so, what should it do?)  FIXME - There are no provisions for argument parameters with spaces.  This should probably parse arguments like the tcl interpreter does instead.  Except it probably shouldn't parse $ and such out.  Should accept abbrievs."

proc getopts { text args } {
    set splittext [split $text " "]
    set loc [lsearch -exact $splittext --]
    if { $loc==-1 } {
	set parselist $splittext
	set rest ""
    } else {
	set parselist [lrange $splittext 0 [expr $loc-1]]
	set rest [lrange $splittext [expr $loc+1] end]
    }
    set start ""
    foreach arg $args {
	if { [string index [lindex $arg 0] 0]=="-" } {
	    set nodash [string range [lindex $arg 0] 1 end]
	} else {
	    set nodash [lindex $arg 0]
	}
	if { [llength $arg]==1 } {
	    upvar $nodash var
	    set var 0
	    set loc [lsearch -exact $parselist -$nodash]
	    if { $loc!=-1 } {
		set parselist [concat [lrange $parselist 0 [expr $loc-1]] [lrange $parselist [expr $loc+1] end]]
		set var 1
	    }
	} elseif { [llength $arg]==2 } {
	    upvar $nodash var
	    upvar [lindex $arg 1] data
	    set var 0
	    set loc [lsearch -exact $parselist -$nodash]
	    if { $loc!=-1 } {
		set parselist [concat [lrange $parselist 0 [expr $loc-1]] [lrange $parselist [expr $loc+2] end]]
		set data [lindex $parselist $data]
		set var 1
		# Should we check for null data error?
	    }
	} else {
	    error "Improper number of items in an argument list item."
	}
    }
    return [join [concat $parselist $rest]]
}

# is_ip_addr
doc add "Procedures ($doc_type)/$doc_section/is_ip_addr" "is_ip_addr <ip>

Returns true if ip is a numeric dotted ipv4 address."

proc is_ip_addr { addr } {
    return [regexp {^[0-9][0-9]?[0-9]?\.[0-9][0-9]?[0-9]?\.[0-9][0-9]?[0-9]?\.[0-9][0-9]?[0-9]?$} $addr]
}

# is_link
doc add "Procedures ($doc_type)/$doc_section/is_link" "is_link <file>

Returns true if file exists and is a symlink."

proc is_link { file } {
    set result 0
    catch { if { [file type $file]=="link" } { set result 1 } }
    return $result
}

# is_number
doc add "Procedures ($doc_type)/$doc_section/is_number" "is_number <number>

Returns true if the given argument is a number, false if not."

proc is_number { number } {
    if {[catch [list expr "double($number)"]]} {
	return 0
    } else {
	return 1
    }
}

# llongest
doc add "Procedures ($doc_type)/$doc_section/llongest" "llongest <list>

Returns the string length of the longest entry in the list."

proc llongest { list } {
    set longest 0
    foreach entry $list {
	if { [string length $entry] > $longest } {
	    set longest [string length $entry]
	}
    }
    return $longest
}

# mask
doc add "Procedures ($doc_type)/$doc_section/mask" "mask <type> <mask>

Returns a generalized version of the given mask according to the given type.

The types are as follows:
  0   *!user@host
  1   *!*user@host
  2   *!*@host
  3   *!*user@*.host.com
  4   *!*@*.host.com
  5   nick!user@host
  6   nick!*user@host
  7   nick!*@host
  8   nick!*user@*.host.com
  9   nick!*@*.host.com

*.host.com would be 123.123.123.* if the IP were numeric.  To get *.host.com, the first word is replaced with a *."

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

# max
doc add "Procedures ($doc_type)/$doc_section/max" "max <a> <b>

Returns the larger of the two numbers."

proc max { a b } {
    if { $b > $a } {
	return $b
    } else {
	return $a
    }
}

# member
doc add "Procedures ($doc_type)/$doc_section/member" "member <list> <item>

Returns true if item is a member of list."

proc member { list item } {
    return [expr [lsearch -exact $list $item]+1]
}

# openurl
doc add "Procedures ($doc_type)/$doc_section/openurl" "openurl <pathname>

Gets the text from the URL tag currently in focus from pathname, then runs netscape -remote, or just runs netscape if netscape isn't running.  If url_command is not set to builtin_netscape, whatever is in the url_command variable is run."

proc openurl { pathname } {
    set text [$pathname tag prevrange URL [$pathname index insert]]
    set list1 [split $text]
    set temps [$pathname get [lindex $list1 0] [lindex $list1 1]]
    if { $::dynamic::url_command == "builtin_netscape" } {
	if { [is_link $::env(HOME)/.netscape/lock] } {
	    if { [catch {
		exec netscape -remote openURL($temps,new-window) 2>&1 > /dev/null &
	    }] } {
		file delete $::env(HOME)/.netscape/lock
		exec netscape $temps 2>&1 > /dev/null &
	    }
	} else {
	    exec netscape $temps 2>&1 > /dev/null &
	}
    } else {
	set command [escape $::dynamic::url_command]
        regsub -all -- {\\ } $command { } command2
        regsub -all -- {\\"} $command2 {"} command
        set command [parseformat $command {{u {[escape $temps]}}}]
        eval "exec $command"
    }
}
    
# parseformat
doc add "Procedures ($doc_type)/$doc_section/parseformat" "parseformat <format string> <format/variable list>

Takes a format string, with substrings such as %e, %w, and %% in them.  It then parses this info, replacing the escape sequences with what it finds in the format/variable list.  It will not handle items for which no escape sequence exists.  The %% sequence always generates a single %.

For example:

parseformat \"This is %e and this is not %w.  That is %t accurate to 23%%e-3\" {{e THE_E} {w THE_W}}

Returns:

\"This is THE_E and this is not THE_W.  That is %t accurate to 23%e-3\""

proc parseformat { format list } {
    set ret ""
    for { set i 0 } { $i < [string length $format] } { incr i } {
        set char [string index $format $i]
	if { $char == "%" && [string length $format]-1 != $i } {
            incr i
	    set char [string index $format [expr $i]]
	    if { $char == "%" } {
		append ret $char
		continue
	    }
	    set got 0
	    foreach item $list {
		if { [lindex $item 0] == $char } {
		    append ret [lindex $item 1]
		    set got 1
		    break
		}
	    }
	    if { !$got } {
		append ret "%$char"
	    }
	} else {
	    append ret $char
	}
    }
    return $ret
}

# push
doc add "Procedures ($doc_type)/$doc_section/push" "push <stack> <item>

Pushes the item into the stack."

proc push { thestack item } {
    upvar $thestack stack
    if { ![info exists stack] } {
	set stack ""
    }
    set stack [linsert $stack 0 $item]
}

# pop
doc add "Procedures ($doc_type)/$doc_section/pop" "pop <stack>

Pops an item off the given stack."

proc pop { thestack } {
    upvar $thestack stack
    set temp [lindex $stack 0] 
    set stack [lrange $stack 1 end]
    return $temp
}

# random_quit
doc add "Procedures ($doc_type)/$doc_section/random_quit" "random_quit

Checks for the existance of ~/.quirc/quit.txt.  If it exists, it picks a random quit message from it and sets that to be the default quit message."

proc random_quit {} {
    if { [file exists $::env(HOME)/.quirc/quit.txt] } {
	set file [open $::env(HOME)/.quirc/quit.txt]
	while { ![eof $file] } {
	    gets $file temp
	    if {$temp!=""} {
		lappend quits $temp
	    }
	}
	close $file
	if { [llength $quits]==0 } { return }
	set ::dynamic::default_quit [lindex $quits [expr int(rand() * [llength $quits])]]
    }
}

# rpn
doc add "Procedures ($doc_type)/$doc_section/rpn" "rpn <arg1> <arg2> ...

Returns the results from evaluating the given rpn expression."

proc rpn { args } {
    foreach arg $args {
	if { [is_number $arg] } {
	    push stack $arg
	} else {
	    set second [pop stack]
	    set first [pop stack]
	    push stack [expr $first $arg $second]
	}
    }
    return [pop stack]
}

# scriptglobal
doc add "Procedures ($doc_type)/$doc_section/scriptglobal" "scriptglobal <script>

Loads the given script into the global namespace."

proc scriptglobal { arg } {
    uplevel "#0" "source \"\$env(HOME)/.quirc/$arg\""
    echo " \0030,4 SCRIPT \003 Loading $arg into global namespace."
}

# to_char
doc add "Procedures ($doc_type)/$doc_section/to_char" "to_char <value>

Returns the character that corresponds to the given character code."

proc to_char { value } {
    return [format %c $value]
}

# uniq
doc add "Procedures ($doc_type)/$doc_section/uniq" "uniq <list>

Returns the list (in sorted order) with duplicates removed."

proc uniq { list } {
    set sorted [lsort $list]
    set uniq ""
    set lastitem ""
    foreach item $sorted {
	if { $lastitem!=$item } {
	    lappend uniq $item
	    set lastitem $item
	}
    }
    return $uniq
}

# unknown
doc add "Procedures ($doc_type)/$doc_section/unknown" "unknown <command> \[<arg(s)>]

Handles commands which aren't found and handled immediately."

proc unknown { args } "
    set server \[lindex \[split \[uplevel {namespace current}] :] 2]
    if { !\[regexp {\[0-9]+} \$server] } {
        set server {}
    }
    set command \[lindex \$args 0]
    if { \$server!={} } {
        if { \[string index \$command 0]==\"/\" } {
            set command \[string range \$command 1 \[expr \[string length \$command]-1]]
            set parsed 0
            set returnvalue 0
            foreach script \[set ::\${server}::scripts] {
                if { \"\[info commands ::\${server}::\${script}::alias_\$command]\"!=\"\" } {
                    set parsed 1
                    set returnvalue \[::\${server}::\${script}::alias_\$command \[join \[lrange \$args 1 end]]]
                    if { \$returnvalue==1 } {
                        break
                    } else {
                        set returnvalue 0
                    }
                }
            }
            if { !\$returnvalue && \"\[info commands ::dynamic::alias_\$command]\"!=\"\" } {
                set parsed 1
                set returnvalue \[::dynamic::alias_\$command \[join \[lrange \$args 1 end]]]
                if { \$returnvalue!=1 } {
                    set returnvalue 0
                }
            }
            if { !\$returnvalue && \"\[info commands ::alias_\$command]\"!=\"\" } {
                set parsed 1
                ::alias_\$command \[join \[lrange \$args 1 end]]
            }
            if { !\$parsed } {
                ::template::quote \$server \"\$command \[join \[lrange \$args 1 end]]\"
            }
        } else {
            if { \"\[info commands ::template::\$command]\"!=\"\" } {
                return \[callproc ::template::\$command \[lrange \$args 1 end] \$server]
            } else {
                [info body unknown_original]
            }
        }
    } else {
        if { \[string index \$command 0]==\"/\" } {
            set command \[string range \$command 1 \[expr \[string length \$command]-1]]


            set returnvalue 0
            set parsed 0
            if { \"\[info commands ::dynamic::alias_\$command]\"!=\"\" } {
                set parsed 1
                set returnvalue \[::dynamic::alias_\$command \[join \[lrange \$args 1 end]]]
                if { \$returnvalue!=1 } {
                    set returnvalue 0
                }
            }
            if { !\$returnvalue && \"\[info commands ::alias_\$command]\"!=\"\" } {
                set parsed 1
                ::alias_\$command \[join \[lrange \$args 1 end]]
            }
            if { !\$parsed } {
                [info body unknown_original]
            }
        } else {
            [info body unknown_original]
        }
    }
"

# URLparse
doc add "Procedures ($doc_type)/$doc_section/URLparse" "URLparse <message> <pathname>

Parses message for URLs, adds the URL tag, then returns the taglist."

proc URLparse { message pathname } {
    set mlist [gettags $message]
    set templ $mlist
    if {[regexp "http://" $message]||[regexp {www\.[^.]} $message]} {
	set templ {}
	set count1 0
	while { $count1 < [llength $mlist] } {
	    set n [lindex $mlist $count1]
	    incr count1
	    if {$count1==[llength $mlist]} {
		break
	    }
	    if {[regexp "http\://" $n]||[string first "www." $n]!=-1} {
		#puts $n
		#Find which comes first, the www. or the http://	
		if {[string first "www." $n]==-1} {
		    set token1 "http\://"
		} elseif {[string first "http\://" $n]==-1} {
		    set token1 "www."
		} elseif {[string first "http\://" $n]<[string first "www." $n]} {
		    set token1 "http\://"
		} else {
		    set token1 "www."
		}
		set temp1 [string first $token1 $n]
		set temp2 [expr $temp1+[string length $token1]]
		while {[string index $n $temp2]!=" " &&
		       [string index $n $temp2]!=")" &&
		       [string index $n $temp2]!="'" &&
		       [string length $n]>=$temp2} {
		    incr temp2
		}
		#Add the first section of the string, and the tag
		lappend templ [string range $n 0 [expr $temp1-1]]
		lappend templ [lindex $mlist $count1]
		
		#add the URL and the tag with the URL added	
		set templ2 [string range $n $temp1 [expr $temp2-1]]
		lappend templ2 [lindex $mlist $count1]
		set templ2 [addtag $templ2 URL]
		lappend templ [lindex $templ2 0]
		lappend templ [lindex $templ2 1]
		
		#add the latter part of the string (change this to sort out any remaining URLs)
		set templ3 [URLparse [string range $n $temp2 end] $pathname]
		set templ [concat $templ $templ3]

		# Skip past the tag so we don't add it in the next iteration.
		incr count1

		#Else if there is now HTTP or WWW, just add it on.
	    } else {
		lappend templ $n
	    }
	}
    }
    return $templ
}

doc add "Procedures ($doc_type)/$doc_section/windowlist_addcolor" "windowlist_addcolor <name> <priority> <fg color> \[<bg color>]

Adds a color for use in the windowlist.  Once you have added a color, you can use it to color entries in the windowlist.  The priority is a number that indicates the importance of the color.  The 0 color is special and should generally not be used.  The 'active' color has a priority of 1000.  If your color is more important than the active color, give it a higher priority, for example 2000.  If you want your color to be overwritten when the window becomes active, use a priority such as 500.  The name for the color is just used to identify the color combination.  You must specify a valid Tk color for the foreground and background colors.  The background color is optional."

proc windowlist_addcolor { name priority args } {
    if { [llength $args] == 1 } {
        QListBox::addcolor .windowlist $name $priority [lindex $args 0]
    } elseif { [llength $args] == 2 } {
        QListBox::addcolor .windowlist $name $priority [lindex $args 0] [lindex $args 1]
    } else {
	error "Invalid number of arguments passed to windowlist_addcolor."
    }
}

doc add "Procedures ($doc_type)/$doc_section/windowlist_colorize" "windowlist_colorize <pathname> <name>

Colors the entry in the window list that corresponds to the given pathname.  The name must be one of the colors added by windowlist_addcolor.  Note that the window list entry will only be colored if the priority of the color is higher than the priority of the existing color."

proc windowlist_colorize { pathname name } {
    QListBox::colorize .windowlist [windowindex $pathname] $name
}


# SERVER SPECIFIC PROCEDURES

# ::template::ban
doc add "Procedures (Server)/$doc_section/ban" "ban \[<channel>] <nick or mask> \[<type>]

Bans the given nick from the given, or current, channel.  If no type is given, type 3 (*!*user@*.domain.name) is assumed.  If the nick contains the ! character, it will simply ban it, ignoring any given type.  The types correspond to those produced by the mask procedure."

proc ::template::ban { index args } {
    if { [llength $args]>3 } {
	error "usage: ban [<channel>] <nick> [<type>]"
    }
    set channel [lindex $args 0]
    set nick [lindex $args 1]
    set type [lindex $args 2]
    if { [llength $args]==1 } {
	set channel [channel]
	set nick [lindex $args 0]
	set type 3
    }
    if { [llength $args]==2 } {
	if { [ischannel [lindex $args 0]] } {
	    set type 3
	} else {
	    set channel [channel]
	    set nick [lindex $args 0]
	    set type [lindex $args 1]
	}
    }
    if { [string match *!* $nick] } {
	::template::quote $index "MODE $channel +b $nick"
    } else {
	::template::quote $index "MODE $channel +b [mask $type $nick![::template::userhost $index $nick]]"
    }
}

# ::template::condis
doc add "Procedures (Server)/$doc_section/condis" "condis \[<text>] \[<command>]

This proc is used to set the text and script for the connect/disconnect button.  The text is something such as \"Disconnect\" or \"Connect\" and the command is the corresponding script to run, such as \"connect\""

proc ::template::condis { index {text ""} {command ""} } {
    if { $index==-1 } {
	if { $text!="" } {
	    set ::condis_text $text
	}
	if { $command!="" } {
	    set ::condis_command $command
	}
	if { [currentindex]==-1 } {
	    .buttonbar.condis configure -command $::condis_command -text $::condis_text
	}
    } else {
	if { $text!="" } {
	    set ::${index}::condis_text $text
	}
	if { $command!="" } {
	    set ::${index}::condis_command $command
	}
	if { [currentindex]==$index } {
	    .buttonbar.condis configure -command [set ::${index}::condis_command] -text [set ::${index}::condis_text]
	}
    }
}

# ::template::modequeue
doc add "Procedures (Server)/$doc_section/modequeue" "modequeue <command> <target> <mode> \[<parameter>]

This command implements a generic mode queuer.  command is either add or flush.  Add for adding mode changes, flush for sending them.  Mode changes will be sent if the queue gets too long.  The target is the channel or nick for which the mode change will occur.  mode is the mode change such as \"+m\"   You can specify the optional mode parameter such as a limit number if the mode requires such."

proc ::template::modequeue { index command target args } {
    set target [string tolower $target]
    if { ![info exists ::${index}::modequeue($target)] } {
	set ::${index}::modequeue($target) ""
    }
    if { ![info exists ::${index}::modeparam($target)] } {
	set ::${index}::modeparam($target) ""
    }
    switch -exact -- $command {
	"add" {
	    if { [llength $args]<1 || [llength $args]>2 } {
		error "usage: modequeue (flush|add <target> <mode> [parameter])"
	    }
	    if { [lindex $args 1]!="" } {
		lappend ::${index}::modeparam($target) [lindex $args 1]
	    }
	    lappend ::${index}::modequeue($target) [lindex $args 0]
	    if { [llength [set ::${index}::modequeue($target)]] == $::dynamic::max_modes } {
		::template::modequeue ${index} flush $target
	    }
	}
	"flush" {
	    if { [llength $args]>0 } {
		error "usage: modequeue (flush|add <target> <mode> [parameter])"
	    }
	    if { [set ::${index}::modequeue($target)]!="" } {
		::template::quote $index "MODE $target [join [set ::${index}::modequeue($target)] {}] [join [set ::${index}::modeparam($target)]]"
		unset ::${index}::modequeue($target)
		unset ::${index}::modeparam($target)
	    }
	}
	default {
	    error "usage: modequeue (flush|add <target> <mode> [parameter])"
	}
    }
}

# ::template::queueban
doc add "Procedures (Server)/$doc_section/queueban" "queueban \[<channel>] <nick or mask> \[<type>]

Adds the ban for the given nick to the modequeue.  To actually send the mode changes, do a modequeue flush #channel.  If no channel is given, the current channel is used.  If no type is given, type 3 (*!*user@*.domain.name) is assumed.   If the nick contains the ! character, it will simply ban it, ignoring any given type."

proc ::template::queueban { index args } {
    if { [llength $args]>3 } {
	error "usage: ban [<channel>] <nick or mask> [<type>]"
    }
    set channel [lindex $args 0]
    set nick [lindex $args 1]
    set type [lindex $args 2]
    if { [llength $args]==1 } {
	set channel [channel]
	set nick [lindex $args 0]
	set type 3
    }
    if { [llength $args]==2 } {
	if { [ischannel [lindex $args 0]] } {
	    set type 3
	} else {
	    set channel [channel]
	    set nick [lindex $args 0]
	    set type [lindex $args 1]
	}
    }
    if { [string match *!* $nick] } {
	::template::modequeue $index add $channel +b $nick
    } else {
	::template::modequeue $index add $channel +b [mask $type $nick![::template::userhost $index $nick]]
    }
}

set command_storage ""

#-Some key bindings
#-Should add a GUI for these...
#-Add:
#-  Where is the key effective?
#-  Which key is it? (Ability to press key)
#-  What code should be run (multiple choice as well as custom)
#-Support for mice somehow?

bind . <Up> {histup}
bind . <Down> {histdown}
bind . <Control-p> {histup}
bind . <Control-n> {histdown}
bind . <Control-Down> {nextwindow}
bind . <Control-Up> {previouswindow}
bind . <Shift-Prior> {[currentwindow].text yview scroll -1 page}
bind . <Shift-Next> {[currentwindow].text yview scroll 1 page}
bind . <Prior> {[currentwindow].text yview scroll -1 page}
bind . <Next> {[currentwindow].text yview scroll 1 page}
bind . <Control-Prior> {if { [channel]!="" } { [currentwindow].nicks yview scroll -1 page } }
bind . <Control-Next> {if { [channel]!="" } { [currentwindow].nicks yview scroll 1 page } }
bind . <Alt-Prior> {.windowlist.t yview scroll -1 page}
bind . <Alt-Next> {.windowlist.t yview scroll 1 page}
bind . <Control-F4> {closewindow [currentwindow]}
bind . <Alt-F4> {exit}
bind . <Alt-n> {source $env(HOME)/.quirc/newserver.tcl}
bind . <Control-comma> {
    if { [[currentwindow].entry get]!="" } {
	push command_storage [[currentwindow].entry get]
	[currentwindow].entry delete 0 end
    }
}
bind . <Control-period> {
    if { [set ::internal::storage_result [pop command_storage]]!="" } {
	[currentwindow].entry delete 0 end
	[currentwindow].entry insert 0 $::internal::storage_result
    }
    unset ::internal::storage_result
}
bind . <Control-t> {
    if { [info tclversion]>=8.3 } {
	if { [[currentwindow].text tag cget timestamp -elide]=="" } {
	    [currentwindow].text tag configure timestamp -elide 0
	}
	[currentwindow].text tag configure timestamp -elide [expr 1-[[currentwindow].text tag cget timestamp -elide]]
    }
}
bind . <F1> {doc show}

# For MouseWheel: 4 is up, 5 is down.
# %b is button number
# %X is root x coord
# %Y is root y coord
# winfo contains <x> <y> returns pathname

bind . <ButtonPress> {mousewheel "" %b %X %Y}
bind . <Shift-ButtonPress> {mousewheel "shift" %b %X %Y}
bind . <Control-ButtonPress> {mousewheel "control" %b %X %Y}

proc mousewheel {mod button x y} {
    if { $button == 4 } {
        set direction -1
    } elseif { $button == 5 } {
        set direction 1
    } else {
        return
    }
    if { $mod == "" } {
        set direction [expr $direction*5]
    }
    set type "units"
    if { $mod == "control" } {
        set type "pages"
    }
    set pathname [winfo containing $x $y]
    if { $pathname == ".windowlist.t" ||
         [string match "*.nicks" $pathname] ||
         [string match "*.text" $pathname] ||
         [string match "*.list" $pathname] } {
        $pathname yview scroll $direction $type
    }
    if { [string match "*.entry" $pathname] } {
        if {$direction < 0} { histup }
        if {$direction > 0} { histdown }
    }
}
    

# Make AppIcons work... maybe not.
#wm command . quirc
#wm group . .


# New DCC stuff from Loonacy.

proc dccsenddialog { sindex nick } {
  if {![interp exists dccsendthread]} {
    interp create dccsendthread
    load {} Tk dccsendthread
    dccsendthread alias sendFilename dccsendfile
    interp eval dccsendthread wm withdraw .    
    interp eval dccsendthread {proc getfilename { sindex nick } { set filename [tk_getOpenFile]; if {$filename!=""} {sendFilename $sindex $nick $filename}; }}
    interp eval dccsendthread getfilename $sindex [list $nick]
    interp delete dccsendthread
  }
}

proc dccsendfile { sindex nicks filename } {
  foreach n $nicks {
    ::template::dcc $sindex send $n $filename
  }
}


# Configuration system

# Pack the main frames last
# Change status indicator to say something more intelligent sometimes.
# Set up a "reset to default" button (global reset to default?).
namespace eval ::config {
    proc select { list item selectproc } {
	if { [set location [lsearch -exact [$list get 0 end] $item]]!=-1 } {
	    $list selection clear 0 end
	    $list selection set $location $location
	    $list see $location
	    $selectproc $location
	}
    }

    proc array_refresh { select } {
	set var $::config::basevar
	
	.config.right.remove configure -text "Remove $::config::basevar"

	# Destroy old widgets
	::config::kill .config.right.contents
	destroy .config.right.contents.list
	destroy .config.right.contents.list_yscroll
	destroy .config.right.contents.array
	
	# Set up description.
	.config.right.description.text delete 0.0 end
	set name [lindex [array names ::doc "/Variables (Config)/*/$var"] 0]
	if { $name != "" } {
	    .config.right.description.text insert end $::doc($name)
	} else {
	    .config.right.description.text insert end "No documentation available for $var."
	}
	
	# If it's an array, put up the same editing screen, only have a
	# secondary list that chooses which sub-variable to maniupulate.
	if { [array exists ::dynamic::$var] } {
	    pack [listbox .config.right.contents.list -exportselection no -yscrollcommand {.config.right.contents.list_yscroll set}] -side left -fill y
	    pack [scrollbar .config.right.contents.list_yscroll -command {.config.right.contents.list yview}] -side left -fill y
	    foreach name [lsort [array names ::dynamic::$var]] {
		.config.right.contents.list insert end $name
	    }
	    pack [frame .config.right.contents.array] -expand 1 -fill both
	    
	    pack [frame .config.right.contents.array.contents] -expand 1 -fill both
	    
	    # Set up addremove here.
	    #addremove "array" .config.right.contents.array
	    #focus .config.right.contents.array.add.entry

	    # Set up the add/remove buttons.
	    destroy .config.right.contents.array.remove
	    destroy .config.right.contents.array.add
	
	    pack [frame .config.right.contents.array.add] -fill x
	    pack [entry .config.right.contents.array.add.entry] -side left -fill x -expand 1

	    set addcommand {
		if { [.config.right.contents.array.add.entry get]=={} } { return }
		if { [lsearch -exact [.config.right.contents.list get 0 end] [.config.right.contents.array.add.entry get]]!=-1 } { return }
		set ::dynamic::${::config::basevar}([.config.right.contents.array.add.entry get]) [::config::type_default [::config::type $::config::basevar]]
		::config::array_refresh [.config.right.contents.array.add.entry get]
	    }
	    pack [button .config.right.contents.array.add.button -text "Add" -command $addcommand]
	    bind .config.right.contents.array.add.entry <<Enter>> $addcommand
	    pack [button .config.right.contents.array.remove -text "Remove" -command {
		if { [info exists ::dynamic::$::config::currentvar] } {
		    unset ::dynamic::$::config::currentvar
		    ::config::array_refresh {}
		}
	    }] -fill x

	    if { $select=="" } { focus .config.right.contents.array.add.entry }
	    
	    bind .config.right.contents.list <<Action-1>> "
	        ::config::array_helper \[.config.right.contents.list nearest %y]
	    "

	    select .config.right.contents.list $select ::config::array_helper
	} else {
	    ::config::display $var .config.right.contents
	}
    }

    proc refresh { select } {
	# This should probably be able to handle refreshing array variables
	# too.  So we need to parse out the contents of the array variable
	# if it is one.
	destroy .config.status
	destroy .config.left
	destroy .config.right

	pack [label .config.status -text "Status:  No action performed." -anchor w] -side bottom -fill x
	
	pack [frame .config.left] -fill y -side left
	pack [listbox .config.left.list -yscrollcommand {.config.left.list_yscroll set} -exportselection 0] -side left -fill y
	pack [scrollbar .config.left.list_yscroll -command {.config.left.list yview}] -fill y -expand 1

	pack [frame .config.right] -expand 1 -fill both
	
	pack [frame .config.right.description] -fill x
	pack [text .config.right.description.text -height 5 -width 0 -wrap word -yscrollcommand {.config.right.description.text_yscroll set}] -side left -expand 1 -fill x
	pack [scrollbar .config.right.description.text_yscroll -command {.config.right.description.text yview}] -fill y -expand 1

	pack [frame .config.right.contents] -expand 1 -fill both

	# Set up the add/remove buttons.
	destroy .config.right.remove
	destroy .config.right.add
	
	pack [frame .config.right.add] -fill x
	pack [entry .config.right.add.entry] -side left -fill x -expand 1
	if [info exists ::config::set_type] {unset ::config::set_type}
	if [info exists ::config::set_type_array] {unset ::config::set_type_array}
	pack [checkbutton .config.right.add.array -text "Array of" -variable ::config::set_type_array] -side left

	tk_optionMenu .config.right.add.type ::config::set_type "default" "boolean"
	pack .config.right.add.type -side left
	# Need to handle item type with special handling for the addition
	# of arrays.
	set addcommand {
            if { [.config.right.add.entry get]=={} } { return }
	    if { [lsearch -exact [.config.left.list get 0 end] [.config.right.add.entry get]]!=-1 } { return }
	    if { $::config::set_type_array } {
		array set ::dynamic::[.config.right.add.entry get] {}
	    } else {
		set ::dynamic::[.config.right.add.entry get] [::config::type_default $::config::set_type]
	    }
	    set ::config::type([.config.right.add.entry get]) $::config::set_type
	    ::config::refresh [.config.right.add.entry get]
        }
	pack [button .config.right.add.button -text "Add" -command $addcommand]
	bind .config.right.add.entry <<Enter>> $addcommand
	pack [button .config.right.remove -text "Remove" -command {
	    if { [info exists ::dynamic::$::config::basevar] } {
		unset ::dynamic::$::config::basevar
		::config::refresh {}
	    }
	}] -fill x

	pack [frame .config.right.buttons] -fill x
	pack [button .config.right.buttons.refresh -text "Refresh" -command {::config::refresh ""}] -side left -expand 1 -fill x
	pack [button .config.right.buttons.save -text "Save" -command {/store; ::config::status "Variables saved."}] -side left -expand 1 -fill x
	pack [button .config.right.buttons.close -text "Close" -command {destroy .config}] -side left -expand 1 -fill x

	# Add all the variables in dynamic to the list
	foreach var [lsort [info vars ::dynamic::*]] {
	    .config.left.list insert end [string range $var 11 end]
	}

	bind .config.left.list <<Action-1>> {
	    ::config::helper [.config.left.list nearest %y]
	}

	# Check the type of the selected variable here to determine whether or
	# not to focus.
	if { $select=="" } { focus .config.right.add.entry }

	select .config.left.list $select ::config::helper

	# If we're dealing with an array, do an array_refresh here.
	# This may be uncessary.
    }

    proc status { text } {
	.config.status configure -text "Status:  $text"
    }

    proc helper { index } {
	set ::config::basevar [.config.left.list get $index]
	set ::config::currentvar $::config::basevar

	::config::array_refresh ""
    }

    proc kill { frame } {
	destroy $frame.entry
	destroy $frame.set
	destroy $frame.clear
	destroy $frame.button
	for { set n 0 } { $n < 16 } { incr n } {
	    destroy $frame.button$n
	}
    }

    proc display { var frame } {
	::config::kill $frame

	switch [::config::type $::config::basevar] {
	    "irc_color" {
		# FIXME I'm not done.
		for { set n 0 } { $n < 16 } { incr n } {
		    set red [base 16 10 [string range $::dynamic::theme_color($n) 1 2]]
		    set green [base 16 10 [string range $::dynamic::theme_color($n) 3 4]]
		    set blue [base 16 10 [string range $::dynamic::theme_color($n) 5 6]]
		    set total [expr $red+$blue+$green]
		    if { $total < 255 } {
			set fg \#FFFFFF
		    } else {
			set fg \#000000
		    }
		    grid [button $frame.button$n -background $::dynamic::theme_color($n) -foreground $fg -text $n -activebackground $::dynamic::theme_color($n) -activeforeground $fg] -column [expr $n%4] -row [expr $n/4] -sticky nsew
		    $frame.button$n configure -command "
                        active_set $::config::currentvar $n
                        ::config::display $var $frame
                    "
		}
		$frame.button[set ::dynamic::$::config::currentvar] configure -relief sunken
		for { set n 0 } { $n < 4 } { incr n } {
		    grid rowconfigure $frame $n -weight 1
		    grid columnconfigure $frame $n -weight 1
		}
	    }
	    "boolean" {
		pack [button $frame.button] -padx 5 -pady 5 -fill x
		if {[set ::dynamic::$::config::currentvar]} {
		    $frame.button configure -text "Currently On.  Press to turn off."
		    $frame.button configure -command "
                        active_set $::config::currentvar 0
                        ::config::display $var $frame
		    "
		} else {
		    $frame.button configure -text "Currently Off.  Press to turn on."
		    $frame.button configure -command "
                        active_set $::config::currentvar 1
                        ::config::display $var $frame
		    "
		}
	    }
	    default {
		pack [entry $frame.entry] -padx 5 -pady 5 -fill x
		$frame.entry insert end [set ::dynamic::$var]
		pack [button $frame.set -text "Set" -command "active_set $var \[$frame.entry get]; .config.status configure -text \"Status:  $var set.\""] -padx 5 -pady 5 -fill x
		pack [button $frame.clear -text "Clear" -command "active_set $var {}; $frame.entry delete 0 end; .config.status configure -text \"Status:  $var cleared.\""] -padx 5 -pady 5 -fill x
		bind $frame.entry <<Enter>> "active_set $var \[$frame.entry get]; .config.status configure -text \"Status:  $var set.\""
		focus $frame.entry
	    }
	}
    }

    proc array_helper { index } {
	if { $index==-1 } return
	set name [.config.right.contents.list get $index]
	set ::config::currentvar ${::config::basevar}($name)
	::config::display ${::config::basevar}($name) .config.right.contents.array.contents
    }

    proc type { var } {
	if [info exists ::config::type($var)] {
	    return [set ::config::type($var)]
	}
	return "default"
    }

    proc type_default { type } {
	if [info exists ::config::type_default($type)] {
	    return [set ::config::type_default($type)]
	}
	return ""
    }
}

proc echodcc { filelist } {
    set i 0
    set ::oldtag ""
    foreach file $filelist {
	[currentwindow].text tag configure filetag$i -underline false
	[currentwindow].text tag bind filetag$i <Motion> { filetag_motion %x %y }
	[currentwindow].text tag bind filetag$i <ButtonPress> { filetag_button %x %y }
	echotags [list "\n" "filetagn"]
	if { [file isdirectory $file] } {
	    echotags [addtag [gettags [fparse DCC_COMPLETE_DIR "$file" "/"]] "filetag$i"]
	} else {
	    echotags [addtag [gettags [fparse DCC_COMPLETE_FILE $file]] "filetag$i"]
	}
	incr i
    }
    [currentwindow].text yview moveto 1
}

proc dcc_complete {} { 
    set text [[currentwindow].entry get]
    set pos [[currentwindow].entry index insert]
    set before ""
    set filen ""
    set emresult ""
    # Abort if the text on the entry bar does not indicate a dcc completion..
    if { !([regexp {(/dcc send [^ ]+ )(.*)} $text $text before filen] && $pos >= [string length $before]) } { return [command_complete] }
    
    # Set the current dir to the user's home dir.  Will replace with a default_dcc_send_dir variable later.
    cd ~
    
    # Delete any existing dcc complete text that may be in the window.
    filetag_delete

    set matchtext [lindex [split $filen "/"] end]
    set dir [join [lrange [split $filen "/"] 0 [expr [llength [split $filen "/"]] - 2]] "/"]
    
#    puts "dir: $dir"
#    puts "mat: $matchtext"

    if { [string index $filen 0] == "~" } {
	set newdir [lindex [split $filen "/"] 0 ]
	if { ![catch {file nativename $newdir}] } {
	    set filen "[file nativename $newdir][string range $filen [string length $newdir] end]"
	} else {
	    set user [string trim [lindex [split $filen "/"] 0 ] ~]
	    set rest [join [lrange [split $filen "/"] 1 end] /]
	    set tempcomp [complete [getpwents pw_name] $user 1 1]
	    set emresult [expandmatch $tempcomp "" 1 1]
	    if { $rest != "" } { set rest "/$rest" }
	    if { ![catch {file nativename ~$emresult}] && $emresult != "" } {
		set filen "[file nativename ~$emresult][string range $filen [string length $newdir] end]"
	    } else {
		for { set i 0 } { $i < [llength $tempcomp] } { incr i } { 
		    set tempcomp [lreplace $tempcomp $i $i "~[lindex $tempcomp $i]$rest"]
		}
		echodcc [lsort $tempcomp]
		[currentwindow].entry delete 0 end
		if { $emresult == "" } {
		    [currentwindow].entry insert 0 "$before$filen"
		} else {
		    [currentwindow].entry insert 0 "$before~$emresult$rest"
		}
		return 1
	    }
	}
    }

    set matchtext [lindex [split $filen "/"] end]
    set dir [join [lrange [split $filen "/"] 0 [expr [llength [split $filen "/"]] - 2]] "/"]

    if { $dir != "" } {
	if { [string index $dir 0] != "/" } { set dir "[pwd]/$dir" }
    } else {
	if { [string index $filen 0] != "/" } { set dir [pwd] }
    }
    
    # Get the list of files in the dir that we must search.
    set complist [concat [glob -nocomplain "$dir/.*"] [glob -nocomplain "$dir/*"]]
    
    # Remove .. and . from the list of files.
    set dotdot [lsearch -exact $complist "$dir/.."]
    set complist [lreplace $complist $dotdot $dotdot] 
    set dot [lsearch -exact $complist "$dir/."]
    set complist [lreplace $complist $dot $dot]
    
    # These 2 lines do all the completion work.
    # Get a list of all files matching the matchtext.
    set compresult [complete $complist "$dir/$matchtext" 1 1]
    # Expand the matchtext as much as possible given the search results from the previous line.
    set emresult [expandmatch $compresult "" 1 1]

    # If there are several matches to choose from, echo them.
    # Otherwise just set the text in the entry bar to the only match.
    if { [llength $compresult] > 1 } {
	echodcc [lsort $compresult]
	[currentwindow].entry delete 0 end

    } else {
	if { [file isdirectory $emresult] } {
	    append emresult "/"
	}
	[currentwindow].entry insert 0 "$before$emresult"
    }

    # Clear the entry bar..
    [currentwindow].entry delete 0 end
    # If nothing matched, set the bar back to the way it was.
    # Otherwise insert the expanded matchtext.
    if { $emresult == "" } {
	[currentwindow].entry insert 0 "$before$filen"
    } else {
	[currentwindow].entry insert 0 "$before$emresult"
    }
    # MUST return 1 from this proc or nick completion will be attempted.
    return 1
}

proc filetag_motion { x y } {
    set text [[currentwindow].entry get]
    set pos [[currentwindow].entry index insert]
    set before ""
    set filen ""
    if { !([regexp {(/dcc send [^ ]+ )(.*)} $text $text before filen] && $pos >= [string length $before]) } { 
	filetag_delete
	return 0
    }

    set i [split [[currentwindow].text tag prevrange filetagn [[currentwindow].text index @$x,$y]] " "]
    set i1 [lindex $i 0]
    set i2 [lindex $i 1]
    set b1 [[currentwindow].text index "$i2 linestart"]
    set b2 [[currentwindow].text index "$i2 lineend"]
    set curtag ""
    set match ""
    regexp {.*(filetag[0-9]+).*} [join [[currentwindow].text tag names $b1]] $match curtag
#   puts "$i1, $i2, $b1, $b2, $curtag, $::oldtag"
    if { $curtag != $::oldtag } {
	[currentwindow].text tag configure $curtag -underline true
	[currentwindow].text tag configure $::oldtag -underline false
	set ::oldtag $curtag
    }
    if { $i1 != "" && $i2 != "" } {
	[currentwindow].entry delete 0 end
	[currentwindow].entry insert end "$before[[currentwindow].text get $b1 $b2]"
    }
}

proc filetag_button { x y } {
    set text [[currentwindow].entry get]
    set pos [[currentwindow].entry index insert]
    set before ""
    set filen ""
    if { !([regexp {(/dcc send [^ ]+ )(.*)} $text $text before filen] && $pos >= [string length $before]) } { return 0 }
    set i [split [[currentwindow].text tag prevrange filetagn [[currentwindow].text index @$x,$y]] " "]
    set i1 [lindex $i 0]
    set i2 [lindex $i 1]
    set b1 [[currentwindow].text index "$i2 linestart"]
    set b2 [[currentwindow].text index "$i2 lineend"]
    if { $i1 != "" && $i2 != "" } {
	[currentwindow].entry delete 0 end
	[currentwindow].entry insert end "$before[[currentwindow].text get $b1 $b2]"
	filetag_delete
    }
}

proc dcc_abort {} {
    set text [[currentwindow].entry get]
    set pos [[currentwindow].entry index insert]
    set before ""
    set filen ""
    if { !([regexp {(/dcc send [^ ]+ )(.*)} $text $text before filen] && $pos >= [string length $before]) } { return 0 }
    filetag_delete
    [currentwindow].entry delete 0 end
}

proc event_enter { message pathname } {
    dcc_abort
    return $message
}

proc filetag_delete {} {
    [currentwindow].text configure -state normal
    set c 0
    while { [set i [[currentwindow].text tag nextrange filetag$c 0.0]] != ""} {
	set i1 [lindex $i 0]
	set i2 [lindex $i 1]
	[currentwindow].text delete $i1 $i2
	incr c
    }
    while { [set i [[currentwindow].text tag nextrange filetagn 0.0]] != ""} {
	set i1 [lindex $i 0]
	set i2 [lindex $i 1]
	[currentwindow].text delete $i1 $i2
    }
    [currentwindow].text configure -state disabled
}

proc cnuh { nuh cn ce cu ca ch } {
    set tn [lindex [split $nuh "!"] 0]
    set tu [lindex [split [lindex [split $nuh "!"] 1] "@" ] 0]
    set th [lindex [split [lindex [split $nuh "!"] 1] "@" ] 1]
    if { $th != "" } {
	return "[c]$cn$tn[c]$ce![c]$cu$tu[c]$ca@[c]$ch$th[c]"
    } else {
	return "[c]$cn$tn[c]"
    }
}

proc command_complete { } {
    set text [[currentwindow].entry get]
    set pos [[currentwindow].entry index insert]
    set comm ""
    set after ""
    set emresult ""
    # Abort if the text on the entry bar does not indicate a command completion
    if { !([regexp {/([^ ]+)(.*)} $text $text comm after] && $pos <= [string length "/$comm"]) } { return 0 }
    set tcmds [info commands alias_*]
    foreach scr [set ::[currentindex]::scripts] {
	set tcmds [concat $tcmds [info commands "::[currentindex]::[set scr]::alias_*"]]
    }
    set newcmd ""
    set commands ""
    foreach cmd $tcmds {
	set blah ""
	regexp {.*alias_(.*)} $cmd blah newcmd
	lappend commands $newcmd
    }
    #echo $commands
    set compresult [complete $commands "$comm" 0 1]
    # Expand the matchtext as much as possible given the search results from the previous line.
    set emresult [expandmatch $compresult "" 0 1]
#    echo $emresult
#    echo $compresult
    # Clear the entry bar..
    [currentwindow].entry delete 0 end
    # If nothing matched, set the bar back to the way it was.
    # Otherwise insert the expanded matchtext.
    if { $after == "" && [llength $compresult] == 1 }  {
	[currentwindow].entry insert 0 "/$emresult "
    } else {
	if { [llength $compresult] == 1 } {
	    [currentwindow].entry insert 0 "/$emresult$after"
	    [currentwindow].entry icursor [string length "/$emresult "]
	} else {
	[currentwindow].entry insert 0 "/$emresult$after"
	[currentwindow].entry icursor [string length "/$emresult"]
	}
    }

    # MUST return 1 from this proc or nick completion will be attempted.
    return 1
}
