1#!/usr/bin/perl 2############################################################################## 3# # 4# UNURAN -- Universal Non-Uniform Random number generator # 5# # 6############################################################################## 7# # 8# FILE: merge_h.pl # 9# # 10# Read all UNU.RAN header files, extract manual, and create texinfo file # 11# # 12############################################################################## 13# # 14# Copyright (c) 2000-2006 Wolfgang Hoermann and Josef Leydold # 15# Department of Statistics and Mathematics, WU Wien, Austria # 16# # 17# This program is free software; you can redistribute it and/or modify # 18# it under the terms of the GNU General Public License as published by # 19# the Free Software Foundation; either version 2 of the License, or # 20# (at your option) any later version. # 21# # 22# This program is distributed in the hope that it will be useful, # 23# but WITHOUT ANY WARRANTY; without even the implied warranty of # 24# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # 25# GNU General Public License for more details. # 26# # 27# You should have received a copy of the GNU General Public License # 28# along with this program; if not, write to the # 29# Free Software Foundation, Inc., # 30# 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # 31# # 32############################################################################## 33 34use strict; 35 36# set to 0 to disable output of nodes to stderr 37my $VERBOSE = 1; 38 39# set to 0 if no additinal page breaks should be included 40my $PAGEBREAKS = 1; 41 42# set to 0 if no list of calls should be added to top of 43# Function Reference sections (only in HTML output) 44my $LISTOFCALLS = 1; 45 46############################################################ 47# constants 48 49my $DEP_file = "./src/.dep-unuran_src_texi"; 50 51my $greeks = 52 # small greek letters 53 "alpha|beta|gamma|delta|epsilon|zeta|eta|theta|iota|kappa|lambda|". 54 "mu|nu|xi|omikron|pi|rho|sigma|tau|ypsilon|phi|chi|psi|omega|". 55 # capital greek letters 56 "Gamma|Delta|Theta|Lambda|Xi|Pi|Sigma|Phi|Psi|Omega"; 57 58 59############################################################ 60# $Id: make_texi.pl 5330 2011-04-19 10:50:18Z leydold $ 61# ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 62sub usage { 63 my $progname = $0; 64 $progname =~ s#^.*/##g; 65 66 print STDERR <<EOM; 67usage: $progname <top_src_dir> 68 69Perl script extracts documentation for unuran library from 70header files and transform it into texinfo format. 71 72The output is written on STDOUT. 73 74For a detailed description see README. 75 76EOM 77 exit; 78} 79############################################################ 80 81use FileHandle; 82 83############################################################ 84 85my %node_TAGs = 86 ( 87 "=TOP" => { "format" => \&texi_NODE }, 88 "=NODE" => { "format" => \&texi_NODE }, 89 "=NODEX" => { "format" => \&texi_NODE }, 90 "=DISTR" => { "format" => \&texi_NODE }, 91 "=METHOD" => { "format" => \&texi_NODE }, 92 "=APPENDIX" => { "format" => \&texi_NODE }, 93 ); 94 95#........................................................... 96 97my %TAGs = 98 ( 99 100 "=UP" => { "scan" => \&scan_UP }, 101 "=DESCRIPTION" => { "scan" => \&scan_do_nothing }, 102 "=HOWTOUSE" => { "scan" => \&scan_do_nothing }, 103 "=ROUTINES" => { "scan" => \&scan_ROUTINES }, 104 "=REQUIRED" => { "scan" => \&scan_chop_blanks }, 105 "=OPTIONAL" => { "scan" => \&scan_chop_blanks }, 106 "=SPEED" => { "scan" => \&scan_chop_blanks }, 107 "=REINIT" => { "scan" => \&scan_chop_blanks }, 108 "=SEEALSO" => { "scan" => \&scan_do_nothing }, 109 "=ABSTRACT" => { "scan" => \&scan_do_nothing }, 110 "=REF" => { "scan" => \&scan_REF }, 111 "=PDF" => { "scan" => \&scan_PDF }, 112 "=PMF" => { "scan" => \&scan_PDF }, 113 "=CONST" => { "scan" => \&scan_PDF }, 114 "=CDF" => { "scan" => \&scan_PDF }, 115 "=DOMAIN" => { "scan" => \&scan_PDF }, 116 "=FPARAM" => { "scan" => \&scan_FPARAM }, 117 "=STDGEN" => { "scan" => \&scan_STDGEN }, 118 119 "=END" => { "scan" => \&scan_do_nothing }, 120 ); 121 122############################################################# 123 124# list of nodes 125my $LIST_nodes; 126my @LIST_nodes_sorted; 127 128# list of routines 129my $LIST_routines; 130 131# scanned input 132# it is stored in the form 133# $IN->{node name}->{TAG} = entry 134my $IN; 135 136# texinfo output 137my $TEXI = "\@c automatically generated by `make_texi.pl'\n\n"; 138 139# dependencies 140my $DEP = "\$(unuran_src): "; 141 142############################################################# 143 144# read directory name from argument list ... 145my $top_dir = shift; 146(usage and die) unless $top_dir; 147 148# header files in directory tree ... 149# files are stored with key = filename and 150# value = complete path of file. 151my %header_files; 152scan_dir($top_dir); 153 154# now scan all header files 155foreach my $file (sort keys %header_files) { 156 scan_file($file); 157} 158 159# check node structure 160check_node_structure(); 161 162# format texinfo output 163texi_node("TOP",0); 164 165# write all output on STDOUT 166print $TEXI; 167 168# write dependencies 169open DEP, ">$DEP_file" or die "Cannot open file for writing: $DEP_file"; 170print DEP "$DEP\n"; 171close DEP; 172 173# end of job 174exit 0; 175 176 177############################################################# 178# get all header files in all sub directories ... 179# 180 181sub scan_dir { 182 my $dir = $_[0]; 183 184 # search subtree for header files ... 185 open (FILES, "find $dir |") or die "cannot find directory \"$dir\"."; 186 187 while (<FILES>) { 188 chomp; 189 next unless /^.*\/+(.*\.d?h)$/; 190 next if /\.\#/; 191 next if /source/; # we are not interested in these files 192 next if /struct/; # we are not interested in these files 193 $header_files{$1} = $_; # store file and path of file 194 } 195 close FILES; 196} # end of scan_dir() 197 198 199############################################################# 200# scan given file ... 201# 202 203sub scan_file { 204 my $file = $_[0]; 205 my $file_handle = new FileHandle; 206 207 # open file ... 208 open $file_handle, $header_files{$file} or die "cannot find file $file\n"; 209 210 # scan file 211 my $have_found_TAG = 0; 212 while (1) { 213 214 # search for node TAG 215 while (<$file_handle>) { 216 last if /^\s*=[A-Z]/; 217 } 218 219 # is there a node TAG ? 220 unless (/^\s*(\/\*)?\s*(=[A-Z]+)/) { 221 print STDERR "[$file] -- no doc --\n" if $VERBOSE and not $have_found_TAG; 222 close $file_handle or die "wrong file handle"; 223 return; 224 } 225 226 # prepare line with node TAG 227 s/^\s*//; s/\s*$//; # trim blanks 228 my $node_line = $_; # store line 229 230 # have found node TAG 231 (my $node_type, my $node_name, my $node_title) = split /\s+/, $node_line, 3; 232 233 # print info on screen 234 print STDERR "[$file] $node_type ($node_name):\t" if $VERBOSE; 235 236 # is this a valid node TAG 237 unless ($node_TAGs{$node_type}) { 238 print STDERR "\n\t[$file] invalid node TAG `$node_type' (skip over rest of file)\n"; 239 close $file_handle or die "wrong file handle"; 240 return; 241 } 242 243 # node must be unique 244 if ($LIST_nodes->{$node_name}) { 245 print STDERR "\n\t[$file] node `$node_name' used twice (skip over node)\n"; 246 close $file_handle or die "wrong file handle"; 247 return; 248 } 249 250 # store node name 251 $LIST_nodes->{$node_name} = 1; 252 $have_found_TAG = 1; 253 254 # read till end of node 255 my $node_text = $node_line."\n"; 256 while (<$file_handle>) { 257 if (/^\s*(\/\*)?\s*=EON/) { 258 # End-Of-Node TAG 259 last; 260 } 261 else { 262 # add line to stored text 263 s/^\s*//; s/\s*$//; # trim blanks 264 $node_text .= $_."\n"; # store content of node 265 } 266 } 267 268 # add dependency 269 $DEP .= "$header_files{$file} "; 270 271 # now scan node text; 272 scan_node($node_text, $file); 273 } 274 275} # end of scan_file() 276 277 278############################################################# 279# scan mode ... 280# 281 282sub scan_node { 283 my $node_text = $_[0]; 284 my $file = $_[1]; 285 286 # add =END TAG to text (for convienience) 287 $node_text .= "\n=END"; 288 289 # split into lines 290 my @lines = split /\n/, $node_text; 291 292 # first line contains node definition 293 my $node_line = shift @lines; 294 295 # get node name 296 (my $node_type, my $node_name, my $node_title) = split /\s+/, $node_line, 3; 297 298 # store node 299 $IN->{$node_name}->{"=NODE_TYPE"} = $node_type; 300 $IN->{$node_name}->{"=TITLE"} = $node_title; 301 $IN->{$node_name}->{"=FILE"} = $file; 302 303 # scan all TAGs (node sections) 304 my $this_TAG = "=END"; # add =END tag to node TAG 305 306 foreach my $l (@lines) { 307 # next TAG ? 308 if ($l =~ /^\s*(\/\*)?\s*(=[A-Z]+)\s*(.*)$/) { 309 # store next TAG 310 $this_TAG = $2; 311 # save rest of line 312 $l = $3; 313 print STDERR " $this_TAG" if $VERBOSE and $this_TAG ne "=END"; 314 unless ($TAGs{$this_TAG}) { 315 print STDERR "\n\t[$file] $node_name: invalid TAG `$this_TAG'\n"; 316 last; 317 } 318 } 319 320 # append to stored lines 321 # (except for =END TAG) 322 unless ($this_TAG eq "=END") { 323 $IN->{$node_name}->{$this_TAG} .= $l."\n"; 324 } 325 } 326 327 # scan and format all node sections 328 foreach my $tag (keys %TAGs) { 329 &{$TAGs{$tag}{"scan"}} ($node_name,$tag); 330 # make some modifications 331 transform_special_strings(\($IN->{$node_name}->{$tag})); 332 } 333 334 # close line on screen 335 print STDERR "\n" if $VERBOSE; 336 337 # there must be an UP TAG 338 die "UP missing for node $node_name" unless $IN->{$node_name}->{"=UP"}; 339 340} # end of scan_node() 341 342 343############################################################# 344# check node structure 345# 346sub check_node_structure { 347 348 # we need a TOP node 349 die "TOP node missing" unless $IN->{TOP}; 350 351 # add node `(dir)' to list of node 352 $LIST_nodes->{"(dir)"} = 1; 353 354 # check =UP nodes 355 foreach my $n (keys %{$IN}) { 356 unless ($LIST_nodes->{$IN->{$n}->{"=UP"}}) { 357 print STDERR "$n: invalid UP node `".$IN->{$n}->{"=UP"}."'\n"; 358 } 359 } 360 361 # sort nodes 362 @LIST_nodes_sorted = sort nodes_by_order_tag keys %$LIST_nodes; 363 364 # print node structure 365 print_node("TOP",""); 366 367} # end of check_node_structure() 368 369sub print_node { 370 my $node = $_[0]; # node for which all subnodes should be printed 371 my $indent = $_[1]; # line indent 372 373 # print node on screen 374 print STDERR "$indent$node: (".$IN->{$node}->{"=TITLE"}.")\n" if $VERBOSE; 375 376 # search for all subnodes 377 foreach my $n (@LIST_nodes_sorted) { 378 next unless $IN->{$n}->{"=UP"} eq $node; 379 print_node($n,"$indent\t"); 380 } 381 382} # end if print_node() 383 384 385############################################################# 386# compare two nodes by their order TAG (lexicographically) 387# 388 389sub nodes_by_order_tag { 390 $IN->{$a}->{"=ORDERING"} cmp $IN->{$b}->{"=ORDERING"}; 391} 392 393 394############################################################# 395# make texinfo output 396# 397 398sub texi_node { 399 my $node = $_[0]; # node for which all subnodes should be printed 400 my $level = $_[1]; # level for node. 401 402 # make section type 403 my $section = ''; 404 if ($IN->{$node}->{"=NODE_TYPE"} eq "=APPENDIX") { 405 LEVEL: { 406 if ($level == 0) { # TOP node 407 $section = "\@top "; 408 last LEVEL; } 409 if ($level == 1) { 410 $section = "\@appendix "; 411 last LEVEL; } 412 if ($level == 2) { 413 $section = "\@appendixsec"; 414 last LEVEL; } 415 if ($level == 3) { 416 $section = "\@appendixsubsec "; 417 last LEVEL; } 418 if ($level >= 4) { 419 $section = "\@appendixsubsubsec "; 420 last LEVEL; } 421 } 422 } 423 else { 424 LEVEL: { 425 if ($level == 0) { # TOP node 426 $section = "\@top "; 427 last LEVEL; } 428 if ($level == 1) { 429 $section = "\@chapter "; 430 last LEVEL; } 431 if ($level == 2) { 432 $section = "\@section "; 433 last LEVEL; } 434 if ($level == 3) { 435 $section = "\@subsection "; 436 last LEVEL; } 437 if ($level >= 4) { 438 $section = "\@subsubsection "; 439 last LEVEL; } 440 } 441 } 442 443 # make title 444 my $title = $IN->{$node}->{"=TITLE"}; 445 if ($IN->{$node}->{"=NODE_TYPE"} eq "=METHOD") { 446 $title = "$node -- ".$IN->{$node}->{"=TITLE"}; 447 } 448 if ($IN->{$node}->{"=NODE_TYPE"} eq "=DISTR") { 449 $title = "\@code{$node} -- ".$IN->{$node}->{"=TITLE"}."\n"; 450 $title .= "\@anchor{funct:unur_distr_$node}\n"; 451 $title .= "\@findex unur_distr_$node\n"; 452 } 453 454 # make menu 455 my $menu; 456 foreach my $n (@LIST_nodes_sorted) { 457 next unless $IN->{$n}->{"=UP"} eq $node; 458 $menu .= "* $n\:\: ".$IN->{$n}->{"=TITLE"}."\n"; 459 } 460 if ($menu) { 461 $menu = "\@menu\n".$menu."\@end menu\n\n"; 462 } 463 464 # print header file name 465 $TEXI .= "\@c -------------------------------------\n"; 466 $TEXI .= "\@c ".$IN->{$node}->{"=FILE"}."\n"; 467 $TEXI .= "\@c\n\n"; 468 469 # page break (?) 470 if ($PAGEBREAKS) { 471 if (($IN->{$node}->{"=NODE_TYPE"} eq "=METHOD") or 472 ($IN->{$node}->{"=NODE_TYPE"} eq "=NODEX")) { 473 $TEXI .= "\@page\n"; } 474 } 475 476 # print node and section 477 $TEXI .= "\@node $node\n"; 478 $TEXI .= "$section $title\n\n"; 479 480 # print menu 481 $TEXI .= $menu; 482 483 # print REQUIRED, OPTIONAL, etc. of method 484 if ($IN->{$node}->{"=NODE_TYPE"} eq "=METHOD") { 485 if ($IN->{$node}->{"=REQUIRED"}) { 486 $TEXI .= "\@table \@i\n"; 487 if ($IN->{$node}->{"=REQUIRED"}) { 488 $TEXI .= "\@item Required:\n".$IN->{$node}->{"=REQUIRED"}."\n"; 489 } 490 if ($IN->{$node}->{"=OPTIONAL"}) { 491 $TEXI .= "\@item Optional:\n".$IN->{$node}->{"=OPTIONAL"}."\n"; 492 } 493 if ($IN->{$node}->{"=SPEED"}) { 494 $TEXI .= "\@item Speed:\n".$IN->{$node}->{"=SPEED"}."\n"; 495 } 496 if ($IN->{$node}->{"=REINIT"}) { 497 $TEXI .= "\@item Reinit:\n".$IN->{$node}->{"=REINIT"}."\n"; 498 } 499 if ($IN->{$node}->{"=REF"}) { 500 $TEXI .= "\@item Reference:\n".$IN->{$node}->{"=REF"}."\n"; 501 } 502 $TEXI .= "\@end table\n\@sp 1\n\n"; 503 } 504 } 505 506 # print PDF, domain, etc. distribution 507 if ($IN->{$node}->{"=NODE_TYPE"} eq "=DISTR") { 508 $TEXI .= "\@table \@i\n"; 509 if ($IN->{$node}->{"=PDF"}) { 510 $TEXI .= "\@item PDF:\n".$IN->{$node}->{"=PDF"}."\n"; 511 } 512 if ($IN->{$node}->{"=PMF"}) { 513 $TEXI .= "\@item PMF:\n".$IN->{$node}->{"=PMF"}."\n"; 514 } 515 if ($IN->{$node}->{"=CONST"}) { 516 $TEXI .= "\@item constant:\n".$IN->{$node}->{"=CONST"}."\n"; 517 } 518 if ($IN->{$node}->{"=CDF"}) { 519 $TEXI .= "\@item CDF:\n".$IN->{$node}->{"=CDF"}."\n"; 520 } 521 if ($IN->{$node}->{"=DOMAIN"}) { 522 $TEXI .= "\@item domain:\n".$IN->{$node}->{"=DOMAIN"}."\n"; 523 } 524 if ($IN->{$node}->{"=FPARAM"}) { 525 $TEXI .= $IN->{$node}->{"=FPARAM"}; 526 } 527 if ($IN->{$node}->{"=REF"}) { 528 $TEXI .= "\@item reference:\n".$IN->{$node}->{"=REF"}."\n"; 529 } 530 if ($IN->{$node}->{"=STDGEN"}) { 531 $TEXI .= "\@item special generators:\n".$IN->{$node}->{"=STDGEN"}."\n"; 532 } 533 $TEXI .= "\@end table\n\n"; 534 } 535 536 # print description 537 $TEXI .= $IN->{$node}->{"=DESCRIPTION"}; 538 539 # print howtouse 540 if ($IN->{$node}->{"=HOWTOUSE"}) { 541 $TEXI .= "\n\@subsubheading How To Use\n\n"; 542 $TEXI .= $IN->{$node}->{"=HOWTOUSE"}."\n\n"; 543 } 544 545 # print function reference 546 if ($IN->{$node}->{"=ROUTINES"}) { 547 $TEXI .= "\n\@subheading Function reference\n\n"; 548 if ($LISTOFCALLS) { 549 $TEXI .= $IN->{$node}->{"=ROUTINESLIST"}."\n\n"; } 550 $TEXI .= $IN->{$node}->{"=ROUTINES"}."\n\n"; 551 } 552 553 # print `end of header file' 554 $TEXI .= "\n\@c\n"; 555 $TEXI .= "\@c end of ".$IN->{$node}->{"=FILE"}."\n"; 556 $TEXI .= "\@c -------------------------------------\n"; 557 558 # search for all subnodes 559 foreach my $n (@LIST_nodes_sorted) { 560 next unless $IN->{$n}->{"=UP"} eq $node; 561 562 # print all sub nodes 563 texi_node($n,$level+1); 564 } 565 566} # end of texi_node() 567 568 569############################################################# 570# scan bibligraphic references 571# 572 573sub scan_REF { 574 my $node_name = $_[0]; # name of node 575 my $tag = $_[1]; # TAG (node section) 576 577 # content of node 578 my $entry = $IN->{$node_name}->{$tag}; 579 580 # empty ? 581 return unless $entry; 582 583 # split into entries 584 my @bibrefs = split /\]\s*\[/, $entry; 585 586 # now print entries 587 $IN->{$node_name}->{$tag} = ""; 588 foreach my $bre (@bibrefs) { 589 $bre =~ s/[\[\]]//g; # remove all square brackets 590 $IN->{$node_name}->{$tag} .= transform_bibref($bre); 591 } 592 593} # end of scan_REF() 594 595 596############################################################# 597# texify string 598# 599 600sub texify_string { 601 my $string = $_[0]; 602 603 # infinity --> oo 604 $string =~ s/(infinity)/\\infty/g; 605 606 # replace '*' by space 607 $string =~ s/\*/\\, /g; 608 609 # name of functions 610 $string =~ s/(exp|log|max|min|sqrt|det)/\\$1/g; 611 612 # greek letters 613 $string =~ s/($greeks)/\\$1/g; 614 615 # <, <=, etc. 616 $string =~ s/<=/\\leq/g; 617 $string =~ s/>=/\\geq/g; 618 619 # fractions 620 $string =~ s/\\frac\{([^\}]+)\}\{([^\}]+)\}/\{$1\\over $2\}/g; 621 622 return $string; 623 624} # end of texify_string() 625 626 627 628############################################################# 629# scan domain for distribution 630# 631 632sub scan_DOMAIN { 633 my $node_name = $_[0]; # name of node 634 my $tag = $_[1]; # TAG (node section) 635 636 # content of node 637 my $entry = $IN->{$node_name}->{$tag}; 638 639 # empty ? 640 return unless $entry; 641 642 # trim heading blanks 643 $entry =~ s/^\s*//; 644 645 # chop off trailing blanks 646 $entry =~ s/\s+$//; 647 648 # remove newlines 649 $entry =~ s/\n+/ /g; 650 651 # format tex output 652 my $texentry = texify_string($entry); 653 654 # return result 655 $IN->{$node_name}->{$tag} = "\@iftex\n\@tex\n\$$texentry\$\n\@end tex\n\@end iftex\n"; 656 $IN->{$node_name}->{$tag} .= "\@ifnottex\n$entry\n\@end ifnottex\n"; 657 658} # end of scan_DOMAIN() 659 660 661############################################################# 662# scan PDF for distribution 663# 664 665sub scan_PDF { 666 my $node_name = $_[0]; # name of node 667 my $tag = $_[1]; # TAG (node section) 668 my $texentry; # content of node converted to TeX 669 670 # content of node 671 my $entry = $IN->{$node_name}->{$tag}; 672 673 # empty ? 674 return unless $entry; 675 676 # trim heading blanks 677 $entry =~ s/^\s*//; 678 679 # chop off trailing blanks 680 $entry =~ s/\s+$//; 681 682 # remove newlines 683 $entry =~ s/\n+/ /g; 684 685 # text mode 686 if ($entry =~ /\@text\{(.*)\}/) { 687 $texentry = $1; 688 $entry = $1; 689 } 690 691 else { 692 # format tex output 693 $texentry = "\$".texify_string($entry)."\$"; 694 695 # format other output 696 $entry =~ s/\\over\s+/\//g; 697 698 $entry =~ s/\\hbox{\s*(\w+)\s*}/ $1 /g; 699 $entry =~ s/\\hfil+\\break/\n\n/g; 700 701 $entry =~ s/\\frac\{([^\}]+[\s\+\-]+[^\}]+)\}\{([^\}]+[\s\+\-]+[^\}]+)\}/\($1\)\/\($2\)/g; 702 $entry =~ s/\\frac\{([^\}]+)\}\{([^\}]+[\s\+\-]+[^\}]+)\}/$1\/\($2\)/g; 703 $entry =~ s/\\frac\{([^\}]+[\s\+\-]+[^\}]+)\}\{([^\}]+)\}/\($1\)\/$2/g; 704 $entry =~ s/\\frac\{([^\}]+)\}\{([^\}]+)\}/$1\/$2/g; 705 706 $entry =~ s/\{/\(/g; 707 $entry =~ s/\}/\)/g; 708 } 709 710 # return result 711 $IN->{$node_name}->{$tag} = "\@iftex\n\@tex\n$texentry\n\@end tex\n\@end iftex\n"; 712 $IN->{$node_name}->{$tag} .= "\@ifnottex\n$entry\n\@end ifnottex\n"; 713 714} # end of scan_PDF() 715 716 717############################################################# 718# scan list of parameters for distribution 719# 720 721sub scan_FPARAM { 722 my $node_name = $_[0]; # name of node 723 my $tag = $_[1]; # TAG (node section) 724 725 # content of node 726 my $entry = $IN->{$node_name}->{$tag}; 727 728 # empty ? 729 return unless $entry; 730 731 # trim heading blanks 732 $entry =~ s/^\s*//; 733 734 # chop off trailing blanks 735 $entry =~ s/\s+$//; 736 737 # remove blanks around `:' 738 $entry =~ s/[ \t]*\:[ \t]*/\:/g; 739 740 # split into lines 741 my @lines = split /\n+/, $entry; 742 743 # process lines 744 my $out; 745 my $texout; 746 my $flist; 747 my $n_total = 0; 748 my $n_optional = 0; 749 my $opt_level; 750 my $last_opt_level; 751 752 foreach my $l (@lines) { 753 # each line must start with a [\d+] 754 next unless $l =~ /\[*\d+/; 755 # split into columns 756 my @cols = split /\:/, $l; 757 die "\nwrong number of columns for =FPARAM: $#cols" if $#cols != 4; 758 759 # get entries 760 my $number = $cols[0]; 761 $number =~ s/(.*)(\d+).*/\[$2\]/; 762 $opt_level = $1; 763 764 my $name = $cols[1]; 765 my $cond = $cols[2]; 766 my $default = $cols[3]; 767 my $type = $cols[4]; 768 769 # append list of parameters 770 if ($opt_level ne $last_opt_level) { 771 $last_opt_level = $opt_level; 772 $flist .= " ["; 773 } 774 if ($n_total) { 775 $flist .= ", $name"; 776 } 777 else { 778 $flist .= " $name"; 779 } 780 781 # process 782 $out .= "\@item \@code{$number} \@tab $name \@tab $cond \@tab $default \@tab \@i{($type)}\n"; 783 784 $texout .= "\@item \@code{$number}\n"; 785 $texout .= "\@tab\@tex\$$name \$\@end tex\n"; 786 $texout .= "\@tab\@tex\$$cond \$\@end tex\n"; 787 $texout .= "\@tab $default\n"; 788 $texout .= "\@tab (\@i{$type})\n"; 789 790 ++$n_total; 791 ++$n_optional if length $default; 792 } 793 my $n_required = $n_total - $n_optional; 794 795 $last_opt_level =~ s/\[/ \]/g; 796 $flist .= $last_opt_level; 797 798 # make TeX output 799 $texout =~ s/<=/\\leq/g; 800 $texout =~ s/>=/\\geq/g; 801 $texout =~ s/($greeks)(\W|\_)/\\$1$2/g; 802 803 my $texout_header = "\@iftex\n"; 804 $texout_header .= "\@item parameters $n_required ($n_total): \@r{$flist}\n\@sp 1\n"; 805 $texout_header .= "\@multitable {No.} {namex} {999999999999} {defaultx} {xxxxxxxxxxxxxxxxxxxxxxxx}\n"; 806 $texout_header .= "\@item No. \@tab name \@tab \@tab default\n"; 807 808 $IN->{$node_name}->{$tag} = $texout_header.$texout."\@end multitable\n\@end iftex\n"; 809 810 # make other output 811 my $out_header = "\@ifnottex\n"; 812 $out_header .= "\@item parameters $n_required ($n_total): $flist\n"; 813 $out_header .= "\@multitable {No.xx} {namexxx} {99999999999} {defaultx} {xxxxxxxxxxxxxxxxxxxxxxxx}\n"; 814 $out_header .= "\@item No. \@tab name \@tab \@tab default\n"; 815 816 $IN->{$node_name}->{$tag} .= $out_header.$out."\@end multitable\n\@end ifnottex\n"; 817 818} # end of scan_FPARAM() 819 820 821############################################################# 822# scan list of parameters for distribution 823# 824 825sub scan_STDGEN { 826 my $node_name = $_[0]; # name of node 827 my $tag = $_[1]; # TAG (node section) 828 829 # content of node 830 my $entry = $IN->{$node_name}->{$tag}; 831 832 # empty ? 833 return unless $entry; 834 835 # trim heading blanks 836 $entry =~ s/^\s*//; 837 838 # chop off trailing blanks 839 $entry =~ s/\s+$//; 840 841 # split into lines 842 my @lines = split /\n+/, $entry; 843 844 my $out = "\@table \@code\n"; 845 846 # process lines 847 foreach my $l (@lines) { 848 849 # split into indicator and description 850 (my $id, my $body) = split /\s+/, $l, 2; 851 852 if ($body =~ /\[(\w+)\]/) { 853 # there are references 854 my @references; 855 while ($body =~ /\[(\w+)\]/) { 856 $body =~ s /\[(\w+)\]\s*//; 857 push @references, $1; 858 } 859 $out .= "\@item $id\n"; 860 861 # tex output 862 my $texbody = texify_string($body); 863 $texbody =~ s/(\@tex)/\n$1/g; 864 $texbody =~ s/(\@end\s+tex)/\n$1\n/g; 865 $out .= "\@iftex\n"; 866 $out .= $texbody; 867 foreach my $r (@references) { 868 $out .= " [$r]"; 869 } 870 $out .= "\n\@end iftex\n"; 871 872 # remove tex marks 873 $body =~ s/\$//g; 874 $body =~ s/\@tex//g; 875 $body =~ s/\@end\s+tex//g; 876 877 $out .= "\@ifhtml\n"; 878 $out .= "$body "; 879 foreach my $r (@references) { 880 $out .= "\@ref{bib:$r, [$r]} "; 881 } 882 $out .= "\n\@end ifhtml\n"; 883 884 $out .= "\@ifinfo\n"; 885 $out .= "$body "; 886 foreach my $r (@references) { 887 $out .= "[$r] "; 888 } 889 $out .= "\n\@end ifinfo\n"; 890 } 891 892 else { 893 # there is no reference 894 $out .= "\@item $id\n"; 895 $out .= "$body\n"; 896 } 897 } 898 899 $out .= "\@end table\n"; 900 901 # make other output 902 $IN->{$node_name}->{$tag} = $out; 903 904} # end of scan_STDGEN() 905 906 907############################################################# 908# chop off trailing blanks 909# 910 911sub scan_chop_blanks { 912 my $node_name = $_[0]; # name of node 913 my $tag = $_[1]; # TAG (node section) 914 915 # content of node 916 my $entry = $IN->{$node_name}->{$tag}; 917 918 # trim heading blanks 919 $entry =~ s/^\s*//; 920 921 # chop off trailing blanks 922 $entry =~ s/\s+$//; 923 924 # remove newlines 925 $entry =~ s/\n+/ /g; 926 927 # return result 928 $IN->{$node_name}->{$tag} = $entry; 929 930} # end of scan_chop_blanks() 931 932 933############################################################# 934# dummy routine 935# 936 937sub scan_do_nothing { 938 my $node_name = $_[0]; # name of node 939 my $tag = $_[1]; # TAG (node section) 940 941 # we have to process @unur macros 942 process_unur_macros("tex|html|info",\($IN->{$node_name}->{$tag})); 943 944 # nothing else to do 945 return; 946} # end of scan_do_nothing() 947 948 949############################################################# 950# scan TAG (node section) =UP 951# 952 953sub scan_UP { 954 my $node_name = $_[0]; # name of node 955 my $tag = $_[1]; # TAG (node section); not used 956 957 # content of node 958 my $entry = $IN->{$node_name}->{"=UP"}; 959 $entry =~ s/^\s*//; # trim heading blanks 960 961 # we have two entries which are separated by blanks 962 # the first entry is the name of the UP node 963 # the second entry is used to order within this upper node 964 (my $upper_name, my $order) = split /\s+/, $entry, 2; 965 966 # store upper node 967 $IN->{$node_name}->{"=UP"} = $upper_name; 968 969 # extract string for ordering (lexicographic ordering is used) 970 if ($order =~ /\[(\w+)\]/) { 971 $IN->{$node_name}->{"=ORDERING"} = $1; 972 } 973 else { # use node name 974 $IN->{$node_name}->{"=ORDERING"} = $node_name; 975 } 976 977} # end if scan_UP() 978 979 980############################################################# 981# scan TAG (node section) =ROUTINES 982# 983 984sub scan_ROUTINES { 985 my $node_name = $_[0]; # name of node 986 my $tag = $_[1]; # TAG (node section) 987 988 # valid C data types 989 my @C_TYPES = ( "UNUR_PAR", 990 "UNUR_GEN", 991 "UNUR_DISTR", 992 "UNUR_URNG", 993 "UNUR_ERROR_HANDLER", 994 "UNUR_FUNCT_CONT", 995 "UNUR_FUNCT_CVEC", 996 "UNUR_VFUNCT_CVEC", 997 "FILE", 998 "extern", 999 "struct", 1000 "const", 1001 "void", 1002 "int", 1003 "double", 1004 "float", 1005 "long", 1006 "char", 1007 "short", 1008 "unsigned", 1009 "signed" ); 1010 1011 # content of node 1012 my $entry = $IN->{$node_name}->{"=ROUTINES"}; 1013 1014 # trim heading blanks 1015 $entry =~ s/^\s*//; 1016 1017 # remove double blank lines 1018 $entry =~ s/\n\s*\n\s*\n/\n\n/g; 1019 1020 # simplify comment markers: /** --> /* 1021 $entry =~ s/\/\*+/\/\*/g; 1022 $entry =~ s/\*+\//\*\//g; 1023 1024 # remove blanks and new lines inside comments at markers 1025 $entry =~ s/\/\*\s+/\/\*/g; 1026 $entry =~ s/\s+\*\//\*\//g; 1027 1028 # remove blank lines at begin and end of entry 1029 $entry =~ s/^(\s*\n)+//g; 1030 $entry =~ s/(\s*\n)+$//g; 1031 1032 # if there are blocks of comments, separated by empty lines 1033 # then delete all but the first block of comments 1034 ## $entry =~ s/\*\/\s*\n\s*\n\s*\/\*[.\n]*\*\//\*\//g; 1035 1036 # split into blocks 1037 my @blocks = split /\*\/\s*\n\s*\n/, $entry ; 1038 1039 # store processed text 1040 my $proc = ''; 1041 1042 # local list of functions 1043 my $listhtml; 1044 my $listinfo; 1045 1046 # deftypefn block closed 1047 my $defblock_open = 0; 1048 1049 # process blocks 1050 my $fkt_block = ''; 1051 foreach my $block (@blocks) { 1052 1053 # remove anyting that starts with an # 1054 $block =~ s/^\#.*$//mg; 1055 1056 # remove all comment markers 1057 $block =~ s/\*\/\s*//g; 1058 $block =~ s/\s*\/\*//g; 1059 1060 # skill over empty blocks 1061 next unless $block; 1062 1063 # "verbatim" block ? 1064 if ($block =~/^\s*==DOC/) { 1065 # remove subTAG and copy text verbatim 1066 $block =~ s/^\s*==DOC\s*//; 1067 $proc .= "$block\n\n"; 1068 next; # next block 1069 } 1070 1071 # split into function declaration and its description 1072 (my $fkt, my $body) = split /\;/, $block, 2; 1073 1074 # check function type 1075 my $type_ok = 0; 1076 foreach my $type (@C_TYPES) { 1077 if ("$fkt " =~ /^\s*$type /) { 1078 $type_ok = 1; 1079 last; 1080 } 1081 } 1082 # if this is not a valid type, skip to next block. 1083 next unless $type_ok; 1084 1085 # add blanks around braces 1086 $fkt =~ s/\(/ \( /g; 1087 $fkt =~ s/\)/ \) /g; 1088 1089 # move pointer '*' from name to type 1090 $fkt =~ s/\s+(\*+)/$1 /g; 1091 1092 # get argument list of function 1093 (my $fkt_decl, my $fn_args) = split /\s+\(\s+/, $fkt, 2; 1094 $fn_args =~ s/\s*\)\s*$//; 1095 my @argslist = split /\s*\,\s*/, $fn_args; 1096 1097 # $fkt_decl should contain of at least two words 1098 unless ($fkt_decl =~ /^\s*(.*)\s+([\*\w+]+)\s*$/ ) { 1099 die "type or name missing for function: '$fkt_decl'"; 1100 } 1101 1102 # get function type and name 1103 # the first part in $fkt_decl is the function type, 1104 # the last word is the function name 1105 my $fn_type = $1; 1106 my $fn_name = $2; 1107 1108 # routine name must be unique 1109 die "Function defined twice: $fn_name" if $LIST_routines->{$fn_name}; 1110 1111 # store in list of all routines 1112 $LIST_routines->{$fn_name} = 1; 1113 1114 # write entry 1115 my $first = 1; 1116 if (@argslist) { 1117 # this is a function with arguments 1118 1119 # store in table of routines 1120 $listhtml .= "\@item \@ref{funct:$fn_name,$fn_name}\n"; 1121 $listinfo .= "\@item $fn_name\n"; 1122 1123 # make anchor 1124 $fkt_block .= "\@anchor{funct:$fn_name}\n"; 1125 # make texinfo tag 1126 $fkt_block .= (($defblock_open) ? "\@deftypefnx" : "\@deftypefn"); 1127 $fkt_block .= " %%%Function%%% \{$fn_type\} $fn_name ("; 1128 foreach my $arg (@argslist) { 1129 (my $type, my $arg_name) = split /\s+/, $arg, 2; 1130 if ($first) { $first = 0; } 1131 else { $fkt_block .= ", "; } 1132 if ($arg_name) { 1133 # we have to take care of args that are function points 1134 if ($arg_name =~ /\s*\(/ ) { 1135 $arg_name =~ s/\s*\(\s*/\(/g; 1136 $arg_name =~ s/\s*\((\* )*(.*?)\s*\)\s*(.*)/\($1\@var\{$2\}\)$3/; 1137 $fkt_block .= "$type $arg_name"; 1138 } 1139 else { 1140 $arg_name =~ s/(.*?)(\s*\))*\s*$/\@var\{$1\}$2/; 1141 $fkt_block .= "$type $arg_name"; 1142 } 1143 } 1144 else { 1145 $fkt_block .= "$type"; 1146 } 1147 } 1148 $fkt_block .= ")\n"; 1149 } 1150 else { 1151 # this is a function does not have arguments 1152 # maybe it is an variable 1153 1154 # store in table of routines 1155 $listhtml .= "\@item \@ref{var:$fn_name,$fn_name}\n"; 1156 $listinfo .= "\@item $fn_name\n"; 1157 1158 # make anchor 1159 $fkt_block .= "\@anchor{var:$fn_name}\n"; 1160 # make texinfo tag 1161 $fkt_block .= (($defblock_open) ? "\@deftypevarx" : "\@deftypevar"); 1162 $fkt_block .= " \{$fn_type\} $fn_name\n"; 1163 $fkt_block .= "\@findex $fn_name\n"; 1164 } 1165 # description 1166 if ($body) { 1167 $fkt_block .= "$body\n"; 1168 if (@argslist) { 1169 $fkt_block .= "\@end deftypefn\n"; } 1170 else { 1171 $fkt_block .= "\@end deftypevar\n"; } 1172 $defblock_open = 0; 1173 # for info file 1174 my $fkt_string = $fkt_block; 1175 process_unur_macros("have_info",\$fkt_string); 1176 $fkt_string =~ s/%%%Function%%%/Function/g; 1177 $proc .= "\@ifinfo\n$fkt_string\@end ifinfo\n"; 1178 # for other output formats 1179 $fkt_string = $fkt_block; 1180 process_unur_macros("tex|html",\$fkt_string); 1181 $fkt_string =~ s/%%%Function%%%/{}/g; 1182 $proc .= "\@ifnotinfo\n$fkt_string\@end ifnotinfo\n\n"; 1183 # clear block 1184 $fkt_block = ''; 1185 } 1186 else { 1187 $defblock_open = 1; 1188 } 1189 } 1190 1191 die "last function without description: $fkt_block" if $defblock_open; 1192 1193 # make list of routines 1194 my $listproc; 1195 if ($listhtml) { 1196 $listproc = "\@ifhtml\n\@itemize\n".$listhtml."\@end itemize\n\@end ifhtml\n"; 1197 ## Currently we only display list of calls in HTML output 1198 ## $listproc .= "\@ifnothtml\n\@itemize\n".$listinfo."\@end itemize\n\n\@sp 1\n\@end ifnothtml\n"; 1199 } 1200 1201 # store new lines 1202 $IN->{$node_name}->{"=ROUTINES"} = $proc; 1203 $IN->{$node_name}->{"=ROUTINESLIST"} = $listproc; 1204 1205 return; 1206 1207} # end of scan_ROUTINES() 1208 1209 1210############################################################# 1211# format texinfo output for =NODE 1212# 1213 1214sub texi_NODE { 1215 my $node = $_[0]; 1216 1217 # node string is used AS IS. 1218 return $node; 1219} # end of texi_TOP() 1220 1221 1222############################################################# 1223# transform special strings 1224# 1225 1226sub transform_special_strings { 1227 my $line = $_[0]; 1228 1229 # trim blanks 1230 $$line =~ s/[ \t\r\f]+\n/\n/g; 1231 1232 # @cc_start --> /* 1233 # @cc_stop --> */ 1234 $$line =~ s/\@cc_start/\/*/g; 1235 $$line =~ s/\@cc_stop/*\//g; 1236 1237 # NULL --> @code{NULL} 1238 # TRUE --> @code{TRUE} 1239 # FALSE --> @code{FALSE} 1240 $$line =~ s/ (NULL|TRUE|FALSE)/ \@code\{$1\}/g; 1241 $$line =~ s/^(NULL|TRUE|FALSE)/\@code\{$1\}/g; 1242 $$line =~ s/\n(NULL|TRUE|FALSE)/\n\@code\{$1\}/g; 1243 1244 # transform (\w+)\(\) --> @command($1) 1245 my $first = "\n\@ifhtml\n\@ref\{funct:"; 1246 my $middle = "\}\n\@end ifhtml\n\@ifnothtml\n"; 1247 my $last = "\n\@end ifnothtml\n"; 1248 1249 $$line =~ s/\s+(\w+)\(\)([\.\,\;\:])\s*/$first$1,\@command\{$1\}$2$middle\@command\{$1\}$2$last/g; 1250 $$line =~ s/\s+(\w+)\(\)(\n|\s*)/$first$1,\@command\{$1\}$middle\@command\{$1\}$last/g; 1251 1252} # end of transform_special_strings() 1253 1254 1255############################################################# 1256# transform special strings 1257# 1258 1259sub process_unur_macros { 1260 my $iftype = $_[0]; 1261 my $lineptr = $_[1]; 1262 my $line = $$lineptr; 1263 1264 while ((my $macroidx = index $line, "\@unur") > -1) { 1265 # start of macrobody 1266 my $bodyidx = 1 + index $line, "{", $macroidx; 1267 die "Cannot find opening brace for \@unur macro" unless $bodyidx > $macroidx; 1268 # end of macrobody 1269 my $idx = $bodyidx; 1270 my $open = 1; 1271 while ($open) { 1272 ++$open if substr($line, $idx, 1) eq "{"; 1273 --$open if substr($line, $idx, 1) eq "}"; 1274 ++$idx; 1275 die "Cannot find closing brace for \@unur macro" if $idx > length($line); 1276 } 1277 my $bodyendidx = $idx; 1278 # get name of macro 1279 my $macro = substr $line, $macroidx, $bodyidx-$macroidx-1; 1280 # get body of macro 1281 my $body = substr $line, $bodyidx, $bodyendidx-$bodyidx-1; 1282 1283 # evaluate macro 1284 my $replacement = ""; 1285 1286 MACRO: { 1287 if ($macro =~ /\@unurbibref\s*$/) { 1288 $replacement = transform_bibref($body); 1289 substr($line, $bodyendidx) =~ s/^[ \t]*\n?[ \t]*//; 1290 last MACRO; 1291 } 1292 1293 if ($macro =~ /\@unurmath\s*$/) { 1294 $replacement .= transform_tex($iftype,$body,0); 1295 substr($line, $bodyendidx) =~ s/^[ \t]*\n?[ \t]*//; 1296 last MACRO; 1297 } 1298 1299 if ($macro =~ /\@unurmathdisplay\s*$/) { 1300 $replacement .= transform_tex($iftype,$body,1); 1301 substr($line, $bodyendidx) =~ s/^[\s]+//s; 1302 last MACRO; 1303 } 1304 1305 if ($macro =~ /\@unurimage\s*$/) { 1306 $replacement = "\n\@sp 1\n\@image{$body}\n\@sp 1\n"; 1307 last MACRO; 1308 } 1309 1310 else { 1311 die "Unknown \@unur macro: $macro"; 1312 } 1313 } 1314 1315 # replace macro 1316 substr $line, $macroidx, $bodyendidx-$macroidx, $replacement; 1317 1318 # trim white space 1319 substr($line, 0, $macroidx) =~ s/[\s\n]+$/\n/s; 1320 } 1321 1322 $$lineptr = $line; 1323} # end of process_unur_macros() 1324 1325 1326############################################################# 1327 1328sub transform_bibref { 1329 my $entry = $_[0]; # entry to be transformed 1330 1331 # empty ? 1332 return unless $entry; 1333 1334 # remove newlines 1335 $entry =~ s/\n+/ /g; 1336 1337 # trim heading blanks 1338 $entry =~ s/^\s*//; 1339 1340 # chop off trailing blanks 1341 $entry =~ s/\s+$//; 1342 1343 # split into ref and optional remark 1344 # which is separated by a colon 1345 (my $anchor, my $remark) = split /[\:\,]\s*/, $entry, 2; 1346 if ($remark) { 1347 $remark =~ s/\,/\;/g; # we cannot use a comma here 1348 $remark = ": $remark"; 1349 } 1350 1351 # output 1352 my $entrywithlink = "\@ref{bib:$anchor,, [$anchor$remark]}"; 1353 $entry = "[$anchor$remark]"; 1354 1355 # output 1356 my $output = 1357 "\@ifhtml\n$entrywithlink\n\@end ifhtml\n". 1358 "\@ifnothtml\n$entry\n\@end ifnothtml\n"; 1359 1360 return $output; 1361 1362} # end of transform_bibref() 1363 1364############################################################# 1365 1366sub transform_tex { 1367 my $iftype = $_[0]; 1368 my $entry = $_[1]; # entry to be transformed 1369 my $display = $_[2]; # whether this is a display or not 1370 1371 my $tex; 1372 my $html; 1373 my $info; 1374 1375 parse_tex($entry,\$tex,\$html,\$info); 1376 1377 my $output; 1378 1379 if ($iftype =~ /tex/) { 1380 my $tmp = "\@math{$tex}\n"; 1381 if ($display) { $tmp = "\n\@quotation\n".$tmp."\@end quotation\n\n"; } 1382 unless ($iftype =~ /have_tex/) { $tmp = "\@iftex\n".$tmp."\@end iftex\n"; } 1383 $output .= $tmp; 1384 } 1385 if ($iftype =~ /html/) { 1386 my $tmp = "\@html\n$html\n\@end html\n"; 1387 if ($display) { $tmp = "\@quotation\n".$tmp."\@end quotation\n"; } 1388 unless ($iftype =~ /have_html/) { $tmp = "\@ifhtml\n".$tmp."\@end ifhtml\n"; } 1389 $output .= $tmp; 1390 } 1391 if ($iftype =~ /info/) { 1392 my $tmp = "\@math{$info}\n"; 1393 if ($display) { $tmp = "\@quotation\n".$tmp."\@end quotation\n"; } 1394 unless ($iftype =~ /have_info/) { $tmp = "\@ifinfo\n".$tmp."\@end ifinfo\n"; } 1395 if ($display) { $tmp .= "\n"; } 1396 $output .= $tmp; 1397 } 1398 1399 if ($display) { $output .= "\@noindent\n"; } 1400 1401 return $output; 1402 1403} # end of transform_tex() 1404 1405############################################################# 1406 1407sub parse_tex { 1408 my $entry = $_[0]; # entry to be parsed 1409 1410 my $tex = $_[1]; # pointer to output string for all formats 1411 my $html = $_[2]; 1412 my $info = $_[3]; 1413 1414 1415 # replace special characters 1416 $entry =~ s/[\s\n]+/ /g; # trim blanks 1417 $entry =~ s/\s*:\s*/\\colon /g; # : 1418 $entry =~ s/\s*<=\s*/\\leq /g; # <= 1419 $entry =~ s/\s*>=\s*/\\geq /g; # >= 1420 $entry =~ s/\s*\\{\s*/\\lbrace /g; # { 1421 $entry =~ s/\s*\\}\s*/\\rbrace /g; # } 1422 1423 # scan TeX 1424 my @token; 1425 1426 until ($entry eq "") { 1427 if ($entry =~ s/^(\s|\n)+//) { 1428 # white space 1429 push @token, {type=>"blank", value=>" "}; next; } 1430 if ($entry =~ s/^([a-zA-Z]+)//) { 1431 # text 1432 push @token, {type=>"letter", value=>"$1"}; next; } 1433 if ($entry =~ s/^([0-9]+)//) { 1434 # number 1435 push @token, {type=>"number", value=>"$1"}; next; } 1436 if ($entry =~ s/^(\[|\]|\(|\)|\_|\'|\,|\;|\.|\=|\/|\+|\-|\<|\>|\|)//) { 1437 # other printable symbols 1438 push @token, {type=>"symbol", value=>"$1"}; next; } 1439 1440 if ($entry =~ s/^\\([a-zA-Z]+)(\s*)//) { 1441 # macro 1442 push @token, {type=>"macro", value=>"\\$1$2"}; next; } 1443 if ($entry =~ s/^\\(\\|\,|\;|{|})(\s*)//) { 1444 # macro with special charcter 1445 push @token, {type=>"macro", value=>"\\$1$2"}; next; } 1446 1447 if ($entry =~ s/^(\_|\^|\.|\,|\!)//) { 1448 # special characters 1449 push @token, {type=>"special", value=>"$1"}; next; } 1450 1451 if ($entry =~ /^\{/) { 1452 # block --> find end of block 1453 my $idx = 1; 1454 my $open = 1; 1455 while ($open) { 1456 ++$open if substr($entry, $idx, 1) eq "{"; 1457 --$open if substr($entry, $idx, 1) eq "}"; 1458 ++$idx; 1459 die "Cannot find closing brace for \@unur macro" if $idx > length($entry); 1460 } 1461 1462 # store block 1463 my $block = substr $entry, 1, $idx-2; 1464 push @token, {type=>"block", value=>"$block"}; 1465 1466 # update $entry 1467 $entry = substr $entry, $idx; 1468 next; 1469 } 1470 1471 # else: unknown character: 1472 print STDERR "\n\@unurmath: $entry\n"; 1473 die "Unknown Character: '".substr($entry,0,1)."' "; 1474 } 1475 1476 # write text 1477 while ( @token ) { 1478 next_tex_token(\@token,$tex,$html,$info); 1479 } 1480 1481 # trim blanks 1482 $$html =~ s/[\s\n]+/ /g; 1483 $$html =~ s/^[\s\n]+//g; 1484 $$html =~ s/[\s\n]+$//g; 1485 $$info =~ s/[\s\n]+/ /g; 1486 $$info =~ s/^[\s\n]+//g; 1487 $$info =~ s/[\s\n]+$//g; 1488 1489} # end of parse_tex() 1490 1491############################################################# 1492 1493sub next_tex_token { 1494 my $token = $_[0]; # pointer to token list 1495 1496 my $tex = $_[1]; # pointer to output string for all formats 1497 my $html = $_[2]; 1498 my $info = $_[3]; 1499 1500 # get next token 1501 my $tok = shift @$token; 1502 1503 # check token 1504 die "token missing" unless $tok; 1505 1506 my $type = $tok->{type}; 1507 my $value = $tok->{value}; 1508 1509 ## print STDERR "{type = $type\t value = $value}\n"; 1510 1511 if ($type eq "block") { 1512 $$tex .= "{"; 1513 $$html .= ""; 1514 $$info .= "("; 1515 parse_tex($value,$tex,$html,$info); 1516 $$tex .= "}"; 1517 $$html .= ""; 1518 $$info .= ")"; 1519 return; 1520 } 1521 1522 # letters 1523 if ($type =~ /^(letter)$/ ) { 1524 $$tex .= $value; 1525 $$html .= "<I>$value</I>"; 1526 $$info .= $value; 1527 return; 1528 } 1529 # numbers and symbols 1530 if ($type =~ /^(blank|number|symbol)$/ ) { 1531 $$tex .= $value; 1532 $$html .= $value; 1533 $$info .= $value; 1534 return; 1535 } 1536 1537 # macros 1538 if ($type eq "macro") { 1539 if ($value =~ /^(\\;|\\,)\s*$/) { 1540 # white spaces 1541 $$tex .= $value; 1542 $value =~ s/^(\\;|\\,)$/ /; 1543 $$info .= $value; 1544 $$html .= $value; 1545 return; 1546 } 1547 if ($value =~ /^\\\\\s*$/) { 1548 # new line 1549 $$tex .= "\\hfil\\break "; 1550 $$info .= "\@*"; 1551 $$html .= "\@*"; 1552 return; 1553 } 1554 if ($value =~ /^\\(colon|leq|geq|mapsto|times|rbrace|lbrace|ldots)\s*$/) { 1555 # :, <=, >=, ->, x, {, } 1556 $$tex .= $value; 1557 $value =~ s/^\\(colon)\s*/ : /g; 1558 $value =~ s/^\\(leq)\s*/ <= /g; 1559 $value =~ s/^\\(geq)\s*/ >= /g; 1560 $value =~ s/^\\(mapsto)\s*/ -> /g; 1561 $value =~ s/^\\(times)\s*/x/g; 1562 $value =~ s/^\\(rbrace)\s*/ \@} /g; 1563 $value =~ s/^\\(lbrace)\s*/ \@{ /g; 1564 $value =~ s/^\\(ldots)\s*/.../g; 1565 $$html .= $value; 1566 $$info .= $value; 1567 return; 1568 } 1569 if ($value =~ /^\\(pm|infty|cdot)\s*$/) { 1570 # +/-, infinity 1571 $$tex .= $value; 1572 $value =~ s/^\\(pm)\s*/ +\/- /g; 1573 $value =~ s/^\\(infty)\s*/ infinity /g; 1574 $value =~ s/^\\(cdot)\s*/ * /g; 1575 $$html .= $value; 1576 $$info .= $value; 1577 return; 1578 } 1579 if ($value =~ /^\\(inf|sup|min|max|log|exp|det)\s*$/) { 1580 # macros that are printed as is in non-TeX formats 1581 $$tex .= $value; 1582 $$html .= " $1"; 1583 $$info .= " $1"; 1584 return; 1585 } 1586 if ($value =~ /^\\(in|subset)\s*$/) { 1587 # macros that are printed as is in non-TeX formats 1588 $$tex .= $value; 1589 $$html .= " $1 "; 1590 $$info .= " $1 "; 1591 return; 1592 } 1593 if ($value =~ /^\\($greeks)(\s*)$/) { 1594 # greek letters 1595 $$tex .= $value; 1596 $$html .= " $1$2"; 1597 $$info .= " $1$2"; 1598 return; 1599 } 1600 if ($value =~ /^\\(limits)\s*$/) { 1601 # macros that are ignored in non-TeX formats 1602 $$tex .= $value; 1603 return; 1604 } 1605 if ($value =~ /^\\(sqrt)\s*$/) { 1606 # sqrt 1607 $$tex .= $value; 1608 $value =~ s/^\\(sqrt)\s*/sqrt/g; 1609 $$html .= "$value("; 1610 $$info .= $value; 1611 next_tex_token($token,$tex,$html,$info); 1612 $$html .= ")"; 1613 $$info .= ""; 1614 return; 1615 } 1616# $$tex .= $value; 1617# $$html .= $value; 1618# $$info .= $value; 1619# return; 1620 } 1621 1622 # special characters 1623 if ($type eq "special") { 1624 if ($value =~ /^(\_|\^)$/) { 1625 $$tex .= $value; 1626 $$info .= $value; 1627 $$html .= ($value =~ /^(\_)$/) ? "<SUB>" : "<SUP>"; 1628 next_tex_token($token,$tex,$html,$info); 1629 $$html .= ($value =~ /^(\_)$/) ? "</SUB>" : "</SUP>"; 1630 return; 1631 } 1632 if ($value =~ /^(\.|\,|\!)$/) { 1633 $$tex .= $value; 1634 $$info .= $value; 1635 $$html .= $value; 1636 return; 1637 } 1638 } 1639 1640 # else --> error 1641 die "\nPanic: don't know what to do with type '$type', value = '$value'\n"; 1642 1643} # end of next_tex_token() 1644 1645############################################################# 1646