--******************************************************************************
--*                                                                            *
--*  File:        BasicDefinitions.lua                  Revision:  1.0         *
--*                                                                            *
--*  Purpose:     provides some basic definitions for Lua scripts              *
--*                                                                            *
--*  Creation:    13.03.2002                   Last Modification:  02.04.2002  *
--*                                                                            *
--*  Platform:    IBM-compatible PC running Windows 98SE                       *
--*                                                                            *
--*  Environment: Lua 4.0, TkLua 4.0                                           *
--*                                                                            *
--*  Author:      Andreas Rozek           Phone:  ++49 (711) 6770682           *
--*               Kirschblütenweg 15      Fax:    -                            *
--*             D-70569 Stuttgart         EMail:  Andreas.Rozek@T-Online.De    *
--*               Germany                                                      *
--*                                                                            *
--*  URL:         http://www.Andreas-Rozek.de/                                 *
--*                                                                            *
--*  Copyright:   the software is published under the "GNU Lesser General Pub- *
--*               lic  License" (see "http://www.fsf.org/copyleft/lesser.html" *
--*               for additional information)                                  *
--*                                                                            *
--*  Comments:    (none)                                                       *
--*                                                                            *
--******************************************************************************

--**** do not execute this script more often than once ****

  if (type(isList) == "function") then return nil; end;

--**** define boolean values ****

  true,false = not nil,nil;-- because the author prefers explicit boolean values

--**** preserve references to some intrinsic functions ****

  local _assert   = assert;
  local _print    = print;
  local _tostring = tostring;
  local _write    = write;

--******************************************************************************
--*                                                                            *
--* assert                           replaces the homonymous built-in function *
--*                                                                            *
--******************************************************************************

  function assert (Condition, Message)
    if (Condition == nil) then
      if (type(Message) == "string") then
        error(Message);                  -- avoids the "assertion failed"-prefix
      else
        %_alert(nil,Message);
      end;
    end;
  end;

--******************************************************************************
--*                                                                            *
--* encodedString     replaces special char.s in 'Value' with escape sequences *
--*                                                                            *
--******************************************************************************

  local _ReplacementTable = {
    ["\a"]="\\a", ["\b"]="\\b", ["\f"]="\\f", ["\n"]="\\n", ["\r"]="\\r", ["\t"]="\\t",
    ["\v"]="\\v", ["\\"]="\\\\", ["\""]="\\\"", ["\'"]="\\\'", ["\0"]="\\0"
  };

  local _ReplacementFunction = function (oldSequence)
    local newSequence = rawget(%_ReplacementTable, oldSequence);
    if (newSequence ~= nil) then
      return newSequence;                 -- yields a predefined escape sequence
    else
      return "\\"..strbyte(oldSequence); -- yields numerically encoded character
    end;
  end;

  function encodedString (Value)
    assert(                                         -- also rejects 'nil' values
      type(Value) == "string",
      "invalid type of argument \"Value\" (expected \"string\", got \""..type(Value).."\")"
    );
    return gsub(Value, "(['\"%c%z])", %_ReplacementFunction);
  end;

--******************************************************************************
--*                                                                            *
--* isBoolean          checks if the given argument represents a boolean value *
--*                                                                            *
--******************************************************************************

  function isBoolean (Candidate)
    return (Candidate == true) or (Candidate == false);
  end;

--******************************************************************************
--*                                                                            *
--* isFileHandle     checks if the given argument represents a Lua file handle *
--*                                                                            *
--******************************************************************************

  local _FileTag = tag(_STDOUT); -- assuming that stdout has not yet been redefined
  function isFileHandle (Candidate)
    return (type(Candidate) == "userdata") and (tag(Candidate) == %_FileTag);
  end;

--******************************************************************************
--*                                                                            *
--* isList                checks if the given argument represents a Lua "list" *
--*                                                                            *
--******************************************************************************

  function isList (Candidate)
    if (type(Candidate) ~= "table") then return false; end;

    for Key,Value in Candidate do
      if ((type(Key) ~= "number") and (Key ~= "n")) then return false; end;
    end;

    return true;                        -- 'Candidate' does represent a Lua list
  end;

--******************************************************************************
--*                                                                            *
--* print     extends the intrinsic 'print' function to handle more data types *
--*                                                                            *
--******************************************************************************

  function print (...)
    call(write,arg);             -- uses 'write' to handle individual data types
    write("\n");
  end;

--******************************************************************************
--*                                                                            *
--* strabbrev      checks if 'Candidate' is a valid abbreviation of 'Template' *
--*                                                                            *
--******************************************************************************

  function strabbrev (Candidate, Template, minLength, ignoreCase)
    assert(
      type(Candidate) == "string",
      "invalid type of \"Candidate\" (expected \"string\", got \""..type(Candidate).."\")"
    );

    assert(
      type(Template) == "string",
      "invalid type of \"Template\" (expected \"string\", got \""..type(Template).."\")"
    );

    assert(
      type(minLength) == "number",
      "invalid type of \"minLength\" (expected \"string\", got \""..type(minLength).."\")"
    );

    assert(minLength > 0, "invalid \"minLength\" given ("..minLength..")");

    local CandidateLength = strlen(Candidate);
    if (CandidateLength < minLength)        then return false; end;
    if (CandidateLength > strlen(Template)) then return false; end;

    if (ignoreCase) then
      return (strlower(strsub(Template,1,CandidateLength)) == strlower(Candidate));
    else
      return (strsub(Template,1,CandidateLength) == Candidate);
    end;
  end;

--******************************************************************************
--*                                                                            *
--* strtrim    yields a copy of 'Argument' without any leading/trailing blanks *
--*                                                                            *
--******************************************************************************

  function strtrim (Argument)
    assert(
      type(Argument) == "string",
      "invalid type of \"Argument\" (expected \"string\", got \""..type(Argument).."\")"
    );

    return gsub(gsub(Argument, "^ *", ""), " *$", "");
  end;

--******************************************************************************
--*                                                                            *
--* tostring          extends the intrinsic function to handle more data types *
--*                                                                            *
--******************************************************************************

  toString_DefaultNestLevel = 4;         -- limit "tostring" nesting to 4 levels

  function tostring (Argument,NestLevel)
    NestLevel = NestLevel or tonumber(toString_DefaultNestLevel);

    local Result = "";
      ArgType = type(Argument);

      if     (ArgType == "nil") then
        Result = Result.."(nil)";
      elseif (ArgType == "number") then
        Result = Result..%_tostring(Argument);
      elseif (ArgType == "string") then
        Result = Result..Argument;
      elseif (ArgType == "function") then
        Result = Result.."(function)";
      elseif (ArgType == "userdata") then
        Result = Result.."(userdata)";
      else -- ArgType == "table"
        local specificMethod = Argument.tostring or Argument.toString;
        if (type(specificMethod) == "function") then
          Result = Result..specificMethod(Argument,NestLevel-1);
        else
          Result = Result.."{";
            if (isList(Argument)) then
              local Count = getn(Argument);
              for j = 1,Count do
                local Value = Argument[j];
                if (type(Value) == "string") then
                  Result = Result.."\""..encodedString(Value).."\"";
                else
                  Result = Result..tostring(Value,NestLevel-1);
                end;

                if (j < Count) then Result = Result..","; end;
              end;
            else
              local firstItem = true;         -- used to handle comma separators

              local Key,Value = next(Argument,nil);
              while (Key ~= nil) do
                if (firstItem) then
                  firstItem = false;
                else
                  Result = Result..",";
                end;

                if (validSymbol(Key)) then
                  Result = Result..Key.."=";
                elseif (type(Key) == "string") then
                  Result = Result.."[\""..encodedString(Key).."\"]=";
                else         -- since ANY kind of object may be used as a key...
                  Result = Result.."[\""..type(Key).."\"]=";     -- experimental
                end;

                if (type(Value) == "string") then
                  Result = Result.."\""..encodedString(Value).."\"";
                else
                  Result = Result..tostring(Value,NestLevel-1);
                end;

                Key,Value = next(Argument,Key);
              end;
            end;
          Result = Result.."}";
        end;
      end;
    return Result;
  end;

  toString = tostring;                             -- allow alternative spelling

--******************************************************************************
--*                                                                            *
--* toTk                       encodes a given string as argument for 'tkeval' *
--*                                                                            *
--******************************************************************************

  function toTk (Value)
    return Value;                                        -- for the moment only!
  end;

--******************************************************************************
--*                                                                            *
--* validSymbol                    checks if 'Candidate' is a valid Lua symbol *
--*                                                                            *
--******************************************************************************

  function validSymbol (Candidate)
    if (type(Candidate) ~= "string") then return false; end;
    return (strfind(Candidate, "^[%a_][%w_]*$") ~= nil);
  end;

--******************************************************************************
--*                                                                            *
--* write     extends the intrinsic 'write' function to handle more data types *
--*                                                                            *
--******************************************************************************

  function write (...)
    local ArgCount = getn(arg);
    if (ArgCount == 0) then return nil; end;

    if (isFileHandle(arg[1])) then
      for i = 2,getn(arg) do                  -- "survives" empty argument lists
        ArgType = type(arg[i]);

        if     (ArgType == "nil") then
          _, ErrMsg = %_write(arg[1], "(nil)");
        elseif (ArgType == "number") then
          _, ErrMsg = %_write(arg[1], %_tostring(arg[i]));
        elseif (ArgType == "string") then
          _, ErrMsg = %_write(arg[1], arg[i]);
        elseif (ArgType == "function") then
          _, ErrMsg = %_write(arg[1], "(function)");
        elseif (ArgType == "userdata") then
          _, ErrMsg = %_write(arg[1], "(userdata)");
        else -- ArgType == "table"
          _, ErrMsg = %_write(arg[1], tostring(arg[i]));
        end;

        if (ErrMsg ~= nil) then return nil, ErrMsg; end;
      end;
    else
      for i = 1,getn(arg) do                  -- "survives" empty argument lists
        ArgType = type(arg[i]);

        if     (ArgType == "nil") then
          %_write("(nil)");
        elseif (ArgType == "number") then
          %_write(%_tostring(arg[i]));
        elseif (ArgType == "string") then
          %_write(arg[i]);
        elseif (ArgType == "function") then
          %_write("(function)");
        elseif (ArgType == "userdata") then
          %_write("(userdata)");
        else -- ArgType == "table"
          %_write(tostring(arg[i]));
        end;
      end;
    end;
  end;

--******************************************************************************
--*                                                                            *
--* writeln                                 provides an alternative to 'print' *
--*                                                                            *
--******************************************************************************

  function writeln (...)
    tinsert(arg,"\n"); -- works with and without an explicitly given file handle
    call(write,arg);             -- uses 'write' to handle individual data types
  end;