|
Warning: this is an htmlized version!
The original is here, and the conversion rules are here. |
#!/usr/bin/env lua50
-- This is the `blogme.lua' file of BlogMe.
-- Copyright 2005 Eduardo Ochs <edrx@mat.puc-rio.br>
-- Author: Eduardo Ochs <edrx@mat.puc-rio.br>
-- Version: 2005jul24
-- License: GPL (I'll add the complete headers later)
-- Latest: http://angg.twu.net/blogme/blogme.lua
--
-- The documentation was moved to the file README.
-- Add the curent directory to LUA_PATH (if in standalone mode).
-- (find-es "lua5" "require")
-- luapath_append = function (path) LUA_PATH = LUA_PATH..";"..path end
-- luapath_prepend = function (path) LUA_PATH = path..";"..LUA_PATH end
--
LUA_PATH = LUA_PATH or os.getenv("LUA_PATH") or "?;?.lua"
if not library then
local _, __, arg0path = string.find(arg[0], "^(.*)/[^/]*$")
if arg0path then LUA_PATH = LUA_PATH..";"..arg0path.."/?" end
end
require "edrxlib.lua"
--[[
# Notes about using 0-based string positions:
# (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"
--]]
----------[ The "hard part" of the kernel starts here ]----------
--;;
--;; 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
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 is defined below
printpos("b:", b)
printpos("e:", e)
error()
end
end
-- Parsing "{}:eval" is so confusing.
-- [ 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
----------[ the "hard part" of the kernel ends here ]----------
--;;
--;; 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
--;;
--;; vparse: parse and return val
--;; pparse: parse a string and print the result (for debugging)
--;;
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
--;;
--;; functions to parse the rest (for head_do)
--;;
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
--;;
--;; setgetargs, setstubs - simple tools for defining heads
--;;
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
--;;
--;; 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..\"")
str = string.gsub(str, "%$(%b[])", function (s)
return "]]..("..strsub(s, 2, -2)..")..[["
end)
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
--;;
--;; def - a higher-level tool for defining heads
--;;
restspecs = {
["1"]=vargs1, ["2"]=vargs2, ["3"]=vargs3, ["4"]=vargs4,
["1L"]=vargs1_a, ["2L"]=vargs2_a, ["3L"]=vargs3_a, ["4L"]=vargs4_a
}
-- (find-luafile "src/lib/lstrlib.c" "case 's' : res = isspace(c)")
-- (find-node "(libc)Classification of Characters" "int isspace")
def = function (str)
local _, __, name, restspec, arglist, body =
-- string.find (str, "^%s*([^%s]+)%s+([^%s]+)%s+([^%s]+)%s(.*)")
string.find (str, "^%s*(%S+)%s+(%S+)%s+(%S+)%s(.*)")
_G[name] = lambda(arglist, undollar(body))
_GETARGS[name] = restspecs[restspec] or _G[restspec]
or error("Bad restspec: "..name)
end
--;;
--;; printpos, 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
----------[ the "soft part" of the kernel ends here ]----------
--;;
--;; 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
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 [[ 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" ]]
-- (find-angg "TH/Htmllib.tcl")
-- (find-angg "TH/index-old.th")
metastr = "" -- keywords, etc; addmeta, addkeywords are missing
TITLEDHTML = lambda("title, body",
[[HTML(HEAD(TITLE(title)..metastr).."\n"..(BODY(body)))]])
setgetargs(vargs2, "TITLEDHTML")
--;;
--;; entities and quoting (Q)
--;;
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")
--;;
--;; heads with strange evaluation strategies (quoting, usually)
--;;
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
_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
-- 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)"]])
localhack = function () return "" end
-- HTMLIZE = lambda("title, body",
-- [[TITLEDHTML(Q(title), H3(Q(title)).."\n"..body..localhack())]])
HTMLIZE = function (title, body)
return TITLEDHTML(Q(title), H3(Q(title)).."\n"..body..localhack())
end
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")
--;;
--;; 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]")
if not library then
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
elseif a == "-remote" then LR = R; i = i+1
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)
-- ee-anchor-format: "\n%s = function"
-- End: