Warning: this is an htmlized version!
The original is here, and
the conversion rules are here.
#!/usr/bin/env lua50
-- -*- coding: raw-text-unix -*-
-- This is the `blogme2-outer.lua' file of blogme2.
-- It contains the "outer layer" of the kernel of blogme2 - the
-- standard words (and what else?)
-- Author and version: Eduardo Ochs <edrx@mat.puc-rio.br>, 2006sep09
-- License: GPL.
-- (find-fline "INTERNALS")
-- (find-fline "blogme2-inner.lua")
-- (find-fline "blogme2-middle.lua")
-- (find-fline "blogme2-outer.lua")

-- (find-blogmefile "blogme.lua" "_G[\"lua:\"]")


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

--;;
--;; setgetargs, setstubs - simple tools for defining heads
--;;

setgetargs = function (argf, headnames)
    headnames = split(headnames)
    for i=1,getn(headnames) do _A[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
      _A[name] = vargs1
    end
  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
join = table.concat

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

--------------------
_G["set"] = function (varname, text) _G[varname] = text end
_A["set"] = vargs2

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

P0 = P       -- backup P (the debugging function) as P0

J = function (str) return str end     -- join / identity
setgetargs(vargs1, "J")

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

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

def [[ UL     1  str       "<ul>\n$str</ul>\n"        ]]
def [[ LI     1  str       "<li>$str\n"               ]]
def [[ LIST1  1L arr       UL(join(map(LI, nonvoids(arr)), ""))]]
def [[ LIST2  1L arr       UL(join(map(LI, nonvoids(arr)), ""))]]
def [[ LIST3  1L arr       UL(join(map(LI, nonvoids(arr)), ""))]]
def [[ HLIST1 2L head,arr  H2(head)..LIST1(arr)       ]]
def [[ HLIST2 2L head,arr  head.."\n"..LIST2(arr)     ]]
def [[ HLIST3 2L head,arr  head.."\n"..LIST3(arr)     ]]

def [[ BF     1 str        "<strong>$str</strong>"              ]]
def [[ IT     1 str        "<i>$str</i>"                        ]]
def [[ RM     1 str        "</i>$str<i>"                        ]]
def [[ TT     1 str        "<code>$str</code>"                  ]]
def [[ EM     1 str        "<em>$str</em>"                      ]]
def [[ PRE    1 str        "<pre>$str</pre>"                    ]]
def [[ SMALL  1 body       "<small>$body</small>"               ]]
def [[ NAME   2 tag,str    "<a name=\"$tag\">$str</a>"          ]]
def [[ COLOR  2 color,str  "<font color=\"$color\">$str</font>" ]]

def [[ IMG    2 url,alt    "<img src=\"$url\" alt=\"$alt\" border=0>\n" ]]
def [[ IMAGE  2 url,alt    HREF(url, "<br>"..IMG(url,alt))               ]]

def [[ P      1 str        "\n\n<p>$str" ]]

def [[ TITLE  1 str        "<title>$str</title>\n"   ]]
def [[ HEAD   1 str        "<head>\n$str</head>\n"   ]]
def [[ BODY   1 str        "<body>\n$str\n</body>\n" ]]
def [[ HTML   1 str        "<html>\n$str</html>\n"   ]]

def [[ TABLE 1 text  "<table>$text</table>\n" ]]
def [[ TR    1 text  "<tr>$text</tr>\n" ]]
def [[ TD    1 text  "<td>$text</td>\n" ]]
def [[ TH    1 text  "<th>$text</th>\n" ]]
def [[ DIV   1 text  "<div>$text</div>\n" ]]

def [[ TABLE+ 2 attribs,text  "<table $attribs>$text</table>\n" ]]
def [[ TR+    2 attribs,text  "<tr $attribs>$text</tr>\n"       ]]
def [[ TD+    2 attribs,text  "<td $attribs>$text</td>\n"       ]]
def [[ TH+    2 attribs,text  "<th $attribs>$text</th>\n"       ]]
def [[ DIV+   2 attribs,text  "<div $attribs>$text</div>\n"     ]]

def [[ UL+    2 attribs,str   "<ul $attribs>\n$str</ul>\n"      ]]

def [[ STYLE  1 style "style=\"$style\"" ]]
def [[ CLASS  1 class "class=\"$class\"" ]]

def [[ NARROW 1 text "\n<blockquote>\n$text\n</blockquote>\n"              ]]
def [[ BOX    1 body "\n<table><tr><td>\n"..body.."\n</td></tr></table>\n" ]]
def [[ BORDERLESSBOX 1 body
               "<table border=\"0\"><tr><td>\n$body\n</td></tr></table>\n" ]]
def [[ BORDERLESSBOX+ 2 attribs,body
      "<table border=\"0\" $attribs><tr><td>\n$body\n</td></tr></table>\n" ]]

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

--;;
--;; entities and quoting (Q)
--;; (find-eleimfile "quail/sgml-input.el")
--;;

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
  Ñ Ntilde ñ ntilde
  × times
]] .. " \" 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

def [[ Q 1 text encode_entities(text) ]]

-- Q = encode_entities
-- setgetargs(vargs1, "Q")


--;;
--;; unaccent (useful to make anchors)
--;;

unaccent_from, unaccent_to = 
  "ÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖØÙÚÛÜÝàáâãäåçèéêëìíîïñòóôõöøùúûüý",
  "AAAAAACEEEEIIIINOOOOOOUUUUYaaaaaaceeeeiiiinoooooouuuuy"
unaccent_re = "(["..unaccent_from.."])"
unaccent_table = {}
for i = 1,strlen(unaccent_from) do
  unaccent_table[strsub(unaccent_from, i, i)] = strsub(unaccent_to, i, i)
end
unaccent = function (str)
    return gsub(str, unaccent_re, function (c)
        return unaccent_table[c]
      end)
  end

def [[ UNACCENT 1 str unaccent(str) ]]


--;;
--;; heads with strange evaluation strategies (quoting, usually)
--;;

SHOWTHIS   = function () print(substring(b, e)); return "" end
_G["#"]    = function () return "" end
_G["'"]    = function () parse("%s*"); return substring(pos, e) end
_G["lua:"] = function () return eval(substring(pos, e)) or "" end
_G["<"]    = function () return "[" end
_G[">"]    = function () return "]" 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]..".e.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

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

setstubs("LUANODE LIBCNODE EXPNODE")

def [[ E 2 stem,anchor  "e/$stem.e.html"..section(anchor) ]]

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")

-- 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")

--;;
--;; dtd
--;;

dtd_transitional =
[[<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
    "http://www.w3.org/TR/html4/loose.dtd">
]]
dtd_strict =
[[<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN"
    "http://www.w3.org/TR/REC-html40/strict.dtd">
]]
headdtd = dtd_transitional
html_dtd = dtd_transitional

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

-- New way:
html_style    = ""   -- (find-wdgrefw3m "html40/head/head.html" "STYLE")
html_meta     = ""   -- (find-wdgrefw3m "html40/head/head.html" "META")
html_favicon  = ""
html_speedbar = ""
def [[ html_head   1 title      HEAD(TITLE(title)..html_meta..
                                      html_favicon..html_style)             ]]
def [[ html_body_0 2 title,body H3(Q(title)).."\n"..body..localhack()       ]]
def [[ html_body_1 2 title,body DIV(BORDERLESSBOX(html_body_0(title,body))) ]]
def [[ html_body_2 2 title,body html_speedbar..html_body_1(title,body)      ]]
def [[ html_body   2 title,body html_body_0(title,body)                     ]]
def [[ html_all    2 title,body html_dtd..
                                HTML(html_head(title).."\n"..
                                     BODY(html_body(title,body)))           ]]

def [[ htmlize   2 title,body set("blogme_output", html_all(title, body))   ]]

-- Example: [SETHEADSTYLE h3 { background-color: orange; }]
def [[ HEADSTYLE    1 styles
         "<style type=\"text/css\"><!--\n$styles -->\n</style>\n" ]]
def [[ SETHEADSTYLE 1 styles set("html_style", HEADSTYLE(styles)) ]]
def [[ SETFAVICON 1 url  set("html_favicon",
         "<link rel=\"shortcut icon\" href=\"$url\" />\n") ]]

-- Old:
-- headstyle = ""        -- for an inline stylesheet
-- def [[ SETHEADSTYLE 1 styles set("headstyle", HEADSTYLE(styles)) ]]
-- _G["SETHEADSTYLE"] = function (styles) headstyle = HEADSTYLE(styles) end
-- _A["SETHEADSTYLE"] = vargs1
-- HTMLIZE = lambda("title, body",
--   [[TITLEDHTML(Q(title), H3(Q(title)).."\n"..body..localhack())]])
-- def [[ HTMLIZE 2 title,body
--          TITLEDHTML(Q(title), H3(Q(title)).."\n"..body..localhack()) ]]
-- def [[ htmlize 2 title,body set("blogme_output", HTMLIZE(title, body)) ]]

localhack = lambda("", [["\n(Local hack not implemented)"]])
localhack = function () return "" end

-- Missing: this should change temporarily the file name and should check
-- the brackets
def [[ INCLUDE 1 fname withsubj(readfile(fname), vparse) ]]

def [[ WAYBACK 1 url "http://web.archive.org/web/*/"..url ]]
def [[ pkg     2 section,name
  R("http://packages.debian.org/testing/$section/"..name, name) ]]

-- (find-dn4file "dednat4.lua" "untabify =")
-- (find-es "lua5" "string.gsub")
untabify_table =
  {"        ", "       ", "      ", "     ", "    ", "   ", "  ", " "}
--{"--------", "-------", "------", "-----", "----", "---", "--", "-"}
untabify_strtab = function (strbeforetab)
    return strbeforetab ..
      untabify_table[math.mod(strlen(strbeforetab), 8) + 1]
  end
two_d_trim = function (str)
    str = gsub(str, "^([ \t]*\n)*", "")   -- remove initial blank lines
    str = gsub(str, "[ \t]+\n", "\n")     -- remove whitespace at the right
    str = gsub(str, "[ \t\n]*$", "")      -- remove whitespace at the end
    str = gsub(str, "([^\t\n]*)\t", untabify_strtab)  -- untabify
    return str
  end



-- (find-fline "blogme2-inner.lua")
-- (find-fline "blogme2-middle.lua")
-- (find-fline "blogme2-outer.lua")