Grutatxt.pm

   1 #####################################################################
   2 #
   3 #   Grutatxt - A text to HTML (and other things) converter
   4 #
   5 #   Copyright (C) 2000/2002 Angel Ortega <angel@triptico.com>
   6 #
   7 #   This program is free software; you can redistribute it and/or
   8 #   modify it under the terms of the GNU General Public License
   9 #   as published by the Free Software Foundation; either version 2
  10 #   of the License, or (at your option) any later version.
  11 #
  12 #   This program is distributed in the hope that it will be useful,
  13 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 #   GNU General Public License for more details.
  16 #
  17 #   You should have received a copy of the GNU General Public License
  18 #   along with this program; if not, write to the Free Software
  19 #   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  20 #
  21 #   http://www.triptico.com
  22 #
  23 #####################################################################
  24
  25 package Grutatxt;
  26
  27 use locale;
  28
  29 $VERSION='2.0.4';
  30
  31 =pod
  32
  33 =head1 NAME
  34
  35 Grutatxt - Text to HTML (and other formats) converter
  36
  37 =head1 SYNOPSIS
  38
  39  use Grutatxt;
  40
  41  # create a new Grutatxt converter object
  42  $grutatxt=new Grutatxt();
  43
  44  # process a Grutatxt format string
  45  @output=$grutatxt->process($text);
  46
  47  # idem for a file
  48  @output2=$grutatxt->process_file($file);
  49
  50 =head1 DESCRIPTION
  51
  52 Grutatxt is a module to process text documents in
  53 a special markup format (also called Grutatxt), very
  54 similar to plain ASCII text. These documents can be
  55 converted to HTML or troff.
  56
  57 The markup is designed to be fairly intuitive and
  58 straightforward and can include headings, bold and italic
  59 text effects, bulleted, numbered and definition lists, URLs,
  60 function and variable names, preformatted text, horizontal
  61 separators and tables. Special marks can be inserted in the
  62 text and a heading-based structural index can be obtained
  63 from it.
  64
  65 A comprehensive description of the markup is defined in
  66 the README file, included with the Grutatxt package (it is
  67 written in Grutatxt format itself, so it can be converted
  68 using the I<grutatxt> tool to any of the supported formats).
  69 The latest version (and more information) can be retrieved
  70 from the Grutatxt home page at:
  71
  72  http://www.triptico.com/software/grutatxt.html
  73
  74 =head1 FUNCTIONS AND METHODS
  75
  76 =head2 B<new>
  77
  78  $grutatxt=new Grutatxt([ "mode"  => $mode, ]
  79                         [ "title" => \$title, ]
  80                         [ "marks" => \@marks, ]
  81                         [ "index" => \@index, ]
  82                         [ "abstract" => \$abstract, ]
  83                         [ "strip-parens" => $bool, ]
  84                         [ "strip-dollars" => $bool, ]
  85                         [ %driver_specific_arguments ] );
  86
  87 Creates a new Grutatxt object instance. All parameters are
  88 optional.
  89
  90 =over 4
  91
  92 =item I<mode>
  93
  94 Output format. Can be HTML or troff. HTML is used if not specified.
  95
  96 =item I<title>
  97
  98 If I<title> is specified as a reference to scalar, the first
  99 level 1 heading found in the text is stored inside it.
 100
 101 =item I<marks>
 102
 103 Marks in the Grutatxt markup are created by inserting the
 104 string <-> alone in a line. If I<marks> is specified as a
 105 reference to array, it will be filled with the subscripts
 106 (relative to the output array) of the lines where the marks
 107 are found in the text.
 108
 109 =item I<index>
 110
 111 If I<index> is specified as a reference to array, it will
 112 be filled with strings in the format
 113
 114  level,heading
 115
 116 This information can be used to build a table of contents
 117 of the processed text.
 118
 119 =item I<strip-parens>
 120
 121 Function names in the Grutatxt markup are strings of
 122 alphanumeric characters immediately followed by a pair
 123 of open and close parentheses. If this boolean value is
 124 set, function names found in the processed text will have
 125 their parentheses deleted.
 126
 127 =item I<strip-dollars>
 128
 129 Variable names in the Grutatxt markup are strings of
 130 alphanumeric characters preceded by a dollar sign.
 131 If this boolean value is set, variable names found in
 132 the processed text will have the dollar sign deleted.
 133
 134 =item I<abstract>
 135
 136 The I<abstract> of a Grutatxt document is the fragment of text
 137 from the beginning of the document to the end of the first
 138 paragraph after the title. If I<abstract> is specified as a
 139 reference to scalar, it will contain (after each call to the
 140 B<process()> method) the subscript of the element of the output
 141 array that marks the end of the subject.
 142
 143 =back
 144
 145 =cut
 146
 147 sub new
 148 {
 149         my ($class,%args)=@_;
 150         my ($gh);
 151
 152         $args{'mode'}||='HTML';
 153
 154         $class.="::".$args{'mode'};
 155
 156         $gh=new $class(%args);
 157
 158         return($gh);
 159 }
 160
 161
 162 =head2 B<process>
 163
 164  @output=$grutatxt->process($text);
 165
 166 Processes a text in Grutatxt format. The result is returned
 167 as an array of lines.
 168
 169 =cut
 170
 171 sub process
 172 {
 173         my ($gh,$content)=@_;
 174         my ($p);
 175
 176         # clean output
 177         @{$gh->{'o'}}=();
 178
 179         # clean title and paragraph numbers
 180         $gh->{'-title'}="";
 181         $gh->{'-p'}=0;
 182
 183         # clean marks
 184         @{$gh->{'marks'}}=() if ref($gh->{'marks'});
 185
 186         # clean index
 187         @{$gh->{'index'}}=() if ref($gh->{'index'});
 188
 189         # reset abstract line
 190         ${$gh->{'abstract'}}=0 if ref($gh->{'abstract'});
 191
 192         # insert prefix
 193         $gh->_prefix();
 194
 195         $gh->{'-mode'}=undef;
 196
 197         foreach my $l (split(/\n/,$content))
 198         {
 199                 # inline data (passthrough)
 200                 if($l =~ /^<<$/ .. $l =~ /^>>$/)
 201                 {
 202                         $gh->_inline($l);
 203                         next;
 204                 }
 205
 206                 # marks
 207                 if($l =~ /^\s*<\->\s*$/)
 208                 {
 209                         push(@{$gh->{'marks'}},scalar(@{$gh->{'o'}}))
 210                                 if ref($gh->{'marks'});
 211
 212                         next;
 213                 }
 214
 215                 # escape possibly dangerous characters
 216                 $l=$gh->_escape($l);
 217
 218                 # empty lines
 219                 $l =~ s/^\r$//ge;
 220                 if($l =~ s/^$/$gh->_empty_line()/ge)
 221                 {
 222                         # mark the abstract end
 223                         if($gh->{'-title'})
 224                         {
 225                                 $gh->{'-p'}++;
 226
 227                                 # mark abstract if it's the
 228                                 # second paragraph from the title
 229                                 ${$gh->{'abstract'}}=scalar(@{$gh->{'o'}})-1
 230                                         if $gh->{'-p'}==2;
 231                         }
 232                 }
 233
 234                 if($gh->{'-process-urls'})
 235                 {
 236                         # URLs followed by a parenthesized phrase
 237                         $l =~ s/(http:\/\/\S+)\s+\(([^\)]+)\)/$gh->_url($1,$2)/ge;
 238
 239                         # URLs without phrase
 240                         $l =~ s/([^=][^\"])(http:\/\/\S+)/$1.$gh->_url($2)/ge;
 241                         $l =~ s/^(http:\/\/\S+)/$gh->_url($1)/ge;
 242                 }
 243
 244                 # change '''text''' and *text* into strong emphasis
 245                 $l =~ s/\'\'\'([^\'][^\'][^\']*)\'\'\'/$gh->_strong($1)/ge;
 246                 $l =~ s/\*(\S[^\*]+\S)\*/$gh->_strong($1)/ge;
 247                 $l =~ s/\*(\S+)\*/$gh->_strong($1)/ge;
 248
 249                 # change ''text'' and _text_ into emphasis
 250                 $l =~ s/\'\'([^\'][^\']*)\'\'/$gh->_em($1)/ge;
 251                 $l =~ s/\b_(\S[^_]*\S)_\b/$gh->_em($1)/ge;
 252                 $l =~ s/\b_(\S+)_\b/$gh->_em($1)/ge;
 253
 254                 # enclose function names
 255                 if($gh->{'strip-parens'})
 256                 {
 257                         $l =~ s/(\w+)\(\)/$gh->_funcname($1)/ge;
 258                 }
 259                 else
 260                 {
 261                         $l =~ s/(\w+)\(\)/$gh->_funcname($1."()")/ge;
 262                 }
 263
 264                 # enclose variable names
 265                 if($gh->{'strip-dollars'})
 266                 {
 267                         $l =~ s/\$([\w_\.]+)/$gh->_varname($1)/ge;
 268                 }
 269                 else
 270                 {
 271                         $l =~ s/(\$[\w_\.]+)/$gh->_varname($1)/ge;
 272                 }
 273
 274                 #
 275                 # main switch
 276                 #
 277
 278                 # definition list
 279                 if($l =~ s/^\s\*\s+([\w\s\-]+)\:\s+/$gh->_dl($1)/e)
 280                 {
 281                 }
 282
 283                 # unsorted list
 284                 elsif($gh->{'-mode'} ne "pre" and
 285                      ($l =~ s/^(\s+)\*\s+/$gh->_unsorted_list($1)/e or
 286                       $l =~ s/^(\s+)\-\s+/$gh->_unsorted_list($1)/e))
 287                 {
 288                 }
 289
 290                 # sorted list
 291                 elsif($gh->{'-mode'} ne "pre" and
 292                      ($l =~ s/^(\s+)\#\s+/$gh->_ordered_list($1)/e or
 293                       $l =~ s/^(\s+)1\s+/$gh->_ordered_list($1)/e))
 294                 {
 295                 }
 296
 297                 # quoted block
 298                 elsif($l =~ s/^\s\"/$gh->_blockquote()/e)
 299                 {
 300                 }
 301
 302                 # table rows
 303                 elsif($l =~ s/^\s*\|(.*)\|\s*$/$gh->_table_row($1)/e)
 304                 {
 305                 }
 306
 307                 # table heading / end of row
 308                 elsif($l =~ s/^\s*(\+[-\+\|]+\+)\s*$/$gh->_table($1)/e)
 309                 {
 310                 }
 311
 312                 # preformatted text
 313                 elsif($l =~ s/^(\s.*)$/$gh->_pre($1)/e)
 314                 {
 315                 }
 316
 317                 # anything else
 318                 else
 319                 {
 320                         # back to normal mode
 321                         $gh->_new_mode(undef);
 322                 }
 323
 324                 # 1 level heading
 325                 $l =~ s/^(=+)\s*$/$gh->_process_heading(1,$1)/e;
 326
 327                 # 2 level heading
 328                 $l =~ s/^(-+)\s*$/$gh->_process_heading(2,$1)/e;
 329
 330                 # 3 level heading
 331                 $l =~ s/^(~+)\s*$/$gh->_process_heading(3,$1)/e;
 332
 333                 # change ------ into hr
 334                 $l =~ s/^----*$/$gh->_hr()/e;
 335
 336                 # push finally
 337                 $gh->_push($l) if $l;
 338         }
 339
 340         # flush
 341         $gh->_new_mode(undef);
 342
 343         # postfix
 344         $gh->_postfix();
 345
 346         # set title
 347         ${$gh->{'title'}}=$gh->{'-title'} if ref($gh->{'title'});
 348
 349         # set abstract, if not set
 350         ${$gh->{'abstract'}}=scalar(@{$gh->{'o'}})
 351                 if ref($gh->{'abstract'}) and not ${$gh->{'abstract'}};
 352
 353         return(@{$gh->{'o'}});
 354 }
 355
 356
 357 =head2 B<process_file>
 358
 359  @output=$grutatxt->process_file($filename);
 360
 361 Processes a file in Grutatxt format.
 362
 363 =cut
 364
 365 sub process_file
 366 {
 367         my ($gh,$file)=@_;
 368
 369         open F, $file or return(undef);
 370
 371         my ($content)=join('',<F>);
 372         close F;
 373
 374         return($gh->process($content));
 375 }
 376
 377
 378 sub _push
 379 {
 380         my ($gh,$l)=@_;
 381
 382         push(@{$gh->{'o'}},$l);
 383 }
 384
 385
 386 sub _process_heading
 387 {
 388         my ($gh,$level,$hd)=@_;
 389         my ($l);
 390
 391         $l=pop(@{$gh->{'o'}});
 392
 393         if($l eq $gh->_empty_line())
 394         {
 395                 $gh->_push($l);
 396                 return($hd);
 397         }
 398
 399         # store title
 400         $gh->{'-title'}=$l if $level==1 and not $gh->{'-title'};
 401
 402         # store index
 403         if(ref($gh->{'index'}))
 404         {
 405                 push(@{$gh->{'index'}},"$level,$l");
 406         }
 407
 408         return($gh->_heading($level,$l));
 409 }
 410
 411
 412 sub _calc_col_span
 413 {
 414         my ($gh,$l)=@_;
 415         my (@spans);
 416
 417         # strip first + and all -
 418         $l =~ s/^\+//;
 419         $l =~ s/-//g;
 420
 421         my ($t)=1; @spans=();
 422         for(my $n=0;$n < length($l);$n++)
 423         {
 424                 if(substr($l,$n,1) eq '+')
 425                 {
 426                         push(@spans,$t);
 427                         $t=1;
 428                 }
 429                 else
 430                 {
 431                         # it's a colspan mark:
 432                         # increment
 433                         $t++;
 434                 }
 435         }
 436
 437         return(@spans);
 438 }
 439
 440
 441 sub _table_row
 442 {
 443         my ($gh,$str)=@_;
 444
 445         my @s=split(/\|/,$str);
 446
 447         for(my $n=0;$n < scalar(@s);$n++)
 448         {
 449                 ${$gh->{'-table'}}[$n].=' '.$s[$n];
 450         }
 451
 452         return("");
 453 }
 454
 455
 456 sub _pre
 457 {
 458         my ($gh,$l)=@_;
 459
 460         # if any other mode is active, add to it
 461         if($gh->{'-mode'} and $gh->{'-mode'} ne "pre")
 462         {
 463                 $l =~ s/^\s+//;
 464
 465                 my ($a)=pop(@{$gh->{'o'}})." ".$l;
 466                 $gh->_push($a);
 467                 $l="";
 468         }
 469         else
 470         {
 471                 $gh->_new_mode("pre");
 472         }
 473
 474         return($l);
 475 }
 476
 477
 478 sub _multilevel_list
 479 {
 480         my ($gh, $str, $ind)=@_;
 481         my (@l,$level);
 482
 483         @l = @{$gh->{$str}};
 484         $ind = length($ind);
 485         $level = 0;
 486
 487         if($l[-1] < $ind)
 488         {
 489                 # if last level is less indented, increase
 490                 # nesting level
 491                 push(@l, $ind);
 492                 $level++;
 493         }
 494         elsif($l[-1] > $ind)
 495         {
 496                 # if last level is more indented, decrease
 497                 # levels until the same is found (or back to
 498                 # the beginning if not)
 499                 while(pop(@l))
 500                 {
 501                         $level--;
 502                         last if $l[-1] == $ind;
 503                 }
 504         }
 505
 506         $gh->{$str} = \@l;
 507
 508         return($level);
 509 }
 510
 511
 512 sub _unsorted_list
 513 {
 514         my ($gh, $ind)=@_;
 515
 516         return($gh->_ul($gh->_multilevel_list('-ul-levels', $ind)));
 517 }
 518
 519
 520 sub _ordered_list
 521 {
 522         my ($gh, $ind)=@_;
 523
 524         return($gh->_ol($gh->_multilevel_list('-ol-levels', $ind)));
 525 }
 526
 527
 528 # empty stubs for falling through the superclass
 529
 530 sub _inline { my ($gh,$l)=@_; $l; }
 531 sub _escape { my ($gh,$l)=@_; $l; }
 532 sub _empty_line { my ($gh)=@_; ""; }
 533 sub _url { my ($gh,$url,$label)=@_; ""; }
 534 sub _strong { my ($gh,$str)=@_; $str; }
 535 sub _em { my ($gh,$str)=@_; $str; }
 536 sub _funcname { my ($gh,$str)=@_; $str; }
 537 sub _varname { my ($gh,$str)=@_; $str; }
 538 sub _new_mode { my ($gh,$mode)=@; }
 539 sub _dl { my ($gh,$str)=@_; $str; }
 540 sub _ul { my ($gh,$level)=@_; ""; }
 541 sub _ol { my ($gh,$level)=@_; ""; }
 542 sub _blockquote { my ($gh,$str)=@_; $str; }
 543 sub _hr { my ($gh)=@_; "" }
 544 sub _heading { my ($gh,$level,$l)=@_; $l; }
 545 sub _table { my ($gh,$str)=@_; $str; }
 546 sub _prefix { my ($gh)=@_; }
 547 sub _postfix { my ($gh)=@_; }
 548
 549 ###########################################################
 550
 551 =head1 DRIVER SPECIFIC INFORMATION
 552
 553 =cut
 554
 555 ###########################################################
 556 # HTML Driver
 557
 558 package Grutatxt::HTML;
 559
 560 @ISA=("Grutatxt");
 561
 562 =head2 HTML Driver
 563
 564 The additional parameters for a new Grutatxt object are:
 565
 566 =over 4
 567
 568 =item I<table-headers>
 569
 570 If this boolean value is set, the first row in tables
 571 is assumed to be the heading and rendered using <th>
 572 instead of <td> tags.
 573
 574 =item I<center-tables>
 575
 576 If this boolean value is set, tables are centered.
 577
 578 =item I<expand-tables>
 579
 580 If this boolean value is set, tables are expanded (width 100%).
 581
 582 =item I<dl-as-dl>
 583
 584 If this boolean value is set, definition lists will be
 585 rendered using <dl>, <dt> and <dd> instead of tables.
 586
 587 =item I<header-offset>
 588
 589 Offset to be summed to the heading level when rendering
 590 <h?> tags (default is 0).
 591
 592 =item I<class-oddeven>
 593
 594 If this boolean value is set, tables will be rendered
 595 with an "oddeven" CSS class, and rows alternately classed
 596 as "even" or "odd". If it's not set, no CSS class info
 597 is added to tables.
 598
 599 =back
 600
 601 =cut
 602
 603 sub new
 604 {
 605         my ($class,%args)=@_;
 606         my ($gh);
 607
 608         bless(\%args,$class);
 609         $gh=\%args;
 610
 611         $gh->{'-process-urls'}=1;
 612
 613         return($gh);
 614 }
 615
 616
 617 sub _inline
 618 {
 619         my ($gh,$l)=@_;
 620
 621         # accept unnamed and HTML inlines
 622         if($l =~ /^<<$/ or $l =~ /^<<\s*html$/i)
 623         {
 624                 $gh->{'-inline'}="HTML";
 625                 return;
 626         }
 627
 628         if($l =~ /^>>$/)
 629         {
 630                 delete $gh->{'-inline'};
 631                 return;
 632         }
 633
 634         if($gh->{'-inline'} eq "HTML")
 635         {
 636                 $gh->_push($l);
 637         }
 638 }
 639
 640
 641 sub _escape
 642 {
 643         my ($gh,$l)=@_;
 644
 645         $l =~ s/&/&amp;/g;
 646         $l =~ s/</&lt;/g;
 647         $l =~ s/>/&gt;/g;
 648
 649         return($l);
 650 }
 651
 652
 653 sub _empty_line
 654 {
 655         my ($gh)=@_;
 656
 657         return("<p>");
 658 }
 659
 660
 661 sub _url
 662 {
 663         my ($gh,$url,$label)=@_;
 664
 665         $label=$url unless $label;
 666
 667         return("<a href=\"$url\">$label</a>");
 668 }
 669
 670
 671 sub _strong
 672 {
 673         my ($gh,$str)=@_;
 674         return("<strong class=strong>$str</strong>");
 675 }
 676
 677
 678 sub _em
 679 {
 680         my ($gh,$str)=@_;
 681         return("<em class=em>$str</em>");
 682 }
 683
 684
 685 sub _funcname
 686 {
 687         my ($gh,$str)=@_;
 688         return("<code class=funcname>$str</code>");
 689 }
 690
 691
 692 sub _varname
 693 {
 694         my ($gh,$str)=@_;
 695         return("<code class=var>$str</code>");
 696 }
 697
 698
 699 sub _new_mode
 700 {
 701         my ($gh,$mode,$params)=@_;
 702
 703         if($mode ne $gh->{'-mode'})
 704         {
 705                 my $tag;
 706
 707                 # flush previous mode
 708
 709                 # clean list levels
 710                 if($gh->{'-mode'} eq "ul")
 711                 {
 712                         $gh->_push("</ul>" x scalar(@{$gh->{'-ul-levels'}}));
 713                 }
 714                 elsif($gh->{'-mode'} eq "ol")
 715                 {
 716                         $gh->_push("</ol>" x scalar(@{$gh->{'-ol-levels'}}));
 717                 }
 718                 elsif($gh->{'-mode'})
 719                 {
 720                         $gh->_push("</$gh->{'-mode'}>");
 721                 }
 722
 723                 # send new one
 724                 $tag=$params ? "<$mode $params>" : "<$mode>";
 725                 $gh->_push($tag) if $mode;
 726
 727                 $gh->{'-mode'}=$mode;
 728
 729                 # clean previous lists
 730                 $gh->{'-ul-levels'} = undef;
 731                 $gh->{'-ol-levels'} = undef;
 732         }
 733 }
 734
 735
 736 sub _dl
 737 {
 738         my ($gh,$str)=@_;
 739
 740         if($gh->{'dl-as-dl'})
 741         {
 742                 $gh->_new_mode("dl");
 743                 return("<dt><strong class=term>$str</strong><dd>");
 744         }
 745         else
 746         {
 747                 $gh->_new_mode("table");
 748                 return("<tr><td valign=top><strong class=term>$1</strong>&nbsp;&nbsp;</td><td valign=top>");
 749         }
 750 }
 751
 752
 753 sub _ul
 754 {
 755         my ($gh, $levels)=@_;
 756         my ($ret);
 757
 758         $ret="";
 759
 760         if($levels > 0)
 761         {
 762                 $ret="<ul>";
 763         }
 764         elsif($levels < 0)
 765         {
 766                 $ret="</ul>" x abs($levels);
 767         }
 768
 769         $gh->{'-mode'}="ul";
 770
 771         $ret.="<li>";
 772
 773         return($ret);
 774 }
 775
 776
 777 sub _ol
 778 {
 779         my ($gh, $levels)=@_;
 780         my ($ret);
 781
 782         $ret="";
 783
 784         if($levels > 0)
 785         {
 786                 $ret="<ol>";
 787         }
 788         elsif($levels < 0)
 789         {
 790                 $ret="</ol>" x abs($levels);
 791         }
 792
 793         $gh->{'-mode'}="ol";
 794
 795         $ret.="<li>";
 796
 797         return($ret);
 798 }
 799
 800
 801 sub _blockquote
 802 {
 803         my ($gh)=@_;
 804
 805         $gh->_new_mode("blockquote");
 806         return("\"");
 807 }
 808
 809
 810 sub _hr
 811 {
 812         my ($gh)=@_;
 813
 814         return("<hr size=1 noshade>");
 815 }
 816
 817
 818 sub _heading
 819 {
 820         my ($gh,$level,$l)=@_;
 821
 822         # substitute anchor spaces with underscores
 823         my ($a)=lc($l); $a =~ s/\s/_/g;
 824
 825         $l=sprintf("<a name=\"%s\"></a>\n<h%d class=level$level>%s</h%d>",
 826                 $a, $level+$gh->{'header-offset'},
 827                 $l, $level+$gh->{'header-offset'});
 828
 829         return($l);
 830 }
 831
 832
 833 sub _table
 834 {
 835         my ($gh,$str)=@_;
 836
 837         if($gh->{'-mode'} eq "table")
 838         {
 839                 my ($class)="";
 840                 my (@spans)=$gh->_calc_col_span($str);
 841
 842                 # calculate CSS class, if any
 843                 if($gh->{'class-oddeven'})
 844                 {
 845                         $class=($gh->{'-tbl-row'} & 1) ? "odd" : "even";
 846                 }
 847
 848                 $str="<tr $class>";
 849
 850                 # build columns
 851                 for(my $n=0;$n < scalar(@{$gh->{'-table'}});$n++)
 852                 {
 853                         my ($i,$s);
 854
 855                         $i=${$gh->{'-table'}}[$n];
 856                         $i="&nbsp;" if $i =~ /^\s*$/;
 857
 858                         $s=" colspan=$spans[$n]" if $spans[$n] > 1;
 859
 860                         if($gh->{'table-headers'} and $gh->{'-tbl-row'}==1)
 861                         {
 862                                 $str.="<th $class $s>$i</th>";
 863                         }
 864                         else
 865                         {
 866                                 $str.="<td $class $s>$i</td>";
 867                         }
 868                 }
 869
 870                 @{$gh->{'-table'}}=();
 871                 $gh->{'-tbl-row'}++;
 872         }
 873         else
 874         {
 875                 # new table
 876                 my ($params);
 877
 878                 $params="border=1";
 879                 $params.=" width='100\%'" if $gh->{'expand-tables'};
 880                 $params.=" align=center" if $gh->{'center-tables'};
 881                 $params.=" class=oddeven" if $gh->{'class-oddeven'};
 882
 883                 $gh->_new_mode("table", $params);
 884
 885                 @{$gh->{'-table'}}=();
 886                 $gh->{'-tbl-row'}=1;
 887                 $str="";
 888         }
 889
 890         return($str);
 891 }
 892
 893
 894 ###########################################################
 895 # troff Driver
 896
 897 package Grutatxt::troff;
 898
 899 @ISA=("Grutatxt");
 900
 901 =head2 troff Driver
 902
 903 The troff driver uses the B<-me> macros and B<tbl>. A
 904 good way to post-process this output (to PostScript in
 905 the example) could be by using
 906
 907  groff -t -me -Tps
 908
 909 The additional parameters for a new Grutatxt object are:
 910
 911 =over 4
 912
 913 =item I<normal-size>
 914
 915 The point size of normal text. By default is 10.
 916
 917 =item I<heading-sizes>
 918
 919 This argument must be a reference to an array containing
 920 the size in points of the 3 different heading levels. By
 921 default, level sizes are [ 20, 18, 15 ].
 922
 923 =item I<table-type>
 924
 925 The type of table to be rendered by B<tbl>. Can be
 926 I<allbox> (all lines rendered; this is the default value),
 927 I<box> (only outlined) or I<doublebox> (only outlined by
 928 a double line).
 929
 930 =back
 931
 932 =cut
 933
 934 sub new
 935 {
 936         my ($class,%args)=@_;
 937         my ($gh);
 938
 939         bless(\%args,$class);
 940         $gh=\%args;
 941
 942         $gh->{'-process-urls'}=0;
 943
 944         $gh->{'heading-sizes'}||=[ 20, 18, 15 ];
 945         $gh->{'normal-size'}||=10;
 946         $gh->{'table-type'}||="allbox"; # box, allbox, doublebox
 947
 948         return($gh);
 949 }
 950
 951
 952 sub _prefix
 953 {
 954         my ($gh)=@_;
 955
 956         $gh->_push(".nr pp $gh->{'normal-size'}");
 957         $gh->_push(".nh");
 958 }
 959
 960
 961 sub _inline
 962 {
 963         my ($gh,$l)=@_;
 964
 965         # accept only troff inlines
 966         if($l =~ /^<<\s*troff$/i)
 967         {
 968                 $gh->{'-inline'}="troff";
 969                 return;
 970         }
 971
 972         if($l =~ /^>>$/)
 973         {
 974                 delete $gh->{'-inline'};
 975                 return;
 976         }
 977
 978         if($gh->{'-inline'} eq "troff")
 979         {
 980                 $gh->_push($l);
 981         }
 982 }
 983
 984
 985 sub _escape
 986 {
 987         my ($gh,$l)=@_;
 988
 989         $l =~ s/\\/\\\\/g;
 990         $l =~ s/^'/\\&'/;
 991
 992         return($l);
 993 }
 994
 995
 996 sub _empty_line
 997 {
 998         my ($gh)=@_;
 999
1000         return(".lp");
1001 }
1002
1003
1004 sub _strong
1005 {
1006         my ($gh,$str)=@_;
1007         return("\\fB$str\\fP");
1008 }
1009
1010
1011 sub _em
1012 {
1013         my ($gh,$str)=@_;
1014         return("\\fI$str\\fP");
1015 }
1016
1017
1018 sub _funcname
1019 {
1020         my ($gh,$str)=@_;
1021         return("\\fB$str\\fP");
1022 }
1023
1024
1025 sub _varname
1026 {
1027         my ($gh,$str)=@_;
1028         return("\\fI$str\\fP");
1029 }
1030
1031
1032 sub _new_mode
1033 {
1034         my ($gh,$mode,$params)=@_;
1035
1036         if($mode ne $gh->{'-mode'})
1037         {
1038                 my $tag;
1039
1040                 # flush previous list
1041                 if($gh->{'-mode'} eq "pre")
1042                 {
1043                         $gh->_push(".)l");
1044                 }
1045                 elsif($gh->{'-mode'} eq "table")
1046                 {
1047                         chomp($gh->{'-table-head'});
1048                         $gh->{'-table-head'} =~ s/\s+$//;
1049                         $gh->_push($gh->{'-table-head'}.".");
1050                         $gh->_push($gh->{'-table-body'}.".TE\n.sp 0.6");
1051                 }
1052                 elsif($gh->{'-mode'} eq "blockquote")
1053                 {
1054                         $gh->_push(".)q");
1055                 }
1056
1057                 # send new one
1058                 if($mode eq "pre")
1059                 {
1060                         $gh->_push(".(l L");
1061                 }
1062                 elsif($mode eq "blockquote")
1063                 {
1064                         $gh->_push(".(q");
1065                 }
1066
1067                 $gh->{'-mode'}=$mode;
1068         }
1069 }
1070
1071
1072 sub _dl
1073 {
1074         my ($gh,$str)=@_;
1075
1076         $gh->_new_mode("dl");
1077         return(".ip \"$str\"\n");
1078 }
1079
1080
1081 sub _ul
1082 {
1083         my ($gh)=@_;
1084
1085         $gh->_new_mode("ul");
1086         return(".bu\n");
1087 }
1088
1089
1090 sub _ol
1091 {
1092         my ($gh)=@_;
1093
1094         $gh->_new_mode("ol");
1095         return(".np\n");
1096 }
1097
1098
1099 sub _blockquote
1100 {
1101         my ($gh)=@_;
1102
1103         $gh->_new_mode("blockquote");
1104         return("\"");
1105 }
1106
1107
1108 sub _hr
1109 {
1110         my ($gh)=@_;
1111
1112         return(".hl");
1113 }
1114
1115
1116 sub _heading
1117 {
1118         my ($gh,$level,$l)=@_;
1119
1120         $l=".sz ".${$gh->{'heading-sizes'}}[$level - 1]."\n$l\n.sp 0.6";
1121
1122         return($l);
1123 }
1124
1125
1126 sub _table
1127 {
1128         my ($gh,$str)=@_;
1129
1130         if($gh->{'-mode'} eq "table")
1131         {
1132                 my ($h,$b);
1133                 my (@spans)=$gh->_calc_col_span($str);
1134
1135                 # build columns
1136                 $h="";
1137                 $b="";
1138                 for(my $n=0;$n < scalar(@{$gh->{'-table'}});$n++)
1139                 {
1140                         my ($i);
1141
1142                         if($gh->{'table-headers'} and $gh->{'-tbl-row'}==1)
1143                         {
1144                                 $h.="cB ";
1145                         }
1146                         else
1147                         {
1148                                 $h.="l ";
1149                         }
1150
1151                         # add span columns
1152                         $h.="s " x ($spans[$n] - 1) if $spans[$n] > 1;
1153
1154                         $b.="#" if $n;
1155
1156                         $i=${$gh->{'-table'}}[$n];
1157                         $i =~ s/^\s+//;
1158                         $i =~ s/\s+$//;
1159                         $i =~ s/(\s)+/$1/g;
1160                         $b.=$i;
1161                 }
1162
1163                 # add a separator
1164                 $b.="\n_" if $gh->{'table-headers'} and
1165                              $gh->{'-tbl-row'}==1 and
1166                              $gh->{'table-type'} ne "allbox";
1167
1168                 $gh->{'-table-head'}.="$h\n";
1169                 $gh->{'-table-body'}.="$b\n";
1170
1171                 @{$gh->{'-table'}}=();
1172                 $gh->{'-tbl-row'}++;
1173         }
1174         else
1175         {
1176                 # new table
1177                 $gh->_new_mode("table");
1178
1179                 @{$gh->{'-table'}}=();
1180                 $gh->{'-tbl-row'}=1;
1181
1182                 $gh->{'-table-head'}=".TS\n$gh->{'table-type'} tab (#);\n";
1183                 $gh->{'-table-body'}="";
1184         }
1185
1186         $str="";
1187         return($str);
1188 }
1189
1190
1191 sub _postfix
1192 {
1193         my ($gh)=@_;
1194
1195         # add to top headings and footers
1196         unshift(@{$gh->{'o'}},".ef '\%' ''");
1197         unshift(@{$gh->{'o'}},".of '' '\%'");
1198         unshift(@{$gh->{'o'}},".eh '$gh->{'-title'}' ''");
1199         unshift(@{$gh->{'o'}},".oh '' '$gh->{'-title'}'");
1200 }
1201
1202
1203 =head1 AUTHOR
1204
1205 Angel Ortega angel@triptico.com
1206
1207 =cut
1208
1209 1;