functions

EPIC IRC客户端。来源于IRCII客户端但做了很多性能和功能的优化。

#
# Some misc functions..  for 2.2 and beyond.
# by: Ian Frechette  ([e-mail])
# Wed Aug 18 00:26:53 MDT 1993
#
# ircII scripting note.  @ var = <expression> is used a lot. One case
# where it is not feasible to use  the @ var = othervar or @ var = funct()
# format is when the $(stuff) construct is needed.  In that case you
# must surround it with [].  e.g.   @ blah = [$($0)]   will assign
# to 'blah' the contents of the variable named in arg 0.
#

#
# These have been updated to handle multiple words.
# format and lformat differ from $[-num]var and $[num]var in that
# They don't chop off the string if it is too long.
# These are obsoleted by the built in $pad() function.
#
alias format {
	@ IRCII.word = [$1-]
	if (@IRCII.word < [$0]) 
		{ @ function_return = [$([-$0]IRCII.word)] } 
		{ @ function_return = IRCII.word } 
}

alias lformat {
	@ IRCII.word = [$1-]
	if (@IRCII.word < [$0]) 
		{ @ function_return = [$([$0]IRCII.word)] } 
		{ @ function_return = IRCII.word } 
}

# pluck a word from a list.
# eg. $blah == "one two three four five"
# $pluck(blah three)     returns "one two four five"
#
alias pluck @ function_return = $0 = $remw($1 $($0))

/* These map some of the original functions to their EPIC names. */
alias notword @ function_return = notw($*)
alias remove @ function_return = remw($*)

/*
 * All of these functions have been obsoleted by built in functions
 * in ircII-EPIC.  Some of them were obsoleted by comparable functions,
 * and several of them were re-implemented as built-in functions for no
 * reason other than to provide a faster alternative to these functions.
 */

/*
# 
# reverse a string fed to it.  The first argument is the width of the
# field in which to right justify the reversed text
# $reverse(65 one two three) returns.. 
#                                                          eerht owt eno
# if 0 is given as the width it's reversed and output left justified
#
# Obsoleted by the built-in $reverse().  You can get the effect of the
# 'width' argument by specifying the width operator: 
#         $[-65]reverse(one two three)
#
alias reverse 
{
	^assign -rev.result
	@ rev.ind = 0
	@ rev.str = [$1-]
	while (mid($rev.ind 1 $rev.str)!=[])
	{
		@ rev.result = mid($rev.ind 1 $rev.str) ## rev.result
		@ rev.ind = rev.ind + 1
	}
	# This right justifies to a field with of $0.  
	# strip out the format() function if you don't want it formatted.
	@ function_return = format($0 $rev.result)
}


#
# Center text within a given width.   center(width text)
# "$center(10 one)"   returns "   one"
# this might not make sense at first, but it saves a lot of cursor travel
# not writing all the spaces on the right side.
#
# Obsoleted by the built-in $center().
#
alias center 
{
	@ IRCII.word = [$1-]
	@ IRCII.wordl = @IRCII.word
	@ IRCII.width = [$0]
	if (IRCII.wordl > IRCII.width)
		{ @ function_return = ircII.word }
		{ @ function_return = [$([${(IRCII.width - ircII.wordl)/2}])] ## IRCII.word }
}

#
# This is the huge beastly CPU expensive search and replace function 
# written entirely in ircII script language.
# $sandr(search pat/replace pat/words)
# the search and replace patterns can contain spaces or any other chars
# with the exception of '/'.
#
# Obsoleted by the built-in $sar(), which has more features, allows
# more flexibility, and is orders of magnitude faster.
#
alias sandr 
{
	@ sr.src = left($index(/ $*) $*)
	@ sr.rep = mid(${index(/ $*) +1} ${rindex(/ $*) - index(/ $*) +1} $*)
	@ sr.word = mid(${rindex(/ $*) + 1} 512 $*)
	@ sr.srcl = @sr.src
	@ sr.wordl = @sr.word
	@ sr.cnt1 = 0
	@ sr.cnt2 = 0
	@ sr.lmark = 0
	@ sr.gotit = 0
	^assign -sr.fstring
	while (sr.cnt1 < sr.wordl)
	{
		@ sr.scnt1 = sr.cnt1
		while ((mid($sr.cnt1 1 $sr.word) == mid($sr.cnt2 1 $sr.src)) && (sr.cnt2 < sr.srcl))
		{
			if (sr.cnt2 == sr.srcl - 1)
			{
				@ sr.gotit = 1
			}
			@ sr.cnt1 = sr.cnt1 + 1
			@ sr.cnt2 = sr.cnt2 + 1
		}
		@ sr.cnt2 = 0
		if (sr.gotit)
		{
			@ sr.fstring = sr.fstring ## mid($sr.lmark ${sr.scnt1 - sr.lmark} $sr.word) ## sr.rep
			@ sr.gotit = 0
			@ sr.lmark = sr.cnt1
		}
		{
			@ sr.cnt1 = sr.cnt1 +1
		}
	}
	@ sr.fstring = sr.fstring ## mid($sr.lmark 512 $sr.word)
	@ function_return = sr.fstring
}

#
# The perfect complement to the $word() function.  
# $notword(index words)  returns words minus the indexed word. 
# the special handling of nw.sep is to deal with the cases when 
# the index points to the first or last word.
#
# Obsoleted by the built-in $notw() function, which actually works reliably
# if $~ appears more than once in the arguments (this breaks in that case)
#
alias notword 
{
    if ([$0] > 0)
    {
	if (([$0] > 1) && ([$0] < #))
		{ @ nw.sep = [ ] }
		{ @ nw.sep = [] }
		
	@ function_return = [$(1-${[$0]-1})] ## nw.sep ## [$(${[$0]+1}-)]
    }
    {
        @ function_return = [$1-]
    }
    ^assign -nw.sep
}


# If you want to look an array.. Type /show <arrayname>
# Lists keys and contents
^alias show 
{
	if ( [$($0)] ) echo $0 $($0)
	foreach $0 ii { show $0.$ii }
	^assign -ii
}


# push an item onto the head of a list
# this only takes the name of the list instead of the variable itself. 
# examples.
# /push list Item
# or     if (push(list Item)) { echo push successful } { echo push failed }
# echo $list returns 'Item'
#
# Obsoleted by the built-in $push() function, and built-in PUSH command.
#
alias push 
{
	if (![$1])
		{ @function_return = 0 }
		{ eval @ $0 = [$1- $($0)];@function_return = 1}
}
	
# pop an item off a list.  Specified with $pop(listname)
# note there is no $ in front of listname.
# examples.
# /eval echo $pop(list)         returns 'Item' and the list is shortened
# push List2 $pop(List1)        moves first item from List1 to List2
#
# Obsoleted by the built-in $pop() function, and built-in POP command.
#
alias pop 
{
	@function_return = word(0 $($0))
	eval @ $0 = notword(1 $($0))
}


#
# Obsoleted by the built-in $remw() function
#
alias remove {
	@ rem.tmp = [$($0)]
	while (rmatch($1 ${rem.tmp = pluck(rem.tmp $1)})) {#}
	@ function_return = rem.tmp
}


# This alias sorts flat lists case insensitive
# IT can be easily changed to sort case sensitive by removing the
# $toupper() call.
# operation..    $sort(list or words here)   will return a string with
# the list of words sorted in ascending order.
# to sort in reverse order
#
# Obsoleted by the built-in $sort() function.
#
alias sort {
	@ sort.tmp = [$*]
	while (sort.word = pop(sort.tmp)) {
		eval @ sort.str.$encode($toupper($sort.word)) = sort.word
	}
	@ sort.sep = []
	foreach sort.str ii {
		# sort ascending
		@ sort.tmp = sort.tmp ## sort.sep ## sort.str[$ii]
		# sort descending
		# push sort.tmp sort.str[$ii]
		^assign -sort.str[$ii]
		@ sort.sep = [ ]
	}
	@ function_return = sort.tmp
	^assign -sort.sep
	^assign -sort.tmp
}

*/

# $min() $max().
fe (min leftw max rightw) foo bar {
	alias $foo return \$$bar\(1 \$numsort($*)\)
}

# $regpattern() and $regfilter() work exactly like $pattern()
# and $filter except that they use regexes rather than wildcards.
stack push alias alias
alias alias (args) fe (filter ! pattern "") func cond {
	//alias $msar(gr/\${func}/$func/\${cond}/$cond/args)
}
alias reg${func} (ret) {
	@:reg=regcomp($shift(ret))
	fe ret foo {
		@ foo = ${cond}regexec($reg $foo) ? [] : foo=~[* *] ? ["\$foo"] : foo
	}
	@regfree($reg)
	return $ret
}
stack pop alias alias

# A version of $indextoword() that ignores double quoting.
alias indextowword return $indextoword($tr(/"/_/$*))
alias wwordtoindex return $wordtoindex($tr(/"/_/$*))

# Character jot.
# $jotc(afWZ) returns abcdefWXYZ.
alias jotc return $chr($jotm($ascii($*)))
alias jotm (ret) {
	fe ret foo bar {
		@ foo = jot($foo $bar)
		@ bar = []
	}
	return $ret
}

# A version of $mask() that operates with multiple args.
alias maskm (mask,args) {
	fe args arg {
		@ arg = mask($mask $arg)
	}
	return $args
}

# $randn( rep val ) returns rep random numbers up to val.
alias randn (args) {
	@ :rep = isnumber(b10 $args) ? shift(args) : 1
	@ :val = isnumber(b10 $args) ? shift(args) : 0
	eval return$repeat($rep  \$rand\($val\))
}

# $replace(#x# x $jot(0 3)) returns #0# #1# #2# #3#.
alias replace (args) {
	@ :in = shift(args)
	@ :rep = shift(args)
	fe args arg {
		@ arg = sar(g/$rep/$arg/$in)
	}
	return $args
}

# Shuffle functions shuffle their args.
# The s in shuffles stands for "slow".
# The f in shufflef stands for "fast".
# The c in shufflec stands for "char".
# The slow version is actually faster than the fast for smaller arg lists.
alias shufflec return $chr($shufflef($ascii($*)))
alias shufflef (args) {
	@ :foo = randn($#args 2)
	if (#args < 1000) {
		return $shuffles($copattern(0 foo args)) $shuffles($copattern(1 foo args))
	} else {
		return $shufflef($copattern(0 foo args)) $shufflef($copattern(1 foo args))
	}
}
alias shuffles {
	@ :w = 0
	@ :ret = []
	if (xdebug(extractw) =~ [-*]) {
		fe ($*) foo {
			@ splice(ret $rand(${++w}) 0 $foo)
		}
	} else {
		@ :space = chr($jot(1 32))
		fe ($*) foo {
			@ splice(ret $rand(${++w}) 0 ${0>index("$space" $foo)?foo:["$foo"]})
		}
	}
	return $ret
}

# A lot more like the shell version of "uniq -d" than $uniq().
# $uniqd() removes unique items in a list.
alias uniqd (ret) {
	fe ret foo {
		if (last!=foo) {
			@ :last = foo
			@ :foo = []
		}
	}
	return $ret
}

# $wordn(0.9.2,9.0.2 $jot(0 9)) returns "0 2 4 6 8 9 7 5 3 1".
alias wordn (num,args) {
	@ :num = split(, $num)
	fe num foo {
		@ :foo = foo =~ [*.*] ? jot($split(. $foo)) : foo
	}
	fe num foo {
		@ foo = word($foo $args)
	}
	return $num
}

# $cut(0.9.2,9.0.2 : $unsplit(: $jot(0 9))) returns "0:2:4:6:8:9:7:5:3:1".
alias cut (num,sep,args) {
	switch ($num) {
		(*,*) {
			@ :mid = (count(, $num) + 1) / 2
			return $cut($before($mid , $num) $sep $args)$sep$cut($after($mid , $num) $sep $args)
		}
		(*.*) {
			return $cut($unsplit(, $jot($split(. $num))) $sep $args)
		}
		(*) {
			return $before(1 $sep ${num ? after($num $sep $args) : args}$sep)
		}
	}
}

# Splice characters.  The bless is so it can be called on local vars.
alias splicec (var,start,count,replace) {
	bless
	^assign $var $ascii($($var))
	@ function_return = chr($splice($var $start $count $ascii($replace)))
	^assign $var $chr($($var))
}

# Bit of a hack here.  Return all args with spacing removed.
alias words return $unsplit(" " $*)

# $chvoices() returns the  voiced users on a channel.
# $chnovoices() is the compliment.
stack push alias alias
alias alias (args) {
	fe (chhops 1 ishalfop nochhops 0 ishalfop chvoices 1 ischanvoice chnovoices 0 ischanvoice) cmd val fn {
		//alias $msar(gr/\$cmd/$cmd/\$val/$val/\$fn/$fn/args)
	}
}
alias $cmd (args) {
	@ :chan = shift(args)
	@ :ret = chanusers($chan)
	fe ret user {
		@ user = $val == $fn($user $chan) ? user : []
	}
	return $ret
}
stack pop alias alias

alias mychats (args) {
	@ :function_return = dccctl(typematch chat)
	fe function_return dcc {@ :dcc = [=]##dccctl(get $dcc user)}
}