--- inc.lua - my (edrx) standard "include file" for Lua, with several
--- important utility functions.

-- «.p»		(to "p")
-- «.px»	(to "px")
-- «.split»	(to "split")
-- «.split1»	(to "split1")
-- «.split_at_first»	(to "split_at_first")
-- «.split_at_last»	(to "split_at_last")
-- «.untabify_line»	(to "untabify_line")
-- «.file_functions»	(to "file_functions")
-- «.loadextension»	(to "loadextension")
-- «.loadtklua»		(to "loadtklua")
-- «.loadluasocket»	(to "loadluasocket")
-- «.expandfname»	(to "expandfname")
-- «.copy»		(to "copy")
-- «.explode»		(to "explode")
-- «.eval»		(to "eval")

-- (find-es "lua")
-- (find-luafile "")
-- (find-luafile "src/lib/")
-- (find-luafile "src/lib/liolib.c" "\"getenv\"")

-- dofile(getenv("HOME").."/LUA/inc.lua")

-- (find-luanode "Top")

-- (find-es "lua" "lua_docs")
-- (find-fline "~/tmp/lua-manual.txt")

function printf(...) write(call(format, arg)) end
function errprintf(exitcode, ...)
  write(call(format, arg))
  if exitcode then exit(errcode) else error() end
end




--#####
--#
--# "p", a function based on savevar that can show almost any object
--#
--#####

-- «p»  (to ".p")
-- (find-fline "/usr/doc/lua/examples/")
-- (find-fline "/usr/doc/lua/examples/save.lua")
function savevar (n,v)
 if v == nil then return end
 if type(v)=="userdata" then return end
 -- if type(v)=="userdata" or type(v)=="function" then return end
 -- if type(v)=="userdata" or type(v)=="function" then write("\t-- ") end
 write(n,"=")
 if type(v) == "string" then write(format("%q",v))
 elseif type(v) == "table" then
   if v.__visited__ ~= nil then
     write(v.__visited__)
   else
    write("{}\n")
    -- v.__visited__ = n
    for r,f in v do
      if r ~= "__visited__" then
        if type(r) == 'string' then
          savevar(n.."."..r,f)
	else
          savevar(n.."["..r.."]",f)
	end
      end
    end
   end
 else write(tostring(v)) end
 write("\n")
end

function pp(vname, v)
  savevar(vname, v)
  return v
end

function p (value, vname)
  savevar(vname or "_", value)
  return value
end





--#####
--#
--# px, a "p" for when the arrays have only integer indices
--#
--#####

-- «px»  (to ".px")

function arrtostr(a, s0, s1, s2, imager, s00)
  s0 = s0 or "{"
  s1 = s1 or ", "
  s2 = s2 or "}"
  imager = imager or xtostr
  s00 = s00 or s0 .. s2
  local s, i
  local n = getn(a)
  if n == 0 then
    return s00
  end
  s = s0 .. imager(a[1])
  for i = 2, n do
    s = s .. s1 .. imager(a[i])
  end
  return s .. s2
end

function xtostr(x)
  if type(x) == "string" then
    return format("%q", x)
  elseif type(x) == "number" then
    return x
  elseif type(x) == "table" then
    return arrtostr(x, "{", ", ", "}", xtostr, "{}")
  end
  return "?" .. type(x)
end

function id(x) return x end

function join(a, sep, f)
  sep = sep or " "
  f = f or id
  return arrtostr(a, "", sep, "", f)
end

-- function px(x) print(xtostr(x)) end
function px(...) print(join(arg, "   ", xtostr)) end

function sx(...) return join(arg, "   ", xtostr) end




function values(t)
  local value
  local a = {}
  for _, value in t do
    tinsert(a, value)
  end
  return a
end




--#####
--#
--# two functions to split strings
--#
--#####

-- «split»  (to ".split")
function split(s)
  local a={}; local found, first
  while 1 do
    found, _, first, s = strfind(s, "^[%s]*([^%s]+)[%s]*(.*)")
    if not found then return a; end
    tinsert(a, first)
  end
end

-- luae ' p(split("foo  bar plic")) '

-- «split1»  (to ".split1")
function split1(str, c)
  local arr, pos1, pos2 = {}, 0
  c = c or " "
  while 1 do
    pos2 = strfind(str, c, pos1+1, 1)
    if pos2 then
      tinsert(arr, strsub(str, pos1+1, pos2-1))
      pos1 = pos2
    else
      tinsert(arr, strsub(str, pos1+1))
      return arr
    end
  end
end

-- luae ' p(split1("indio bororo", "o")) '
-- luae ' p(split1("indio bororo")) '

-- luae ' p(split("  indio		b oro")) '
function split(s)
  local t = {}
  gsub(s, '(%S+)', function (str) tinsert(%t, str) end)
  return t
end





-- «split_at_first»  (to ".split_at_first")
function split_at_first(str, delim, d1, d2, d3)
  local posbeg, posend = strfind(str, delim, 1, 1)
  if posbeg then
    return strsub(str, 1, posbeg-1), delim, strsub(str, posend+1, -1)
  else
    return d1, d2, d3
  end
end

-- «split_at_last»  (to ".split_at_last")
function split_at_last(str, delim, d1, d2, d3)
  local posbeg, posend = strfind(str, delim, 1, 1)
  if not posbeg then return d1, d2, d3 end
  local posbeg2, posend2
  while 1 do
    posbeg2, posend2 = strfind(str, delim, posend+1, 1)
    if posbeg2 then
      posbeg, posend = posbeg2, posend2
    else
      return strsub(str, 1, posbeg-1), delim, strsub(str, posend+1, -1)
    end
  end
end

-- px(stem_and_version("/var/cache/apt/archives/gcc_1%3a2.95.2-12_i386.deb"))



-- «untabify_line»  (to ".untabify_line")
function untabify_line(str)
  local reps, p
  reps = {"        ", "       ", "      ", "     ", "    ", "   ", "  ", " "}
  --reps = {"--------", "-------", "------", "-----", "----", "---", "--", "-"}
  while 1 do
    p = strfind(str, "\t")
    if not p then return str end
    str = strsub(str, 1, p-1) .. reps[mod(p-1,8)+1] .. strsub(str, p+1)
  end
end




--#####
--#
--# file functions
--# «file_functions»  (to ".file_functions")
--#
--#####

-- (find-angg "TCL/inc.tcl")
-- (find-luanode "openfile")

function myopenfile(fname, mode)
  local f, err = openfile(fname, mode)
  if err then
    errprintf(nil, "openfile(%q, %q) error: %s\n", fname, mode, err)
  end
  return f
end

function readfile(fname) 
  local f, s
  f = myopenfile(fname, "r")
  s = read(f, "*a")
  closefile(f)
  return s
end

function writefile(fname, bigstr)
  local f, s
  f = myopenfile(fname, "w+")
  write(f, bigstr)
  closefile(f)
end



-- «loadextension»  (to ".loadextension")
-- (find-luafile "src/libdllua/loadlib.c")
function loadextension(libfname, initfunctionname)
  local libhandle, err = loadlib(libfname)
  if err then
   printf("loadextension(%q, %q) error: %s\n", libfname, initfunctionname, err)
  end
  callfromlib(libhandle, initfunctionname)
end

function loadlib_v(libfname)
  local libhandle, err = loadlib(libfname)
  if err then
    printf("loadlib_v(%q, %q) error: %s\n", libfname, err)
  end
  return libhandle
end

-- «loadtklua»  (to ".loadtklua")
-- (find-es "lua" "loadtklua")
-- (find-tkluafile "src/bin/tkluamain.c" "tkluaCreate")
-- (find-tkluafile "src/lib/tklua.c" "tkmainloop")
--
function loadtklua()
  loadlib_v("/usr/X11R6/lib/libX11.so")
  loadlib_v("/usr/lib/libtcl8.3.so")
  -- loadlib_v("/usr/lib/libtk8.3.so")
  loadlib_v("/usr/src/tk8.3-8.3.1/unix/libtk8.3.so.1")
  loadlib_v("/usr/src/tolua/lib/libtolua.so")
  loadextension("/usr/src/tklua/lib/libtklua.so", "tkluaCreate")
end

-- «loadluasocket»  (to ".loadluasocket")
-- (find-luasockfile "lua.c" "/* add your libraries here */")
function loadluasocket()
  loadextension("/usr/src/luasocket-1.3b/luasocket.so", "lua_socketlibopen")
end


-- «expandfname»  (to ".expandfname")
-- (find-elnode "File Name Expansion")
function expandfname(fname)
  return gsub(fname, "%$([A-Za-z0-9_]+)", getenv)
end





-- «copy»  (to ".copy")
-- bug: it does no typechecking and works only for tables
function copy(arr)
  local newarr, key, val = {}
  for key,val in arr do
    newarr[key] = arr[key]
  end
  return newarr
end

-- «explode»  (to ".explode")
-- (find-luanode "tremove")
-- Demo: (eev "mylua -e 'px(explode{4,5,6,7}); px(explode{})'")
function explode(arr)	-- note: arr will lose its elements
  if getn(arr)==0 then return end
  if getn(arr)==1 then return arr[1] end
  local firstelement = tremove(arr, 1)
  return firstelement, explode(arr)
end

-- «eval»  (to ".eval")
-- A temporary hack
-- (eev "mylua -e 'px(eval(\"2, 3\")); px(eval(\"nil\"))'")
-- (eev "mylua -e 'px(eval(\"foo()\")); px(eval(\"2, 3\"))'")
-- (eev "mylua -e 'px(eval(\"foo(\"))'")
--
function eval(codestr)
  local asarray = function(...) return arg end
  local rets = asarray(dostring("return \"ok\"," .. codestr))
  local r1 = tremove(rets, 1)
  if r1=="ok" then
    return explode(rets)
  else
    exit(1)
  end
end




-- Local Variables:
-- coding:               no-conversion
-- ee-anchor-format:     "«%s»"
-- ee-charset-indicator: "Ñ"
-- End: