Parent Directory
| 
Revision Log
commiting PGML.pl
1 package PGML; 2 3 ###################################################################### 4 5 my %terminate; # defined below; 6 my %initiate; # defined below; 7 8 ###################################################################### 9 10 my $indent = '^\t+'; 11 my $linebreak = '\n+'; 12 my $lineend = "(?: |(?: +<<| #+) *)\$"; 13 my $linestart = ' *[-+*o] +|(?:---+|===+)(?= *(?:\{.*?\} *)?$)|#+ |(?:\d+|[a-zA-Z])\. +|>> +|: '; 14 my $emphasis = ' ?\*+ ?|(?:^|(?<=\t)| )_+(?=[^_\s]|$)|(?<=[^_\s])_+(?: |$)'; 15 #my $chars = '\\\\.|(?:(?<=\])|(?<=\]\*))\n(?:\t+)? *\{|[{}[\]\'"]'; # allows { on next line after ] 16 my $chars = '\\\\.|[{}[\]\'"]'; 17 my $ansrule = '\[(?:_+|[ox^])\]\*?'; 18 my $open = '\[(?:[!<%@$]|::?|``?|\|+)'; 19 my $close = '(?:[!>%@$]|::?|``?|\|+)\]'; 20 21 my $linestart = "^(?:$linestart)|(?<=\\t)(?:$linestart)"; 22 23 my $splitPattern = qr/($indent|$linestart|$open|$ansrule|$close|$lineend|$linebreak|$emphasis|$chars)/m; 24 25 sub splitString { 26 my $string = shift; 27 $string =~ s/\t/ /g; # turn tabs into spaces 28 $string =~ s!^((?: )+)!"\t"x(length($1)/4)!gme; # make initial indent into tabs 29 $string =~ s!^(?:\t* +|\t+ *)$!!gm; # make blank lines blank 30 return split($splitPattern,$string); 31 } 32 33 ###################################################################### 34 ###################################################################### 35 36 sub startBlock { 37 my ($stack,$type,$indent) = @_; 38 $type = "block" unless $type; 39 my $block; my $top = topBlock($stack); 40 if ($top && $top->{typpe} eq 'block' && $top->{stack} && scalar(@{$top->{stack}}) == 0) { 41 $block = $top; 42 $block->{type} = $type; 43 $block->{indent} = $indent if defined $indent; 44 } else { 45 $block = { 46 type => $type, indent => ($indent || 0), 47 stack => [], parseAll => 1, 48 }; 49 push(@{$stack},$block); 50 } 51 return $block; 52 } 53 54 sub endBlock { 55 my $stack = shift; my $cur = shift; my $action = shift || "paragraph ends"; 56 collapseText($cur); 57 popWithError($cur,"'%s' was not closed before $action") if ref($cur->{terminator}) eq 'Regexp' || $cur->{cancelPar}; 58 my $block = topBlock($stack); 59 delete $block->{parseAll}; delete $block->{pendingIndent}; delete $block->{ignoreNL}; 60 } 61 62 sub topBlock {shift->[-1] || {}} 63 sub prevBlock {shift->[-2] || {}} 64 65 sub pushBlock { 66 my ($cur,$token,$stack,$action,$type,$flags) = @_; 67 endBlock($stack,$cur,$action); 68 if ($type) { 69 $cur = startBlock($stack,$type); 70 foreach my $field (keys %{$cur}) {delete $cur->{$field} unless $field eq 'type'} 71 $cur->{token} = $token; 72 } 73 $cur = startBlock($stack); 74 if ($flags) {foreach my $flag (keys %$flags) {$cur->{$flag} = $flags->{$flag}}} 75 $cur->{token} = $token unless defined $type; 76 return $cur; 77 } 78 79 sub pushText { 80 my $cur = shift; my $text = shift; 81 return if $text eq ""; 82 delete $cur->{pendingIndent}; delete $cur->{ignoreNL}; 83 push(@{$cur->{stack}},{type=>"text",phrases=>[]}) 84 if scalar(@{$cur->{stack}}) == 0 || $cur->{stack}[-1]{type} ne "text" || !$cur->{stack}[-1]{phrases}; 85 push(@{$cur->{stack}[-1]{phrases}},$text); 86 } 87 88 sub pushItem { 89 my ($cur,$token,$item) = @_; 90 delete $cur->{pendingIndent}; delete $cur->{ignoreNL}; 91 collapseText($cur); 92 $item = {%$item, stack=>[], prev=>$cur, token=>$token}; 93 return $item; 94 } 95 96 sub popItem { 97 my $cur = shift; 98 my $prev = $cur->{prev}; 99 pushText($prev,$cur->{token}); 100 push(@{$prev->{stack}},@{$cur->{stack}}); 101 pushText($prev,$cur->{terminator}) if $cur->{terminator} && ref($cur->{terminator}) ne 'Regexp'; 102 return $prev; 103 } 104 105 sub popWithError { 106 my $cur = shift; my $message = shift; 107 parseError($cur,$message); 108 return popItem($cur); 109 } 110 111 ###################################################################### 112 113 our @warnings = (); 114 our $warningsFatal = 0; 115 sub Warning { 116 my $warning = join("",@_); 117 $warning =~ s/ at line \d+ of \(eval \d+\)//; 118 $warning =~ s/ at \(eval \d+\) line \d+//; 119 $warning =~ s/, at EOF$//; 120 die $warning if $warningsFatal; 121 push @warnings,$warning; 122 } 123 sub ClearWarnings {@warnings = ()}; 124 125 sub parseError { 126 my $cur = shift; my $message = shift; 127 my $name = $cur->{token}; $name =~ s/^\s+|\s+$//g; 128 $message = sprintf($message,$name); 129 Warning "Error parsing PGML: $message"; 130 } 131 132 sub Eval {main::PG_restricted_eval(@_)} 133 134 ###################################################################### 135 ###################################################################### 136 137 sub parseList { 138 my $split = [@_]; my $i = 0; 139 my $stack = []; 140 my $cur = startBlock($stack); $cur->{ignoreNL} = 1; 141 while ($i < scalar(@$split)) { 142 pushText($cur,$split->[$i++]); 143 my $token = $split->[$i++]; 144 for ($token) { 145 $cur->{terminator} && /^$cur->{terminator}\z/ && do {$cur = parseEnd($cur,$token,$stack); last}; 146 /^\[[@\$]/ && ($cur->{parseAll} || $cur->{parseSubstitutions}) && do {$cur = parseBegin($cur,$token); last}; 147 /^\[%/ && ($cur->{parseAll} || $cur->{parseComments}) && do {$cur = parseBegin($cur,$token); last}; 148 /^\\./ && ($cur->{parseAll} || $cur->{parseSlashes}) && do {$cur = parseSlash($cur,$token); last}; 149 /^\n\z/ && do {$cur = parseLineBreak($cur,$token); last}; 150 /^\n\n+\z/ && do {$cur = parseParBreak($cur,$token,$stack); last}; 151 $cur->{balance} && /^$cur->{balance}/ && do {$cur = parseBegin($cur,$token,substr($token,0,1)); last}; 152 $cur->{balance} && /$cur->{balance}$/ && do {$cur = parseBegin($cur,$token,substr($token,-1,1)); last}; 153 $cur->{parseAll} && do {$cur = parseAll($cur,$token,$stack,$split,\$i); last}; 154 /^[\}\]]\z/ && do {$cur = parseUnbalanced($cur,$token); last}; 155 pushText($cur,$token); 156 } 157 } 158 endBlock($stack,$cur,"END_PGML"); 159 my $top = topBlock($stack); 160 pop(@$stack) if $top->{type} eq 'block' && scalar(@{$top->{stack}}) == 0; 161 return $stack 162 } 163 164 ###################################################################### 165 166 sub parseEnd { 167 my ($cur,$token,$stack) = @_; 168 my $prev = $cur->{prev}; collapseText($cur); 169 foreach my $field ("prev","parseComments","parseSubstitutions","parseSlashes", 170 "parseAll","cancelUnbalanced","cancelNL","cancelPar","balance") 171 {delete $cur->{$field}} 172 $cur->{terminator} = $token; delete $cur->{pendingIndent}; delete $cur->{ignoreNL}; 173 if (defined $terminate{$cur->{type}}) 174 {$prev = &{$terminate{$cur->{type}}}($prev,$cur,$stack)} else {push(@{$prev->{stack}},$cur)} 175 return $prev; 176 } 177 178 sub parseBegin { 179 my $cur = shift; my $token = shift; my $id = shift || $token; 180 return pushItem($cur,$token,$initiate{$id}); 181 } 182 183 sub parseBeginBlock { 184 my ($cur,$token,$stack,$action,$id) = @_; $id = $token unless defined($id); 185 my $top = topBlock($stack); my $indent; 186 $indent = $top->{indent} if $top->{pendingIndent}; 187 $cur = pushBlock($cur,$token,$stack,$action,undef,$initiate{$id}); 188 $cur->{indent} = $indent if defined $indent; 189 return $cur; 190 } 191 192 sub parseSlash { 193 my $cur = shift; my $token = shift; 194 pushText($cur,substr($token,1)); 195 return $cur; 196 } 197 198 sub parseLineBreak { 199 my $cur = shift; my $token = shift; 200 if ($cur->{ignoreNL}) {delete $cur->{ignoreNL}; return $cur} 201 $cur = popWithError($cur,"%s was not closed before line break") if $cur->{cancelNL}; 202 pushText($cur,$token); $cur->{ignoreNL} = 1; 203 return $cur; 204 } 205 206 sub parseParBreak { 207 my ($cur,$token,$stack) = @_; 208 return pushBlock($cur,$token,$stack,"paragraph break","par",{ignoreNL=>1}); 209 } 210 211 sub parseUnbalanced { 212 my ($cur,$token) = @_; 213 $cur = popWithError($cur,"parenthesis mismatch: %s terminated by $token") if $cur->{cancelUnbalanced}; 214 pushText($cur,$token); 215 return $cur; 216 } 217 218 sub parseAll { 219 my ($cur,$token,$stack,$split,$i) = @_; 220 return parseBegin($cur,$token) if (substr($token,0,1) eq "[" && $initiate{$token}); 221 for ($token) { 222 /\t/ && do {return parseIndent($cur,$token,$stack)}; 223 /\d+\. / && do {return parseBullet($cur,$token,$stack,"numeric")}; 224 /[a-z]\. /i && do {return parseBullet($cur,$token,$stack,"alpha")}; 225 /[-+o] / && do {return parseBullet($cur,$token,$stack,"bullet")}; 226 /\{/ && do {return parseBrace($cur,$token,$stack)}; 227 /\[\|/ && do {return parseVerbatim($cur,$token)}; 228 /\[./ && do {return parseAnswer($cur,$token)}; 229 /_/ && do {return parseEmphasis($cur,$token,$stack)}; 230 /\*/ && do {return parseStar($cur,$token,$stack)}; 231 /#/ && do {return parseHeading($cur,$token,$stack)}; 232 /-|=/ && do {return parseRule($cur,$token,$stack)}; 233 /^ $/ && do {return parseBreak($cur,$token)}; 234 / <</ && do {return parseCenter($cur,$token,$stack)}; 235 />> / && do {return parseBeginBlock($cur,$token,$stack,"start of aligned text",">> ")}; 236 /: / && do {return parseBeginBlock($cur,$token,$stack,"start of preformatted text")}; 237 pushText($cur,$token); 238 } 239 return $cur; 240 } 241 242 sub parseIndent { 243 my ($cur,$token,$stack) = @_; 244 my $indent = length($token); 245 my $block = topBlock($stack); 246 if (scalar(@{$block->{stack}}) == 0) { 247 $block->{indent} = $indent; 248 } elsif ($indent != $block->{indent}) { 249 $cur = pushBlock($cur,$token,$stack,"indentation change",undef,{indent=>$indent}) 250 } 251 $cur->{pendingIndent} = 1; 252 return $cur; 253 } 254 255 sub parseBullet { 256 my ($cur,$token,$stack,$type) = @_; 257 $cur = parseBeginBlock($cur,$token,$stack,"start of list item","bullet"); 258 $cur->{bullet} = $type; $cur->{indent}++; 259 return $cur; 260 } 261 262 sub parseStar { 263 my ($cur,$token,$stack) = @_; 264 if ($token =~ m/\*( *)/ && scalar(@{$cur->{stack}}) && $cur->{stack}[-1]{allowStar}) { 265 $cur->{stack}[-1]{hasStar} = 1; 266 pushText($cur,$1) if $1 ne ""; 267 return $cur; 268 } 269 return parseBullet($cur,$token,$stack,"bullet") 270 if $token =~ m/\* +/ && ($cur->{ignoreNL} || $cur->{pendingIndent}); 271 return parseEmphasis($cur,$token,$stack) 272 } 273 274 sub parseEmphasis { 275 my ($cur,$token,$stack) = @_; 276 my $stars = $token; $stars =~ s/ //g; 277 if (length($stars) <= 3) { 278 if ($cur->{type} eq 'emphasis') { 279 return parseEnd($cur,$token,$stack) 280 if $stars eq $cur->{stars} && $token =~ m/^\S/; 281 } elsif ($token !~ m/ $/) { 282 $cur = parseBegin($cur,$token,'*'); 283 $cur->{stars} = $stars; 284 return $cur; 285 } 286 } 287 pushText($cur,$token); 288 return $cur; 289 } 290 291 sub parseBrace { 292 my ($cur,$token,$stack) = @_; 293 my $top = topBlock($stack); my $prev = prevBlock($stack); 294 if (scalar(@{$cur->{stack}}) && $cur->{stack}[-1]{options}) { 295 $cur = parseBegin($cur,$token,' {'); 296 } elsif ($prev->{type} eq 'rule' && $top->{ignoreNL}) { 297 pop(@$stack); 298 $cur = {%{$initiate{' {'}},stack=>[],token=>$token,type=>'boptions'}; 299 push(@$tack,$cur); 300 } else {pushText($cur,$token)} 301 return $cur; 302 } 303 304 sub parseRule { 305 my ($cur,$token,$stack) = @_; 306 $cur = pushBlock($cur,$token,$stack,"horizontal rule","rule",{ignoreNL=>1}); 307 my $prev = prevBlock($stack); 308 $prev->{options} = ["width","size"]; 309 return $cur; 310 } 311 312 sub parseBreak { 313 my ($cur,$token) = @_; 314 delete $cur->{pendingIndent}; 315 push(@{$cur->{stack}},{type=>"break",token=>$token}); 316 return $cur; 317 } 318 319 sub parseVerbatim { 320 my ($cur,$token) = @_; 321 my $bars = "\\".join("\\",split('',substr($token,1))); 322 $cur = parseBegin($cur,$token,' [|'); 323 $cur->{terminator} = qr/$bars\]/; 324 return $cur; 325 } 326 327 sub parseAnswer { 328 my ($cur,$token) = @_; 329 collapseText($cur); 330 my @options = (); push(@options,hasStar=>1) if ($token =~ s/\*$//); 331 push(@{$cur->{stack}},{ 332 type=>"answer", 333 options=>["answer","width","name","array"], 334 token=>$token, 335 @options, 336 }); 337 return $cur; 338 } 339 340 sub parseHeading { 341 my ($cur,$token,$stack) = @_; 342 if ($token =~ m/^ /) { 343 my $block = topBlock($stack); 344 if ($block->{type} eq 'heading') { 345 my $stars = $token; $stars =~ s/[^\#]//g; 346 if ($cur->{n} == length($stars)) { 347 $block->{terminator} = $token; 348 push(@{$cur->{stack}},{type=>"break"}) if $token =~ m/ $/; 349 $cur = pushBlock($cur,$token,$stack,"end of heading",undef,{ignoreNL=>1}); 350 delete $cur->{token}; 351 } else {pushText($cur,$token)} 352 } else {pushText($cur,$token)} 353 } else { 354 my $stars = $token; $stars =~ s/[^\#]//g; 355 $cur = parseBeginBlock($cur,$token,$stack,"start of heading","# "); 356 $cur->{n} = length($stars); 357 } 358 return $cur; 359 } 360 361 sub parseCenter { 362 my ($cur,$token,$stack) = @_; 363 my $block = topBlock($stack); 364 if ($block->{align} eq 'right') { 365 $block->{align} = 'center'; 366 $block->{terminator} = $token; 367 push(@{$cur->{stack}},{type=>"break"}) if $token =~ m/ $/; 368 $cur = pushBlock($cur,$token,$stack,"end of centered text",undef,{ignoreNL=>1}); 369 } else {pushText($cur,$token)} 370 return $cur; 371 } 372 373 ###################################################################### 374 ###################################################################### 375 376 sub terminateComment { 377 my ($prev,$cur) = @_; 378 return $prev; 379 } 380 381 sub terminatePre { 382 my ($prev,$cur,$stack) = @_; 383 terminateGetString($prev,$cur); 384 return startBlock($stack); 385 } 386 387 sub terminateBlockOptions { 388 my ($prev,$cur,$stack) = @_; 389 terminateGetString($prev,$cur); pop(@$tack); 390 applyOptions(topBlock($stack),$cur->{text}); 391 $cur = startBlock($stack); 392 $cur->{ignoreNL} = 1; 393 return $cur; 394 } 395 396 sub terminateOptions { 397 my ($prev,$cur,$stack) = @_; 398 applyOptions($prev->{stack}[-1],stackString($cur)); 399 return $prev; 400 } 401 402 sub applyOptions { 403 my $cur = shift; my $options = shift; 404 if ($options =~ m/^[a-z_][a-z0-9_]*=>/i) { 405 my %allowed = (map {$_ => 1} (@{$cur->{options}})); 406 my ($options,$error) = Eval("{$options}"); 407 $options={},Warning "Error evaluating options: $error" if $error; 408 foreach my $option (keys %{$options}) { 409 if ($allowed{$option}) {$cur->{$option} = $options->{$option}} 410 else {Warning "Error: unknown option '$option'"} 411 } 412 } else { 413 foreach my $option (@{$cur->{options}}) { 414 if (!defined($cur->{$option})) { 415 if (!ref($options)) { 416 my ($value,$error) = Eval($options); 417 $options = $value unless $error; ### should give warning? only evaluate some answers? 418 } 419 $cur->{$option} = $options; 420 return; 421 } 422 } 423 Warning "Error: extra option '$options'"; 424 } 425 } 426 427 sub terminateBalance { 428 my ($prev,$cur) = @_; 429 pushText($prev,$cur->{token}.stackString($cur).$cur->{terminator}); 430 return $prev; 431 } 432 433 sub terminateGetString { 434 my ($prev,$cur) = @_; 435 $cur->{text} = stackString($cur); 436 delete $cur->{stack}; 437 push(@{$prev->{stack}},$cur); 438 return $prev; 439 } 440 441 ###################################################################### 442 443 sub stackString { 444 my $cur = shift; 445 my @strings = (); 446 foreach my $item (@{$cur->{stack}}) { 447 for ($item->{type}) { 448 /text/ && do {push(@strings,replaceText($item)); last}; 449 /variable/ && do {push(@strings,replaceVariable($item,$cur)); last}; 450 /command/ && do {push(@strings,replaceCommand($item)); last}; 451 Warning "Warning: unexpected type '$item->{type}' in stackString\n"; 452 } 453 } 454 return $strings[0] if scalar(@strings) == 1; 455 return join('',@strings); 456 } 457 458 sub replaceText { 459 my $item = shift; 460 return $item->{text} if defined $item->{text}; 461 return join('',@{$item->{phrases}}); 462 } 463 464 sub replaceVariable { 465 my $item = shift; my $cur = shift; 466 my $var = "\$main::" . $item->{text}; 467 ### check $var for whether it looks like a variable reference 468 my ($result,$error) = Eval($var); 469 Warning "Error evaluating variable \$$item->{text}: $error" if $error; 470 if ($cur->{type} eq 'math' && Value::isValue($result)) { 471 if ($cur->{parsed}) {$result = $result->string} else {$result = '{'.$result->TeX.'}'} 472 } 473 return $result; 474 } 475 476 sub replaceCommand { 477 my $item = shift; 478 my $cmd = $item->{text}; 479 my ($result,$error) = Eval($cmd); 480 Warning "Error evaluating command: $error" if $error; 481 return $result; 482 } 483 484 sub collapseText { 485 my $cur = shift; 486 return unless $cur->{stack} && scalar(@{$cur->{stack}}) && $cur->{stack}[-1]{type} eq 'text'; 487 $cur->{stack}[-1]{text} = join('',@{$cur->{stack}[-1]{phrases}}); 488 delete $cur->{stack}[-1]{phrases}; 489 } 490 491 ###################################################################### 492 493 %terminate = ( 494 comment => \&terminateComment, 495 pre => \&terminatePre, 496 boptions => \&terminateBlockOptions, 497 balance => \&terminateBalance, 498 variable => \&terminateGetString, 499 command => \&terminateGetString, 500 math => \&terminateGetString, 501 image => \&terminateGetString, 502 link => \&terminateGetString, 503 verbatim => \&terminateGetString, 504 options => \&terminateOptions, 505 ); 506 507 my $balanceAll = qr/[\{\[\'\"]/; 508 509 %initiate = ( 510 "[:" => {type=>'math', parseComments=>1, parseSubstitutions=>1, terminator=>qr/:\]/, parsed=>1, 511 options=>["context","reduced"]}, 512 "[::" => {type=>'math', parseComments=>1, parseSubstitutions=>1, terminator=>qr/::\]/, parsed=>1, display=>1, 513 options=>["context","reduced"]}, 514 "[`" => {type=>'math', parseComments=>1, parseSubstitutions=>1, terminator=>qr/\`\]/}, 515 "[``" => {type=>'math', parseComments=>1, parseSubstitutions=>1, terminator=>qr/\`\`\]/, display=>1}, 516 "[!" => {type=>'image', parseComments=>1, parseSubstitutions=>1, terminator=>qr/!\]/, cancelNL=>1, 517 options=>["title"]}, 518 "[<" => {type=>'link', parseComments=>1, parseSubstitutions=>1, terminator=>qr/>\]/, cancelNL=>1, 519 options->["text","title"]}, 520 "[%" => {type=>'comment', parseComments=>1, terminator=>qr/%\]/}, 521 "[\@" => {type=>'command', parseComments=>1, parseSubstitutions=>1, terminator=>qr/@\]/, 522 balance=>qr/[\'\"]/, allowStar=>1}, 523 "[\$" => {type=>'variable', parseComments=>1, parseSubstitutions=>1, terminator=>qr/\$?\]/, 524 balance=>$balanceAll, cancelUnbalanced=>1, cancelNL=>1, allowStar=>1}, 525 ' [|' => {type=>'verbatim', cancelNL=>1, allowStar=>1}, 526 " {" => {type=>'options', parseComments=>1, parseSubstitutions=>1, terminator=>qr/\}/, 527 balance=>$balanceAll, cancelUnbalanced=>1}, 528 "{" => {type=>'balance', parseComments=>1, parseSubstitutions=>1, terminator=>qr/\}/, 529 balance=>$balanceAll, cancelUnbalanced=>1}, 530 "[" => {type=>'balance', parseComments=>1, parseSubstitutions=>1, terminator=>qr/\]/, 531 balance=>$balanceAll, cancelUnbalanced=>1}, 532 "'" => {type=>'balance', terminator=>qr/\'/}, 533 '"' => {type=>'balance', terminator=>qr/\"/}, 534 ": " => {type=>'pre', terminator=>qr/\n+/}, 535 ">> " => {type=>'block', parseAll=>1, align=>"right"}, 536 "# " => {type=>'heading', parseAll=>1}, 537 "bullet" => {type=>'bullet', parseAll=>1}, 538 "*" => {type=>"emphasis", parseAll=>1, cancelPar=>1}, 539 ); 540 541 ###################################################################### 542 ###################################################################### 543 544 sub htmlString { 545 my $stack = shift; 546 my @strings = (); my $string; 547 my $indents = []; 548 foreach my $i (0..scalar(@$stack)-1) { 549 my $item = $stack->[$i]; 550 push(@strings,htmlIndent($item,$indents)) if defined $item->{indent}; 551 next if $item->{processed}; 552 for ($item->{type}) { 553 /block/ && do {push(@strings,htmlBlock($stack,$i)); last}; 554 /par/ && do {push(@strings,htmlPar($item)); last}; 555 /bullet/ && do {push(@strings,htmlBullet($stack,$i)); last}; 556 /heading/ && do {push(@strings,htmlHeading($stack,$i)); last}; 557 /rule/ && do {push(@strings,htmlRule($item)); last}; 558 /pre/ && do {push(@strings,htmlPre($stack,$i)); last}; 559 Warning "Warning: unknown block type: $item->{type}\n"; 560 } 561 } 562 while (scalar(@$indents)) {push(@strings,htmlStopIndent(pop(@$indents)))} 563 return join('',@strings); 564 } 565 566 my $block = {type => "block"}; 567 sub htmlIndent { 568 my $item = shift; my $indents = shift; 569 my $string; 570 if ($item->{indent} > scalar(@$indents)) { 571 while ($item->{indent}-1 > scalar(@$indents)) {$string .= htmlStartIndent($block); push(@$indents,$block)} 572 $string .= htmlStartIndent($item); push(@$indents,$item); 573 return $string; 574 } 575 while ($item->{indent} < scalar(@$indents)) {$string .= htmlStopIndent(pop(@$indents))} 576 if (scalar(@$indents) && $item->{type} eq 'bullet' && $indents->[-1]{type} ne 'bullet') { 577 $string = htmlStopIndent(pop(@$indents)).htmlStartIndent($item); 578 push(@$indents,$item); 579 } 580 return $string; 581 } 582 583 sub htmlStartIndent { 584 my $item = shift; 585 return "<blockquote>\n" unless $item->{type} eq 'bullet'; 586 $item->{isFirst} = 1; 587 return "<ul>\n" if $item->{bullet} eq 'bullet'; 588 return "<ol>\n" if $item->{bullet} eq 'numeric'; 589 return '<ol type="a">'."\n"; 590 } 591 592 sub htmlStopIndent { 593 my $item = shift; 594 return "</blockquote>\n" unless $item->{type} eq 'bullet'; 595 return "</li>\n</ul>\n" if $item->{bullet} eq 'bullet'; 596 return "</li>\n</ol>\n"; 597 } 598 599 sub htmlBlock { 600 my $stack = shift; my $i = shift; my $item = $stack->[$i]; 601 my $html = htmlStack($item); 602 return $html unless $item->{align}; 603 my $next = $stack->[$i+1] || {}; 604 $item->{isContinued} = $next->{isContinuation} = 1 605 if $next->{type} eq 'block' && 606 $next->{indent} == $item->{indent} && 607 $next->{align} eq $item->{align}; 608 return ($item->{isContinuation} ? "" : '<div align="'.$item->{align}.'">'."\n"). 609 htmlStack($item). 610 ($item->{isContinued} ? "\n" : "\n</div>\n"); 611 } 612 613 sub htmlBreak {"<br />\n"} 614 615 sub htmlPar { 616 my $item = shift; 617 my $end = ($item->{endLI} ? "</li>" : ""); 618 return $end."\n<p>\n" 619 }; 620 621 sub htmlBullet { 622 my $stack = shift; my $i = shift; my $item = $stack->[$i]; 623 while (++$i < scalar(@$stack)) { 624 if ($stack->[$i]{type} eq 'bullet' && $stack->[$i]{indent} == $item->{indent}) { 625 $stack->[$i-1]{endLI} = $stack->[$i]{isFirst} = 1 if $stack->[$i-1]{type} eq 'par'; 626 last; 627 } 628 if (defined $stack->[$i]{indent} && $stack->[$i]{indent} < $item->{indent}) { 629 $stack->[$i-1]{indent} = $stack->[$i]{indent} if $stack->[$i-1]{type} eq 'par'; 630 last; 631 } 632 } 633 $stack->[-1]{indent} = 0 if $i == scalar(@$stack) && $stack->[-1]{type} eq 'par'; 634 my $end = ($item->{isFirst} ? "" : "</li>\n"); 635 return "$end<li>".htmlStack($item); 636 } 637 638 sub htmlHeading { 639 my $stack = shift; my $i = shift; my $item = $stack->[$i]; 640 my $n = $item->{n}; my $next = $stack->[$i+1] || {}; 641 $item->{isContinued} = $next->{isContinuation} = 1 642 if $next->{type} eq 'heading' && 643 $next->{indent} == $item->{indent} && 644 $next->{n} == $n; 645 return ($item->{isContinuation} ? "\n" : "<h$n>"). 646 htmlStack($item). 647 ($item->{isContinued} ? "" : "</h$n>\n"); 648 } 649 650 sub htmlRule { 651 my $item = shift; my $width = ""; my $size = ""; 652 $width = ' width="'.$item->{width}.'"' if defined $item->{width}; 653 $size = ' size="'.$item->{size}.'"' if defined $item->{size}; 654 return "\n<hr$width$size />\n"; 655 } 656 657 sub htmlPre { 658 my $stack = shift; my $i = shift; my $item = $stack->[$i]; 659 my $next = $stack->[$i+1] || {}; 660 $item->{isContinued} = $next->{isContinuation} = 1 661 if $next->{type} eq 'pre' && $next->{indent} == $item->{indent}; 662 return ($item->{isContinuation} ? "\n" : "\n<pre><code>"). 663 htmlEscape($item->{text}). 664 ($item->{isContinued} ? "" : "</code></pre>\n"); 665 } 666 667 sub htmlMath { 668 my $item = shift; my $math = $item->{text}; 669 if ($item->{parsed}) { 670 my $context = $main::context{Typeset}; 671 if ($item->{context}) { 672 if (Value::isContext($item->{context})) {$context = $item->{context}} 673 else {$context = Parser::Context->getCopy(undef,$item->{context})} 674 } 675 $context->clearError; 676 my $obj = Parser::Formula($context,$math); 677 if ($context->{error}{flag}) { 678 Warning "Error parsing mathematics: $context->{error}{message}"; 679 return "(math error)"; 680 } 681 $math = $obj->TeX; 682 } 683 $math = "\\displaystyle{$math}" if $item->{display}; 684 return main::math_ev3($math); 685 } 686 687 sub htmlEmphasis { 688 my $item = shift; 689 my ($begin,$end) = @{(['<i>','</i>'],['<b>','</b>'],['<i><b>','</b></i>'])[length($item->{stars})-1]}; 690 my ($bspace,$espace) = ($item->{token},$item->{terminator}); 691 $bspace =~ s/\S//g; $espace =~ s/\S//g; 692 return $bspace.$begin.stackString($item).$end.$espace; 693 } 694 695 sub htmlAnswer { 696 my $item = shift; 697 my $ans = $item->{answer}; 698 $item->{width} = length($item->{token})-2 if (!defined($item->{width})); 699 if (defined($ans)) { 700 if (ref($ans) =~ /CODE|AnswerEvaluator/) { 701 if ($item->{name}) { 702 main::NAMED_ANS($item->{name} => $ans); 703 return main::NAMED_ANS_RULE($item->{name},$item->{width}); 704 } else { 705 main::ANS($ans); 706 return main::ans_rule($item->{width}); 707 } 708 } 709 unless (Value::isValue($ans)) { 710 $ans = Parser::Formula($item->{answer}); 711 if (defined($ans)) { 712 $ans = $ans->eval if $ans->isConstant; 713 $ans->{correct_ans} = "$item->{answer}"; 714 $item->{answer} = $ans; $cmp = $ans->cmp; 715 } else { 716 Warning "Error parsing answer: ".Value->context->{error}{message}; 717 $ans = main::String(""); ### use something else? 718 } 719 } 720 my @options = ($item->{width}); 721 my $method = ($item->{hasStar} ? "ans_array" : "ans_rule"); 722 if ($item->{name}) { 723 unshift(@options,$item->{name}); 724 $method = "named_".$method; 725 } 726 main::ANS($ans->cmp) unless ref($ans) eq 'MultiAnswer' && $ans->{part} > 1; 727 if ($item->{hasStar}) { 728 my $HTML = $ans->$method(@options); 729 $HTML =~ s!\\!\\\\!g; 730 return main::EV3($HTML); 731 } else {return $ans->$method(@options)} 732 } else { 733 return main::ans_rule($item->{width}); 734 } 735 } 736 737 sub htmlVerbatim { 738 my $item = shift; 739 my $text = htmlEscape($item->{text}); 740 $text = "<code>$text</code>" if $item->{hasStar}; 741 return $text; 742 } 743 744 sub htmlCommand { 745 my $item = shift; 746 my $text = replaceCommand($item); 747 $text = htmlEscape($text) unless $item->{hasStar}; 748 return $text; 749 } 750 751 sub htmlVariable { 752 my ($item,$cur) = @_; 753 my $text = replaceVariable($item,$cur); 754 $text = htmlEscape($text) unless $item->{hasStar}; 755 return $text; 756 } 757 758 sub htmlStack { 759 my $cur = shift; 760 my @strings = (); 761 foreach my $item (@{$cur->{stack}}) { 762 for ($item->{type}) { 763 /text/ && do {push(@strings,htmlEscape(replaceText($item))); last}; 764 /variable/ && do {push(@strings,htmlVariable($item,$cur)); last}; 765 /command/ && do {push(@strings,htmlCommand($item)); last}; 766 /math/ && do {push(@strings,htmlMath($item)); last}; 767 /emphasis/ && do {push(@strings,htmlEmphasis($item)); last}; 768 /break/ && do {push(@strings,htmlBreak($item)); last}; 769 /verbatim/ && do {push(@strings,htmlVerbatim($item)); last}; 770 /answer/ && do {push(@strings,htmlAnswer($item)); last}; 771 Warning "Warning: unexpected type '$item->{type}' in htmlStack\n"; 772 } 773 } 774 return join('',@strings); 775 } 776 777 sub htmlEscape { 778 my $string = shift; 779 $string =~ s/&/\&/g; 780 $string =~ s/</</g; 781 $string =~ s/>/>/g; 782 $string =~ s/"/"/g; 783 return $string; 784 } 785 786 ###################################################################### 787 ###################################################################### 788 789 sub Format { 790 die "TeX mode not yet implemented" if $main::displayMode eq 'TeX'; 791 ClearWarnings; 792 my $html = htmlString(parseList(splitString(shift))); 793 warn join('',@warnings)."\n" if scalar(@warnings); 794 return $html; 795 } 796 797 ###################################################################### 798 799 800 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |