# -*- coding: utf-8 -*- ## frozen_string_literal: truemoduleRougemoduleLexersclassTCL<RegexLexertitle"Tcl"desc"The Tool Command Language (tcl.tk)"tag'tcl'filenames'*.tcl'mimetypes'text/x-tcl','text/x-script.tcl','application/x-tcl'defself.detect?(text)returntrueiftext.shebang?'tclsh'returntrueiftext.shebang?'wish'returntrueiftext.shebang?'jimsh'endKEYWORDS=%w(
after apply array break catch continue elseif else error
eval expr for foreach global if namespace proc rename return
set switch then trace unset update uplevel upvar variable
vwait while
)BUILTINS=%w(
append bgerror binary cd chan clock close concat dde dict
encoding eof exec exit fblocked fconfigure fcopy file
fileevent flush format gets glob history http incr info interp
join lappend lassign lindex linsert list llength load loadTk
lrange lrepeat lreplace lreverse lsearch lset lsort mathfunc
mathop memory msgcat open package pid pkg::create pkg_mkIndex
platform platform::shell puts pwd re_syntax read refchan
regexp registry regsub scan seek socket source split string
subst tell time tm unknown unload
)OPEN=%w| \( \[ \{ " |CLOSE=%w| \) \] \} |ALL=OPEN+CLOSEEND_LINE=CLOSE+%w(; \n)END_WORD=END_LINE+%w(\r \t \v)CHARS=lambda{|list|Regexp.new%/[#{list.join}]/}NOT_CHARS=lambda{|list|Regexp.new%/[^#{list.join}]/}state:worddorule%r/\{\*\}/,Keywordmixin:brace_abortmixin:interprule%r/\{/,Punctuation,:bracerule%r/\(/,Punctuation,:parenrule%r/"/,Str::Double,:stringrule%r/#{NOT_CHARS[END_WORD]}+?(?=#{CHARS[OPEN+['\\\\']]})/,Textenddefself.gen_command_state(name='')state(:"command#{name}")domixin:wordrule%r/##{NOT_CHARS[END_LINE]}+/,Comment::Singlerule%r/(?=#{CHARS[END_WORD]})/dopush:"params#{name}"endrule%r/#{NOT_CHARS[END_WORD]}+/do|m|ifKEYWORDS.include?m[0]tokenKeywordelsifBUILTINS.include?m[0]tokenName::BuiltinelsetokenTextendendmixin:whitespaceendenddefself.gen_delimiter_states(name,close,opts={})gen_command_state("_in_#{name}")state:"params_in_#{name}"doruleclosedotokenPunctuationpop!2end# mismatched delimiters. Braced strings with mismatched# closing delimiters should be okay, since this is standard# practice, like {]]]]}ifopts[:strict]ruleCHARS[CLOSE-[close]],ErrorelseruleCHARS[CLOSE-[close]],Textendmixin:paramsendstatenamedoruleclose,Punctuation,:pop!mixin:"command_in_#{name}"endend# tcl is freaking impossible. If we're in braces and we encounter# a close brace, we have to drop everything and close the brace.# This is so silly things like {abc"def} and {abc]def} don't b0rk# everything after them.# TODO: TCL seems to have this aborting behavior quite a lot.# such things as [ abc" ] are a runtime error, but will still# parse. Currently something like this will muck up the lex.state:brace_abortdorule%r/}/doifin_state?:bracepop!untilstate?:bracepop!tokenPunctuationelsetokenErrorendendendstate:paramsdorule%r/;/,Punctuation,:pop!rule%r/\n/,Text,:pop!rule%r/else|elseif|then/,Keywordmixin:wordmixin:whitespacerule%r/#{NOT_CHARS[END_WORD]}+/,Textendgen_delimiter_states:brace,/\}/,:strict=>falsegen_delimiter_states:paren,/\)/,:strict=>truegen_delimiter_states:bracket,/\]/,:strict=>truegen_command_statestate:rootdomixin:commandendstate:whitespacedo# not a multiline regex because we want to capture \n sometimesrule%r/\s+/,Textendstate:interpdorule%r/\[/,Punctuation,:bracketrule%r/\$[a-z0-9.:-]+/,Name::Variablerule%r/\$\{.*?\}/m,Name::Variablerule%r/\$/,Text# escape sequencesrule%r/\\[0-7]{3}/,Str::Escaperule%r/\\x[0-9a-f]{2}/i,Str::Escaperule%r/\\u[0-9a-f]{4}/i,Str::Escaperule%r/\\./m,Str::Escapeendstate:stringdorule%r/"/,Str::Double,:pop!mixin:interprule%r/[^\\\[\$"{}]+/m,Str::Double# strings have to keep count of their internal braces, to support# for example { "{ }" }.rule%r/{/do@brace_count||=0@brace_count+=1tokenStr::Doubleendrule%r/}/doifin_state?:braceand@brace_count.to_i==0pop!untilstate?:bracepop!tokenPunctuationelse@brace_count-=1tokenStr::Doubleendendendendendend