-- blogme.lua - a program to generate html
-- Author: Eduardo Ochs
-- Version: 2005feb19
--
-- The "language" that this program accepts is extensible and can deal
-- with input having a lot of explicit mark-up, like this,
--
--   [HLIST2 Items:
--     [HREF http://foo/bar a link]
--     [HREF http://another/link]
--     [IT Italic text]
--     [BF Boldface]
--   ]
--
-- and conceivably also with input with a lot of _implicit_ mark-up
-- and with control structures, like these examples (which haven't
-- been implemented yet):
--
--   [BLOGME
--     Tuesday, February 15, 2005
--
--     I usually write my notes in plain text files using Emacs; in
--     these files "["s and "]"s can appear unquoted, urls appear
--     anywhere without any special markup (like http://angg.twu.net/)
--     and should be recognized and htmlized to links, some lines are
--     dates or "anchors" and should be treated in special ways, the
--     number of blank lines between paragraphs matter, in text
--     paragraphs maybe _this markup_ should mean bold or italic, and
--     there may be links to images that should be inlined, etc etc
--     etc.
--   ]
--
--   [IF somecondition [(then this)]
--                     [(else this)]
--   ]
--
-- We also support executing blocks of Lua code on-the-fly, like this:
--
--   [lua:
--      -- we can put any block of Lua code here
--      -- as long as its "["s and "]"s are balanced
--   ]
--
-- The trick is simple. In this language there is only one special
-- syntactical construct, "[...]". We only have four classes of
-- characters "[", "]", whitespace, and "word"; "[...]" blocks in the
-- text are treated specially, and we use Lua's "%b[]" regexp-ish
-- construct to skip over the body of a "[...]" quickly, skipping over
-- all balanced "[]" pairs inside. The first "word" of such a block
-- (we call it the "head" of the block) determines how to deal with
-- the "rest" of the block.
--
-- To "evaluate" an expression like
--
--   [HREF http://foo/bar a link]
--
-- we only parse its "head" - "HREF" - and then we run the Lua
-- function called HREF. It is up to that function HREF to parse what
-- comes after the head (the "rest"); HREF may evaluate the
-- []-expressions in the rest, or use the rest without evaluations, or
-- even ignore the rest completely. After the execution of HREF the
-- parsing resumes from the point after the associated "]".
--
-- Actually the evaluation process is a bit more sophisticated than
-- that. Instead of executing just HREF() we use an auxiliary table,
-- _GETARGS, and we execute:
--
--   HREF(_GETARGS["HREF"]())
--
-- _GETARGS["HREF"] returns a function, vargs2, that uses the rest to
-- produce arguments for HREF. Running vargs2() in that situation returns 
--
--   "http://foo/bar", "a link"
--
-- and HREF is called as HREF("http://foo/bar", "a link"). So, to
-- define HREF as a head all we would need to do ("would" because it's
-- already defined) is:
--
--   HREF = function (url, text)
--       return "<a href=\""..url.."\">"..text.."</a>"
--     end
--   _GETARGS["HREF"] = vargs2
--
-- More later.


--[[
# (eechannel-xterm "LUA")
lua
= strfind("abcde", "cd()", 2+1)  -- 2+1 4 4+1
= strfind("abcde", "cd()", 3+1)  -- nil
= strsub("abcde", 2+1, 4)        -- "cd"
--]]

-- (find-fline "brackets.lua")



--;;
--;; The basic parsers (culminating at "{}:eval")
--;;

subj = ""			-- will be changed later
pos = 0				-- all my positions will be 0-based
val = nil
b,e = 0, 0			-- beginning and end of the text inside []s

substring = function (b, e) return strsub(subj, b+1, e) end

parser = {}
parse = function (tag) return parser[tag]() end

-- a variation of `parse' that is useful for debugging (and only for that):
PARSE = function (prompt, tag)
    local b = pos
    if parse(tag) then
      print(prompt, "<".. substring(b, pos) ..">")
      return true
    end
  end

parsepat = function (patstr)
    local _, __, e = string.find(subj, patstr, pos+1)
    if _ then pos = e-1; return true end
  end
parser["_*"] = function () return parsepat("^[ \t\n]*()") end
parser["w+"] = function () return parsepat("^[^ \t\n%[%]]+()") end
parser["{}"] = function () return parsepat("^%b[]()") end

parser["w+:string"] = function ()
    local b = pos
    if parse("w+") then val = substring(b, pos); return true end
  end

parser["(w+:string|{}:eval)+:concat"] = function ()
    local empty, result = true, nil
    while parse("w+:string") or parse("{}:eval") do
      if empty then result = val; empty = false  else result = result .. val end
    end
    if not empty then val = result; return true end
  end
parser["bigword"] = parser["(w+:string|{}:eval)+:concat"]
parser["_*bigword"] = function () parse("_*"); return parse("bigword") end

-- heads = {}
-- head_do = function (head) return heads[head]() end

_GETARGS = {}
functionp = function (obj) return type(obj) == "function" end
head_do = function (head)
    local f, g = _G[head], _GETARGS[head]
    if functionp(f) and functionp(g) then return f(g())
    else print("Bad head:", head)
         printpos("pos:", pos)
         printpos("b:", b)
         printpos("e:", e)
	 error()
    end
  end



--  [ head args ]
-- /\pos               instant 0
--  /\b         /\pos  instant 1
--  /\pos      /\e     instant 2
--       /\pos         instant 3
--
parser["{}:eval"] = function ()
    local oldb, olde = b, e
    b = pos+1
    if parse("{}") then
      e = pos-1
      pos = b
      parse("_*bigword")
      val = head_do(val)
      b, e, pos = oldb, olde, e+1
      return true
    end
    b, e = oldb, olde
  end



--;;
--;; Two parsers for "all the other bigwords"
--;;

parser["(_*bigword)*:list"] = function ()
    local blist = {}
    while parse("_*bigword") do tinsert(blist, val) end
    val = blist
    return true
  end
parser["bigwordlist"] = parser["(_*bigword)*:list"]

parser["(_|w)+"] = function () return parsepat("^[^%[%]]+()") end
parser["(_|w)+:string"] = function ()
    local b = pos
    if parse("(_|w)+") then val = substring(b, pos); return true end
  end
parser["((_|w)+:string|{}:eval)+:concat"] = function ()
    local empty, result = true, nil
    while parse("(_|w)+:string") or parse("{}:eval") do
      if empty then result = val; empty = false  else result = result .. val end
    end
    if not empty then val = result; return true end
  end
parser["bigwords:concat"] = parser["((_|w)+:string|{}:eval)+:concat"]
parser["rest:eval"]       = parser["((_|w)+:string|{}:eval)+:concat"]
parser["_*rest:eval"] = function () parse("_*"); return parse("rest:eval") end



--;;
--;; functions to build transformers
--;;

vparse = function (tag) if parse(tag or "rest:eval") then return val end end
pparse = function (str, tag) subj, pos = str, 0; print(vparse(tag)) end -- dbg

vword = function () return vparse("_*bigword") end
vrest = function () return vparse("_*rest:eval") end
vrest_a = function () return vparse("bigwordlist") end

vargs1_ = function () return vrest() end
vargs2_ = function () return vword(), vrest() end
vargs3_ = function () return vword(), vword(), vrest() end
vargs4_ = function () return vword(), vword(), vword(), vrest() end

vargs1 = function () return vrest() or "" end
vargs2 = function () return vword(), vrest() or "" end
vargs3 = function () return vword(), vword(), vrest() or "" end
vargs4 = function () return vword(), vword(), vword(), vrest() or "" end

vargs1_a = function () return vrest_a() end
vargs2_a = function () return vword(), vrest_a() end
vargs3_a = function () return vword(), vword(), vrest_a() end
vargs4_a = function () return vword(), vword(), vword(), vrest_a() end

nop = function () end


--;;
--;; tests - new style
--;;

setgetargs = function (argf, headnames)
    headnames = split(headnames)
    for i=1,getn(headnames) do _GETARGS[headnames[i]] = argf end
  end

setstubs = function (headnames)
    headnames = split(headnames)
    for i=1,getn(headnames) do
      local name = headnames[i]
      _G[name] = function (str) return "("..name.." "..str..")" end
      _GETARGS[name] = vargs1
    end
  end


--[[
-- _GETARGS["R"] = vargs2
-- R = function (a, b) return "<<"..a.." __ "..b..">>" end
-- pparse("foo [R 1 [R http://foo/bar   ab   cd ] ] bar", "rest:eval")
--]]


--;;
--;; eval, expr and lambda
--;;

eval = function (body) return assert(loadstring(body))() end
expr = function (body) return assert(loadstring("return "..body))() end
slambda = function (arglist, body)           -- here body is made of statements
    return assert(loadstring(
      "return function ("..arglist..")\n"..body.."\nend"))()
  end
lambda = function (arglist, body)            -- here body is an expression
    return assert(loadstring(
      "return function ("..arglist..")\nreturn "..body.."\nend"))()
  end


--;;
--;; undollar, map, join, smash, nonvoids
--;;

-- undollar = lambda("str", [[string.gsub(str, "%$([a-z]+)", "\"..%1..\"")]])
undollar = function (str)
    str = string.gsub(str, "%$([a-z]+)", "\"..%1..\"")
    str = string.gsub(str, "%$(%b())",   "\"..%1..\"")
    return str
  end

map = function (f, arr)
    local brr = {}
    for i=1,getn(arr) do tinsert(brr, f(arr[i])) end
    return brr
  end
join = function (arr, sep)
    local str, n = {}, getn(arr)
    if n==0 then return "" end
    str = arr[1]
    for i=2,n do str = str .. sep .. arr[i] end
    return str
  end

smash = function (obj) if obj=="" then return nil else return obj end end
nonvoids = function (arr)
    local brr = {}
    for i=1,getn(arr) do
      if not(smash(obj)) then tinsert(brr, arr[i]) end
    end
    return brr
  end


--;;
--;; Html functions
--;;

_P = P       -- P is a debugging function that I use; here we backup it as _P

J = function (str) return str end     -- join / identity

HREF = lambda("url, str", undollar [["<a href=\"$url\">$str</a>"]])
H1   = lambda("str",      undollar [["<h1>$str</h1>\n"]])
H2   = lambda("str",      undollar [["<h2>$str</h2>\n"]])
H3   = lambda("str",      undollar [["<h3>$str</h3>\n"]])
H4   = lambda("str",      undollar [["<h4>$str</h4>\n"]])
H5   = lambda("str",      undollar [["<h5>$str</h5>\n"]])
H6   = lambda("str",      undollar [["<h6>$str</h6>\n"]])

UL   = lambda("str",      undollar [["<ul>\n$str</ul>\n"]])
LI   = lambda("str",      undollar [["<li>$str\n"]])

LIST1 = lambda("arr", [[UL(join(map(LI, nonvoids(arr)), ""))]])
LIST2 = lambda("arr", [[UL(join(map(LI, nonvoids(arr)), ""))]])
LIST3 = lambda("arr", [[UL(join(map(LI, nonvoids(arr)), ""))]])

HLIST1 = lambda("head, arr", [[H2(head)..LIST1(arr)]])
HLIST2 = lambda("head, arr", [[head.."\n"..LIST2(arr)]])
HLIST3 = lambda("head, arr", [[head.."\n"..LIST3(arr)]])

BF    = lambda("str",        undollar [["<strong>$str</strong>"]])
IT    = lambda("str",        undollar [["<i>$str</i>"]])
RM    = lambda("str",        undollar [["</i>$str<i>"]])
TT    = lambda("str",        undollar [["<code>$str</code>"]])
EM    = lambda("str",        undollar [["<em>$str</em>"]])
PRE   = lambda("str",        undollar [["<pre>$str</pre>"]])
NAME  = lambda("tag, str",   undollar [["<a name=\"$tag\">$str</a>"]])
COLOR = lambda("color, str", undollar [["<font color=\"$color\">$str</font>"]])

IMAGE = lambda("url, text", undollar
                 [[HREF(url, "<br><img src=\"$url\" alt=\"$text\">\n")]])

P = lambda("str", undollar [["\n\n<p>$str"]])

setgetargs(vargs1, "J H1 H2 H3 H4 H5 H6 UL LI BF IT RM TT EM PRE P")
setgetargs(vargs2, "HREF NAME COLOR IMAGE")
setgetargs(vargs1_a, "LIST1 LIST2 LIST3")
setgetargs(vargs2_a, "HLIST1 HLIST2 HLIST3")

-- (find-angg "TH/Htmllib.tcl")
-- (find-angg "TH/index-old.th")

TITLE = lambda("str", undollar [["<title>$str</title>\n"]])
HEAD  = lambda("str", undollar [["<head>\n$str</head>\n"]])
BODY  = lambda("str", undollar [["<body>\n$str\n</body>\n"]])
HTML  = lambda("str", undollar [["<html>\n$str</html>\n"]])

metastr = ""	      -- keywords, etc; addmeta, addkeywords are missing
TITLEDHTML = lambda("title, body",
  [[HTML(HEAD(TITLE(title)..metastr).."\n"..(BODY(body)))]])

setgetargs(vargs1, "TITLE HEAD BODY HTML")
setgetargs(vargs2, "TITLEDHTML")




--;;
--;; entities
--;;

entities_string = [[
  Æ AElig  Á Aacute  Acirc  À Agrave Å Aring  à Atilde Ä Auml  
  Ç Ccedil É Eacute Ê Ecirc  È Egrave Ë Euml   Í Iacute Ï Iuml  
  Ó Oacute Ô Ocirc  Ò Ograve Õ Otilde Ö Ouml   Ú Uacute Û Ucirc 
  Ù Ugrave Ü Uuml   á aacute â acirc  æ aelig  à agrave å aring 
  ã atilde ä auml   ç ccedil é eacute ê ecirc  è egrave ë euml  
  í iacute î icirc  ì igrave ï iuml   ó oacute ô ocirc  ò ograve
  õ otilde ö ouml   ß szlig  ú uacute û ucirc  ù ugrave ü uuml  
  ª ordf   « laquo  ° deg    º ordm   » raquo
  & amp  > gt  < lt
]] .. " \" quot "

reset_entities = function ()
    entities = {}
    entities_chars = ""
    entities_re = "[]"
  end

add_entities = function (entstr)
    local e = split(entstr)
    for i=1,getn(e)-1,2 do
      entities[e[i]] = "&"..e[i+1]..";"
      entities_chars = entities_chars..e[i]
    end
    entities_re = "(["..entities_chars.."])"
  end

reset_entities()
add_entities(entities_string)

encode_entities = function (str)
    return string.gsub(str, entities_re, function (c) return entities[c] end)
  end

Q = encode_entities
setgetargs(vargs1, "Q")

_G["<"] = function () return "[" end
_G[">"] = function () return "]" end
setgetargs(vargs1, "< >")



--;;
--;; heads with different evaluation strategies ("quoting")
--;;

SHOWTHIS   = function () print(substring(b, e)); return "" end
_G["#"]    = function () return "" end
_G["'"]    = function () parse("_*"); return substring(pos, e) end
_G["lua:"] = function () return eval(substring(pos, e)) or "" end

setgetargs(nop, "SHOWTHIS # ' lua:")




--;;
--;; snarf urls (fake for the moment)
--;;

-- (find-angg "TH/")
-- (find-angg "TH/Htmllib.tcl" "local_remote_urls")

tosnarf_prefix = "/home/edrx/snarf/"
tosnarf = function (str)
    local _, __, p, rest = string.find(str, "^([a-z]+)://(.*)")
    if _ and (p == "http" or p == "ftp" or p == "file") then
      return tosnarf_prefix..p.."/"..rest
    end
  end

R = lambda("url, body", [[HREF(url, smash(body) or url)]])
L = lambda("url, body", [[HREF(tosnarf(url) or url, smash(body) or url)]])
LR = lambda("url, body", [[L(url, body).." ("..R(url,"rmt")..")"]])
A0L = R

relativepathto_prefix = ""
relativepathto = function (str) return relativepathto_prefix .. str end
section = function (str) return (smash(str) and "#"..str) or "" end

MYL = function (fname, text)
    return HREF(relativepathto(fname), smash(text) or fname)
  end
MYURL = function (url, name)
    return relativepathto(smash(name) and url or url.."#"..name)
  end
AURL = function (astem, name)
    return relativepathto(astem..".html"..section(name))
  end


-- str = "foo#bar#plic"
-- PP(split(str, "#"))
-- str = "foo"
-- P(string.find(str, "^([^#]*)#?(.*)"))

bef_aft_hash = function (str)
    local _, __, bef, aft = string.find(str or "", "^([^#]*)#?(.*)")
    return {bef, aft}
  end
vargshash2 = function () return bef_aft_hash(vword()), vrest() or "" end

AL = function (anggurl, text)
    return L(AURL(anggurl[1], anggurl[2]), smash(text) or anggurl[1])
  end
ES = function (target, text)
    return L(relativepathto("e/"..target[1]..".html"..section(target[2])),
             smash(text) or target[1])
  end

nbytes = function (fname)
    local f = io.open(fname)
    if f then return f:seek("end"), f:close() end
  end
MYLBYTES = function (fname, txt)
    local size = nbytes(fname)
    return MYL(fname, txt.." ("..(size or "??").." bytes)")
  end


-- procj AL1 {anggurl text} {	# experimental version
--   foreach {astem name} $anggurl {}
--   L1 [AURL $astem $name] [or $text $astem]
-- }
-- 
-- beforehash = function (str)
-- afterhash

-- (find-angg "TH/Generate" "link_functions")
-- (find-zsh "cd ~/LUA/; lua blogme.lua")
-- (find-fline "index.blogme")

localhack = lambda("", [["\n(Local hack not implemented)"]])
HTMLIZE = lambda("title, body",
  [[TITLEDHTML(Q(title), H3(Q(title)).."\n"..body..localhack())]])

setgetargs(vargs2, "R L LR A0L MYL HTMLIZE MYLBYTES")
setgetargs(vargshash2, "AL ES")

setstubs("LUANODE LIBCNODE EXPNODE")

IFL = J
IFR = J
BR   = function () return "\n<br>\n" end
RULE = function () return "\n\n<hr size=1>\n\n" end
ANAME = NAME
setgetargs(vargs1, "IFL IFR BR RULE ANAME")



--;;
--;; checkbrackets
--;;

blogme_input_fname = "?"

printpos = function (str, pos)
    printf("%s (progn (find-fline \"%s\") (goto-char %d))\n",
           str, blogme_input_fname, pos+1)
  end

checkbrackets = function ()
    local opens, neopens, necloses = {}, 0, 0
    for i=0,strlen(subj)-1 do
      local c = substring(i, i+1)
      if c == "[" then tinsert(opens, i)
      elseif c == "]" then
        if getn(opens)>0 then
          tremove(opens)
        else
          necloses = necloses + 1
          printpos("Extra close:", i+1)
        end
      end
    end
    for i=1,getn(opens) do
      neopens = neopens + 1
      printpos("Extra open:", opens[i]+1)
    end
    return neopens+necloses
  end



-- _P(R, _GETARGS["R"])
-- print(R("ftp://a", "bluu"))

--;;
--;; blogme
--;;

htmlize = function (title, body)
    blogme_output = HTMLIZE(title, body)
    return ""
  end
setgetargs(vargs2, "htmlize")

blogme_test = function (infname, outfname)
    blogme_input_fname  = infname
    blogme_output_fname = outfname
    blogme_input = readfile(blogme_input_fname)
    subj, pos = blogme_input, 0
    if checkbrackets(blogme_fname) > 0 then
      os.exit(1)
    end
    vparse()
    if blogme_output_fname then
      writefile(blogme_output_fname, blogme_output)
    else
      print(blogme_output)
    end
  end 

-- pparse("[AL foo]")



do
  local i = 1
  local infname, outfname
  while i <= arg.n do
    local a, b = arg[i], arg[i+1]
    if     a == "-o" then outfname = b; i = i+2
    elseif a == "-i" then blogme_test(b, outfname); i = i+2
    elseif a == "-p" then relativepathto_prefix = b; i = i+2
    elseif a == "-e" then assert(loadstring(b))(); i = i+2
    else print("Unrecognized option: " .. a); os.exit(1)
    end
  end
end

-- blogme_test("index.blogme", "index.html")

-- (find-fline "index.blogme")
-- (find-fline "math.blogme")
-- (find-zsh "cd ~/LUA/; lua blogme.lua")
-- (find-zsh "cd ~/LUA/; lua blogme.lua -o ~/TH/L/index-b.html -i index.blogme")
-- (find-zsh "cd ~/LUA/; lua blogme.lua -o ~/TH/L/math-b.html -i math.blogme")
-- (find-w3m "~/LUA/index.html")

-- Bad head: <a href="http://www.gnu.org/gnu/linux-and-gnu.html">GNU/</a>
-- pos, b, e
-- 14491
-- 14440
-- 14491




pparse2 = function (str, tag)
    print("\""..str.."\"")
    print(" 0123456789012345678901234567890123456")
    pparse(str, tag)
  end --dbg

-- pparse("foo [R ftp://a [R http://foo/bar   ab   cd ] ] bar")
-- pparse2("foo [R ftp://a bbb] bar")
-- pparse2("foo [R ftp://a [R http://boo bbb eee]] bar")
-- pparse2("foo [SHOWTHIS ftp://a bbb] bar")
-- pparse2("foo [lua: print(\"Hi!\")] bar")

-- (find-zsh "cd ~/LUA/; lua blogme.lua")
-- 012345678901234567890123

-- pparse(readfile "index.blogme")
-- pparse("[HTMLIZE titl body]")




-- Local Variables:
-- coding:               raw-text-unix
-- modes:                (fundamental-mode lua-mode)
-- End: