pret-pas/pret-pas.lua

if not modules then modules = { } end modules ['pret-pas'] = {
	version   = 1.0,
	comment   = "custom pretty printer for Pascal code",
	author    = "Stefan Müller, Chemnitz DE",
	copyright = "Stefan Müller",
	license   = "see context related readme files"
}

-- The code formatting is adapted from Lazarus, a Free Pascal RAD IDE, which
-- should be quite similar to the Delphi style. Please note that comments are
-- not typeset with bold fontface but slanted, which improves output when not
-- using colors.
-- http://lazarus.freepascal.org/

local visualizer = buffers.newvisualizer("pas")

-- The list of reserved words is taken from 
-- http://www.freepascal.org/docs-html/ref/refse3.html
visualizer.reservedwords = {
	-- Turbo Pascal
	"absolute", "and", "array", "asm", "begin", "case", "const", "constructor",
	"destructor", "div", "do", "downto", "else", "end", "file", "for",
	"function", "goto", "if", "implementation", "in", "inherited", "inline",
	"interface", "label", "mod", "nil", "not", "object", "of", "on", "operator",
	"or", "packed", "procedure", "program", "record", "reintroduce", "repeat",
	"self", "set", "shl", "shr", "string", "then", "to", "type", "unit",
	"until", "uses", "var", "while", "with", "xor",

	-- Free Pascal
	-- these are not bold type (keeping them, just in case)
	-- "dispose", "exit", "false", "new", "true",

	-- Object Pascal
	"as", "class", "dispinterface", "except", "exports", "finalization",
	"finally", "initialization", "inline", "is", "library", "on", "out",
	"packed", "property", "raise", "resourcestring", "threadvar", "try",

	-- Modifiers
	-- some of these are only bold in specific places (in the following, this is
	-- deliberately ignored)
	"absolute", "abstract", "alias", "assembler", "cdecl", "cppdecl", "default",
	"export", "external", "far", "far16", "forward", "index", "local", "name", 
	"near", "nostackframe", "oldfpccall", "override", "pascal", "private",
	"protected", "public", "published", "read", "register", "reintroduce",
	"safecall", "softfloat", "stdcall", "virtual", "write"
}

local known_words = { }

for k,v in next, visualizer.reservedwords do
	known_words[v] = k
end

local colors = {
	"prettyone", -- red: compiler directive, symbol
	"prettytwo", -- green: assembler (dark green)
	"prettythree", -- blue: comment, number (dark blue)
	"prettyfour", -- yellow
}

local reserved_style = "\{\\bf "
local comment_style = "\{\\sl "

local inlongcomment, inlongcomment_alt, incompdirec, inasm = false, 0, false, false

local function flush_pas_word(word, state)
	if word then
		local lword = string.lower(word)
        local id = known_words[lword]
        if id then
			if inasm and (lword == "end") then
				-- asm mode ends
				state = buffers.finishstate(state)
				inasm = false
				print("leave asm")
			end
			if not inasm then
				tex.sprint(tex.ctxcatcodes, reserved_style)
				tex.write(word)
				tex.sprint(tex.ctxcatcodes, "\}")
				if lword == "asm" then
					-- asm mode begins
					print("enter asm")
					inasm = true
					state = buffers.changestate(2, state)
				end
			else
				tex.write(word)
			end
        else
        	tex.write(word)
        end
    end
	return state
end

local function flush_whatever(str)
	if str then
		for c in string.utfcharacters(str) do
			if c == " " then
				tex.sprint(tex.ctxcatcodes, "\\obs")
			elseif c == "\t" then
				tex.sprint(tex.ctxcatcodes, "\\obs")
				if buffers.visualizers.enabletab then
					tex.sprint(tex.ctxcatcodes,rep("\\obs ", buffers.visualizers.tablength))
				end
			else
				tex.write(c);
			end
		end
	end
end

function visualizer.reset()
	inlongcomment, inlongcomment_alt, incompdirec, inasm = false, 0, false, false
end

function visualizer.flush_line(str, nested)
	local state = 0
	local incomment, instring = false, false
	--local code, comment = nil, nil
	buffers.currentcolors = colors

	if inlongcomment or (inlongcomment_alt == 2) or incompdirec then
		incomment = true
		if incompdirec then
			state = buffers.changestate(1, state)
		else
			state = buffers.changestate(3, state)
		end
		tex.sprint(tex.ctxcatcodes, comment_style)
	elseif inasm then
		state = buffers.changestate(2, state)
	end
	
	local c, word = nil, nil
	for nextc in string.utfcharacters(str .. " ") do
		if c then
			if instring then
				if c == "'" then
					-- string ends
					tex.write(c)
					state = buffers.finishstate(state)
					instring = false
				else
					-- inside the string
					flush_whatever(c)
				end
			elseif incomment then
				if ((inlongcomment or incompdirec) and (c == "}"))
				or (inlongcomment_alt == 1) then
					-- long comment/(alternative)/compiler directive ends
					tex.write(c)
					tex.sprint(tex.ctxcatcodes, "\}")
					if inasm then
						-- resume to asm mode
						state = buffers.changestate(2, state)
					else
						state = buffers.finishstate(state)
					end
					incompdirec = false
					inlongcomment = false
					inlongcomment_alt = 0
					incomment = false
				elseif (inlongcomment_alt == 2) and (c == "*") and (nextc == ")") then
					-- long comment (alternative) ends after nextc
					tex.write(c)
					inlongcomment_alt = 1
				else
					-- inside the comment
					flush_whatever(c)
				end
			elseif string.find(c, "^[%a_]$") then
				-- char belongs to identifier
				if word then
					word = word .. c
				else
					word = c
				end
			elseif string.find(c, "^[%d]$") then
				if word and (#word > 1) then
					-- number, that belongs to identifier
					word = word .. c
				else
					if not inasm then
						-- number
						state = buffers.changestate(3, state)
					end
					tex.write(c)
				end
			else
				if not inasm then
					state = buffers.finishstate(state)
				end
				-- identifier complete, check if it's a reserved word and flush
				state = flush_pas_word(word, state)
				word = nil
				if c == " " then
					tex.sprint(tex.ctxcatcodes, "\\obs")
				elseif c == "\t" then
					tex.sprint(tex.ctxcatcodes, "\\obs")
					if buffers.visualizers.enabletab then
						tex.sprint(tex.ctxcatcodes,rep("\\obs ", buffers.visualizers.tablength))
					end
				elseif c == "'" then
					if not inasm then
						-- string begins
						instring = true
						state = buffers.changestate(3, state)
					end
					tex.write(c)
				elseif (c == "/") and (nextc == "/") then
					-- one-line comment begins
					incomment = true
					state = buffers.changestate(3, state)
					tex.sprint(tex.ctxcatcodes, comment_style)
					tex.write(c)
				elseif c == "{" then
					incomment = true
					if nextc == "$" then
						-- compiler directive begins
						incompdirec = true
						state = buffers.changestate(1, state)
					else
						-- long comment begins
						inlongcomment = true
						state = buffers.changestate(3, state)
					end
					tex.sprint(tex.ctxcatcodes, comment_style)
					tex.write(c)
				elseif (c == "(") and (nextc == "*") then 
					-- long comment (alternative) begins
					incomment = true
					inlongcomment_alt = 2
					state = buffers.changestate(3, state)
					tex.sprint(tex.ctxcatcodes, comment_style)
					tex.write(c)
				else
					if not inasm then
						-- symbol
						state = buffers.changestate(1, state)
					end
					tex.write(c)
				end
			end
		end
		c = nextc
	end
	if not incomment and not inasm then
		state = buffers.finishstate(state)
	end
	-- maybe something left, check if it's a reserved word and flush
	state = flush_pas_word(word, state)
	if incomment then
		-- end the comment-line
		tex.sprint(tex.ctxcatcodes, "\}")
	end
	state = buffers.finishstate(state)	
end