#
# fset.irc - FSET command for EPIC4
# Copyright (c) 2005 Brian Weiss <brian@epicsol.org>
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without   
# modification, are permitted provided that the following conditions
# are met:
# 1. All redistributions, whether of source code or in binary form must
#    retain the above copyright notice, the above paragraph (the one   
#    permitting redistribution), this list of conditions, and the following
#    disclaimer.
# 2. The names of the author(s) may not be used to endorse or promote  
#    products derived from this software without specific prior written
#    permission.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 
# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.   
# IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT, 
# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 
# BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED 
# AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,  
# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 
# SUCH DAMAGE.
#
# Last modified: 2005/04/07
#
# TODO:
#  * Convert everything that uses $aliasctl() to $symbolctl().
#  * Provide a way for format files to remove formats or at least overwrite
#    existing ones.
#  * Write an /addformat alias that adds the /on hook _and_ the fset var.
#

# Make sure this file gets loaded with the PF loader.
if (word(2 $loadinfo()) != [pf])
{
	load -pf $word(1 $loadinfo());
	return;                       
};

#
# ADDFSET <variable> [value]
#
# Adds a new FSET variable into the system. This is just a wrapper
# to $fsetctl(ADD ...).
#
alias addfset (var, val)
{
	if (_FSET[$var]) {
		xecho -b ADDFSET: Variable exists: $toupper($var);
	} else {
		@ fsetctl(ADD $var $val);
	};
};

alias fparse (...)
{
	eval return $cparse($(FORMAT.$0));
};

#
# FSET <variable> [-][value]
#
# This works just like the builtin /SET command but operates only on
# format variables created with $fsetctl(ADD ...)
#
alias fset (variable, value)
{
	if (!variable)
	{
		if (FORMAT.FSET_HEADER) {xecho -s $fparse(FSET_HEADER $#getfsets())};
		for foo in ($aliasctl(assign match _FSET.))
		{
			@ :bar = after(1 . $foo);
			if (!FORMAT[$bar]) {
				echo $fparse(FSET_NOVALUE $toupper($bar));
			} else {
				echo $fparse(FSET $toupper($bar) $FORMAT[$bar]);
			};
		};
		if (FORMAT.FSET_FOOTER) {xecho -s $fparse(FSET_FOOTER $#getfsets())};
	}{
		@ :var     = strip(- $variable);
		@ :bingo   = aliasctl(assign get _FSET.$var) ? 1 : 0;
		@ :matches = aliasctl(assign match _FSET.$var);

		if (#matches > 1 && !bingo)
		{
			if (FORMAT.FSET_HEADER)    {xecho -s $fparse(FSET_HEADER $#getfsets($var*) $var)};
			if (FORMAT.FSET_AMBIGUOUS) {xecho -s $fparse(FSET_AMBIGUOUS $toupper($var))};
			for foo in ($matches)
			{
				@ :bar = after(1 . $foo);
				if (!FORMAT[$bar]) {
					echo $fparse(FSET_NOVALUE $toupper($bar));
				} else {
					echo $fparse(FSET $toupper($bar) $FORMAT[$bar]);
				};
			};
			if (FORMAT.FSET_FOOTER)    {xecho -s $fparse(FSET_FOOTER $#getfsets($var*) $var)};
		}
		else if (bingo || #matches == 1)
		{
			@ :var     = after(1 . $word(0 $matches));
			@ :oldval  = aliasctl(assign get FORMAT.$var);

			if (variable =~ [-%])
			{
				^assign -FORMAT.$var;
				xecho -s $fparse(FSET_CHANGE $toupper($var) <EMPTY>);
				# Hook the changes so scripts can act on it.
				hook FSET $var $oldval;
			}
			else if (value == [])
			{
				if (FORMAT.FSET_HEADER) {xecho -s $fparse(FSET_HEADER 1 $var)};
				if (!FORMAT[$var]) {
					echo $fparse(FSET_NOVALUE $toupper($var));
				} else {
					echo $fparse(FSET $toupper($var) $FORMAT[$var]));
				};
				if (FORMAT.FSET_FOOTER) {xecho -s $fparse(FSET_FOOTER 1 $var)};
			}
			else
			{
				^assign FORMAT.$var $value;
				xecho -s $fparse(FSET_CHANGE $toupper($var) $value);
				hook FSET $var $oldval;
			};
		}{
			xecho -b -s No matches for \"$toupper($var)\" found;
		};
	};
};

#
# fsetctl(ADD <variable> [value])
# fsetctl(GET <variable>)
# fsetctl(MATCH <pattern>)
# fsetctl(SET <variable> [value])
#
alias fsetctl (cmd, var, ...)
{
	if (!var)
		return;

	switch ($cmd)
	{
		(ADD) {
			if (_FSET[$var]) {
				return;
			} else {
				^assign _FSET.$var 1;
				^assign FORMAT.$var $*;
				@ function_return = var;
			};
		};
		(GET) {
			@ function_return = FORMAT[$var];
		};
		(MATCH) {
			# I hate to use $sar() here but it's probably faster than
			# looping through the results and using $after().
			@ function_return = sar(g/_FSET.//$aliasctl(assign match _FSET.$var));
		};
		(SET) {
			^assign FORMAT.$var $*;
			@ function_return = 1;
		};
	};
};

alias getfsets (args default "*")
{                                
	for patt in ($args) {
		@ push(function_return $pattern("$patt" $fsetctl(MATCH $var)));
	};
};

alias loadformats (file, void)
{
	if (!file)
		return;

	if ((:fd = open($file r)) != -1)
	{
		@ :cnt = 0;
		while (!eof($fd))
		{
			if (:line = read($fd))
			{
				@ :type = word(0 $line);
				if (fsetctl(ADD $type $restw(1 $line))) {
					^on ^$type "*" if \(FORMAT.$type\) \{echo \$fparse\($type \$*)\};
				} else {
					xecho -b LOADFORMATS: Error adding format: $type;
				};
			};
			@ :cnt++;
		};
		@ :cnt--;
		xecho -b Successfully loaded $cnt format${cnt == 1 ? [] : [s]}
	}{
		xecho -b LOADFORMATS: Unable to open file for reading: $file;
	};
};


@ fsetctl(ADD FSET $$G Current value of $$1 is $$2-);
@ fsetctl(ADD FSET_AMBIGUOUS $$G "$$1" is ambiguous);
@ fsetctl(ADD FSET_CHANGE $$G Value of $$1 set to $$2-);
@ fsetctl(ADD FSET_FOOTER);
@ fsetctl(ADD FSET_HEADER);
@ fsetctl(ADD FSET_NOVALUE $$G No value for $$1 has been set);