-- A preprocessor for generating HMTL,
-- inspired in the format of my ".th" files.

find    = string.find
strlen  = string.len
strsub  = string.sub
getn    = table.getn
tinsert = table.insert
tremove = table.remove

_vars = {n=0}
pushglobals = function (...)
    for i=1,getn(arg) do
      local varname = arg[i]
      tinsert(_vars, {varname, _G[varname]})
    end
  end
popglobals = function (...)
    for i=getn(arg),1,-1 do
      local varname, pair = arg[i], tremove(_vars)
      if varname ~= pair[1] then
        error("tried to pop "..varname.." but _vars had "..pair[1].." on top")
      end
      _G[varname] = pair[2]
    end
  end


--%%%%
--%
--% parseplainchars, parsespaces,
--% parsecurlyblock, parserest
--%
--%%%%

-- All these "parse" functions work
-- on the globals s and pos.
--
parseplainchars = function ()
    local  _,__,word = string.find(s, "^([^{} \n\t]+)", pos)
    if _ then pos = __+1; return word end
  end
parsespaces = function ()
    local  _,__,spaces = string.find(s, "^([ \n\t]+)", pos)
    if _ then pos = __+1; return spaces end
  end
parsecurlyblock = function ()
    local _,__,stuff = string.find(s, "^(%b{})", pos)
    if _ then pos = __+1; return string.sub(stuff, 2, -2) end
  end

parserest = function ()
    local rest = strsub(s, pos)
    pos = strlen(s)
    return rest
  end



--%%%%
--%
--% parsing functions that know about curlyactive blocks
--%
--%%%%

curly = {}
curly["lua:"] = function () return assert(loadstring(parserest()))() end

parsecurlyactive = function ()
    local stuff = parsecurlyblock()
    if not stuff then return end
    pushglobals("s", "pos")
    s = stuff
    pos = 1
    local key = parseplainchars() or ""
    if not curly[key] then
      error("curly[\""..key.."\"]: action undefined")
    end
    local rslt = curly[key]()
    popglobals("s", "pos")
    return rslt or ""
  end

-- parsewordonly glues plainchars and curlyactives together
parsewordonly = function ()
    local rslt
    while 1 do
      local stuff = parseplainchars() or parsecurlyactive()
      if not stuff then return rslt end
      if rslt then
        rslt = rslt..stuff
      else
        rslt = stuff
      end
    end
  end
parseword = function () parsespaces(); return parsewordonly() end

parsesws = function (finitw, fw)
    local initsp, mid, sp, w
    initsp = parsespaces()
    mid = parsewordonly()
    if finitw then mid = finitw(mid) end
    if not mid then return initsp end
    while 1 do
      sp = parsespaces()
      w = parsewordonly()
      if not w then
        return initsp, mid, sp
      end
      if not fw then
        mid = mid..sp..w
      else
        mid = fw(mid, sp, w)
      end
    end
  end

parsej = function ()
    local initsp, mid, endsp = parsesws()
    return mid or ""
  end
parselist = function ()
    return parsesws(function (initw) return {initw} end,
                    function (mid, sp, w) return tinsert(mid, w) end) or {}
  end


--%%%%
--%
--% some html functions
--%
--%%%%

maketbfunction = function (formatstr)
    return function (tag, body)
        return format(formatstr, tag, body)
      end
  end
maketbtfunction = function (formatstr)
    return function (tag, body)
        return format(formatstr, tag, body, tag)
      end
  end
maketebtfunction = function (formatstr)
    return function (tag, extra, body)
        return format(formatstr, tag, extra, body, tag)
      end
  end
maketepbtfunction = function (formatstr)
    return function (tag, extra, param, body)
        return format(formatstr, tag, extra, param, body, tag)
      end
  end
maketepbfunction = function (formatstr)
    return function (tag, extra, param, body)
        return format(formatstr, tag, extra, param, body)
      end
  end

tbn    = maketbfunction  "<%s>%s\n"

tnbntn = maketbtfunction "<%s>\n%s\n</%s>\n"
tnbtn  = maketbtfunction "<%s>\n%s</%s>\n"
tbt    = maketbtfunction "<%s>%s</%s>"
tbtn   = maketbtfunction "<%s>%s</%s>\n"
tbntn  = maketbtfunction "<%s>%s\n</%s>\n"

tebt   = maketebtfunction  "<%s %s>%s</%s>"
tepbt  = maketepbtfunction "<%s %s=\"%s\">%s</%s>"
tepb   = maketepbfunction  "<%s %s=\"%s\">%s"

UL = function (str) return tnbtn("ul", str) end
LI = function (str) return tbn ("li", str) end
H1 = function (str) return tbtn("h1", str) end
H2 = function (str) return tbtn("h2", str) end
H3 = function (str) return tbtn("h3", str) end
H4 = function (str) return tbtn("h4", str) end
H5 = function (str) return tbtn("h5", str) end
H6 = function (str) return tbtn("h6", str) end

HREF = function (url, str) return tepbt("a", "href", url, str) end
NAME = function (tag, str) return tepb ("a", "name", tag, str) end
COLOR = function (color, str) return tepbt("font", "color", color, str) end

BF = function (str) return tbt("strong", str) end
IT = function (str) return tbt("i",      str) end
TT = function (str) return tbt("code",   str) end
ET = function (str) return tbt("em",     str) end
PRE = function (str) return tbt("pre",   str) end

P  = function (str) return "\n\n<p>"..str end

LIST = function (list)
    local str = ""
    for i=1,getn(list) do
      str = str..LI(list[i])
    end
    return UL(str)
  end

HLIST1 = function (head, list) return H2(head)..LIST(list) end
HLIST2 = function (head, list) return    head ..LIST(list) end
HLIST3 = function (head, list) return    head ..LIST(list) end

snarfdir = snarfdir or "/home/edrx/snarf"
emptytonil = function (str) if str~="" then return str end end
urltolocal = function (url)
    local _, __, prot, rest = find("^([a-z][a-z][a-z][a-z]?)://(.*)", url)
    if _ then return snarfdir.."/"..prot.."/"..rest end
    return url
  end

R = function (url, str) return HREF(url, emptytonil(str) or url) end
L = function (url, str)
    return HREF(urltolocal(url), emptytonil(str) or url)
  end
LR = function (url, str)
    return L(url, str).." ("..R(url, "rmt")..")"
  end

TITLE = function (str) return tbntn("title", str) end
HEAD  = function (str) return tnbtn("head", str) end
BODY  = function (str) return tnbntn("body", "\n"..str.."\n") end
HTML  = function (str) return tnbtn("html", str) end

TITLEDHTML = function (title, body)
    return HTML(HEAD(TITLE(title))).."\n"..BODY(body)
  end

-- missing feature:
-- (find-angg "TH/Htmllib.tcl" "procj TITLEDHTML1" "metastr")


--%%%%
--%
--% some curly actions
--%
--%%%%

-- parseword
-- parselist

-- curly[""] = parsej
curly["J"] = parsej

--[[
(defun curly (fargs f &rest rest)
  (let ((FOSTR "curly[\"%s\"] = function () return %s(%s) end\n"))
    (insert (format FOSTR f f fargs))
    (if rest (apply 'curly fargs rest))))

(progn
(curly "parsej()"
       "UL" "LI" "H1" "H2" "H3" "H4" "H5" "H6"
       "BF" "IT" "TT" "ET" "PRE" "P" "TITLE" "HEAD" "BODY" "HTML")
(curly "parseword(), parsej()"
       "HREF" "NAME" "COLOR" "R" "L" "LR")
(curly "parselist()"
       "LIST")
(curly "parseword(), parselist()"
       "HLIST1" "HLIST2" "HLIST3")
)
--]]

curly["UL"] = function () return UL(parsej()) end
curly["LI"] = function () return LI(parsej()) end
curly["H1"] = function () return H1(parsej()) end
curly["H2"] = function () return H2(parsej()) end
curly["H3"] = function () return H3(parsej()) end
curly["H4"] = function () return H4(parsej()) end
curly["H5"] = function () return H5(parsej()) end
curly["H6"] = function () return H6(parsej()) end
curly["BF"] = function () return BF(parsej()) end
curly["IT"] = function () return IT(parsej()) end
curly["TT"] = function () return TT(parsej()) end
curly["ET"] = function () return ET(parsej()) end
curly["PRE"] = function () return PRE(parsej()) end
curly["P"] = function () return P(parsej()) end
curly["TITLE"] = function () return TITLE(parsej()) end
curly["HEAD"] = function () return HEAD(parsej()) end
curly["BODY"] = function () return BODY(parsej()) end
curly["HTML"] = function () return HTML(parsej()) end
curly["HREF"] = function () return HREF(parseword(), parsej()) end
curly["NAME"] = function () return NAME(parseword(), parsej()) end
curly["COLOR"] = function () return COLOR(parseword(), parsej()) end
curly["R"] = function () return R(parseword(), parsej()) end
curly["L"] = function () return L(parseword(), parsej()) end
curly["LR"] = function () return LR(parseword(), parsej()) end
curly["LIST"] = function () return LIST(parselist()) end
curly["HLIST1"] = function () return HLIST1(parseword(), parselist()) end
curly["HLIST2"] = function () return HLIST2(parseword(), parselist()) end
curly["HLIST3"] = function () return HLIST3(parseword(), parselist()) end


--%%%%
--%
--% some demos
--%
--%%%%

s = "foo {lua: return 2+3 } bar"
pos = 1
print()
P(parseplainchars())
P(parsespaces())
P(parsecurlyblock())
P(parsespaces())
P(parseplainchars())

s = "foo {lua: return 2+3 } bar"
pos = 1
print()
P(parseplainchars())
P(parsespaces())
P(parsecurlyactive())
P(parsespaces())
P(parseplainchars())

s = "foo {lua: return {2,3} } mip{lua: return 2+3 }mop bar"
pos = 1
print()
P(parseword())
PP(parseword())
P(parseword())

s = "foo mip{L http://foo/ }mop mip{L http://foo/ Foo}mop bar"
pos = 1
print()
print(parseword())
print(parseword())
print(parseword())


-- (eev "lua50 ~/LUA/lh.lua")


print(TITLEDHTML("Title",
        HLIST1("Items:", {COLOR("orange", "something orange"),
			  LR("http://foo/bar"),
                          "233"
                         }
              )))