[system] / trunk / pg / macros / PGML.pl Repository:
ViewVC logotype

View of /trunk/pg/macros/PGML.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 7008 - (download) (as text) (annotate)
Thu Jul 28 23:03:52 2011 UTC (8 years, 6 months ago) by gage
File size: 43383 byte(s)
update PGML.pl to current version on courses


    1 loadMacros("contextTypeset.pl");
    2 
    3 
    4 ######################################################################
    5 ######################################################################
    6 
    7 package PGML;
    8 
    9 sub show {
   10   ClearWarnings;
   11   my $parser = PGML::Parse->new(shift);
   12   warn join("\n","==================","Errors parsing PGML:",@warnings,"==================\n") if scalar(@warnings);
   13   return $parser->{root}->show;
   14 }
   15 
   16 our @warnings = ();
   17 our $warningsFatal = 0;
   18 sub Warning {
   19   my $warning = join("",@_);
   20   $warning =~ s/ at line \d+ of \(eval \d+\)//;
   21   $warning =~ s/ at \(eval \d+\) line \d+//;
   22   $warning =~ s/, at EOF$//;
   23   die $warning if $warningsFatal;
   24   push @warnings,$warning;
   25 }
   26 sub ClearWarnings {@warnings = ()};
   27 
   28 sub Eval {main::PG_restricted_eval(@_)}
   29 
   30 sub Sort {return main::lex_sort(@_)}
   31 
   32 ######################################################################
   33 
   34 package PGML::Parse;
   35 
   36 my $wordStart = qr/[^a-z0-9]/;
   37 
   38 my $indent = '^\t+';
   39 my $lineend = '\n+';
   40 my $linebreak = '   ?(?=\n)';
   41 my $heading = '#+';
   42 my $rule = '(?:---+|===+)';
   43 my $list = '(?:^|(?<=[\t ]))(?:[-+o*]|(?:\d|[ivx]+|[IVX]+|[a-zA-Z])[.)]) +';
   44 my $align = '>> *| *<<';
   45 my $pre = ':   ';
   46 my $emphasis = '\*+|_+';
   47 my $chars = '\\\\.|[{}[\]\'"]';
   48 my $ansrule = '\[(?:_+|[ox^])\]\*?';
   49 my $open = '\[(?:[!<%@$]|::?|``?|\|+ ?)';
   50 my $close = '(?:[!>%@$]|::?|``?| ?\|+)\]';
   51 my $noop = '\[\]';
   52 
   53 my $splitPattern =
   54   qr/($indent|$open|$ansrule|$close|$linebreak|$lineend|$heading|$rule|$list|$align|$pre|$emphasis|$noop|$chars)/m;
   55 
   56 my %BlockDefs;
   57 
   58 sub new {
   59   my $self = shift; my $class = ref($self) || $self;
   60   my $string = shift;
   61   my $parser = bless {
   62     string => $string,
   63     indent => 0, actualIndent => 0,
   64     atLineStart => 1, atBlockStart => 1
   65   }, $class;
   66   $parser->Parse($parser->Split($string));
   67   return $parser;
   68 }
   69 
   70 sub Split {
   71   my $self = shift; my $string = shift;
   72   $string =~ s/\t/    /g;                             # turn tabs into spaces
   73   $string =~ s!^((?:    )+)!"\t"x(length($1)/4)!gme;  # make initial indent into tabs
   74   $string =~ s!^(?:\t* +|\t+ *)$!!gm;                 # make blank lines blank
   75   return split($splitPattern,$string);
   76 }
   77 
   78 sub Error {
   79   my $self = shift; my $message = shift;
   80   my $name = $self->{block}{token}; $name =~ s/^\s+|\s+$//g;
   81   $message = sprintf($message,$name);
   82   PGML::Warning $message;
   83 }
   84 
   85 sub Unwind {
   86   my $self = shift;;
   87   my $block = $self->{block}; $self->{block} = $block->{prev};
   88   $self->{block}->popItem;
   89   $self->Text($block->{token});
   90   $self->{block}->pushItem(@{$block->{stack}});
   91   $self->Text($block->{terminator}) if $block->{terminator} && ref($block->{terminator}) ne 'Regexp';
   92   $self->{atBlockStart} = 0;
   93 }
   94 
   95 sub blockError {
   96   my $self = shift; my $message = shift;
   97   $self->Error($message);
   98   $self->Unwind;
   99 }
  100 
  101 sub isLineEnd {
  102   my $self = shift; my $block = shift;
  103   $block = $block->{prev}; my $i = $self->{i};
  104   while ($i < scalar(@{$self->{split}})) {
  105     return 0 unless $self->{split}[$i++] eq '';
  106     my $token = $self->{split}[$i++];
  107     last if $token =~ m/^\n+$/;
  108     next if $token =~ m/^   ?$/;
  109     return 0 unless $token =~ m/^ +<<$/ && $block->{align};
  110     $block = $block->{prev};
  111   }
  112   return 1;
  113 }
  114 
  115 sub nextChar {
  116   my $self = shift; my $default = shift; $default = '' unless defined $default;
  117   return substr(($self->{split}[$self->{i}] || $self->{split}[$self->{i}+1] || $default),0,1);
  118 }
  119 
  120 sub prevChar {
  121   my $self = shift; my $default = shift; $default = '' unless defined $default;
  122   my $i2 = $self->{i}-2; $i2 = 0 if $i2 < 0;
  123   my $i3 = $self->{i}-3; $i3 = 0 if $i3 < 0;
  124   return substr(($self->{split}[$i2] || $self->{split}[$i3] || $default),-1,1);
  125 }
  126 
  127 sub Parse {
  128   my $self = shift; my $block;
  129   $self->{split} = [@_]; $self->{i} = 0;
  130   $self->{block} = $self->{root} = PGML::Root->new($self);
  131   while ($self->{i} < scalar(@{$self->{split}})) {
  132     $block = $self->{block};
  133     $self->Text($self->{split}[($self->{i})++]);
  134     my $token = $self->{split}[($self->{i})++]; next unless defined $token && $token ne '';
  135     for ($token) {
  136       $block->{terminator} && /^$block->{terminator}\z/                    && do {$self->Terminate($token); last};
  137       /^\[[@\$]/  && ($block->{parseAll} || $block->{parseSubstitutions})  && do {$self->Begin($token); last};
  138       /^\[%/      && ($block->{parseAll} || $block->{parseComments})       && do {$self->Begin($token); last};
  139       /^\\./      && ($block->{parseAll} || $block->{parseSlashes})        && do {$self->Slash($token); last};
  140       /^\n\z/     && do {$self->Break($token); last};
  141       /^\n\n+\z/  && do {$self->Par($token); last};
  142       /^\*\*?$/   && (!$block->{parseAll} && $block->{parseSubstitutions}) && do {$self->Star($token); last};
  143       $block->{balance} && /^$block->{balance}/ && do {$self->Begin($token,substr($token,0,1)); last};
  144       $block->{balance} && /$block->{balance}$/ && do {$self->Begin($token,substr($token,-1,1)); last};
  145       $block->{parseAll} && do {$self->All($token); last};
  146       /^[\}\]]\z/ && do {$self->Unbalanced($token); last};
  147       $self->Text($token);
  148     }
  149   }
  150   $self->End("END_PGML");
  151   delete $self->{root}{parser};
  152 }
  153 
  154 sub All {
  155   my $self = shift; my $token = shift;
  156   return $self->Begin($token) if substr($token,0,1) eq "[" && $BlockDefs{$token};
  157   for ($token) {
  158     /\t/          && do {return $self->Indent($token)};
  159     /\d+\. /      && do {return $self->Bullet($token,"numeric")};
  160     /[ivx]+[.)] / && do {return $self->Bullet($token,"roman")};
  161     /[a-z][.)] /  && do {return $self->Bullet($token,"alpha")};
  162     /[IVX]+[.)] / && do {return $self->Bullet($token,"Roman")};
  163     /[A-Z][.)] /  && do {return $self->Bullet($token,"Alpha")};
  164     /[-+o*] /     && do {return $self->Bullet($token,"bullet")};
  165     /\{/          && do {return $self->Brace($token)};
  166     /\[]/         && do {return $self->NOOP($token)};
  167     /\[\|/        && do {return $self->Verbatim($token)};
  168     /\[./         && do {return $self->Answer($token)};
  169     /_/           && do {return $self->Emphasis($token)};
  170     /\*/          && do {return $self->Star($token)};
  171     /[\"\']/      && do {return $self->Quote($token)};
  172     /^   ?$/      && do {return $self->ForceBreak($token)};
  173     /#/           && do {return $self->Heading($token)};
  174     /-|=/         && do {return $self->Rule($token)};
  175     /<</          && do {return $self->Center($token)};
  176     />>/          && do {return $self->Align($token)};
  177     /:   /        && do {return $self->Preformatted($token)};
  178     $self->Text($token);
  179   }
  180 }
  181 
  182 sub Begin {
  183   my $self = shift; my $token = shift; my $id = shift || $token;
  184   my $options = shift || {};
  185   my $def = {%{$BlockDefs{$id}},%$options, token => $token};
  186   my $type = $def->{type}; delete $def->{type};
  187   my $block = PGML::Block->new($type,$def);
  188   $self->{block}->pushItem($block); $block->{prev} = $self->{block};
  189   $self->{block} = $block;
  190   $self->{atLineStart} = 0; $self->{atBlockStart} = 1;
  191 }
  192 
  193 sub End {
  194   my $self = shift; my $action = shift || "paragraph ends"; my $endAt = shift;
  195   my $block = $self->{block};
  196   $block->popItem if $block->topItem->{type} eq 'break' && $block->{type} ne 'align';
  197   while ($block->{type} ne 'root') {
  198     if (ref($block->{terminator}) eq 'Regexp' || $block->{cancelPar}) {
  199       $self->blockError("'%s' was not closed before $action");
  200     } else {
  201       $self->Terminate;
  202     }
  203     return if $endAt && $endAt == $block;
  204     $block = $self->{block};
  205   }
  206 }
  207 
  208 sub Terminate {
  209   my $self = shift; my $token = shift;
  210   my $block = $self->{block}; my $prev = $block->{prev};
  211   if (defined($token)) {
  212     $block->{terminator} = $token;
  213     my $method = $block->{terminateMethod};
  214     $self->$method($token) if defined $method;
  215   }
  216   foreach my $field ("prev","parseComments","parseSubstitutions","parseSlashes",
  217                      "parseAll","cancelUnbalanced","cancelNL","cancelPar","balance",
  218          "terminateMethod","noIndent") {delete $block->{$field}}
  219   $self->{block} = $prev;
  220   if ($block->{stack}) {
  221     if (scalar(@{$block->{stack}}) == 0) {$prev->popItem}
  222     elsif ($block->{combine}) {$prev->combineTopItems}
  223   }
  224 }
  225 
  226 sub Unbalanced {
  227   my $self = shift; my $token = shift;
  228   $self->blockError("parenthesis mismatch: %s terminated by $token") if $self->{block}{cancelUnbalanced};
  229   $self->Text($token);
  230 }
  231 
  232 sub Text {
  233   my $self = shift; my $text = shift; my $force = shift;
  234   if ($text ne "" || $force) {
  235     $self->{block}->pushText($text,$force);
  236     $self->{atLineStart} = $self->{atBlockStart} = $self->{ignoreNL} = 0;
  237   }
  238 }
  239 
  240 sub Item {
  241   my $self = shift; my $type = shift; my $token = shift;
  242   my $def = {%{shift || {}}, token => $token};
  243   $self->{block}->pushItem(PGML::Item->new($type,$def));
  244   $self->{atBlockStart} = 0;
  245 }
  246 
  247 
  248 sub Break {
  249   my $self = shift; my $token = shift;
  250   if ($self->{ignoreNL}) {
  251     $self->{ignoreNL} = 0;
  252   } else {
  253     $self->blockError("%s was not closed before line break") while $self->{block}{cancelNL};
  254     my $top = $self->{block}->topItem;
  255     if ($top->{breakInside}) {$top->pushText($token)} else {$self->Text($token)}
  256     $self->{ignoreNL} = 1;
  257   }
  258   $self->{atLineStart} = 1;
  259   $self->{actualIndent} = 0;
  260 }
  261 
  262 sub ForceBreak {
  263   my $self = shift; my $token = shift;
  264   $self->blockError("%s was not closed before forced break") while $self->{block}{cancelNL};
  265   if ($token eq '   ') {
  266     $self->End("forced break");
  267     $self->Item("forced",$token,{noIndent => 1});
  268     $self->{indent} = 0;
  269   } else {
  270     my $top = $self->{block}->topItem;
  271     if ($top->{breakInside}) {$top->pushItem(PGML::Item->new("break",{token=>$token}))}
  272     else {$self->Item("break",$token,{noIndent => 1})}
  273   }
  274   $self->{atLineStart} = $self->{ignoreNL} = 1;
  275   $self->{actualIndent} = 0;
  276 }
  277 
  278 sub Par {
  279   my $self = shift; my $token = shift;
  280   $self->End;
  281   $self->Item("par",$token,{noIndent => 1});
  282   $self->{atLineStart} = $self->{ignoreNL} = 1;
  283   $self->{indent} = $self->{actualIndent} = 0;
  284 }
  285 
  286 sub Indent {
  287   my $self = shift; my $token = shift;
  288   if ($self->{atLineStart}) {
  289     my $indent = $self->{actualIndent} = length($token);
  290     if ($indent != $self->{indent}) {
  291       $self->End("indentation change");
  292       $self->{indent} = $indent;
  293     }
  294   } else {
  295     $self->Text($token);
  296   }
  297 }
  298 
  299 sub Slash {
  300   my $self = shift; my $token = shift;
  301   $self->Text(substr($token,1));
  302 }
  303 
  304 sub Brace {
  305   my $self = shift; my $token = shift;
  306   my $top = $self->{block}->topItem;
  307   if ($top->{options}) {$self->Begin($token,' {')} else {$self->Text($token)}
  308 }
  309 
  310 sub Verbatim {
  311   my $self = shift; my $token = shift;
  312   my $bars = $token; $bars =~ s/[^|]//g;
  313   my $bars = "\\".join("\\",split('',$bars));
  314   $self->Begin($token,' [|',{terminator => qr/ ?$bars\]/});
  315 }
  316 
  317 sub Answer {
  318   my $self = shift; my $token = shift;
  319   my $def = {options => ["answer","width","name","array"]};
  320   $def->{hasStar} = 1 if $token =~ m/\*$/;
  321   $self->Item("answer",$token,$def);
  322 }
  323 
  324 sub Emphasis {
  325   my $self = shift; my $token = shift;
  326   my $type = $BlockDefs{substr($token,0,1)}->{type};
  327   my $block = $self->{block};
  328   return $self->Terminate if $block->{type} eq $type;
  329   while ($block->{type} ne 'root') {
  330     if ($block->{prev}{type} eq $type) {
  331       $self->End("end of $type",$block);
  332       $self->Terminate();
  333       return;
  334     }
  335     $block = $block->{prev};
  336   }
  337   if ($self->nextChar(' ') !~ m/\s/ && $self->prevChar(' ') !~ m/[a-z0-9]/)
  338     {$self->Begin($token,substr($token,0,1))} else {$self->Text($token)}
  339 }
  340 
  341 sub Star {
  342   my $self = shift; my $token = shift;
  343   return if $self->StarOption($token);
  344   if ($self->{block}{parseAll}) {$self->Emphasis($token)} else {$self->Text($token)}
  345 }
  346 
  347 sub Rule {
  348   my $self = shift; my $token = shift;
  349   if ($self->{atLineStart}) {
  350 ### check for line end or braces
  351     $self->Item("rule",$token,{options => ["width","size"]});
  352     $self->{ignoreNL} = 1;
  353   } else {
  354     $self->Text($token);
  355   }
  356 }
  357 
  358 sub Bullet {
  359   my $self = shift; my $token = shift; my $bullet = shift;
  360   return $self->Text($token) unless $self->{atLineStart};
  361   $bullet = {'*'=>'bullet', '+'=>'square', 'o'=>'circle', '-'=>'bullet'}->{substr($token,0,1)} if $bullet eq 'bullet';
  362   my $block = $self->{block};
  363   if ($block->{type} ne 'root' && !$block->{align}) {
  364     while ($block->{type} ne 'root' && !$block->{prev}{align}) {$block = $block->{prev}}
  365     $self->End("start of list item",$block);
  366   }
  367   $self->{indent} = $self->{actualIndent};
  368   $self->Begin("","list",{bullet => $bullet});
  369   $self->Begin($token,"bullet");
  370 }
  371 
  372 sub Heading {
  373   my $self = shift; my $token = shift;
  374   my $n = length($token);
  375   return $self->Text($token) if $n > 6;
  376   my $block = $self->{block};
  377   if ($self->{atLineStart}) {
  378     if ($block->{type} ne 'root' && $block->{type} ne 'align') {
  379       while ($block->{type} ne 'root' && $block->{prev}{type} ne 'align') {$block = $block->{prev}}
  380       $self->End("start of heading",$block);
  381     }
  382     $self->Begin($token,"#",{n => $n});
  383   } else {
  384     while ($block->{type} ne 'heading' || $block->{n} != $n) {
  385       return $self->Text($token) if $block->{type} eq 'root';
  386       $block = $block->{prev};
  387     }
  388     if ($self->isLineEnd($block)) {
  389       $self->End("end of heading",$block);
  390       $block->{terminator} = $token;
  391       $self->{indent} = 0;
  392     } else {$self->Text($token)}
  393   }
  394 }
  395 
  396 sub Center {
  397   my $self = shift; my $token = shift;
  398   my $block = $self->{block};
  399   while (!$block->{align} || $block->{align} ne 'right') {
  400     return $self->Text($token) if $block->{type} eq 'root';
  401     $block = $block->{prev};
  402 }
  403   if ($self->isLineEnd($block)) {
  404     $block->{align} = 'center';
  405     $block->{terminator} = $token;
  406     $self->End("end of centering",$block);
  407   } else {$self->Text($token)}
  408 }
  409 
  410 sub Align {
  411   my $self = shift;  my $token = shift;
  412   return $self->Text($token) if !$self->{atLineStart} ||
  413     ($self->{block}{type} eq 'align' && $self->{atBlockStart});
  414   $self->End("start of aligned text");
  415   $self->{indent} = $self->{actualIndent};
  416   $self->Begin($token,">>");
  417   $self->{atLineStart} = $self->{ignoreNL} = 1;
  418 }
  419 
  420 sub Preformatted {
  421   my $self = shift;  my $token = shift; my $action = shift; my $id = shift || $token;
  422   return $self->Text($token) if !$self->{atLineStart} ||
  423     ($self->{block}{type} eq 'align' && $self->{atBlockStart});
  424   $self->End("start of preformatted text");
  425   $self->{indent} = $self->{actualIndent};
  426   $self->Begin($token,':   ');
  427 }
  428 
  429 sub Quote {
  430   my $self = shift; my $token = shift;
  431   $self->Item("quote",$token);
  432 }
  433 
  434 sub NOOP {
  435   my $self = shift;
  436   $self->Text("",1);
  437 }
  438 
  439 ######################################################################
  440 
  441 my $balanceAll = qr/[\{\[\'\"]/;
  442 
  443 %BlockDefs = (
  444   "[:"   => {type=>'math', parseComments=>1, parseSubstitutions=>1,
  445                terminator=>qr/:\]/, terminateMethod=>'terminateGetString',
  446          parsed=>1, allowStar=>1, options=>["context","reduced"]},
  447   "[::"  => {type=>'math', parseComments=>1, parseSubstitutions=>1,
  448                terminator=>qr/::\]/, terminateMethod=>'terminateGetString',
  449          parsed=>1, allowStar=>1, display=>1, options=>["context","reduced"]},
  450   "[`"   => {type=>'math', parseComments=>1, parseSubstitutions=>1,
  451                terminator=>qr/\`\]/, terminateMethod=>'terminateGetString',},
  452   "[``"  => {type=>'math', parseComments=>1, parseSubstitutions=>1,
  453                terminator=>qr/\`\`\]/, terminateMethod=>'terminateGetString', display=>1},
  454   "[!"   => {type=>'image', parseComments=>1, parseSubstitutions=>1,
  455                terminator=>qr/!\]/, terminateMethod=>'terminateGetString',
  456                cancelNL=>1, options=>["title"]},
  457   "[<"   => {type=>'link', parseComments=>1, parseSubstitutions=>1,
  458                terminator=>qr/>\]/, terminateMethod=>'terminateGetString',
  459                cancelNL=>1, options=>["text","title"]},
  460   "[%"   => {type=>'comment', parseComments=>1, terminator=>qr/%\]/},
  461   "[\@"  => {type=>'command', parseComments=>1, parseSubstitutions=>1,
  462                terminator=>qr/@\]/, terminateMethod=>'terminateGetString',
  463                balance=>qr/[\'\"]/, allowStar=>1, allowDblStar=>1},
  464   "[\$"  => {type=>'variable', parseComments=>1, parseSubstitutions=>1,
  465                terminator=>qr/\$?\]/, terminateMethod=>'terminateGetString',
  466          balance=>$balanceAll, cancelUnbalanced=>1, cancelNL=>1, allowStar=>1, allowDblStar=>1},
  467   ' [|'  => {type=>'verbatim', cancelNL=>1, allowStar=>1, terminateMethod=>'terminateGetString'},
  468   " {"   => {type=>'options', parseComments=>1, parseSubstitutions=>1, terminator=>qr/\}/,
  469          balance=>$balanceAll, cancelUnbalanced=>1, terminateMethod => 'terminateOptions'},
  470   "{"    => {type=>'balance', parseComments=>1, parseSubstitutions=>1, terminator=>qr/\}/,
  471          balance=>$balanceAll, cancelUnbalanced=>1},
  472   "["    => {type=>'balance', parseComments=>1, parseSubstitutions=>1, terminator=>qr/\]/,
  473          balance=>$balanceAll, cancelUnbalanced=>1},
  474   "'"    => {type=>'balance', terminator=>qr/\'/, terminateMethod=>'terminateBalance'},
  475   '"'    => {type=>'balance', terminator=>qr/\"/, terminateMethod=>'terminateBalance'},
  476   ":   " => {type=>'pre', parseAll=>1, terminator=>qr/\n+/, terminateMethod=>'terminatePre',
  477                combine=>{pre=>"type"}, noIndent=>-1},
  478   ">>"   => {type=>'align', parseAll=>1, align=>"right", breakInside=>1,
  479          combine=>{align=>"align",par=>1}, noIndent=>-1},
  480   "#"    => {type=>'heading', parseAll=>1, breakInside=>1, combine=>{heading=>"n"}},
  481   "*"    => {type=>'bold', parseAll=>1, cancelPar=>1},
  482   "_"    => {type=>'italic', parseAll=>1, cancelPar=>1},
  483   "bullet" => {type=>'bullet', parseAll=>1},
  484   "list" => {type=>'list', parseAll=>1, combine=>{list=>"bullet",par=>1}, noIndent=>-1},
  485 );
  486 
  487 ######################################################################
  488 
  489 sub terminateGetString {
  490   my $self = shift; my $token = shift;
  491   my $block = $self->{block};
  492   $block->{text} = $self->stackString;
  493   delete $block->{stack};
  494 }
  495 
  496 sub terminateBalance {
  497   my $self = shift; my $token = shift;
  498   my $block = $self->{block}; my $stackString = $self->stackString;
  499   $self->{block} = $block->{prev}; $self->{block}->popItem;
  500   if ($block->{token} eq '"' || $block->{token} eq "'") {
  501     $self->Item("quote",$block->{token});
  502     $self->Text($stackString);
  503     $self->Item("quote",$block->{terminator});
  504   } else {
  505     $self->Text($block->{token}.$stackString.$block->{terminator});
  506   }
  507 }
  508 
  509 sub terminatePre {
  510   my $self = shift; my $token = shift;
  511   $self->{block}{terminator} = ''; # we add the ending token to the text below
  512   if ($token =~ m/\n\n/) {
  513     $self->{block} = $self->{block}{prev};
  514     $self->Par($token);
  515   } else {
  516     $self->Text($token);
  517     $self->{atLineStart} = 1;
  518     $self->{actualIndent} = 0;
  519 }
  520 }
  521 
  522 sub terminateOptions {
  523   my $self = shift; my $token = shift;
  524   my $options = $self->stackString;
  525   $self->{block} = $self->{block}{prev}; $self->{block}->popItem;
  526   $block = $self->{block}->topItem;
  527   if ($options =~ m/^[a-z_][a-z0-9_]*=>/i) {
  528     my %allowed = (map {$_ => 1} (@{$block->{options}}));
  529     my ($options,$error) = PGML::Eval("{$options}");
  530     $options={},PGML::Warning "Error evaluating options: $error" if $error;
  531     foreach my $option (keys %{$options}) {
  532       if ($allowed{$option}) {$block->{$option} = $options->{$option}}
  533         else {PGML::Warning "Unknown $self->{type} option '$option'"}
  534     }
  535   } else {
  536     foreach my $option (@{$block->{options}}) {
  537       if (!defined($block->{$option})) {
  538   if (!ref($options)) {
  539     my ($value,$error) = PGML::Eval($options);
  540     $options = $value unless $error; ### should give warning? only evaluate some options?
  541   }
  542   $block->{$option} = $options;
  543   return;
  544       }
  545     }
  546     PGML::Warning "Error: extra option '$options'";
  547   }
  548 }
  549 
  550 sub StarOption {
  551   my $self = shift; my $token = shift;
  552   my $top = $self->{block}->topItem;
  553   if ($token eq '**' && $top->{allowDblStar}) {
  554     $self->{block}->popItem;
  555     my $string;
  556     for ($top->{type}) {
  557       /variable/ && do {$string = $self->replaceVariable($top); last;};
  558       /command/  && do {$string = $self->replaceCommand($top); last;};
  559       PGML::Warning "Unexpected type '$top->{type}' in ".ref($self)."->Star";
  560     }
  561     my @split = $self->Split($string);
  562     push(@split,undef) if scalar(@split) % 2 == 1;
  563     splice(@{$self->{split}},$self->{i},0,@split);
  564     return 1;
  565   }
  566   if ($token eq '*' && $top->{allowStar}) {
  567     $top->{hasStar} = 1;
  568     return 1;
  569 }
  570   return 0;
  571 }
  572 
  573 sub stackString {
  574   my $self = shift; my $block = $self->{block};
  575   my @strings = ();
  576   foreach my $item (@{$block->{stack}}) {
  577     for ($item->{type}) {
  578       /text/     && do {push(@strings,$self->replaceText($item)); last};
  579       /quote/    && do {push(@strings,$self->replaceQuote($item)); last};
  580       /variable/ && do {push(@strings,$self->replaceVariable($item)); last};
  581       /command/  && do {push(@strings,$self->replaceCommand($item)); last};
  582       PGML::Warning "Warning: unexpected type '$item->{type}' in stackString\n";
  583     }
  584   }
  585   return join('',@strings);
  586 }
  587 
  588 sub replaceText {
  589   my $self = shift; my $item = shift;
  590   return join('',@{$item->{stack}});
  591 }
  592 
  593 sub replaceQuote {
  594   my $self = shift; my $item = shift;
  595   return $item->{token};
  596 }
  597 
  598 sub replaceVariable {
  599   my $self = shift; my $item = shift;
  600   my $block = $self->{block};
  601   my $var = "\$main::" . $item->{text};
  602   ### check $var for whether it looks like a variable reference
  603   my ($result,$error) = PGML::Eval($var);
  604   PGML::Warning "Error evaluating variable \$$item->{text}: $error" if $error;
  605   $result = "" unless defined $result;
  606   if ($block->{type} eq 'math' && Value::isValue($result)) {
  607     if ($block->{parsed}) {$result = $result->string} else {$result = '{'.$result->TeX.'}'}
  608   }
  609   return $result;
  610 }
  611 
  612 sub replaceCommand {
  613   my $self = shift; my $item = shift;
  614   my $cmd = $item->{text};
  615   my ($result,$error) = PGML::Eval($cmd);
  616   PGML::Warning "Error evaluating command: $error" if $error;
  617   $result = "" unless defined $result;
  618   return $result;
  619 }
  620 
  621 ######################################################################
  622 ######################################################################
  623 
  624 package PGML::Item;
  625 
  626 sub new {
  627   my $self = shift; my $class = ref($self) || $self;
  628   my $type = shift; my $fields = shift || {};
  629   bless {type => $type, %$fields}, $class;
  630 }
  631 
  632 sub show {
  633   my $self = shift; my $indent = shift || "";
  634   my @strings = ();
  635   foreach my $id (PGML::Sort(keys %$self)) {
  636     next if $id eq "stack";
  637     if (ref($self->{$id}) eq 'ARRAY') {
  638       push(@strings,$indent.$id.": [".join(',',map {"'".$self->quote($_)."'"} @{$self->{$id}})."]");
  639     } else {
  640       push(@strings,$indent.$id.": '".$self->quote($self->{$id})."'");
  641     }
  642   }
  643   return join("\n",@strings);
  644 }
  645 
  646 sub quote {
  647   my $self = shift;
  648   my $string = shift;
  649   $string =~ s/\n/\\n/g;
  650   $string =~ s/\t/\\t/g;
  651   return $string;
  652 }
  653 
  654 ######################################################################
  655 
  656 package PGML::Block;
  657 our @ISA = ('PGML::Item');
  658 
  659 sub new {
  660   my $self = shift; my $type = shift; my $fields = shift || {};
  661   $self->SUPER::new($type, {
  662     %$fields,
  663     stack => [],
  664   });
  665 }
  666 
  667 sub pushText {
  668   my $self = shift; my $text = shift; my $force = shift;
  669   return if $text eq "" && !$force;
  670   my $top = $self->topItem;
  671   if ($top->{type} ne "text") {$self->pushItem(PGML::Text->new($text))}
  672                          else {$top->pushText($text)}
  673 }
  674 
  675 sub pushItem {
  676   my $self = shift;
  677   push(@{$self->{stack}},@_);
  678 }
  679 
  680 sub topItem {
  681   my $self = shift; my $i = shift || -1;
  682   return $self->{stack}[$i] || PGML::Block->new("null");
  683 }
  684 
  685 sub popItem {
  686   my $self = shift;
  687   pop(@{$self->{stack}});
  688 }
  689 
  690 sub combineTopItems {
  691   my $self = shift; my $i = shift; $i = -1 unless defined $i;
  692   my $top = $self->topItem($i); my $prev = $self->topItem($i-1); my $par;
  693   if ($prev->{type} eq 'par' && $top->{combine}{par}) {$par = $prev; $prev = $self->topItem($i-2)}
  694   my $id = $top->{combine}{$prev->{type}}; my $value; my $inside = 0;
  695   if ($id) {
  696     if (ref($id) eq 'HASH') {($id,$value) = %$id; $inside = 1} else {$value = $prev->{$id}}
  697     if ($top->{$id} eq $value) {
  698       #
  699       #  Combine identical blocks
  700       #
  701       $prev = $prev->topItem if $inside;
  702       splice(@{$self->{stack}},$i,1);
  703       if ($par) {splice(@{$self->{stack}},$i,1); $prev->pushItem($par)}
  704       $i = -scalar(@{$top->{stack}});
  705       $prev->pushItem(@{$top->{stack}});
  706       $prev->combineTopItems($i) if $prev->{type} ne 'text' && $prev->topItem($i)->{combine};
  707       return;
  708     } elsif ($top->{type} eq 'indent' & $prev->{type} eq 'indent' &&
  709        $top->{indent} > $prev->{indent} && $prev->{indent} > 0) {
  710       #
  711       #  Move larger indentations into smaller ones
  712       #
  713       splice(@{$self->{stack}},$i,1);
  714       if ($par) {splice(@{$self->{stack}},$i,1); $prev->pushItem($par)}
  715       $top->{indent} -= $prev->{indent};
  716       $prev->pushItem($top);
  717       $prev->combineTopItems;
  718       return;
  719     }
  720   }
  721 return;
  722   #
  723   #  Remove unneeded zero indents
  724   #
  725   if ($top->{type} eq 'indent' && $top->{indent} == 0) {
  726     splice(@{$self->{stack}},$i,1,@{$top->{stack}});
  727     $top = $self->topItem($i);
  728     $self->combineTopItems($i) if $top->{combine};
  729   }
  730 }
  731 
  732 sub show {
  733   my $self = shift; my $indent = shift || "";
  734   my @strings = ($self->SUPER::show($indent));
  735   if ($self->{stack}) {
  736     push(@strings,$indent."stack: [");
  737     foreach my $i (0..scalar(@{$self->{stack}})-1) {
  738       my $item = $self->{stack}[$i];
  739       if (ref($item)) {
  740   push(@strings,"$indent  [ # $i");
  741   push(@strings,$item->show($indent."    "));
  742   push(@strings,"$indent  ]");
  743       } else {
  744   push(@strings,"$indent  $i: '$item',");
  745       }
  746     }
  747     push(@strings,$indent."]");
  748   }
  749   return join("\n",@strings);
  750 }
  751 
  752 ######################################################################
  753 
  754 package PGML::Root;
  755 our @ISA = ('PGML::Block');
  756 
  757 sub new {
  758   my $self = shift; my $parser = shift;
  759   return $self->SUPER::new("root",{parseAll => 1, parser => $parser});
  760 }
  761 
  762 sub pushItem {
  763   my $self = shift; my $item;
  764   while ($item = shift) {
  765     my $parser = $self->{parser};
  766     if (!$item->{noIndent} || ($parser->{indent} && $item->{noIndent} < 0)) {
  767       $parser->{block} = PGML::Block->new("indent",{
  768    prev => $self, indent => $parser->{indent}, parseAll => 1,
  769    combine => {indent => "indent", list => {indent => 1}, par => 1}
  770       });
  771       $parser->{block}->pushItem($item,@_); @_ = ();
  772       $item = $parser->{block};
  773     }
  774     push(@{$self->{stack}},$item);
  775   }
  776 }
  777 
  778 
  779 ######################################################################
  780 ######################################################################
  781 
  782 package PGML::Text;
  783 our @ISA = ('PGML::Item');
  784 
  785 sub new {
  786   my $self = shift;
  787   $self->SUPER::new("text",{stack=>[@_], combine => {text => "type"}});
  788     }
  789 
  790 sub pushText {
  791   my $self = shift;
  792   foreach my $text (@_) {push(@{$self->{stack}},$text) if $text ne ""}
  793   }
  794 
  795 sub pushItem {
  796   my $self = shift;
  797   $self->pushText(@_);
  798 }
  799 
  800 sub show {
  801   my $self = shift; my $indent = shift;
  802   my @strings = ($self->SUPER::show($indent));
  803   push(@strings,$indent."stack: ['".join("','",map {$self->quote($_)} @{$self->{stack}})."']");
  804   return join("\n",@strings);
  805   }
  806 
  807 ######################################################################
  808 ######################################################################
  809 
  810 package PGML::Format;
  811 
  812 sub new {
  813   my $self = shift; my $class = ref($self) || $self;
  814   my $parser = shift;
  815   bless {parser => $parser}, $class;
  816   }
  817 
  818 sub format {
  819   my $self = shift;
  820   return $self->string($self->{parser}{root});
  821 }
  822 
  823 sub string {
  824   my $self = shift; my $block = shift;
  825   my @strings = (); my $string;
  826   foreach my $item (@{$block->{stack}}) {
  827     $self->{item} = $item;
  828     $self->{nl} = (!defined($strings[-1]) || $strings[-1] =~ m/\n$/ ? "" : "\n");
  829 # warn "type: $item->{type}";
  830     for ($item->{type}) {
  831       /indent/   && do {$string = $self->Indent($item); last};
  832       /align/    && do {$string = $self->Align($item); last};
  833       /par/      && do {$string = $self->Par($item); last};
  834       /list/     && do {$string = $self->List($item); last};
  835       /bullet/   && do {$string = $self->Bullet($item); last};
  836       /text/     && do {$string = $self->Text($item); last};
  837       /variable/ && do {$string = $self->Variable($item,$block); last};
  838       /command/  && do {$string = $self->Command($item); last};
  839       /math/     && do {$string = $self->Math($item); last};
  840       /answer/   && do {$string = $self->Answer($item); last};
  841       /bold/     && do {$string = $self->Bold($item); last};
  842       /italic/   && do {$string = $self->Italic($item); last};
  843       /heading/  && do {$string = $self->Heading($item); last};
  844       /quote/    && do {$string = $self->Quote($item,$strings[-1] || ''); last};
  845       /rule/     && do {$string = $self->Rule($item); last};
  846       /pre/      && do {$string = $self->Pre($item); last};
  847       /verbatim/ && do {$string = $self->Verbatim($item); last};
  848       /break/    && do {$string = $self->Break($item); last};
  849       /forced/   && do {$string = $self->Forced($item); last};
  850       /comment/  && do {$string = $self->Comment($item); last};
  851       PGML::Warning "Warning: unknown block type '$item->{type}' in ".ref($self)."::format\n";
  852     }
  853     push(@strings,$string) unless $string eq '';
  854   }
  855   $self->{nl} = (!defined($strings[-1]) || $strings[-1] =~ m/\n$/ ? "" : "\n");
  856   return join('',@strings);
  857 }
  858 
  859 sub nl {
  860   my $self = shift;
  861   my $nl = $self->{nl}; $self->{nl} = "";
  862   return $nl;
  863 }
  864 
  865 sub Escape   {shift; shift}
  866 
  867 
  868 sub Indent   {return ""}
  869 sub Align    {return ""}
  870 sub Par      {return ""}
  871 sub List     {return ""}
  872 sub Bullet   {return ""}
  873 sub Bold     {return ""}
  874 sub Italic   {return ""}
  875 sub Heading  {return ""}
  876 sub Quote    {return ""}
  877 sub Rule     {return ""}
  878 sub Pre      {return ""}
  879 sub Verbatim {return ""}
  880 sub Break    {return ""}
  881 sub Forced   {return ""}
  882 sub Comment  {return ""}
  883 
  884 sub Math {
  885   my $self = shift; my $item = shift; my $math = $item->{text};
  886   if ($item->{parsed}) {
  887     my $context = $main::context{Typeset};
  888     $context = $main::context{current} if $item->{hasStar};
  889     if ($item->{context}) {
  890       if (Value::isContext($item->{context})) {$context = $item->{context}}
  891       else {$context = Parser::Context->getCopy(undef,$item->{context})}
  892     }
  893     $context->clearError;
  894     my $obj = Parser::Formula($context,$math);
  895     if ($context->{error}{flag}) {
  896       PGML::Warning "Error parsing mathematics: $context->{error}{message}";
  897       return "(math error)";
  898     }
  899     $math = $obj->TeX;
  900   }
  901   $math = "\\displaystyle{$math}" if $item->{display};
  902   return $math;
  903 }
  904 
  905 sub Answer {
  906   my $self = shift; my $item = shift;
  907   my $ans = $item->{answer};
  908   $item->{width} = length($item->{token})-2 if (!defined($item->{width}));
  909   if (defined($ans)) {
  910     if (ref($ans) =~ /CODE|AnswerEvaluator/) {
  911       if (defined($item->{name})) {
  912   main::NAMED_ANS($item->{name} => $ans);
  913   return main::NAMED_ANS_RULE($item->{name},$item->{width});
  914       } else {
  915   main::ANS($ans);
  916   return main::ans_rule($item->{width});
  917       }
  918     }
  919     unless (Value::isValue($ans)) {
  920       $ans = Parser::Formula($item->{answer});
  921       if (defined($ans)) {
  922   $ans = $ans->eval if $ans->isConstant;
  923   $ans->{correct_ans} = "$item->{answer}";
  924   $item->{answer} = $ans;
  925       } else {
  926   PGML::Warning "Error parsing answer: ".Value->context->{error}{message};
  927   $ans = main::String("");  ### use something else?
  928       }
  929     }
  930     my @options = ($item->{width});
  931     my $method = ($item->{hasStar} ? "ans_array" : "ans_rule");
  932     if ($item->{name}) {
  933       unshift(@options,$item->{name});
  934       $method = "named_".$method;
  935     }
  936     main::ANS($ans->cmp) unless ref($ans) eq 'MultiAnswer' && $ans->{part} > 1;
  937     if ($item->{hasStar}) {
  938       my $output = $ans->$method(@options);
  939       $output =~ s!\\!\\\\!g;
  940       return main::EV3($output);
  941     } else {return $ans->$method(@options)}
  942   } else {
  943     return main::NAMED_ANS_RULE($item->{name},$item->{width}) if defined $item->{name};
  944     return main::ans_rule($item->{width});
  945   }
  946 }
  947 
  948 sub Command {
  949   my $self = shift; my $item = shift;
  950   my $text = $self->{parser}->replaceCommand($item);
  951   $text = $self->Escape($text) unless $item->{hasStar};
  952   return $text;
  953 }
  954 
  955 sub Variable {
  956   my $self = shift; my $item = shift; my $cur = shift;
  957   my $text = $self->{parser}->replaceVariable($item,$cur);
  958   $text = $self->Escape($text) unless $item->{hasStar};
  959   return $text;
  960 }
  961 
  962 sub Text {
  963   my $self = shift; my $item = shift;
  964   my $text = $self->{parser}->replaceText($item);
  965   $text =~ s/^\n+// if substr($text,0,1) eq "\n" && $self->nl eq "";
  966   return $self->Escape($text);
  967 }
  968 
  969 ######################################################################
  970 ######################################################################
  971 
  972 package PGML::Format::html;
  973 our @ISA = ('PGML::Format');
  974 
  975 sub Escape {
  976   my $self = shift;
  977   my $string = shift; return "" unless defined $string;
  978   $string =~ s/&/\&amp;/g;
  979   $string =~ s/</&lt;/g;
  980   $string =~ s/>/&gt;/g;
  981   $string =~ s/"/&quot;/g;
  982   return $string;
  983 }
  984 
  985 sub Indent {
  986   my $self = shift; my $item = shift;
  987   return $self->string($item) if $item->{indent} == 0;
  988   my $em = 2.25 * $item->{indent};
  989   return
  990     $self->nl .
  991     '<div style="margin:0 0 0 '.$em.'em">'."\n" .
  992     $self->string($item) .
  993     $self->nl .
  994     "</div>\n";
  995 }
  996 
  997 sub Align {
  998   my $self = shift; my $item = shift;
  999   return
 1000     $self->nl .
 1001     '<div style="text-align:'.$item->{align}.'; margin:0">'."\n" .
 1002     $self->string($item) .
 1003     $self->nl .
 1004     "</div>\n";
 1005 }
 1006 
 1007 my %bullet = (
 1008   bullet  => 'ul',
 1009   numeric => 'ol',
 1010   alpha   => 'ol type="a"',
 1011   Alpha   => 'ol type="A"',
 1012   roman   => 'ol type="i"',
 1013   Roman   => 'ol type="I"',
 1014   circle  => 'ul type="circle"',
 1015   square  => 'ul type="square"',
 1016 );
 1017 sub List {
 1018   my $self = shift; my $item = shift;
 1019   my $list = $bullet{$item->{bullet}};
 1020   return
 1021     $self->nl .
 1022     '<'.$list.' style="margin:0; padding-left:2.25em">'."\n" .
 1023     $self->string($item) .
 1024     $self->nl .
 1025     "</".substr($list,0,2).">\n";
 1026 }
 1027 
 1028 sub Bullet {
 1029   my $self = shift; my $item = shift;
 1030   return $self->nl.'<li>'.$self->string($item)."</li>\n";
 1031 }
 1032 
 1033 sub Pre {
 1034   my $self = shift; my $item = shift;
 1035   return
 1036     $self->nl .
 1037     '<pre style="margin:0"><code>' .
 1038     $self->string($item) .
 1039     "</code></pre>\n";
 1040 }
 1041 
 1042 sub Heading {
 1043   my $self = shift; my $item = shift;
 1044   my $n = $item->{n};
 1045   my $text = $self->string($item);
 1046   $text =~ s/^ +| +$//gm; $text =~ s! +(<br />)!$1!g;
 1047   return '<h'.$n.' style="margin:0">'.$text."</h$n>\n";
 1048 }
 1049 
 1050 sub Par {
 1051   my $self = shift; my $item = shift;
 1052   return $self->nl.'<p style="margin-bottom:0">'."\n"
 1053 }
 1054 
 1055 sub Break {"<br />\n"}
 1056 
 1057 sub Bold {
 1058   my $self = shift; my $item = shift;
 1059   return '<b>'.$self->string($item).'</b>';
 1060 }
 1061 
 1062 sub Italic {
 1063   my $self = shift; my $item = shift;
 1064   return '<i>'.$self->string($item).'</i>';
 1065 }
 1066 
 1067 my %openQuote = ('"' => "&#x201C;", "'" => "&#x2018;");
 1068 my %closeQuote = ('"' => "&#x201D;", "'" => "&#x2019;");
 1069 sub Quote {
 1070   my $self = shift; my $item = shift; my $string = shift;
 1071   return $openQuote{$item->{token}} if $string eq "" || $string =~ m/(^|[ ({\[\s])$/;
 1072   return $closeQuote{$item->{token}};
 1073 }
 1074 
 1075 sub Rule {
 1076   my $self = shift; my $item = shift;
 1077   my $width = " width:100%; "; my $size = "";
 1078   $width = ' width:'.$item->{width}.'; ' if defined $item->{width};
 1079   $size = ' size="'.$item->{size}.'"' if defined $item->{size};
 1080   my $html = '<hr'.$size.' style="margin:.3em auto" />';
 1081   $html = '<div>'.
 1082           '<span style="'.$width.'display:-moz-inline-box; display:inline-block; margin:.3em auto">'.
 1083              $html.
 1084           '</span>'.
 1085           '</div>'; # if $width ne '' && $item->{width} !~ m/%/;
 1086   return $self->nl.$html."\n";
 1087 }
 1088 
 1089 sub Verbatim {
 1090   my $self = shift; my $item = shift;
 1091   my $text = $self->Escape($item->{text});
 1092   $text = "<code>$text</code>" if $item->{hasStar};
 1093   return $text;
 1094 }
 1095 
 1096 sub Math {
 1097   my $self = shift;
 1098   return main::math_ev3($self->SUPER::Math(@_));
 1099 }
 1100 
 1101 ######################################################################
 1102 ######################################################################
 1103 
 1104 package PGML::Format::tex;
 1105 our @ISA = ('PGML::Format');
 1106 
 1107 my %escape = (
 1108   '"'  => '{\ttfamily\char34}',
 1109   "\#" => '{\ttfamily\char35}',
 1110   '$'  => '\$',
 1111   '%'  => '\%',
 1112   '&'  => '\&',
 1113   '<'  => '{\ttfamily\char60}',
 1114   '>'  => '{\ttfamily\char62}',
 1115   '\\' => '{\ttfamily\char92}',
 1116   '^'  => '{\ttfamily\char94}',
 1117   '_'  => '\_',
 1118   '{'  => '{\ttfamily\char123}',
 1119   '|'  => '{\ttfamily\char124}',
 1120   '}'  => '{\ttfamily\char125}',
 1121   '~'  => '{\ttfamily\char126}',
 1122 );
 1123 
 1124 sub Escape {
 1125   my $self = shift;
 1126   my $string = shift; return "" unless defined($string);
 1127   $string =~ s/(["\#\$%&<>\\^_\{|\}~])/$escape{$1}/eg;
 1128   return $string;
 1129 }
 1130 
 1131 sub Indent {
 1132   my $self = shift; my $item = shift;
 1133   return $self->string($item) if $item->{indent} == 0;
 1134   my $em = 2.25 * $item->{indent};
 1135   return
 1136     $self->nl .
 1137     "{\\pgmlIndent\n" .
 1138     $self->string($item) .
 1139     $self->nl .
 1140     "\\par}%\n";
 1141 }
 1142 
 1143 sub Align {
 1144   my $self = shift; my $item = shift;
 1145   my $align = uc(substr($item->{align},0,1)).substr($item->{align},1);
 1146   return
 1147     $self->nl .
 1148     "{\\pgml${align}{}" .
 1149     $self->string($item) .
 1150     $self->nl .
 1151     "\\par}%\n";
 1152 }
 1153 
 1154 sub List {
 1155   my $self = shift; my $item = shift;
 1156   return
 1157     $self->nl .
 1158     "{\\pgmlIndent\\let\\pgmlItem=\\pgml$item->{bullet}Item\n".
 1159     $self->string($item) .
 1160     $self->nl .
 1161     "\\par}%\n";
 1162 }
 1163 
 1164 sub Bullet {
 1165   my $self = shift; my $item = shift;
 1166   return $self->nl."\\pgmlItem{}".$self->string($item)."\n";
 1167 }
 1168 
 1169 sub Pre {
 1170   my $self = shift; my $item = shift;
 1171   return
 1172     $self->nl .
 1173     "{\\pgmlPreformatted%\n" .
 1174     $self->string($item) .
 1175     "\\par}%\n";
 1176 }
 1177 
 1178 sub Heading {
 1179   my $self = shift; my $item = shift;
 1180   my $n = $item->{n};
 1181   my $text = $self->string($item);
 1182   $text =~ s/^ +| +$//gm; $text =~ s/ +(\\pgmlBreak)/$1/g;
 1183   return "{\\pgmlHeading{$n}$text\\par}%\n";
 1184 }
 1185 
 1186 sub Par {
 1187   my $self = shift; my $item = shift;
 1188   return $self->nl."\\vskip\\baselineskip\n";
 1189 }
 1190 
 1191 sub Break {"\\pgmlBreak\n"}
 1192 
 1193 sub Bold {
 1194   my $self = shift; my $item = shift;
 1195   return "{\\bfseries{}".$self->string($item)."}";
 1196 }
 1197 
 1198 sub Italic {
 1199   my $self = shift; my $item = shift;
 1200   return "{\\itshape{}".$self->string($item)."}";
 1201 }
 1202 
 1203 my %openQuote = ('"' => "``", "'" => "`");
 1204 my %closeQuote = ('"' => "''", "'" => "'");
 1205 sub Quote {
 1206   my $self = shift; my $item = shift; my $string = shift;
 1207   return $openQuote{$item->{token}} if $string eq "" || $string =~ m/(^|[ ({\[\s])$/;
 1208   return $closeQuote{$item->{token}};
 1209 }
 1210 
 1211 sub Rule {
 1212   my $self = shift; my $item = shift;
 1213   my $width = "100%"; my $size = "1";
 1214   $width = $item->{width} if defined $item->{width};
 1215   $size = $item->{size} if defined $item->{size};
 1216   $width =~ s/%/\\pgmlPercent/; $size =~ s/%/\\pgmlPercent/;
 1217   $width .= "\\pgmlPixels" if $width =~ m/^\d+$/;
 1218   $size .= "\\pgmlPixels" if $size =~ m/^\d+$/;
 1219   return $self->nl."\\pgmlRule{$width}{$size}%\n";
 1220 }
 1221 
 1222 sub Verbatim {
 1223   my $self = shift; my $item = shift;
 1224   my $text = $self->Escape($item->{text});
 1225   $text = "{\\tt{}$text}" if $item->{hasStar};
 1226   return $text;
 1227 }
 1228 
 1229 sub Math {
 1230   my $self = shift;
 1231   return "\$".$self->SUPER::Math(@_)."\$";
 1232 }
 1233 
 1234 ######################################################################
 1235 ######################################################################
 1236 
 1237 package PGML;
 1238 
 1239 sub Format {
 1240   ClearWarnings;
 1241   my $parser = PGML::Parse->new(shift);
 1242   my $format;
 1243   if ($main::displayMode eq 'TeX') {
 1244     $format = "{\\pgmlSetup\n".PGML::Format::tex->new($parser)->format."\\par}%\n";
 1245   } else {
 1246     $format = '<div class="PGML">'."\n".PGML::Format::html->new($parser)->format.'</div>'."\n";
 1247   }
 1248   warn join("\n","==================","Errors parsing PGML:",@warnings,"==================\n") if scalar(@warnings);
 1249   return $format;
 1250 }
 1251 
 1252 sub Format2 {
 1253   my $string = shift;
 1254   $string =~ s/\\\\/\\/g;
 1255   PGML::Format($string);
 1256 }
 1257 
 1258 ######################################################################
 1259 #
 1260 #  TeX code needed for PGML in hardcopy
 1261 #
 1262 
 1263 our $preamble = <<'END_PREAMBLE';
 1264 \ifdim\lastskip=\pgmlMarker
 1265   \let\pgmlPar=\relax
 1266  \else
 1267   \let\pgmlPar=\par
 1268   \vadjust{\kern3pt}%
 1269 \fi
 1270 
 1271 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 1272 %
 1273 %    definitions for PGML
 1274 %
 1275 
 1276 \ifx\pgmlCount\undefined  % don not redefine if multiple files load PGML.pl
 1277   \newcount\pgmlCount
 1278   \newdimen\pgmlPercent
 1279   \newdimen\pgmlPixels  \pgmlPixels=.5pt
 1280 \fi
 1281 \pgmlPercent=.01\hsize
 1282 
 1283 \def\pgmlSetup{%
 1284   \parskip=0pt \parindent=0pt
 1285 %  \ifdim\lastskip=\pgmlMarker\else\par\fi
 1286   \pgmlPar
 1287 }%
 1288 
 1289 \def\pgmlIndent{\par\advance\leftskip by 2em \advance\pgmlPercent by .02em \pgmlCount=0}%
 1290 \def\pgmlbulletItem{\par\indent\llap{$\bullet$ }\ignorespaces}%
 1291 \def\pgmlcircleItem{\par\indent\llap{$\circ$ }\ignorespaces}%
 1292 \def\pgmlsquareItem{\par\indent\llap{\vrule height 1ex width .75ex depth -.25ex\ }\ignorespaces}%
 1293 \def\pgmlnumericItem{\par\indent\advance\pgmlCount by 1 \llap{\the\pgmlCount. }\ignorespaces}%
 1294 \def\pgmlalphaItem{\par\indent{\advance\pgmlCount by `\a \llap{\char\pgmlCount. }}\advance\pgmlCount by 1\ignorespaces}%
 1295 \def\pgmlAlphaItem{\par\indent{\advance\pgmlCount by `\A \llap{\char\pgmlCount. }}\advance\pgmlCount by 1\ignorespaces}%
 1296 \def\pgmlromanItem{\par\indent\advance\pgmlCount by 1 \llap{\romannumeral\pgmlCount. }\ignorespaces}%
 1297 \def\pgmlRomanItem{\par\indent\advance\pgmlCount by 1 \llap{\uppercase\expandafter{\romannumeral\pgmlCount}. }\ignorespaces}%
 1298 
 1299 \def\pgmlCenter{%
 1300   \par \parfillskip=0pt
 1301   \advance\leftskip by 0pt plus .5\hsize
 1302   \advance\rightskip by 0pt plus .5\hsize
 1303   \def\pgmlBreak{\break}%
 1304 }%
 1305 \def\pgmlRight{%
 1306   \par \parfillskip=0pt
 1307   \advance\leftskip by 0pt plus \hsize
 1308   \def\pgmlBreak{\break}%
 1309 }%
 1310 
 1311 \def\pgmlBreak{\\}%
 1312 
 1313 \def\pgmlHeading#1{%
 1314   \par\bfseries
 1315   \ifcase#1 \or\huge \or\LARGE \or\large \or\normalsize \or\footnotesize \or\scriptsize \fi
 1316 }%
 1317 
 1318 \def\pgmlRule#1#2{%
 1319   \par\noindent
 1320   \hbox{%
 1321     \strut%
 1322     \dimen1=\ht\strutbox%
 1323     \advance\dimen1 by -#2%
 1324     \divide\dimen1 by 2%
 1325     \advance\dimen2 by -\dp\strutbox%
 1326     \raise\dimen1\hbox{\vrule width #1 height #2 depth 0pt}%
 1327   }%
 1328   \par
 1329 }%
 1330 
 1331 \def\pgmlIC#1{\futurelet\pgmlNext\pgmlCheckIC}%
 1332 \def\pgmlCheckIC{\ifx\pgmlNext\pgmlSpace \/\fi}%
 1333 {\def\getSpace#1{\global\let\pgmlSpace= }\getSpace{} }%
 1334 
 1335 {\catcode`\ =12\global\let\pgmlSpaceChar= }%
 1336 {\obeylines\gdef\pgmlPreformatted{\par\small\ttfamily\hsize=10\hsize\obeyspaces\obeylines\let^^M=\pgmlNL\pgmlNL}}%
 1337 \def\pgmlNL{\par\bgroup\catcode`\ =12\pgmlTestSpace}%
 1338 \def\pgmlTestSpace{\futurelet\next\pgmlTestChar}%
 1339 \def\pgmlTestChar{\ifx\next\pgmlSpaceChar\ \pgmlTestNext\fi\egroup}%
 1340 \def\pgmlTestNext\fi\egroup#1{\fi\pgmlTestSpace}%
 1341 
 1342 \def^^M{\ifmmode\else\space\fi\ignorespaces}%
 1343 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 1344 END_PREAMBLE
 1345 
 1346 ######################################################################
 1347 
 1348 package main;
 1349 
 1350 sub _PGML_init {
 1351   $problemPreamble->{TeX} .= $PGML::preamble unless $problemPreamble->{TeX} =~ m/definitions for PGML/;
 1352   if (defined($BR)) {
 1353     ## Avoid bad spacing at the top of the problem (need to modify hardcopyPreamble.tex)
 1354     TEXT(MODES(HTML=>'', TeX=>'
 1355       \ifx\pgmlMarker\undefined
 1356         \newdimen\pgmlMarker \pgmlMarker=0.00314159pt  % hack to lett if \newline was used
 1357       \fi
 1358       \ifx\oldnewline\undefined \let\oldnewline=\newline \fi
 1359       \def\newline{\oldnewline\hskip-\pgmlMarker\hskip\pgmlMarker\relax}%
 1360       \parindent=0pt
 1361       \catcode`\^^M=\active
 1362       \def^^M{\ifmmode\else\fi\ignorespaces}%  skip paragraph breaks in the preamble
 1363       \def\par{\ifmmode\else\endgraf\fi\ignorespaces}%
 1364     '));
 1365   }
 1366   if (!defined($BR)) {PGML::Eval("sub lex_sort {return sort(\@_)}")}  # hack to be able to run this on the command line
 1367 }
 1368 
 1369 ######################################################################
 1370 
 1371 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9