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