1# -*- mode: Perl -*- 2# /=====================================================================\ # 3# | listings | # 4# | Implementation for LaTeXML | # 5# |=====================================================================| # 6# | Part of LaTeXML: | # 7# | Public domain software, produced as part of work done by the | # 8# | United States Government & not subject to copyright in the US. | # 9# |---------------------------------------------------------------------| # 10# | Bruce Miller <bruce.miller@nist.gov> #_# | # 11# | http://dlmf.nist.gov/LaTeXML/ (o o) | # 12# \=========================================================ooo==U==ooo=/ # 13package LaTeXML::Package::Pool; 14use strict; 15use warnings; 16use LaTeXML::Package; 17use MIME::Base64; 18use Encode qw(is_utf8 encode); 19 20#====================================================================== 21# To the extent we succeed in doing all the pretty-printing... 22# It rather seems that preserving a raw, unformatted, copy of the code 23# would be a Useful thing, and in keeping with XML. 24# Wouldn't you want to see the pretty print, but cut&paste the plain code? 25# This may eventually need some schema support... 26 27# NOTE: The MoreSelectCharTable parameter for languages styles is 28# NOT yet implemented; this has an impact on 29# HTML, XML comments & CDATA sections not recognized. 30# Perl, Visual Basic, Java, tcl; something (comments?) is not recognized, but what? 31 32RequireResource('ltx-listings.css'); 33RequirePackage('textcomp'); 34#====================================================================== 35# Top-level listings commands 36#====================================================================== 37 38# Set various Listings keys 39DefPrimitive('\lstset RequiredKeyVals:LST', sub { lstActivate($_[1]); return; }); 40AssignValue(LISTINGS_PREAMBLE => []); 41AssignValue(LISTINGS_PREAMBLE_BEFORE => []); 42AssignValue(LISTINGS_POSTAMBLE => []); 43 44# Like PushValue, but local, not global 45sub lstPushValueLocally { 46 my ($list, @values) = @_; 47 my $prev = LookupValue($list); 48 AssignValue($list => [($prev ? @$prev : ()), @values]); 49 return; } 50 51our $EMPTY_CATTABLE = LaTeXML::Core::State->new(catcodes => 'none'); 52 53DefMacro('\lstinline OptionalKeyVals:LST', sub { 54 my ($gullet, $keyvals) = @_; 55 $STATE->getStomach->bgroup; # To localize activation 56 lstActivate($keyvals); # But do BEFORE reading arg, since some options screw things up. 57 # get opening delim from gullet, before cattable swap, 58 # in case token was already peeked for the optional args! 59 my $init = $gullet->readToken; 60 my $body = listingsReadRawString($gullet, (Equals($init, T_BEGIN) ? T_END : $init)); 61 return ( 62 @{ LookupValue('LISTINGS_PREAMBLE_BEFORE') }, 63 lstProcessInline($body), 64 @{ LookupValue('LISTINGS_POSTAMBLE') }, 65 T_END); }); # to balance ->bgroup 66 67DefPrimitive('\lstMakeShortInline [] DefToken', sub { 68 my ($stomach, $kv, $token) = @_; 69 my $ch = $token->getString; 70 AssignMapping('LST_SHORT_INLINE', 71 $ch => [LookupCatcode($ch) // CC_OTHER, $STATE->lookupMeaning($token)]); 72 AssignCatcode($ch, CC_ACTIVE); 73 DefMacro(T_ACTIVE($ch), 74 Tokens(T_CS('\lstinline'), ($kv ? (T_OTHER('['), $kv, T_OTHER(']')) : ()), T_ACTIVE($ch))); 75 return; }); 76 77DefPrimitive('\lstDeleteShortInline DefToken', sub { 78 my ($stomach, $token) = @_; 79 my $ch = $token->getString; 80 if (my $entry = LookupMapping('LST_SHORT_INLINE', $ch)) { 81 my ($cc, $defn) = @$entry; 82 AssignCatcode($ch, $cc); 83 $STATE->assignMeaning(Token($ch, $cc) => $defn); } 84 return; }); 85 86# But it can also be used as an environment! 87DefMacroI(T_CS('\begin{lstinline}'), 'OptionalKeyVals:LST', sub { 88 my ($gullet, $keyvals) = @_; 89 $STATE->getStomach->bgroup; 90 AssignValue(current_environment => 'lstlisting'); 91 DefMacroI('@currenvir', undef, 'lstlisting'); 92 my $text = listingsReadRawLines($gullet, 'lstinline'); 93 lstActivate($keyvals); 94 return ( 95 @{ LookupValue('LISTINGS_PREAMBLE_BEFORE') }, 96 lstProcessInline($text), 97 @{ LookupValue('LISTINGS_POSTAMBLE') }, 98 T_END); }); # to balance ->bgroup 99 100sub lstProcessInline { 101 my ($text) = @_; 102 return Invocation(T_CS('\@listings@inline'), 103 lstProcess('inline', $text)); } 104 105DefConstructor('\@listings@inline {}', 106 "<ltx:text class='ltx_lstlisting' _noautoclose='1'>#1</ltx:text>", 107 reversion => '\lstinline{#1}'); 108 109# Not a regular environment, since we're going to read the body verbatim! 110DefMacroI(T_CS('\begin{lstlisting}'), 'OptionalKeyVals:LST', sub { 111 my ($gullet, $keyvals) = @_; 112 $STATE->getStomach->bgroup; 113 AssignValue(current_environment => 'lstlisting'); 114 DefMacroI('@currenvir', undef, 'lstlisting'); 115 my $text = listingsReadRawLines($gullet, 'lstlisting'); 116 lstActivate($keyvals); 117 return lstProcessDisplay(lstGetTokens('name'), $text); }); 118 119DefMacro('\lstinputlisting OptionalKeyVals:LST Semiverbatim', sub { 120 my ($gullet, $keyvals, $file) = @_; 121 my $text = listingsReadRawFile($gullet, $file); 122 $STATE->getStomach->bgroup; 123 lstActivate($keyvals); 124 AssignValue('LST@toctitle', $file); # so it shows up in list of.. 125 return lstProcessDisplay($file, $text); }); 126 127NewCounter('lstlisting', 'document', idprefix => 'LST'); 128DefMacro('\ext@lstlisting', 'lol'); 129AssignValue(LISTINGS_DATA_COUNTER => 0); 130 131# Defining new listing environments 132DefPrimitive('\lstnewenvironment {}[Number][] DefPlain DefPlain', sub { 133 my ($stomach, $name, $n, $opt, $start, $end) = @_; 134 $name = ToString($name); 135 DefMacroI(T_CS("\\begin{$name}"), LaTeXML::Package::convertLaTeXArgs($n, $opt), sub { 136 my ($gullet, @args) = @_; 137 $STATE->getStomach->bgroup; 138 lstPushValueLocally(LISTINGS_POSTAMBLE => $end->substituteParameters(@args)); 139 # $start will typically have \lstset, equivalent of lstActivate. 140 # We MUST digest it before the listing string is processed 141 # but it can also contain constructors affecting the listing's xml content. 142 # So, we contrive to treat the already digested material as preamble. 143 my $precs = T_CS('\lst@' . $name . '@preamble'); 144 my $pre = Digest($start->substituteParameters(@args)); 145 DefPrimitiveI($precs, undef, sub { return $pre; }); 146 lstPushValueLocally(LISTINGS_PREAMBLE => $precs); 147 my $text = listingsReadRawLines($gullet, $name); 148 return lstProcessDisplay(lstGetTokens('name'), $text); }); 149}); 150 151# Return 2 lists: body, trailer 152sub lstProcessBlock { 153 my ($name, $text) = @_; 154 # store the data to be placed in the listing 155 my $c = LookupValue('LISTINGS_DATA_COUNTER') + 1; 156 AssignValue('LISTINGS_DATA_COUNTER' => $c, 'global'); 157 AssignValue('LISTINGS_DATA_' . $c => $text, 'global'); 158 return ( 159 [@{ LookupValue('LISTINGS_PREAMBLE_BEFORE') }, 160 Invocation(T_CS('\@@listings@block'), $c, lstProcess('block', $text))], 161 [@{ LookupValue('LISTINGS_POSTAMBLE') }, 162 T_END]); } 163 164sub lstProcessDisplay { 165 my ($name, $text) = @_; 166 # Hmm.. should locally define \lstname to be either name or the file... 167 my ($body, $trailer) = lstProcessBlock($name, $text); 168 my @body = @$body; 169 # Figure out whether the display is numbered, or has a caption or titles. 170 my @caption = (); 171 my ($numbered, $labelled, $caption, $x); 172 if (($x = lstGetTokens('caption')) && scalar($x->unlist)) { 173 my @t = $x->unlist; 174 my @tc = (); 175 if (Equals($t[0], T_OTHER('['))) { 176 while (!Equals($t[0], T_OTHER(']'))) { push(@tc, shift(@t)); } } 177 $numbered = 1; 178 $caption = Invocation(T_CS('\lstlisting@makecaption'), (@tc ? Tokens(@tc) : undef), Tokens(@t)); } 179 elsif (($x = lstGetTokens('title')) && scalar($x->unlist)) { 180 $caption = Invocation(T_CS('\lstlisting@maketitle'), $x); } 181 elsif (($x = lstGetTokens('toctitle')) && scalar($x->unlist)) { 182 $caption = Invocation(T_CS('\lstlisting@maketoctitle'), $x); } 183 if (($x = lstGetTokens('label')) && scalar($x->unlist)) { 184 $labelled = 1; 185 unshift(@body, Invocation(T_CS('\label'), $x)); } 186 if ($caption) { 187 if (lstGetLiteral('captionpos') eq 't') { 188 unshift(@body, $caption); } 189 else { 190 push(@body, $caption); } } 191 192 push(@body, @$trailer); 193 # We go a bit (a bit too far?) to try to treat this as a separate Para level object 194 # (if with captions or titled), 195 # or as an in-block item (within a logical paragraph) 196 197 return ( 198 ($numbered || $caption ? (T_CS('\par')) : ()), 199 T_BEGIN, 200 ($name ? (T_CS('\def'), T_CS('\lstname'), T_BEGIN, $name->unlist, T_END) : ()), 201 ($numbered 202 ? Invocation(T_CS('\@listings'), Tokens(@body)) 203 : ($caption 204 ? Invocation(T_CS('\@@listings'), Tokens(@body)) 205 : @body)), 206 T_END); } 207 208DefMacro('\lstlisting@makecaption[]{}', 209 '\def\@captype{lstlisting}' 210 . '\@@add@caption@counters' 211 . '\@@toccaption{\lx@format@toctitle@@{lstlisting}{\ifx.#1.#2\else#1\fi}}' 212 . '\@@caption{\lx@format@title@@{lstlisting}{#2}}'); 213DefMacroI('\fnum@lstlisting', undef, '\lstlistingname\nobreakspace\thelstlisting'); 214DefMacro('\format@title@lstlisting{}', '\lx@tag[][: ]{\fnum@lstlisting}#1'); 215 216DefMacro('\lstlisting@maketitle{}', 217 '\@@toccaption{#1}' 218 . '\@@caption{#1}'); 219 220DefMacro('\lstlisting@maketoctitle{}', 221 '\@@toccaption{#1}'); 222 223# Numbered form, with caption 224# \@listings <classes> <formatted> 225DefConstructor('\@listings {}', 226 "<ltx:float inlist='lol' xml:id='#id' class='ltx_lstlisting'>" 227 . "#tags" 228 . "#1" 229 . "</ltx:float>", 230 beforeDigest => sub { DefMacroI('\@captype', undef, 'lstlisting'); }, 231 afterDigest => sub { 232 my ($stomach, $whatsit) = @_; 233 RescueCaptionCounters('lstlisting', $whatsit); }); 234 235# Unnumbered form, but with caption 236# \@listings <classes> <formatted> 237DefConstructor('\@@listings {}', 238 "<ltx:float xml:id='#id' class='ltx_lstlisting'>" 239 . "#tags" 240 . "#1" 241 . "</ltx:float>", 242 properties => sub { RefStepID('lstlisting'); }, 243 beforeDigest => sub { DefMacroI('\@captype', undef, 'lstlisting'); }, 244 afterDigest => sub { 245 my ($stomach, $whatsit) = @_; 246 RescueCaptionCounters('lstlisting', $whatsit); }); 247 248DefConstructor('\@@listings@block {} {}', 249"<ltx:listing class='ltx_lstlisting' data='#data' datamimetype='#datamimetype' dataencoding='#dataencoding'>#2</ltx:listing>", 250 afterDigest => sub { 251 my ($stomach, $whatsit) = @_; 252 # Could have some options about encoding? 253 my $data_key = 'LISTINGS_DATA_' . ToString($whatsit->getArg(1)); 254 my $listings_data = LookupValue($data_key); 255 if (is_utf8($listings_data)) { 256 $listings_data = encode('UTF-8', $listings_data); 257 } 258 my $data = encode_base64($listings_data, ''); # NO linebreaking! 259 $whatsit->setProperties(data => $data, datamimetype => 'text/plain', dataencoding => 'base64'); }); 260 261#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 262# Low Level String stuff 263#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 264# Read raw string until closing $until. 265# Note that this does NOT balance groups, even if $until is '}'! 266sub listingsReadRawString { 267 my ($gullet, $until) = @_; 268 # NOTE that this normally does NOT balance {, but DOES within mathescape'd $ 269 # Moreover, neither escapechar nor escapeinside have this effect! 270 # I'd swear this is a bug that became a feature. 271 my $SAVESTATE = $STATE; 272 my $mathescape = lstGetBoolean('mathescape'); 273 my $inmath = 0; 274 my @tokens = (); 275 { local $STATE = $EMPTY_CATTABLE; 276 while (defined(my $token = $gullet->readToken())) { 277 last if $until and $token->getString eq $until->getString; 278 if ($mathescape && ($token->getString eq '$')) { 279 if ($inmath) { $inmath = 0; $STATE = $EMPTY_CATTABLE; } 280 else { $inmath = 1; $STATE = $SAVESTATE; } } 281 if ($inmath && $token->equals(T_BEGIN)) { 282 push(@tokens, T_BEGIN, $gullet->readBalanced->unlist, T_END); } 283 else { 284 push(@tokens, $token); } } 285 while (@tokens && $tokens[-1]->getCatcode == CC_SPACE) { # Remove trailing space 286 pop(@tokens); } } 287 return UnTeX(Tokens(@tokens)); } 288 289# Read raw strings for environment, until matching \end{$environment} 290sub listingsReadRawLines { 291 my ($gullet, $environment) = @_; 292 my @lines = (); 293 my ($line); 294 $gullet->readRawLine; # Ignore 1st line (following \begin{...} 295 while (defined($line = $gullet->readRawLine)) { 296 if ($line =~ /^\s*\\end\{\Q$environment\E\}(.*?)$/) { 297 $gullet->unread(Tokenize($1), T_CR); # put BACK what follows the \end{whatever} 298 last; } 299 push(@lines, $line); } 300 return join("\n", @lines); } 301 302sub listingsReadRawFile { 303 my ($gullet, $file) = @_; 304 my $filename = ToString(Expand($file)); 305 my $path = FindFile($filename); 306 my $text; 307 my $LST_FH; 308 if ($path && open($LST_FH, '<', $path)) { 309 { local $/ = undef; 310 $text = <$LST_FH>; 311 close($LST_FH); } } 312 else { 313 Error('I/O', $filename, $gullet, "Can't read listings file '$filename'", $!); } 314 return $text; } 315 316#====================================================================== 317our $lst_charmapping = { '#' => T_CS('\#'), '$' => T_CS('\textdollar'), '&' => T_CS('\&'), 318 "'" => T_CS('\textquoteright'), 319 '*' => T_CS('\textasteriskcentered'), 320 # ?? '-'=>$-$ ?? 321 '<' => T_CS('\textless'), '>' => T_CS('\textgreater'), '\\' => T_CS('\textbackslash'), 322 '^' => T_CS('\textasciicircum'), '_' => T_CS('\textunderscore'), 323 '`' => T_CS('\textquoteleft'), 324 '{' => T_CS('\textbraceleft'), '}' => T_CS('\textbraceright'), '%' => T_CS('\%'), 325 '|' => T_CS('\textbar'), 326 '~' => T_CS('\textasciitilde'), 327}; 328 329# Note that listings.sty uses a couple of textcomp characters 330# (\textquotesingle, \textasciigrave) 331# when the upquote option is used. 332our $lst_charmapping_upquote = { 333 %$lst_charmapping, 334 "'" => T_CS('\textquotesingle'), 335 '`' => T_CS('\textasciigrave') }; 336 337sub lstRescan { 338 my ($tokens) = @_; 339 my $mapping = (lstGetBoolean('upquote') ? $lst_charmapping_upquote : $lst_charmapping); 340 return (defined $tokens 341 ? Tokens(map { ($_->getCatcode == CC_OTHER ? $$mapping{ $_->getString } || $_ : $_) } $tokens->unlist) 342 : undef); } 343 344#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 345# Managing the sets of keyvals that compose a Listings Style or Language. 346#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 347# Assign (locally) all values or effects from a Listings keyvals 348# Note that we operate on the Pairs form of keyvals to preserve order, repetition 349# 350# LST_CHARACTERS hash (letter|digit|other) => hash : charre=>1 351# LST_CLASSES hash classname => hash : begin, end => Tokens 352# and some extra: index=>indexclassname, escape=>0|1, eval=>0|1, ... 353# LST_WORDS hash word => hash : class=>classname, index=>indexclassname 354# LST_DELIMTERS hash open => hash: regexp=>re, close => re, classname? 355 356foreach my $table (qw(LST_CHARACTERS LST_CLASSES LST_WORDS LST_DELIMITERS)) { 357 AssignValue($table => {}); } 358 359sub lstActivate { 360 my ($kv) = @_; 361 if ($kv) { 362 # We will construct distillations of the various keyword, delimiter, etc data 363 # These tables will sit in the current binding, but we need to copy the data from previous bindings 364 # to get the effect of grouping 365 # Each table is a hash of hashes. 366 foreach my $table (qw(LST_CHARACTERS LST_CLASSES LST_WORDS LST_DELIMITERS)) { 367 my %data = (); 368 if (my $prev = LookupValue($table)) { 369 map { $data{$_} = { %{ $$prev{$_} } } } keys %$prev; } 370 AssignValue($table => {%data}); } 371 # Now start scanning the keywords, in order, and activate their effects. 372 my @pairs = $kv->getPairs(); 373 while (@pairs) { 374 my ($key, $val) = (shift(@pairs), shift(@pairs)); 375 $val = lstUnGroup($val); 376 my $cs = T_CS('\lst@@' . $key); 377 if (IsDefined($cs)) { 378 $val = LookupValue('KEYVAL@LST@' . $key . '@default') unless $val; 379 # Done for effect. 380 Digest(Tokens($cs, ($val ? $val->unlist : Tokens()), T_CS('\end'))); } 381 AssignValue('LST@' . $key => $val); } } 382 return; } 383 384#---------------------------------------------------------------------- 385# Various helpers for dealing with the arguments to options. 386# Strip outer {} if there's only a single group 387# [The need for this may be a sign of not-quite-correct keyval handling?] 388sub lstUnGroup { 389 my ($tokens) = @_; 390 if ($tokens && ref $tokens) { 391 my @t = $tokens->unlist; 392 if (Equals($t[0], T_BEGIN) && Equals($t[-1], T_END) && (count_groups(@t) == 1)) { 393 $tokens = Tokens(@t[1 .. $#t - 1]); } } 394 return $tokens; } 395 396sub count_groups { 397 my (@tokens) = @_; 398 my $groups = 0; 399 my $level = 0; 400 foreach my $t (@tokens) { 401 if (Equals($t, T_END)) { 402 $level--; } 403 elsif (Equals($t, T_BEGIN)) { 404 $groups++ if $level == 0; 405 $level++; } } 406 return $groups; } 407 408sub lstSplit { 409 my ($stuff) = @_; 410 my $string = ToString(lstUnGroup($stuff)); 411 $string =~ s/%.*?\n\s*//sg; 412 $string =~ s/\s+//sg; 413 return split(/,/, $string); } 414 415# Strip of TeX's quoting. 416sub lstDeslash { 417 my ($string) = @_; 418 if ($string) { 419 $string = ToString($string); 420 $string =~ s/^\\(.)/$1/g; # Strip off TeX's "quoting" 421 return $string; } } 422 423# Convert a string of TeX chars to a regexp to match it. 424sub lstRegexp { 425 my ($chars) = @_; 426 if (my $string = lstDeslash($chars)) { 427 $string =~ s/([\!\@\#\$\%\^\&\*\(\)\_\-\+\{\}\[\]\\\<\>\?\/\|])/\\$1/g; # Put back for Perl. 428 return $string; } } 429 430#---------------------------------------------------------------------- 431# A rather bizarro set of keyword value parsing bits. 432# Perhaps should be handled by the keyval types themselves? 433sub lstGetLiteral { 434 my ($value) = @_; 435 my $v = ToString(LookupValue('LST@' . $value)); 436 if ($v =~ /^\{(.*?)\}$/) { 437 $v = $1; } 438 return $v; } 439 440sub lstGetBoolean { 441 my ($value) = @_; 442 return lstGetLiteral($value) eq 'true'; } 443 444sub lstGetNumber { 445 my ($value) = @_; 446 my $n = LookupValue('LST@' . $value); 447 return ($n ? $n->valueOf : 0); } 448 449sub lstGetTokens { 450 my ($value) = @_; 451 if (my $v = LookupValue('LST@' . $value)) { 452 return lstUnGroup($v); } 453 else { 454 return Tokens(); } } 455 456#====================================================================== 457# Support for managing classes, delimiters and such. 458 459sub lstClassName { 460 my ($class, $n) = @_; 461 $n = 1 unless $n; 462 $n = $n->valueOf if ref $n; 463 $n += lstGetNumber('classoffset'); 464 return $class . ($n <= 1 ? '' : $n); } 465 466# Define properties of a Class (comments, strings, etc) 467sub lstSetClassStyle { 468 my ($class, $style, %props) = @_; 469 my $classes = LookupValue('LST_CLASSES'); 470 if ($style) { 471 my $stylestring = ToString($style); 472 $stylestring =~ s/^\s+//s; $stylestring =~ s/\s+$//s; 473 if ($stylestring =~ s/style(\d*)$/s$1/) { # If names a style, convert it into the class name 474 delete $$classes{$class}{begin}; # remove explicit styling 475 $props{class} = $stylestring; } # add indirect to class. 476 else { 477 delete $$classes{$class}{class}; 478 $props{begin} = $style; } } # Otherwise, presumably TeX 479 if ($class =~ /^(\w+?)s?$/) { 480 $props{cssclass} = $1; } 481 map { $$classes{$class}{$_} = $props{$_} } keys %props; 482 return; } 483 484# Specify a set of words belonging to a class 485sub lstSetClassWords { 486 my ($class, $words, $prefix) = @_; 487 # First delete existing words 488 my $wordslist = LookupValue('LST_WORDS'); 489 foreach my $word (keys %$wordslist) { 490 delete $$wordslist{$word}{class} if ($$wordslist{$word}{class} || '') eq $class; } 491 lstAddClassWords($class, $words, $prefix); 492 return; } 493 494sub lstAddClassWords { 495 my ($class, $words, $prefix) = @_; 496 my $wordslist = LookupValue('LST_WORDS'); 497 foreach my $word (lstSplit($words)) { 498 $word = $prefix . $word if $prefix; 499 $$wordslist{$word}{class} = $class unless $$wordslist{$word}{class}; } 500 return; } 501 502sub lstDeleteClassWords { 503 my ($class, $words, $prefix) = @_; 504 my $wordslist = LookupValue('LST_WORDS'); 505 foreach my $word (lstSplit($words)) { 506 $word = $prefix . $word if $prefix; 507 delete $$wordslist{$word}{class} if $$wordslist{$word}{class} eq $class; } 508 return; } 509 510sub lstDeleteClass { 511 my ($class) = @_; 512 my $wordslist = LookupValue('LST_WORDS'); 513 foreach my $word (keys %$wordslist) { 514 delete $$wordslist{$word}{class} 515 if $$wordslist{$word}{class} && ($$wordslist{$word}{class} eq $class); } 516 return; } 517 518# This probably needs a different way of decoding $type. 519# General: b,d,l,s,n (+ i) 520# String: b,d,m,bd (backslash, doubled, matlab-like(?) or backslash or doubled) 521# Need to pull out the $delims decoding, to allow deleting delimiters. 522# Recognized keys: 523# recursive : allows keywords, comments & strings inside 524# cummulative : the effects are cummulative (?) 525# nested : allows comments to be nested 526sub lstAddDelimiter { 527 my ($kind, $type, $style, $delims, %keys) = @_; 528 $type = ToString($type); 529 my $delimlist = LookupValue('LST_DELIMITERS'); 530 my $invisible = ($type =~ /^(?:bd|b|d|l|s|n)i$/) || ($type =~ /^i(?:bd|b|d|l|s|n)$/); 531 $type =~ s/i// if $invisible; 532 my $quoted; 533 my ($open, $close, $openre, $closere, $cssclass); 534 if ($type eq 'b') { # Balanced; same delim open & close; but not when slashed 535 $open = $close = $delims; 536 $openre = lstRegexp($open); 537 $closere = "(?<!\\\\)$openre"; 538 $quoted = "\\\\\\$openre"; } 539 elsif ($type eq 'd') { # Doubled: same delim open & close; but not when doubled. 540 $open = $close = $delims; 541 $openre = lstRegexp($open); 542 $closere = "(?<!$openre)$openre(?!$openre)"; 543 $quoted = $openre . $openre; } 544 elsif ($type eq 'bd') { # Doubled: same delim open & close; not when doubled OR slashed 545 $open = $close = $delims; 546 $openre = lstRegexp($open); 547 $closere = "(?<!\\\\|$openre)$openre(?!$openre)"; 548 $quoted = "\\\\\\$openre|$openre$openre"; } 549 elsif ($type eq 'l') { # Line: close is till end of line 550 $open = $delims; 551 $openre = lstRegexp($open); 552 $close = undef; 553 $closere = "(?=\n)"; } 554 elsif ($type eq 's') { # String: different open & close 555 ($open, $close) = lst_splitDelimiters($delims); 556 $openre = lstRegexp($open); 557 $closere = lstRegexp($close); } 558 elsif ($type eq 'n') { # like String, but allows nesting!!! 559 ($open, $close) = lst_splitDelimiters($delims); 560 $openre = lstRegexp($open); 561 $closere = lstRegexp($close); 562 $keys{nested} = 1; } 563 # Special case? Maybe we have to deal with lstmisc.sty and understand "aspects"??? 564 elsif ($type eq 'directive') { 565 $kind = $type . 's'; 566 $open = $delims; 567 $openre = lstRegexp($open); 568 $closere = "(?=\\W)"; } # ? word boundary but appearing at beginning of string! 569 else { # ??? What should be default? (same as 'directive'???) 570 $open = $delims; 571 $openre = lstRegexp($open); } 572 if (my $openstring = lstDeslash($open)) { 573 # The styling can be a class name, or markup 574 my $class = $kind; 575 my $stylestring = ToString($style); 576 my $styleTeX; 577 if ($stylestring =~ s/style(\d*)$/s$1/) { # Names the style associated with a class. 578 $class = $stylestring; } 579 else { # Otherwise, assume it is markup. 580 $styleTeX = $style; } 581 my $oldclass = $class; 582 $class = $class . ToString($open) . ToString($close); # Create an artificial class for this delimiter. 583 my $openTeX = ($styleTeX 584 ? ($invisible ? $styleTeX : Tokens($styleTeX->unlist, $open)) 585 : ($invisible ? () : $open)); 586 my $closeTeX = ($invisible ? () : $close); 587 lstSetClassStyle($class, undef, begin => $openTeX, end => $closeTeX, 588 class => $oldclass, cssclass => $cssclass); 589 # NOT DONE: 590 # invisibility of the whole delimited expression 591 # nestability. 592 $$delimlist{$openstring} = { open => $openre, close => $closere, class => $class, 593 quoted => $quoted, %keys }; } 594 return; } 595 596sub lstDeleteDelimiterKind { 597 my ($kind) = @_; 598 my $delimlist = LookupValue('LST_DELIMITERS'); 599 foreach my $openstring (keys %$delimlist) { 600 delete $$delimlist{$openstring} if $$delimlist{$openstring}{class} =~ /^\Q$kind\E/; } 601 return; } 602 603# Helper for lstAddDelimiter: 604# Here's the goofy thing: there may or may be {} in delimiters; 605# And, when there's 2 delimiters, it could even be is: open}{close 606# we'll hope there're no extra braces! 607# If type eq 'n', comments are allowed to nest!!! 608sub lst_splitDelimiters { 609 my ($delims) = @_; 610 my @t = grep { !Equals($_, T_BEGIN) } $delims->unlist; # Remove any T_BEGIN 611 my @t1 = (); 612 if (scalar(@t) == 2) { 613 @t1 = ($t[0]); @t = ($t[1]); } 614 else { 615 while (@t && !Equals($t[0], T_END)) { push(@t1, shift(@t)); } 616 @t = grep { !Equals($_, T_END) } @t; } # Remove any remaining T_END 617 return (Tokens(@t1), Tokens(@t)); } # return open & close 618 619# Set character classes 620sub lstSetCharacterClass { 621 my ($class, $chars) = @_; 622 my $charslist = LookupValue('LST_CHARACTERS'); 623 foreach my $char ($chars->unlist) { 624 $char = lstRegexp($char); 625 delete $$charslist{letter}{$char}; 626 delete $$charslist{digit}{$char}; 627 delete $$charslist{other}{$char}; 628 $$charslist{$class}{$char} = 1; } 629 return; } 630 631#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 632# The various parameters 633#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 634 635#====================================================================== 636# 4.3 Space and placement 637#====================================================================== 638# Ignorable 639DefKeyVal('LST', 'float', ''); # [*] t,b,p,h [or defaults?] 640DefKeyVal('LST', 'floatplacement', ''); # t,b,p 641DefKeyVal('LST', 'aboveskip', 'Dimension'); 642DefKeyVal('LST', 'belowskip', 'Dimension'); 643DefKeyVal('LST', 'lineskip', 'Dimension'); 644DefKeyVal('LST', 'boxpos', ''); # b,c,t 645 646#====================================================================== 647# 4.4 Printed range 648#====================================================================== 649# Seemingly handled.... 650DefKeyVal('LST', 'print', '', 'true'); 651DefKeyVal('LST', 'firstline', 'Number'); 652DefKeyVal('LST', 'lastline', 'Number'); 653DefKeyVal('LST', 'showlines', '', 'true'); 654DefKeyVal('LST', 'emptylines', ''); # NOTE: NOT YET HANDLED. 655DefKeyVal('LST', 'gobble', 'Number'); 656 657#====================================================================== 658# 4.5 Language and styles 659#====================================================================== 660# Define a Style being a shorthand for a set of Listings keyvals 661# \lstdefinestyle{stylename}{keys} 662DefPrimitive('\lstdefinestyle{} RequiredKeyVals:LST', sub { 663 my ($stomach, $style, $keyvals) = @_; 664 $style = uc(ToString(lstUnGroup($style))); 665 $style =~ s/\s+//g; 666 AssignValue('LST@STYLE@' . $style => $keyvals); }); 667 668DefKeyVal('LST', 'style', ''); 669DefMacro('\lst@@style Until:\end', sub { 670 my ($gullet, $style) = @_; 671 if ($style = uc(ToString(lstUnGroup($style)))) { 672 $style =~ s/\s+//g; 673 if (my $values = LookupValue('LST@STYLE@' . $style)) { 674 lstActivate($values); } 675 else { 676 Warn('unexpected', $style, $gullet, "No listings style '$style' found"); } } 677 return; }); 678 679sub lstActivateLanguage { 680 my ($language, $dialect) = @_; 681 $language = uc(ToString($language)); $language =~ s/\s+//g; 682 my ($values, $name); 683 if ($language) { 684 while (1) { 685 # Construct the language$dialect that we're trying to find. 686 my $d = ($dialect && $dialect->unlist ? $dialect : LookupValue('LSTDD@' . $language)); 687 $name = 'LST@LANGUAGE@' . $language; 688 if ($d && $d->unlist) { 689 $d = uc(ToString($d)); $d =~ s/\s+//g; 690 $name .= '$' . $d; } 691 # language definition is loaded! 692 last if $values = LookupValue($name); 693 # try to load next configuration file; fail if no more configs. 694 if (my $file = ShiftValue('LST_LANGUAGE_FILES')) { 695 InputDefinitions($file, noerror => 1); } # Note: OK if some definition files missing! 696 else { last; } } 697 # Found a definition, activate it. 698 if ($values) { 699 lstActivate($values); } 700 # Else failed to find one. 701 else { 702 Warn('unexpected', $name, $STATE->getStomach, "No listings language '$language' found"); } } 703 return; } 704 705# Apparently when we activate a langage, we should clear out (some) previous definitions! 706sub lstClearLanguage { 707 # Reverse engineer the commands that add keywords, comments, string 708 lstDeleteClass('keywords'); 709 lstDeleteClass('otherkeywords'); 710 lstDeleteClass('endkeywords'); 711 lstDeleteClass('directives'); 712 lstDeleteClass('textcs'); 713 lstDeleteDelimiterKind('comment'); 714 lstDeleteDelimiterKind('string'); 715 return; } 716 717DefKeyVal('LST', 'language', ''); 718DefMacro('\lst@@language [] Until:\end', sub { 719 lstClearLanguage(); 720 lstActivateLanguage($_[2], $_[1]); 721 lstPushValueLocally(LISTINGS_PREAMBLE => T_CS('\lst@@@set@language')); 722 return; }); 723DefConstructor('\lst@@@set@language', sub { 724 my ($document, %props) = @_; 725 if (my $lang = $props{language}) { 726 $lang = "$2_$1" if $lang =~ /^\[([^\]]*)\](.*)$/; 727 $_[0]->addClass($_[0]->getElement, 'ltx_lst_language_' . $lang); } }, 728 properties => { language => sub { lstGetLiteral('language'); } }); 729 730DefKeyVal('LST', 'alsolanguage', ''); 731DefMacro('\lst@@alsolanguage [] Until:\end', sub { 732 lstActivateLanguage($_[2], $_[1]); return; }); 733 734DefKeyVal('LST', 'defaultdialect', ''); 735DefMacro('\lst@@defaultdialect[] Until:\end', sub { 736 my ($gullet, $dialect, $language) = @_; 737 $language = uc(ToString($language)); $language =~ s/\s+//g; 738 AssignValue('LSTDD@' . $language => $dialect); }); 739 740DefKeyVal('LST', 'printpod', '', 'true'); # NOTE: NOT YET HANDLED 741 742DefKeyVal('LST', 'usekeywordsintag', '', 'true'); # NOTE: NOT YET HANDLED; I don't even understand it 743DefKeyVal('LST', 'tagstyle', ''); 744DefMacro('\lst@@tagstyle Until:\end', sub { 745 lstSetClassStyle('tags', $_[1]); }); 746DefKeyVal('LST', 'markfirstintag', ''); # NOTE: NOT YET HANDLED; I don't even understand it 747 748DefKeyVal('LST', 'makemacrouse', '', 'true'); # NOTE: NOT YET HANDLED 749 750#====================================================================== 751# 4.6 Appearance 752#====================================================================== 753DefKeyVal('LST', 'basicstyle', ''); 754 755DefKeyVal('LST', 'identifierstyle', ''); 756DefMacro('\lst@@identifierstyle Until:\end', sub { 757 lstSetClassStyle('identifiers', $_[1]); }); 758 759DefKeyVal('LST', 'commentstyle', ''); 760DefMacro('\lst@@commentstyle Until:\end', sub { 761 lstSetClassStyle('comments', $_[1]); }); 762 763DefKeyVal('LST', 'stringstyle', ''); 764DefMacro('\lst@@stringstyle Until:\end', sub { 765 lstSetClassStyle('strings', $_[1]); }); 766 767DefKeyVal('LST', 'keywordstyle', ''); 768DefMacro('\lst@@keywordstyle [Number] OptionalMatch:* Until:\end', sub { 769 lstSetClassStyle(lstClassName('keywords', $_[1]), $_[3], uppercase => $_[2]); }); 770DefKeyVal('LST', 'ndkeywordstyle', ''); 771DefMacro('\lst@@ndkeywordstyle Until:\end', sub { 772 lstSetClassStyle('keywords2', $_[1]); }); 773 774DefKeyVal('LST', 'classoffset', 'Number'); 775 776DefKeyVal('LST', 'texcsstyle', ''); 777DefMacro('\lst@@texcsstyle OptionalMatch:* [Number] Until:\end', sub { 778 lstSetClassStyle(lstClassName('texcss', $_[2]), $_[3], slash => $_[1]); }); 779DefKeyVal('LST', 'directivestyle', ''); 780DefMacro('\lst@@directivestyle Until:\end', sub { 781 lstSetClassStyle('directives', $_[1]); }); 782 783DefKeyVal('LST', 'emph', ''); 784DefMacro('\lst@@emph [Number] Until:\end', sub { 785 lstSetClassWords(lstClassName('emph', $_[1]), $_[2]); }); 786DefKeyVal('LST', 'moreemph', ''); 787DefMacro('\lst@@moreemph [Number] Until:\end', sub { 788 lstAddClassWords(lstClassName('emph', $_[1]), $_[2]); }); 789DefKeyVal('LST', 'deleteemph', ''); 790DefMacro('\lst@@deleteemph [Number] Until:\end', sub { 791 lstDeleteClassWords(lstClassName('emph', $_[1]), $_[2]); }); 792DefKeyVal('LST', 'emphstyle', ''); 793DefMacro('\lst@@emphstyle [Number] Until:\end', sub { 794 lstSetClassStyle(lstClassName('emph', $_[1]), $_[2]); }); 795 796DefKeyVal('LST', 'delim', ''); 797# \lst@delim=**[type][style]{delim}{delim2_if_needed} 798# * allow keywords, comments & strings inside 799# * effects are cummulative 800DefMacro('\lst@@delim OptionalMatch:* OptionalMatch:* [] [] Until:\end', sub { 801 # clear delimiters, first ??? 802 lstAddDelimiter('delimiter', $_[3], $_[4], $_[5], 803 ($_[1] ? (recursive => 1) : ()), 804 ($_[2] ? (cummulative => 1) : ())); }); 805DefKeyVal('LST', 'moredelim', ''); 806DefMacro('\lst@@moredelim OptionalMatch:* OptionalMatch:* [] [] Until:\end', sub { 807 lstAddDelimiter('delimiter', $_[3], $_[4], $_[5], 808 ($_[1] ? (recursive => 1) : ()), 809 ($_[2] ? (cummulative => 1) : ())); }); 810 811#====================================================================== 812# 4.7 Getting characters right. 813#====================================================================== 814DefKeyVal('LST', 'extendedchars', '', 'true'); 815DefMacro('\lst@@extendedchars Until:\end', sub { 816 my @chars = map { UTF($_) } 128 .. 255; 817 my $charslist = LookupValue('LST_CHARACTERS'); 818 if (ToString($_[1]) eq 'true') { 819 foreach my $char (@chars) { 820 $$charslist{letter}{$char} = 1; } } 821 else { 822 foreach my $char (@chars) { 823 delete $$charslist{letter}{$char}; } } 824 return; }); 825DefKeyVal('LST', 'inputencoding', ''); # Ignorable? 826DefKeyVal('LST', 'upquote', '', 'true'); # Ignorable? 827DefKeyVal('LST', 'tabsize', 'Number'); 828DefKeyVal('LST', 'showtabs', '', 'true'); # NOTE: Not yet handled 829DefKeyVal('LST', 'tab', ''); # NOTE: Not yet handled 830DefKeyVal('LST', 'showspaces', '', 'true'); 831DefKeyVal('LST', 'showstringspaces', '', 'true'); 832DefKeyVal('LST', 'formfeed', ''); 833 834#====================================================================== 835# 4.8 Line numbers 836#====================================================================== 837# Done... 838DefKeyVal('LST', 'numbers', ''); # none | left | right 839DefPrimitive('\lst@@numbers Until:\end', sub { 840 lstPushValueLocally(LISTINGS_PREAMBLE => T_CS('\lst@@@set@numbers')); }); 841 842DefConstructor('\lst@@@set@numbers', sub { 843 my ($document, %props) = @_; 844 if (($props{position} || 'none') ne 'none') { 845 $_[0]->addClass($_[0]->getElement, 'ltx_lst_numbers_' . $props{position}); } }, 846 properties => { position => sub { lstGetLiteral('numbers'); } }); 847 848DefKeyVal('LST', 'stepnumber', 'Number'); 849DefKeyVal('LST', 'numberfirstline', '', 'true'); 850DefKeyVal('LST', 'numberstyle', ''); 851DefKeyVal('LST', 'numbersep', 'Dimension'); 852DefKeyVal('LST', 'numberblanklines', '', 'true'); 853DefKeyVal('LST', 'firstnumber', ''); 854DefKeyVal('LST', 'name', ''); 855NewCounter('lstnumber'); 856DefMacro('\thelstnumber', '\arabic{lstnumber}'); 857 858#====================================================================== 859# 4.9 Captions 860#====================================================================== 861# Done. 862DefKeyVal('LST', 'title', ''); 863DefKeyVal('LST', 'caption', ''); 864DefKeyVal('LST', 'label', 'Semiverbatim'); 865DefKeyVal('LST', 'nolol', '', 'true'); # Ignorable 866 867DefMacroI('\lstlistlistingname', undef, 'Listings'); 868DefConstructorI('\lstlistoflistings', undef, 869 "<ltx:TOC lists='lol' scope='global'><ltx:title>#name</ltx:title></ltx:TOC>", 870 properties => sub { ( 871 name => DigestIf('\lstlistlistingname')); }); 872 873DefMacroI('\lstlistingname', undef, 'Listing'); 874DefMacro('\thelstlisting', '\arabic{lstlisting}'); 875DefMacro('\thename', ''); 876 877DefKeyVal('LST', 'captionpos', ''); # t,b # done 878DefKeyVal('LST', 'abovecaptionskip', 'Dimension'); # Ignorable 879DefKeyVal('LST', 'belowcaptionskip', 'Dimension'); # Ignorable 880 881#====================================================================== 882# 4.10 Margins and line shape 883#====================================================================== 884# Ignorable 885DefKeyVal('LST', 'linewidth', 'Dimension'); 886DefKeyVal('LST', 'xleftmargin', 'Dimension'); 887DefKeyVal('LST', 'xrightmargin', 'Dimension'); 888DefKeyVal('LST', 'resetmargins', ''); 889DefKeyVal('LST', 'breaklines', '', 'true'); 890DefKeyVal('LST', 'prebreak', ''); 891DefKeyVal('LST', 'postbreak', ''); 892DefKeyVal('LST', 'breakindent', 'Dimension'); 893DefKeyVal('LST', 'breakautoindent', '', 'true'); 894 895#====================================================================== 896# 4.11 Frames 897#====================================================================== 898# Mosly ignorable, but some could be used 899DefKeyVal('LST', 'frame', ''); # none | leftline | topline | bottomline | lines | single | shadowbox 900our %frames = (none => undef, leftline => 'left', topline => 'top', bottomline => 'bottom', 901 lines => 'topbottom', single => 'rectangle', shadowbox => 'rectangle'); 902DefPrimitive('\lst@@frame Until:\end', sub { 903 my $name = ToString(Digest($_[1])); 904 AssignValue(LISTINGS_FRAME => $frames{$name}); 905 lstPushValueLocally(LISTINGS_PREAMBLE => T_CS('\lst@@@set@frame')); }); 906 907DefConstructor('\lst@@@set@frame', "^framed='#frame'", 908 properties => { frame => sub { LookupValue('LISTINGS_FRAME'); } }); 909 910DefKeyVal('LST', 'framearound', ''); # t|f * 4 911DefKeyVal('LST', 'framesep', 'Dimension'); 912DefKeyVal('LST', 'rulesep', 'Dimension'); 913DefKeyVal('LST', 'framerule', 'Dimension'); 914DefKeyVal('LST', 'framexleftmargin', 'Dimension'); 915DefKeyVal('LST', 'framexrightmargin', 'Dimension'); 916DefKeyVal('LST', 'framextopmargin', 'Dimension'); 917DefKeyVal('LST', 'framexbottommargin', 'Dimension'); 918DefKeyVal('LST', 'backgroundcolor', ''); 919 920sub lstExtractColor { 921 my ($stomach, $cmd) = @_; 922 my $color; 923 $stomach->bgroup; 924 if ($cmd->unlist) { 925 Digest($cmd); 926 $color = LookupValue('font')->getColor; } 927 $stomach->egroup; 928 return $color; } 929 930DefPrimitive('\lst@@backgroundcolor Until:\end', sub { 931 my ($stomach, $cmd) = @_; 932 AssignValue(LISTINGS_BACKGROUND => lstExtractColor($stomach, $cmd)); 933 lstPushValueLocally(LISTINGS_PREAMBLE_BEFORE => T_CS('\lst@@@set@background')); }); 934 935DefPrimitive('\lst@@@set@background', sub { 936 MergeFont(background => LookupValue('LISTINGS_BACKGROUND')); }); 937 938DefKeyVal('LST', 'rulecolor', ''); 939DefPrimitive('\lst@@rulecolor Until:\end', sub { 940 my ($stomach, $cmd) = @_; 941 AssignValue(LISTINGS_RULECOLOR => lstExtractColor($stomach, $cmd)); 942 lstPushValueLocally(LISTINGS_PREAMBLE => T_CS('\lst@@@set@rulecolor')); }); 943 944DefConstructor('\lst@@@set@rulecolor', "^framecolor='#color'", 945 properties => { color => sub { LookupValue('LISTINGS_RULECOLOR'); } }); 946 947DefKeyVal('LST', 'fillcolor', ''); 948DefKeyVal('LST', 'rulesepcolor', ''); 949 950#====================================================================== 951# 4.12 Indexing 952#====================================================================== 953DefKeyVal('LST', 'index', ''); 954# HACK: The 2nd optional arg is a list of other classes that should also be indexed!! 955DefMacro('\lst@@index [Number] [] Until:\end', sub { 956 my ($gullet, $n, $c, $words) = @_; 957 my $indexname = lstClassName('index', $n); 958 if ($c) { 959 my $classes = LookupValue('LST_CLASSES'); 960 my @classes = lstSplit($c); 961 map { $$classes{$_}{index} = $indexname } @classes; } 962 my $wordslist = LookupValue('LST_WORDS'); 963 foreach my $word (keys %$wordslist) { 964 delete $$wordslist{$word}{index} if ($$wordslist{$word}{index} || '') eq $indexname; } 965 966 my @words = lstSplit($words); 967 foreach my $word (@words) { 968 $$wordslist{$word}{index} = $indexname; } 969 return; }); 970 971DefKeyVal('LST', 'moreindex', ''); 972DefMacro('\lst@@moreindex [Number] [] Until:\end', sub { 973 my ($gullet, $n, $c, $words) = @_; 974 my $indexname = lstClassName('index', $n); 975 if ($c) { 976 my $classes = LookupValue('LST_CLASSES'); 977 my @classes = lstSplit($c); 978 map { $$classes{$_}{index} = $indexname } @classes; } 979 my $wordslist = LookupValue('LST_WORDS'); 980 my @words = lstSplit($words); 981 foreach my $word (@words) { 982 $$wordslist{$word}{index} = $indexname; } 983 return; }); 984 985DefKeyVal('LST', 'deleteindex', ''); 986DefMacro('\lst@@deleteindex [Number] [] Until:\end', sub { 987 my ($gullet, $n, $c, $words) = @_; 988 my $indexname = lstClassName('index', $n); 989 if ($c) { 990 my $classes = LookupValue('LST_CLASSES'); 991 my @classes = lstSplit($c); 992 foreach my $cl (@classes) { 993 delete $$classes{$cl}{index} if ($$classes{$cl}{index} || '') eq $indexname; } } 994 my $wordslist = LookupValue('LST_WORDS'); 995 foreach my $word (keys %$wordslist) { 996 delete $$wordslist{$word}{index} if ($$wordslist{$word}{index} || '') eq $indexname; } 997 return; }); 998 999DefKeyVal('LST', 'indexstyle', ''); 1000DefMacro('\lst@@indexstyle [Number] Until:\end', sub { 1001 lstSetClassStyle(lstClassName('index', $_[1]), $_[2]); }); 1002 1003DefMacro('\lstindexmacro{}', '\index{{\ttfamily #1}}'); 1004 1005#====================================================================== 1006# 4.13 Column alignment 1007#====================================================================== 1008# Ignorable (?) 1009DefKeyVal('LST', 'columns', ''); 1010DefKeyVal('LST', 'flexiblecolumns', '', 'true'); 1011DefKeyVal('LST', 'keepspaces', '', 'true'); 1012#DefKeyVal('LST','basewidth','Dimension'); # or 2 Dimensions!!!! 1013DefKeyVal('LST', 'basewidth', ''); # or 2 Dimensions!!!! 1014DefKeyVal('LST', 'fontadjust', '', 'true'); 1015 1016#====================================================================== 1017# 4.14 Escaping to LaTeX 1018#====================================================================== 1019 1020DefKeyVal('LST', 'texcl', '', 'true'); 1021DefMacro('\lst@@texcl Until:\end', sub { 1022 my ($gullet, $boole) = @_; 1023 my $classes = LookupValue('LST_CLASSES'); 1024 # This only gets comments classes already defined!! Is that correct? 1025 my @commentclasses = grep { /^comment/ } keys %$classes; 1026 if (ToString($boole) eq 'true') { 1027 map { $$classes{$_}{eval} = 1 } @commentclasses; } 1028 else { 1029 map { delete $$classes{$_}{eval} } @commentclasses; } 1030 return; }); 1031 1032DefKeyVal('LST', 'mathescape', '', 'true'); 1033DefMacro('\lst@@mathescape Until:\end', sub { 1034 my ($gullet, $boole) = @_; 1035 if (ToString($boole) eq 'true') { 1036 LookupValue('LST_DELIMITERS')->{'$'} = { open => '\$', close => '\$', class => 'mathescape', escape => 1 }; 1037 LookupValue('LST_CLASSES')->{mathescape} = { begin => T_MATH, end => T_MATH, eval => 1 }; 1038 delete LookupValue('LST_CHARACTERS')->{letter}{'\$'}; } 1039 else { 1040 delete(LookupValue('LST_DELIMITERS')->{'$'}); } 1041 return; }); 1042DefKeyVal('LST', 'escapechar', ''); 1043DefMacro('\lst@@escapechar Until:\end', sub { 1044 my ($gullet, $escape) = @_; 1045 $escape = lstDeslash($escape); 1046 if ($escape) { 1047 my $escapere = lstRegexp($escape); 1048 LookupValue('LST_DELIMITERS')->{$escape} = { open => $escapere, close => $escapere, class => 'evaluate', escape => 1 }; 1049 LookupValue('LST_CLASSES')->{evaluate}{eval} = 1; 1050 delete LookupValue('LST_CHARACTERS')->{letter}{$escapere}; } 1051 return; }); 1052DefKeyVal('LST', 'escapeinside', ''); 1053DefMacro('\lst@@escapeinside Until:\end', '\ifx.#1.\else\lst@@escapeinside@#1\end\fi'); 1054DefMacro('\lst@@escapeinside@ {} {} Until:\end', sub { 1055 my ($gullet, $escape1, $escape2) = @_; 1056 if ($escape1 && $escape2) { 1057 $escape1 = lstDeslash($escape1); 1058 $escape2 = lstDeslash($escape2); 1059 LookupValue('LST_DELIMITERS')->{$escape1} = { 1060 open => lstRegexp($escape1), close => lstRegexp($escape2), 1061 class => 'evaluate', escape => 1 }; 1062 LookupValue('LST_CLASSES')->{evaluate}{eval} = 1; } 1063 return; }); 1064DefKeyVal('LST', 'escapebegin', ''); 1065DefMacro('\lst@@escapebegin Until:\end', sub { 1066 LookupValue('LST_CLASSES')->{evaluate}{begin} = $_[1]; 1067 return; }); 1068DefKeyVal('LST', 'escapeend', ''); 1069DefMacro('\lst@@escapeend Until:\end', sub { 1070 LookupValue('LST_CLASSES')->{evaluate}{end} = $_[1]; 1071 return; }); 1072 1073#====================================================================== 1074# 4.15 Interface to fancyvrb 1075#====================================================================== 1076# NOTE: fancyvrb Not yet handled, probably won't be 1077DefKeyVal('LST', 'fancyvrb', '', 'true'); 1078DefKeyVal('LST', 'fvcmdparams', ''); 1079DefKeyVal('LST', 'morefvcmdparams', ''); 1080 1081#====================================================================== 1082# 4.17 Language definitions 1083#====================================================================== 1084 1085# \lstdefinelanguage[dialect]{language}[base_dialect]{base_language_if_base_dialect}{keys}[required_aspects] 1086DefMacro('\lstdefinelanguage []{}', 1087 '\@ifnextchar[{\@lstdefinelanguage[#1]{#2}}{\@lstdefinelanguage[#1]{#2}[]{}}'); 1088Let('\lst@definelanguage', '\lstdefinelanguage'); 1089 1090use Data::Dumper; 1091 1092DefPrimitive('\@lstdefinelanguage []{}[]{} SkipSpaces RequiredKeyVals:LST []', sub { 1093 my ($stomach, $dialect, $language, $base_dialect, $base_language, $keyvals, $aspects) = @_; 1094 my @base = (); 1095 if ($base_language->unlist) { 1096 push(@base, T_OTHER('['), $base_dialect->unlist, T_OTHER(']')) if $base_dialect; 1097 push(@base, $base_language->unlist); } 1098 $language = uc(ToString($language)); $language =~ s/\s+//g; 1099 my $name = 'LST@LANGUAGE@' . $language; 1100 if ($dialect && $dialect->unlist) { 1101 $dialect = uc(ToString($dialect)); $dialect =~ s/\s+//g; 1102 $name .= '$' . $dialect; } 1103 $keyvals->setValue('language', Tokens(@base)) if @base; # Probably don't need to clone, first? 1104 AssignValue($name => $keyvals, 'global'); }); 1105 1106# Seems to use <language>$<dialect> as the naming scheme. 1107DefPrimitive('\lstalias []{} []{}', sub { 1108 my ($stomach, $aliasdialect, $alias, $language, $dialect) = @_; 1109 # NOTE! Figure out how aliasing is supposed to work...? 1110 return; }); 1111 1112# keywords (keywordstyle in section 4.6) 1113DefKeyVal('LST', 'keywordprefix', ''); # ??? 1114DefKeyVal('LST', 'keywords', 'Semiverbatim'); 1115DefMacro('\lst@@keywords [Number] Until:\end', sub { 1116 lstSetClassWords(lstClassName('keywords', $_[1]), $_[2]); }); 1117DefKeyVal('LST', 'morekeywords', 'Semiverbatim'); 1118DefMacro('\lst@@morekeywords [Number] Until:\end', sub { 1119 lstAddClassWords(lstClassName('keywords', $_[1]), $_[2]); }); 1120DefKeyVal('LST', 'deletekeywords', 'Semiverbatim'); 1121DefMacro('\lst@@deletekeywords [Number] Until:\end', sub { 1122 lstDeleteClassWords(lstClassName('keywords', $_[1]), $_[2]); }); 1123 1124DefKeyVal('LST', 'ndkeywords', 'Semiverbatim'); 1125DefMacro('\lst@@ndkeywords Until:\end', sub { 1126 lstSetClassWords('keywords2', $_[1]); }); 1127DefKeyVal('LST', 'morendkeywords', 'Semiverbatim'); 1128DefMacro('\lst@@morendkeywords Until:\end', sub { 1129 lstAddClassWords('keywords2', $_[1]); }); 1130DefKeyVal('LST', 'deletendkeywords', 'Semiverbatim'); 1131DefMacro('\lst@@deletendkeywords Until:\end', sub { 1132 lstDeleteClassWords('keywords2', $_[1]); }); 1133 1134DefKeyVal('LST', 'texcs', ''); 1135DefMacro('\lst@@texcs [Number] Until:\end', sub { 1136 AssignValue('LST@TEXCS' => 1); 1137 lstSetClassWords(lstClassName('texcss', $_[1]), $_[2], "\\"); }); 1138DefKeyVal('LST', 'moretexcs', ''); 1139DefMacro('\lst@@moretexcs [Number] Until:\end', sub { 1140 AssignValue('LST@TEXCS' => 1); 1141 lstAddClassWords(lstClassName('texcss', $_[1]), $_[2], "\\"); }); 1142DefKeyVal('LST', 'deletetexcs', ''); 1143DefMacro('\lst@@deletetexcs [Number] Until:\end', sub { 1144 lstDeleteClassWords(lstClassName('texcss', $_[1]), $_[2], "\\"); }); 1145 1146# directives (directivestyle in section 4.6) 1147DefKeyVal('LST', 'directives', 'Semiverbatim'); 1148DefMacro('\lst@@directives Until:\end', sub { 1149 lstSetClassWords('directives', $_[1]); }); 1150DefKeyVal('LST', 'moredirectives', 'Semiverbatim'); 1151DefMacro('\lst@@moredirectives Until:\end', sub { 1152 lstAddClassWords('directives', $_[1]); }); 1153DefKeyVal('LST', 'deletedirectives', 'Semiverbatim'); 1154DefMacro('\lst@@deletedirectives Until:\end', sub { 1155 lstDeleteClassWords('directives', $_[1]); }); 1156 1157DefKeyVal('LST', 'sensitive', '', 'true'); 1158DefKeyVal('LST', 'alsoletter', ''); 1159DefMacro('\lst@@alsoletter Until:\end', sub { 1160 lstSetCharacterClass('letter', $_[1]); }); 1161DefKeyVal('LST', 'alsodigit', ''); 1162DefMacro('\lst@@alsodigit Until:\end', sub { 1163 lstSetCharacterClass('digit', $_[1]); }); 1164DefKeyVal('LST', 'alsoother', ''); 1165DefMacro('\lst@@alsoother Until:\end', sub { 1166 lstSetCharacterClass('other', $_[1]); }); 1167DefKeyVal('LST', 'otherkeywords', ''); # NOTE: Not yet handled 1168 1169DefKeyVal('LST', 'tag', ''); 1170DefMacro('\lst@@tag OptionalMatch:* OptionalMatch:* [] Until:\end', sub { 1171 lstAddDelimiter('delimiter', $_[3], 'tagstyle', $_[4], 1172 ($_[1] ? (recursive => 1) : ()), 1173 ($_[2] ? (cummulative => 1) : ())); }); 1174 1175# Strings 1176DefKeyVal('LST', 'string', ''); 1177DefMacro('\lst@@string [] Until:\end', sub { 1178 lstAddDelimiter('string', $_[1], 'stringstyle', $_[2]); }); 1179DefKeyVal('LST', 'morestring', ''); 1180DefMacro('\lst@@morestring [] Until:\end', sub { 1181 lstAddDelimiter('string', $_[1], 'stringstyle', $_[2]); }); 1182DefKeyVal('LST', 'deletestring', ''); 1183# How to handle??? 1184 1185# Comments 1186DefKeyVal('LST', 'comment', ''); 1187DefMacro('\lst@@comment [] [] Until:\end', sub { 1188 lstAddDelimiter('comment', $_[1], 'commentstyle', $_[3]); }); 1189DefKeyVal('LST', 'morecomment', ''); 1190DefMacro('\lst@@morecomment [] [] Until:\end', sub { 1191 lstAddDelimiter('comment', $_[1], 'commentstyle', $_[3]); }); 1192DefKeyVal('LST', 'deletecomment', ''); 1193# How to handle??? 1194 1195DefKeyVal('LST', 'keywordcomment', ''); 1196DefKeyVal('LST', 'morekeywordcomment', ''); 1197DefKeyVal('LST', 'deletekeywordcomment', ''); 1198DefKeyVal('LST', 'keywordcommentsemicolon', ''); 1199DefKeyVal('LST', 'podcomment', '', 'true'); 1200 1201DefPrimitive('\lstloadlanguages Semiverbatim', undef); 1202 1203#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1204# The listing parser 1205#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1206# Process the listing 1207# The listing is supplied as a list of strings 1208# The result is a Tokens containing the formatted results 1209sub lstProcess { 1210 my ($mode, $text) = @_; 1211 1212 # === Return nothing if print is false 1213 return Tokens() unless (defined $text) && lstGetBoolean('print'); 1214 1215# === Possibly strip trailing blank lines. 1216# NOTE: Not sure if this is supposed to trim from the whole listing, or the requested subset(s) of lines! 1217 if (!lstGetBoolean('showlines')) { # trim empty lines from end. 1218 $text =~ s/\s*$//s; } 1219 1220 # === Establish line numbering parameters 1221 my $name = lstGetLiteral('name'); 1222 my $firstnumber = lstGetLiteral('firstnumber'); 1223 my $line0 = (($firstnumber eq 'last') 1224 ? (LookupValue('LISTINGS_LAST_NUMBER') || 1) 1225 : ($firstnumber eq 'auto' 1226 ? (($name && LookupValue('LISTINGS_LAST_NUMBER_' . $name)) || 1) 1227 : $firstnumber)); 1228 my $numpos = ((lstGetNumber('stepnumber') == 0) ? 'none' : lstGetLiteral('numbers')); 1229 AssignValue('LISTINGS_NEEDS_NUMBER' => (($numpos ne 'none') && lstGetBoolean('numberfirstline'))); 1230 1231 # === Create a line test based on linerange, or firstline & lastline 1232 my $linetest = sub { 1; }; 1233 my ($l1, $l2); 1234 if (my $lr = lstGetLiteral('linerange')) { 1235 my @lr = map { [split(/-/, $_)] } lstSplit($lr); 1236 $linetest = sub { grep { ($$_[0] <= $_[0]) && ($_[0] <= $$_[1]) } @lr; }; } 1237 elsif (($l1 = lstGetNumber('firstline')) 1238 && ($l2 = lstGetNumber('lastline'))) { 1239 $linetest = sub { ($l1 <= $_[0]) && ($_[0] <= $l2); }; } 1240 1241 local $LaTeXML::linetest = $linetest; 1242 # === These hashes have been set up by "activating" the various keywords. 1243 my $words = LookupValue('LST_WORDS'); 1244 my $delimiters = LookupValue('LST_DELIMITERS'); 1245 my $classes = LookupValue('LST_CLASSES'); 1246 my $characters = LookupValue('LST_CHARACTERS'); 1247 # === Extract some regexps to match various important things 1248 my $letter_re = join('', sort keys %{ $$characters{letter} }); 1249 my $digit_re = join('', sort keys %{ $$characters{digit} }); 1250 local $LaTeXML::ID_RE = (LookupValue('LST@TEXCS') ? "\\\\?" : '') . "[$letter_re][$letter_re$digit_re]*"; 1251 local $LaTeXML::DELIM_RE = join('|', map { $$delimiters{$_}{open} } sort keys %$delimiters); 1252 local $LaTeXML::ESCAPE_RE = join('|', map { $$delimiters{$_}{open} } 1253 grep { $$delimiters{$_}{escape} } sort keys %$delimiters); 1254 local $LaTeXML::QUOTED_RE = "\\\\\\\\"; # start w/ backslashed backslash? 1255 local $LaTeXML::SPACE = (lstGetBoolean('showspaces') ? T_CS('\@lst@visible@space') : T_CS("~")); 1256 local $LaTeXML::CASE_SENSITIVE = lstGetBoolean('sensitive'); 1257 if (!$LaTeXML::CASE_SENSITIVE) { # Clunky, but until know, we don't know 1258 foreach my $word (keys %$words) { 1259 $$words{ uc($word) } = $$words{$word}; } } 1260 1261# === Start processing 1262# This whole set of vars probably needs to be adjusted, 1263# since we'll need to recognize constructs inside strings that we've already pulled out (strings,comments) 1264# Better would be to treat the whole string. 1265# then gobble lines etc, can probably work... 1266 local $LaTeXML::linenum = $line0; 1267 local $LaTeXML::colnum = 0; 1268 local $LaTeXML::listing = $text; 1269 local $LaTeXML::mode = $mode; 1270 local $LaTeXML::linestart = undef; 1271 local $LaTeXML::emptyfrom = undef; 1272 local @LaTeXML::lsttokens = (T_BEGIN); 1273 1274 lstProcessPush(@{ LookupValue('LISTINGS_PREAMBLE') }); 1275 lstProcessPush(lstGetTokens('basicstyle')->unlist); 1276 1277 while ($LaTeXML::listing && !&$linetest($LaTeXML::linenum)) { # Ignore initial lines? 1278 $LaTeXML::listing =~ s/^.*?\n//s; 1279 $LaTeXML::linenum++; } 1280 if ($mode ne 'inline') { 1281 lstProcessPush(Invocation(T_CS('\setcounter'), T_OTHER('lstnumber'), Number($LaTeXML::linenum))); 1282 lstProcessStartLine(); } 1283 lstProcess_internal(); 1284 if ($mode ne 'inline') { 1285 lstProcessEndLine(); } 1286 1287 # === Save line number for possible later use. 1288 AssignValue('LISTINGS_LAST_NUMBER' => CounterValue('lstnumber')->valueOf, 'global'); 1289 AssignValue('LISTINGS_LAST_NUMBER_' . $name => CounterValue('lstnumber')->valueOf, 'global') if $name; 1290 # Remove empty trailing lines, if any (GACK!) 1291 @LaTeXML::lsttokens = @LaTeXML::lsttokens[0 .. $LaTeXML::emptyfrom - 1] if $LaTeXML::emptyfrom; 1292 # === And finally, return the tokens we've constructed. 1293 return Tokens(@LaTeXML::lsttokens, T_END); } 1294 1295sub lstProcessPush { 1296 my (@stuff) = @_; 1297 push(@LaTeXML::lsttokens, @stuff); 1298 return; } 1299 1300sub lstProcessStartLine { 1301 my $numpos = ((lstGetNumber('stepnumber') == 0) ? 'none' : lstGetLiteral('numbers')); 1302 $LaTeXML::linestart = scalar(@LaTeXML::lsttokens); # Remember where line started, for potential truncation 1303 lstProcessPush(T_CS('\@lst@startline'), 1304 T_BEGIN, ($numpos ne 'none') ? lstDoNumber($LaTeXML::listing =~ /^\s*?\n/s) : (), T_END); 1305 return; } 1306 1307sub lstProcessEndLine { 1308 if ($LaTeXML::colnum == 0) { # Line was empty; remember where emptyness started... 1309 $LaTeXML::emptyfrom = $LaTeXML::linestart unless $LaTeXML::emptyfrom; } 1310 else { 1311 $LaTeXML::emptyfrom = undef; } 1312 lstProcessPush(T_CS('\@lst@endline')); 1313 return; } 1314 1315sub lstProcess_internal { 1316 my ($end_re, $outerclass) = @_; 1317 my $numpos = ((lstGetNumber('stepnumber') == 0) ? 'none' : lstGetLiteral('numbers')); 1318 my $words = LookupValue('LST_WORDS'); 1319 my $delimiters = LookupValue('LST_DELIMITERS'); 1320 my $classes = LookupValue('LST_CLASSES'); 1321 while ($LaTeXML::listing ne '') { 1322 # Matched the ending regular expression? (typically a close delimiter) 1323 if ($end_re && $LaTeXML::listing =~ s/^($end_re)//s) { 1324 $LaTeXML::colnum += length($1); 1325 last; } 1326 # Various kinds of delimited expressions: escapes, strings, comments, general delimiters. 1327 elsif ($LaTeXML::DELIM_RE && $LaTeXML::listing =~ s/^($LaTeXML::DELIM_RE)//s) { 1328 my $open = $1; 1329 $LaTeXML::colnum += length($1); 1330 my $delim = $$delimiters{$1}; 1331 my $classname = $$delim{class}; 1332 lstProcessPush(lstClassBegin($classname)); 1333# With escapes or texcl, some might be evaluated as TeX; those we match the close delim and simply tokenize. 1334 if (lstClassProperty($classname, 'eval')) { # If this is a comment with texcl applied, just match & expand 1335 if ($LaTeXML::listing =~ s/^(.*?)($$delim{close})//s) { # Simply match until closing regexp 1336 my ($string, $close) = ($1, $2); 1337 my @l = split("\n", $string . $close); # This is the only(?) potentially multiline block 1338 $LaTeXML::linenum += scalar(@l) - 1 if @l > 2; # So adjust line & column 1339 lstProcessPush(TokenizeBalanced($string)); } } 1340 # Others become tricky because the contents of the string, comment etc may need to be processed 1341 # including matching _some_ delimited expressions! 1342 # escaped constructs are always matched. 1343 # nested : allows comments to be nested (ie the SAME delimiter pair) 1344 # recursive: allows any(?) "comments, strings & keywords" to be matched inside. 1345 else { 1346 local $LaTeXML::DELIM_RE = ($$delim{recursive} 1347 ? $LaTeXML::DELIM_RE 1348 : join('|', grep { $_ } $LaTeXML::ESCAPE_RE, $$delim{nested} && $$delim{open})); 1349 local $LaTeXML::ID_RE = ($$delim{recursive} ? $LaTeXML::ID_RE : undef); 1350 local $LaTeXML::QUOTED_RE = join('|', grep { $_ } $LaTeXML::QUOTED_RE, $$delim{quoted}); 1351 local $LaTeXML::SPACE = ($classname && ($classname =~ /^string/) && lstGetBoolean('showstringspaces') 1352 ? T_CS('\@lst@visible@space') : $LaTeXML::SPACE); 1353 # Recurse [note that eval should make the individual tokens tokenize as usual!] 1354 lstProcess_internal($$delim{close}, $classname); } 1355 lstProcessPush(lstClassEnd($classname)); } 1356 # Identifiers (possibly keywords, or other classes) 1357 elsif ($LaTeXML::ID_RE && $LaTeXML::listing =~ s/^($LaTeXML::ID_RE)//) { 1358 $LaTeXML::colnum += length($1); # ? 1359 my $word = $1; 1360 my $lookup = ($LaTeXML::CASE_SENSITIVE ? $word : uc($word)); 1361 my $classname = ($outerclass ? undef : $$words{$lookup}{class} || 'identifiers'); 1362 my @tokens = map { lstRescan($_) } Explode($word); # rescan?? 1363 if (my $indexname = $$words{$lookup}{index} || lstClassProperty($classname, 'index')) { # Should be indexed? 1364 if (my $index = $indexname && $$classes{$indexname}) { 1365 lstProcessPush(lstRescan($$index{begin})->unlist, T_BEGIN, @tokens, T_END); } } 1366 lstProcessPush(($classname ? (lstClassBegin($classname), @tokens, lstClassEnd($classname)) 1367 : @tokens)); } 1368 1369 # NOTE: keywordprefix & otherkeywords probably need a specific regexp 1370 # Perhaps a special keywords_re : otherkeywords | keywordprefix$LaTeXML::ID_RE => keyword 1371 1372 # Various kinds of whitespace, newlines, etc. 1373 elsif ($LaTeXML::listing =~ s/^\s*?\n//s) { # Newline 1374 if ($LaTeXML::mode ne 'inline') { 1375 lstProcessEndLine(); 1376 lstProcessPush(Invocation(T_CS('\stepcounter'), T_OTHER('lstnumber'))); 1377 $LaTeXML::linenum++; # Increment line number 1378 $LaTeXML::colnum = 0; # Reset column number 1379 # NOTE: should ignore blank lines at end of listing, even if they aren't the last line of the code! 1380 # NOTE: should handle showlines, emptylines keywords 1381 while (($LaTeXML::listing ne '') && !&$LaTeXML::linetest($LaTeXML::linenum)) { # Ignore next line? 1382 $LaTeXML::listing =~ s/^.*?(\n|$)//s; 1383 lstProcessPush(Invocation(T_CS('\stepcounter'), T_OTHER('lstnumber'))); 1384 $LaTeXML::linenum++; } 1385 lstProcessStartLine(); } 1386 # === Possibly remove $gobble chars from line 1387 my $gobble = lstGetNumber('gobble'); 1388 (map { $LaTeXML::listing =~ s/^.// } 1 .. $gobble) if $gobble; 1389 } 1390 elsif ($LaTeXML::listing =~ s/^\f//s) { # Formfeed 1391 lstProcessPush(lstGetTokens('formfeed')->unlist); 1392 $LaTeXML::colnum++; } 1393 elsif ($LaTeXML::listing =~ s/^([\t\s]+)//s) { # Tab expansion 1394 my $s = $1; 1395 my $n = 0; 1396 my $tabsize = lstGetNumber('tabsize') || 1; 1397 foreach my $c (split(//, $s)) { 1398 $n += ($c eq ' ' ? 1 : ($tabsize - (($LaTeXML::colnum + $n) % $tabsize))); } 1399 lstProcessPush(lstClassBegin('spaces'), (map { $LaTeXML::SPACE } 1 .. $n), lstClassEnd('spaces')); 1400 $LaTeXML::colnum += $n; } 1401 # Quoted are typically quoted delimiters. 1402 elsif ($LaTeXML::QUOTED_RE && $LaTeXML::listing =~ s/^($LaTeXML::QUOTED_RE)//) { # Something quoted. 1403 # Don't just past together, and watch for leading \ (a common quoter) 1404 lstProcessPush(map { ($_ eq '\\' ? T_CS('\textbackslash') : T_OTHER($_)) } split('', $1)); 1405 1406 $LaTeXML::colnum += length($1); } 1407 else { 1408 if ($LaTeXML::listing =~ s/^(.)//s) { # Anything else, just pass through. 1409 lstProcessPush(lstRescan(T_OTHER($1))); } 1410 $LaTeXML::colnum++; } 1411 } 1412 return; } 1413 1414# Perversely guarantee that the tokenization is balanced to avoid peculiar bugs in bad TeX 1415sub TokenizeBalanced { 1416 my ($string) = @_; 1417 my $tokens = Tokenize($string); 1418 my @toks = 1419 my $level = 0; 1420 foreach my $t ($tokens->unlist) { 1421 if (T_BEGIN->equals($t)) { $level++; } 1422 elsif (T_END->equals($t)) { $level--; } } 1423 if ($level != 0) { # Probably doesn't work all the time, but let's try 1424 my @toks = $tokens->unlist; 1425 while ($level > 0) { push(@toks, T_END); $level--; } 1426 while ($level < 0) { unshift(@toks, T_BEGIN); $level--; } 1427 $tokens = Tokens(@toks); } 1428 return $tokens; } 1429 1430DefConstructor('\@listingKeyword Semiverbatim {}', 1431 "?#class(<ltx:text class='ltx_lst_#class' _noautoclose='1'>#2</ltx:text>)(#2)", 1432 properties => { class => sub { 1433 my $classname = ToString($_[1]); 1434 my $class = $classname && LookupValue('LST_CLASSES')->{$classname}; 1435 my $cssclass = $class && $$class{cssclass}; 1436 $cssclass; } }); 1437 1438# It's conceivable that a group is INTENDED to carry over across lines? 1439# If so, we'd have to maintain a stack.. 1440# But we have to be careful about a group closing ltx:text that may have autoclosed on prev.line! 1441DefConstructor('\@listingGroup Semiverbatim {}', 1442 # "<ltx:text class='#1'>#2</ltx:text>"); 1443 "<ltx:text class='#1'>#2", 1444 # sorta like maybeCloseElement, except only if CURRENT 1445 afterConstruct => sub { my ($doc) = @_; 1446 if ($doc->getNodeQName($doc->getElement) eq 'ltx:text') { 1447 $doc->closeElement('ltx:text'); } }); 1448 1449sub lstClassBegin { 1450 my ($classname) = @_; 1451 my @open = (); 1452 my %classes = (); 1453 if (($classname || '') eq 'spaces') { $classes{space} = 1; } 1454 while (my $class = $classname && LookupValue('LST_CLASSES')->{$classname}) { 1455 if (my $css = $$class{cssclass}) { 1456 $classes{$css} = 1; } 1457 if (my $begin = $$class{begin}) { 1458 unshift(@open, lstRescan($begin)->unlist); } 1459 $classname = $$class{class}; } 1460 return (T_BEGIN, T_CS('\@listingGroup'), 1461 T_BEGIN, T_OTHER(join(' ', map { 'ltx_lst_' . $_ } sort keys %classes)), T_END, 1462 T_BEGIN, @open); } 1463 1464sub lstClassEnd { 1465 my ($classname) = @_; 1466 my @close = (); 1467 while (my $class = $classname && LookupValue('LST_CLASSES')->{$classname}) { 1468 if (my $end = $$class{end}) { 1469 push(@close, lstRescan($end)->unlist); } 1470 $classname = $$class{class}; } 1471 return (@close, T_END, T_END); } 1472 1473sub lstClassProperty { 1474 my ($classname, $property) = @_; 1475 my $class = $classname && LookupValue('LST_CLASSES')->{$classname}; 1476 return ($class && ($$class{$property} 1477 ? $$class{$property} 1478 : lstClassProperty($$class{class}, $property))); } 1479 1480DefConstructor('\@lst@startline{}', "<ltx:listingline xml:id='#id'>#1", 1481 properties => sub { RefStepID('lstnumber'); }); 1482DefConstructor('\@lst@endline', "</ltx:listingline>"); 1483DefConstructor('\@lst@linenumber{}', "<ltx:tags><ltx:tag>#1</ltx:tag></ltx:tags>"); 1484 1485DefConstructor('\@lst@visible@space', "\x{2423}"); 1486 1487sub lstDoNumber { 1488 my ($isempty) = @_; 1489 if ((LookupValue('LISTINGS_NEEDS_NUMBER') 1490 || ((($LaTeXML::linenum - 1) % lstGetNumber('stepnumber')) == 0)) 1491 && (lstGetBoolean('numberblanklines') || !$isempty)) { 1492 AssignValue('LISTINGS_NEEDS_NUMBER' => 0); 1493 return Invocation(T_CS('\@lst@linenumber'), 1494 Tokens(T_BEGIN, lstGetTokens('numberstyle')->unlist, T_CS('\thelstnumber'), T_END)); } 1495 else { 1496 return Invocation(T_CS('\@lst@linenumber'), Tokens()); } } 1497 1498#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1499# Configuration 1500#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1501# Initialize the various parameters... 1502 1503RawTeX(<<'EoTeX'); 1504\lstset{ 1505 alsoletter={abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ@$\_}, 1506 alsodigit={0123456789}, 1507 alsoother={!"#\%&'()*+,-./:;<=>?[\\]^\{|\}~}, 1508 float=tbp,floatplacement=tbp,aboveskip=\medskipamount,belowskip=\medskipamount, 1509 lineskip=0pt,boxpos=c, 1510 print=true,firstline=1,lastline=9999999,showlines=false,emptylines=9999999,gobble=0, 1511 style={},language={},printpod=false,usekeywordsintag=true,tagstyle={}, 1512 markfirstintag=false,makemacrouse=true, 1513 basicstyle={},identifierstyle={},commentstyle=\itshape,stringstyle={}, 1514 keywordstyle=\bfseries,classoffset=0, 1515 emph={},delim={}, 1516 extendedchars=false,inputencoding={},upquote=false,tabsize=8,showtabs=false, 1517 tabs={},showspaces=false,showstringspaces=true,formfeed=\bigbreak, 1518 numbers=none,stepnumber=1,numberfirstline=false,numberstyle={},numbersep=10pt, 1519 numberblanklines=true,firstnumber=auto,name={}, 1520 title={},caption={},label={},nolol=false, 1521 captionpos=t,abovecaptionskip=\smallskipamount,belowcaptionskip=\smallskipamount, 1522 linewidth=\linewidth,xleftmargin=0pt,xrightmargin=0pt,resetmargins=false,breaklines=false, 1523 prebreak={},postbreak={},breakindent=20pt,breakautoindent=true, 1524 frame=none,frameround=ffff,framesep=3pt,rulesep=2pt,framerule=0.4pt, 1525 framexleftmargin=0pt,framexrightmargin=0pt,framextopmargin=0pt,framexbottommargin=0pt, 1526 backgroundcolor={},rulecolor={},fillcolor={},rulesepcolor={}, 1527 frameshape={}, 1528 index={},indexstyle=\lstindexmacro, 1529 columns=[c]fixed,flexiblecolumns=false,keepspaces=false,basewidth={0.6em,0.45em}, 1530 fontadjust=false,texcl=false,mathescape=false,escapechar={},escapeinside={}, 1531 escapebegin={},escapeend={}, 1532 fancyvrb=false,fvcmdparams=\overlay1,morefvcmdparams={}, 1533 ndkeywordstyle=keywordstyle,texcsstyle=keywordstyle,directivestyle=keywordstyle 1534} 1535EoTeX 1536 1537#====================================================================== 1538# Finally, we want to load the definitions from the configurations... 1539# Actually, we should just load .cfg 1540# and the extra files should be loaded as needed, but... 1541sub lstLoadConfiguration { 1542 InputDefinitions("listings", type => 'cfg'); 1543 AssignValue(LST_LANGUAGE_FILES => [lstSplit(Digest(T_CS('\lstlanguagefiles')))], 'global'); 1544 1545 # Now, if you want to read in all definitions immediately, you could do this (on preload) 1546 # otherwise, they'll be read in whenever missing languages are used. 1547 if (LookupValue('InitialPreloads')) { 1548 while (my $file = ShiftValue('LST_LANGUAGE_FILES')) { 1549 InputDefinitions($file, noerror => 1); } } 1550 return; } 1551 1552lstLoadConfiguration(); 1553 1554# Also allow some internal macros which get used from sibling bindings e.g. cleveref 1555DefMacro('\lst@UseHook{}', '\csname\@lst hk@#1\endcsname'); 1556DefMacro('\lst@AddToHook{}{}', ''); # ignore 1557DefMacro('\lst@AddToHookExe{}{}', ''); # ignore 1558DefMacro('\lst@AddTo {}{}', 1559 '\expandafter\gdef\expandafter#1\expandafter{#1#2}', 1560 long => 1); 1561DefMacro('\@lst', 'lst'); 1562#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 15631; 1564