-- lx format
local format = require("core.format")
local patterns = require("core.format.patterns")
local quotes = require("core.text.quotes")

--[[
Intentional compromises:

- Braced words are only colored as strings for simple non-nested single-line {...}
  which avoids the worse failure of treating every brace block as Tcl code

- # is only highlighted at line start or after ;
  matching the common Tcl command-start rule much better than a global # comment rule

- Command substitution brackets are highlighted and command heads inside [...] are recognized,
  but this is not a full recursive Tcl parser

- exec is left as Tcl words and operators; it is not treated as shell source
]]--

local string_subsyntax = {
	patterns = {
		-- Backslash newline continuation
		{ pattern = "\\[ \t]*\n[ \t]*", type = "meta" },

		-- Unicode escape
		{ pattern = "\\U[%da-fA-F][%da-fA-F]?[%da-fA-F]?[%da-fA-F]?[%da-fA-F]?[%da-fA-F]?[%da-fA-F]?[%da-fA-F]?", type = "hex" },

		-- Short unicode escape
		{ pattern = "\\u[%da-fA-F][%da-fA-F]?[%da-fA-F]?[%da-fA-F]?", type = "hex" },

		-- Hex escape
		{ pattern = "\\x[%da-fA-F][%da-fA-F]?", type = "hex" },

		-- Octal escape
		{ pattern = "\\[0-7][0-7]?[0-7]?", type = "number" },

		-- Named escape
		{ pattern = "\\[abfnrtv\\\"%{%}%[%]%$; ]", type = "operator" },

		-- Generic escaped character
		{ pattern = "\\.", type = "operator" },

		-- Braced variable reference
		{ pattern = "%${[^}\r\n]-}", type = "variable" },

		-- Array variable reference
		{ pattern = "%$[:%a_][%w_:]*%b()", type = "variable" },

		-- Scalar variable reference
		{ pattern = "%$[:%a_][%w_:]*", type = "variable" },

		-- Command substitution command head
		{
			pattern = "(%[)(%s*)([%.:%a_][%w_%.:%-]*)",
			type = { "operator", "normal", "function" },
		},

		-- Command substitution delimiters
		{ pattern = "[%[%]]", type = "operator" },
	},
}

format.register({
	name = "Tcl Script",
	shortname = "Tcl",
	author = "liqube",

	extensions = {
		"tcl",
		"tm",
		"test",
		"itcl",
		"itk",
	},

	filenames = {
		"pkgIndex.tcl",
		"tclIndex",
	},

	headers = {
		"^#!.*[ /]tclsh",
		"^#!.*[ /]wish",
		"^#!.*env%s+%-S%s+tclsh",
		"^#!.*env%s+tclsh",
		"^#!.*env%s+wish",
	},

	comment = "#",

	patterns = {
		patterns.shebang_line(),

		-- Backslash newline continuation
		{ pattern = "\\[ \t]*\n[ \t]*", type = "meta" },

		-- Line-start comment
		{ pattern = "%s*#[^\r\n]*", type = "comment", line_start = true },

		-- Command-separator comment
		{
			pattern = "(;)(%s*#[^\r\n]*)",
			type = { "operator", "comment" },
		},

		-- Procedure declaration
		{
			pattern = "%s*(proc)(%s+)([%.:%a_][%w_%.:%-]*)",
			type = { "keyword", "normal", "function" },
			line_start = true,
		},

		-- Namespace eval declaration
		{
			pattern = "%s*(namespace)(%s+)(eval)(%s+)([%.:%a_][%w_%.:%-]*)",
			type = { "keyword", "normal", "keyword", "normal", "keyword2" },
			line_start = true,
		},

		-- Command name at line start
		{
			pattern = "%s*([%.:%a_][%w_%.:%-]*)",
			type = { "function" },
			line_start = true,
		},

		-- Command name after semicolon
		{
			pattern = "(;)(%s*)([%.:%a_][%w_%.:%-]*)",
			type = { "operator", "normal", "function" },
		},

		-- Command substitution command head
		{
			pattern = "(%[)(%s*)([%.:%a_][%w_%.:%-]*)",
			type = { "operator", "normal", "function" },
		},

		-- Double quoted word
		{
			pattern = { '"', '"', "\\" },
			type = "string",
			delim_type = "string",
			syntax = string_subsyntax,
		},

		-- Argument expansion
		{ pattern = "{%*}", type = "operator", followed_by = "%S" },

		-- Simple braced word without nested braces
		{ pattern = "{[^{}\r\n]*}", type = "string" },

		-- Braced variable reference
		{ pattern = "%${[^}\r\n]-}", type = "variable" },

		-- Array variable reference
		{ pattern = "%$[:%a_][%w_:]*%b()", type = "variable" },

		-- Scalar variable reference
		{ pattern = "%$[:%a_][%w_:]*", type = "variable" },

		-- Unicode escape
		{ pattern = "\\U[%da-fA-F][%da-fA-F]?[%da-fA-F]?[%da-fA-F]?[%da-fA-F]?[%da-fA-F]?[%da-fA-F]?[%da-fA-F]?", type = "hex" },

		-- Short unicode escape
		{ pattern = "\\u[%da-fA-F][%da-fA-F]?[%da-fA-F]?[%da-fA-F]?", type = "hex" },

		-- Hex escape
		{ pattern = "\\x[%da-fA-F][%da-fA-F]?", type = "hex" },

		-- Octal escape
		{ pattern = "\\[0-7][0-7]?[0-7]?", type = "number" },

		-- Named escape
		{ pattern = "\\[abfnrtv\\\"%{%}%[%]%$; ]", type = "operator" },

		-- Generic escaped character
		{ pattern = "\\.", type = "operator" },

		-- Binary integer
		{ pattern = "%f[%w_]0[bB][01_]+%f[^%w_]", type = "number" },

		-- Octal integer
		{ pattern = "%f[%w_]0[oO][0-7_]+%f[^%w_]", type = "number" },

		-- Hex integer
		{ pattern = "%f[%w_]0[xX][%da-fA-F_]+%f[^%w_]", type = "hex" },

		-- Explicit decimal integer
		{ pattern = "%f[%w_]0[dD][%d_]+%f[^%w_]", type = "number" },

		-- Floating point number with exponent
		{ pattern = "%f[%w_][%+%-]?%d[%d_]*%.%d[%d_]*[eE][%+%-]?%d[%d_]*%f[^%w_]", type = "number" },

		-- Floating point number
		{ pattern = "%f[%w_][%+%-]?%d[%d_]*%.%d[%d_]*%f[^%w_]", type = "number" },
		{ pattern = "%f[%w_][%+%-]?%d[%d_]*[eE][%+%-]?%d[%d_]*%f[^%w_]", type = "number" },

		-- Integer
		{ pattern = "%f[%w_][%+%-]?%d[%d_]*%f[^%w_]", type = "number" },

		-- Option word
		{ pattern = "%f[%S]%-%-?[%a_][%w_%-]*%f[%s%]%}%)]", type = "keyword2" },

		-- Namespace separator
		{ pattern = "::", type = "operator" },

		-- Expression and command operators
		{ pattern = "%*%*", type = "operator" },
		{ pattern = "<<", type = "operator" },
		{ pattern = ">>", type = "operator" },
		{ pattern = "<=", type = "operator" },
		{ pattern = ">=", type = "operator" },
		{ pattern = "==", type = "operator" },
		{ pattern = "!=", type = "operator" },
		{ pattern = "&&", type = "operator" },
		{ pattern = "%|%|", type = "operator" },

		-- Command substitution and punctuation
		{ pattern = "[%[%]{}%(%)%;,:%?%+%-%*/%%<>=!~&|%^]", type = "operator" },

		-- Bare words
		{ pattern = "[%.:%a_][%w_%.:%-]*", type = "normal" },
	},

	outline_patterns = {
		{ pattern = "%s*proc%s+[%.:%a_][%w_%.:%-]*", line_start = true }, -- Procedure declaration
		{ pattern = "%s*namespace%s+eval%s+[%.:%a_][%w_%.:%-]*", line_start = true }, -- Namespace script
		{ pattern = "%s*oo::class%s+create%s+[%.:%a_][%w_%.:%-]*", line_start = true }, -- TclOO class
		{ pattern = "%s*method%s+[%.:%a_][%w_%.:%-]*", line_start = true }, -- TclOO method
		{ pattern = "%s*constructor%s+", line_start = true }, -- TclOO constructor
		{ pattern = "%s*destructor%s+", line_start = true }, -- TclOO destructor
	},

	quotes = {
		primary = "double",
		profiles = {
			double = quotes.profile.c_style_double(),
		},
	},

	symbols = {
		-- Control and evaluation commands
		["apply"] = "keyword",
		["break"] = "control",
		["catch"] = "keyword",
		["continue"] = "control",
		["error"] = "keyword",
		["eval"] = "keyword",
		["exit"] = "control",
		["expr"] = "keyword",
		["for"] = "control",
		["foreach"] = "control",
		["if"] = "control",
		["lmap"] = "control",
		["return"] = "control",
		["tailcall"] = "control",
		["throw"] = "keyword",
		["try"] = "control",
		["uplevel"] = "keyword",
		["while"] = "control",

		-- Variable and namespace commands
		["append"] = "keyword",
		["array"] = "keyword",
		["global"] = "keyword",
		["incr"] = "keyword",
		["lappend"] = "keyword",
		["lassign"] = "keyword",
		["set"] = "keyword",
		["trace"] = "keyword",
		["unset"] = "keyword",
		["upvar"] = "keyword",
		["variable"] = "keyword",
		["namespace"] = "keyword",

		-- List, dict, and string commands
		["concat"] = "keyword",
		["dict"] = "keyword",
		["join"] = "keyword",
		["lindex"] = "keyword",
		["linsert"] = "keyword",
		["list"] = "keyword",
		["llength"] = "keyword",
		["lrange"] = "keyword",
		["lrepeat"] = "keyword",
		["lreplace"] = "keyword",
		["lreverse"] = "keyword",
		["lsearch"] = "keyword",
		["lset"] = "keyword",
		["lsort"] = "keyword",
		["split"] = "keyword",
		["string"] = "keyword",
		["subst"] = "keyword",

		-- Procedure, object, and introspection commands
		["class"] = "keyword",
		["coroutine"] = "keyword",
		["info"] = "keyword",
		["interp"] = "keyword",
		["my"] = "keyword2",
		["next"] = "keyword2",
		["object"] = "keyword",
		["proc"] = "keyword",
		["rename"] = "keyword",
		["self"] = "keyword2",

		-- Files, channels, and processes
		["cd"] = "keyword",
		["chan"] = "keyword",
		["close"] = "keyword",
		["eof"] = "keyword",
		["exec"] = "keyword",
		["fblocked"] = "keyword",
		["fconfigure"] = "keyword",
		["fcopy"] = "keyword",
		["file"] = "keyword",
		["fileevent"] = "keyword",
		["flush"] = "keyword",
		["gets"] = "keyword",
		["glob"] = "keyword",
		["load"] = "keyword",
		["open"] = "keyword",
		["pid"] = "keyword",
		["pwd"] = "keyword",
		["read"] = "keyword",
		["seek"] = "keyword",
		["socket"] = "keyword",
		["source"] = "keyword",
		["tell"] = "keyword",
		["unload"] = "keyword",

		-- Packages and environment
		["encoding"] = "keyword",
		["package"] = "keyword",
		["platform"] = "keyword",
		["tm"] = "keyword",
		["zlib"] = "keyword",

		-- Expression word operators
		["lt"] = "operator",
		["gt"] = "operator",
		["le"] = "operator",
		["ge"] = "operator",
		["eq"] = "operator",
		["ne"] = "operator",
		["in"] = "operator",
		["ni"] = "operator",

		-- Boolean and special values
		["true"] = "literal",
		["false"] = "literal",
		["yes"] = "literal",
		["no"] = "literal",
		["on"] = "literal",
		["off"] = "literal",
		["Inf"] = "literal",
		["NaN"] = "literal",
		["stdin"] = "keyword2",
		["stdout"] = "keyword2",
		["stderr"] = "keyword2",
		["default"] = "keyword2",
		["end"] = "keyword2",

		-- Common Tk commands
		["button"] = "function",
		["canvas"] = "function",
		["entry"] = "function",
		["frame"] = "function",
		["grid"] = "function",
		["label"] = "function",
		["menu"] = "function",
		["pack"] = "function",
		["place"] = "function",
		["text"] = "function",
		["toplevel"] = "function",
		["winfo"] = "function",
		["wm"] = "function",
	},
})
