lib/reLyX/RelyxTable.pm

   1 # This file is part of reLyX
   2 # Copyright (c) 1998-9 Amir Karger karger@post.harvard.edu
   3 # You are free to use and modify this code under the terms of
   4 # the GNU General Public Licence version 2 or later.
   5
   6 package RelyxTable;
   7
   8 # This is a package to read LaTeX tables and print out LyX tables
   9
  10
  11 # We declare here the sub-packages found in this package.
  12 # This allows the parser to understand "indirect object" form of subroutines
  13 {
  14 package RelyxTable::Table;
  15 package RelyxTable::Column;
  16 package RelyxTable::Row;
  17 }
  18
  19 use strict;
  20
  21 # Variables used by other packages
  22 use vars qw(@table_array $TableBeginString $TableEndString);
  23 # @table_array is the list of all arrays
  24 # $TableBeginString is a string to write during one pass so that a later
  25 #     pass knows to put the table info there
  26 # $TableEndString is written at the end of the table so that we know
  27 #     the table is done
  28 $TableBeginString = '%%%%%Insert reLyX table here!';
  29 $TableEndString =   '%%%%%End of reLyX table!';
  30
  31 # Debugging on?
  32 my $debug_on;
  33
  34 # Are we currently inside a table?
  35 # If we are, return the table
  36 sub in_table {
  37     return "" unless defined(@table_array); # no tables exist
  38     my $thistable = $table_array[-1];
  39     if ($thistable->{"active"}) {
  40         return (bless $thistable, "RelyxTable::Table");
  41     } else {
  42         return "";
  43     }
  44 }
  45
  46
  47 # Global variables###############
  48 # LyX' enums corresponding to table alignments
  49 my %TableAlignments = ("l" => 2, "r" => 4, "c" => 8);
  50 # LyX' enums corresponding to multicol types
  51 #    normal (non-multicol) cell, beginning of a multicol, part of a multicol
  52 my %MulticolumnTypes = ("normal" => 0, "begin" => 1, "part" => 2);
  53
  54 # Subroutines used by tables and rows, e.g.
  55 sub parse_cols {
  56 # parse a table's columns' description
  57 # Returns an array where each element is one column description
  58 # arg0 is the description -- a Text::TeX::Group
  59     my $groupref = shift;
  60     my (@cols, @new_cols);
  61     my ($tok, $description, $i);
  62
  63     # tokens in the group, not including '{' and '}'
  64     my @group = $groupref->contents;
  65
  66     # Loop over the token(s) in the group
  67     my $first = ""; my $tempfirst;
  68     while (@group) {
  69
  70         $tok = shift(@group);
  71         # Each $tok will consist of /^[clr|]*[p*@]?$/
  72         # (Except first may have | and/or @ expressions before it)
  73         # p*@ will end the $tok since after it comes a group in braces
  74         # @ will be a TT::Token, everything else will be in TT::Text
  75         $description = $tok->print;
  76
  77         # Chop off left lines for first column if any
  78         ($tempfirst = $description) =~ s/(\|*).*/$1/;
  79         if ($#cols == -1) { # |'s before any column description
  80             $first .= $tempfirst;
  81         } else {
  82             $cols[-1] .= $tempfirst; # add it to end of current col
  83         }
  84
  85         # Greedy searches, so only 0th column can possibly have left line
  86         @new_cols = ($description =~ /[clr]\|*/g);
  87         push @cols, @new_cols;
  88
  89         # parse a p or * or @ if necessary
  90         # use exact_print in case there's weird stuff in the @ descriptions
  91         $description = substr($description,-1);
  92         if ($description eq 'p') {
  93             $tok = shift(@group);
  94             my $pdes = $description . $tok->exact_print; # "p{foo}"
  95             push @cols, $pdes;
  96
  97         } elsif ($description eq '@') {
  98             $tok = shift(@group);
  99             my $atdes = $description . $tok->exact_print;
 100             if ($#cols == -1) { # it's an @ before any column description
 101                 $first .= $atdes;
 102             } else {
 103                 $cols[-1] .= $atdes; # add it to end of current col
 104             }
 105
 106         } elsif ($description eq '*') {
 107
 108             $tok = shift(@group); # TT::Group with number of repeats in it
 109             my $rep = $tok->contents->print;
 110             $tok = shift(@group); # Group to repeat $rep times
 111             @new_cols = &parse_cols($tok);
 112             foreach $i (1 .. $rep) {
 113                 push @cols, @new_cols;
 114             }
 115         }
 116     } # end loop over description tokens
 117
 118     # this handles description like {|*{3}{c}}
 119     $cols[0] = $first . $cols[0];
 120
 121     return @cols;
 122 } # end sub parse_cols
 123
 124 ################################################################################
 125 # This package handles tables for reLyX
 126
 127 {
 128     package RelyxTable::Table;
 129     # Table class
 130     # Fields:
 131     #    columns - array containing references to RelyxTable::Columns
 132     #    rows    - array containing references to RelyxTable::Rows
 133     #    active  - are we currently reading this table?
 134     # Fields for printout
 135     #    is_long_table
 136     #    rotate
 137     #    endhead
 138     #    end_first_head
 139     #    endfoot
 140     #    end_last_foot
 141
 142
 143 # Subroutines to read and create the table
 144     sub new {
 145     # 'new' takes an argument containing the LaTeX table description string,
 146     #    which is a Text::TeX::Group token
 147
 148         my $class = shift; # should be "table"
 149         my $description = shift;
 150         my $thistable;
 151         # This seems like a convenient place to declare this...
 152         $debug_on= (defined($main::opt_d) && $main::opt_d);
 153
 154         # Initialize fields - including ones we don't support yet
 155         $thistable->{"is_long_table"} = 0;
 156         $thistable->{"rotate"} = 0;
 157         $thistable->{"endhead"} = 0;
 158         $thistable->{"end_first_head"} = 0;
 159         $thistable->{"endfoot"} = 0;
 160         $thistable->{"end_last_foot"} = 0;
 161         $thistable->{"active"} = 1;
 162
 163         bless $thistable, $class;
 164
 165         # Parse the column descriptions: return an array, where each
 166         #    element is a (regular text) single column description
 167         my @cols = &RelyxTable::parse_cols($description);
 168         my $colref;
 169         my $col_description;
 170         foreach $col_description (@cols) {
 171             $colref = new RelyxTable::Column $col_description;
 172             push @{$thistable->{"columns"}}, $colref;
 173         }
 174         # put the table into the table array
 175         push @RelyxTable::table_array, $thistable;
 176
 177
 178         # Now that it's blessed, put the 0th row into the table
 179         $thistable->addrow;
 180
 181         return $thistable;
 182     } # end sub new
 183
 184     sub addrow {
 185     # add a row to the table
 186     # Since we're starting the row, we're in the 0th column
 187         my $thistable = shift;
 188         my $row = new RelyxTable::Row;
 189         push (@{$thistable->{"rows"}}, $row);
 190
 191         # Also initialize the cells for this row
 192         my $col;
 193         foreach $col (@{$thistable->{"columns"}}) {
 194             push (@{$row->{"cells"}}, RelyxTable::Cell->new($row, $col));
 195         }
 196     } # end sub addrow
 197
 198     sub nextcol {
 199     # Go to next column - this just involves calling RT::Row->nextcol
 200     #    on the current row
 201         my $thistable = shift;
 202         my $row = $thistable->current_row;
 203         $row->nextcol;
 204     } # end of sub nextcol
 205
 206     sub hcline {
 207     # interpret an '\hline' or '\cline' command
 208     # (It's cline if there's an arg1)
 209     # hline:
 210     # Add a bottom line to the row *before* the current row, unless it's
 211     #    the top row. In that case, add a top line to the current (top) row
 212     # Change the row and all the cells that make up the row
 213     # cline:
 214     # Change the cells from the row in the range given in arg1
 215         my $thistable = shift;
 216         my $range = shift;
 217         my $is_cline = defined($range);
 218         my ($rownum, $line_str, $lastrow, $cell);
 219
 220         if ($lastrow = $thistable->numrows - 1) { # not top row
 221             $rownum = $lastrow - 1;
 222             $line_str = "bottom_line";
 223         } else {
 224             $rownum = $lastrow;
 225             $line_str = "top_line";
 226         }
 227
 228         my $row = $thistable->{"rows"}[$rownum];
 229         # Add a row line (only) if it's a \hline command
 230         unless ($is_cline) {
 231             $row->{"$line_str"} +=1;
 232             if (defined($main::opt_d) && $row->{"$line_str"} == 2) {
 233                 print "\nToo many \\hline's";
 234             }
 235         }
 236
 237         # Figure out which rows to change
 238         my ($r1, $r2);
 239         if ($is_cline) {
 240             $range =~ /(\d+)-(\d+)/ or warn "weird \\cline range";
 241             # LaTeX numbers columns from 1, we number from 0
 242             ($r1, $r2) = ($1 - 1, $2 - 1);
 243         } else {
 244             $r1 = 0;
 245             $r2 = $thistable->numcols - 1;
 246         }
 247
 248         my $i;
 249         foreach $i ($r1 .. $r2) {
 250             $cell = $row->{"cells"}[$i];
 251             $cell->{"$line_str"} +=1; # change the cells in the row
 252         }
 253     } # end sub hline
 254
 255     sub multicolumn {
 256     # interpret a \multicolumn command
 257     # This really just needs to call RT::Row->multicolumn for the correct row
 258         my $thistable = shift;
 259         my $row = $thistable->current_row;
 260         $row->multicolumn(@_);
 261     } # end sub multicolumn
 262
 263     sub done_reading {
 264     # Finished reading a table
 265         my $thistable = shift;
 266         # If we just had \hlines at the end, it's not a real row
 267         # But if numcols==1, curr_col *has* to be zero!
 268         # HACK HACK HACK. If numcols==1 but we need to subtract a row, we
 269         # won't know until LastLyX. At that point, we'll subtract a row.
 270         my $row = $thistable->current_row;
 271         if ($thistable->numcols > 1 && $row->{"curr_col"} == 0) {
 272             pop @{$thistable->{"rows"}}
 273         }
 274
 275         # We're no longer reading this table
 276         $thistable->{"active"} = 0;
 277
 278         if ($debug_on) {
 279             print "\nDone with table ",$#RelyxTable::table_array,", which has ",
 280                 $thistable->numrows," rows and ",
 281                 $thistable->numcols," columns";
 282             print"\nNumber of rows may be 1 too high" if $thistable->numcols==1;
 283         }
 284     } # end sub done_reading
 285
 286     sub print_info {
 287     # Subroutine to print out the table once it's created
 288         &print_info_221(@_);
 289     }
 290
 291     sub write_string {
 292         my ($name, $s) = @_;
 293         if (!$s) {
 294             return '';
 295         }
 296         return ' ' . $name . '="' . $s . '"';
 297     }
 298
 299     sub write_bool {
 300         my ($name, $b) = @_;
 301         if (!$b) {
 302             return '';
 303         }
 304         write_string $name, "true";
 305     }
 306
 307     sub write_int {
 308         my ($name, $i) = @_;
 309         if (!$i) {
 310             return '';
 311         }
 312         write_string $name, $i;
 313     }
 314
 315     sub print_info_221 {
 316     # Subroutine to print out the table in \lyxformat 221
 317         my $thistable = shift;
 318         my $to_print = '';
 319         # header line
 320         $to_print .= "\n<lyxtabular" .
 321             write_int("version", 3) .
 322             write_int("rows", $thistable->numrows) .
 323             write_int("columns", $thistable->numcols) .
 324             ">\n";
 325         # global longtable options
 326         $to_print .= "<features" .
 327            write_int ("rotate", 0) .
 328            write_bool("islongtable", 0) .
 329            write_int ("firstHeadTopDL", 0) .
 330            write_int ("firstHeadBottomDL", 0) .
 331            write_bool("firstHeadEmpty", 0) .
 332            write_int ("headTopDL", 0) .
 333            write_int ("headBottomDL", 0) .
 334            write_int ("footTopDL", 0) .
 335            write_int ("footBottomDL", 0) .
 336            write_int ("lastFootTopDL", 0) .
 337            write_int ("lastFootBottomDL", 0) .
 338            write_bool("lastFootEmpty", 0) .
 339            ">\n";
 340
 341     }
 342
 343     sub print_info_215 {
 344     # Subroutine to print out the table in \lyxformat 215
 345         # print the header information for this table
 346         my $thistable = shift;
 347         my $to_print = "";
 348         $to_print .= "\n\\LyXTable\nmulticol5\n";
 349         my @arr = ($thistable->numrows,
 350                     $thistable->numcols,
 351                     $thistable->{"is_long_table"},
 352                     $thistable->{"rotate"},
 353                     $thistable->{"endhead"},
 354                     $thistable->{"end_first_head"},
 355                     $thistable->{"endfoot"},
 356                     $thistable->{"end_last_foot"}
 357                   );
 358         $to_print .= join(" ",@arr);
 359         $to_print .= "\n";
 360
 361         # Print row info
 362         my $row;
 363         foreach $row (@{$thistable->{"rows"}}) {
 364             $to_print .= $row->print_info;
 365         }
 366
 367         # Print column info
 368         my $col;
 369         foreach $col (@{$thistable->{"columns"}}) {
 370             $to_print .= $col->print_info;
 371         }
 372
 373         # Print cell info
 374         my $cell;
 375         foreach $row (@{$thistable->{"rows"}}) {
 376             my $count = 0;
 377             foreach $col (@{$thistable->{"columns"}}) {
 378                 $cell = $row->{"cells"}[$count];
 379                 $count++;
 380                 $to_print .= $cell->print_info;
 381             }
 382         }
 383
 384         $to_print .= "\n";
 385
 386         return $to_print;
 387     } # end sub print_info
 388
 389 # Convenient subroutines
 390     sub numrows {
 391         my $thistable = shift;
 392         return $#{$thistable->{"rows"}} + 1;
 393     } # end sub numrows
 394
 395     sub numcols {
 396         my $thistable = shift;
 397         return $#{$thistable->{"columns"}} + 1;
 398     } # end sub numrows
 399
 400     sub current_row {
 401     # Return the current row blessed as an RT::Row
 402         my $thistable = shift;
 403         my $row = $thistable->{"rows"}[-1];
 404         bless $row, "RelyxTable::Row"; #... and return it
 405     } # end sub current_row
 406
 407 } # end package RelyxTable::Table
 408
 409 ################################################################################
 410
 411 {
 412 # Column class
 413 package RelyxTable::Column;
 414
 415 # Fields:
 416 #    alignment - left, right, or center (l, r, or c)
 417 #    right_line- How many lines this column has to its right
 418 #    left_line - How many lines this column has to its left
 419 #                (only first column can have left lines!)
 420 #    pwidth    - width argument to a 'p' alignment command -- e.g., 10cm
 421 #    special   - special column description that lyx can't handle
 422
 423     sub new {
 424         my $class = shift;
 425         my $description = shift;
 426         my $col;
 427
 428         # Initially zero everything, since we set different
 429         # fields for @ and non-@ columns
 430         $col->{"alignment"} = "c";  # default
 431         $col->{"left_line"} = 0;
 432         $col->{"right_line"} = 0;
 433         $col->{"pwidth"} = "";
 434         $col->{"special"} = "";
 435
 436         # Any special (@) column should be handled differently
 437         if ($description =~ /\@/) {
 438            # Just put the whole description in "special" field --- this
 439            # corresponds the the "extra" field in LyX table popup
 440            # Note that LyX ignores alignment, r/l lines for a special column
 441            $col->{"special"} = $description;
 442            print "\n'$description' column won't display WYSIWYG in LyX\n"
 443                                                             if $debug_on;
 444
 445         # It's not a special @ column
 446         } else {
 447
 448             # left line?
 449             $description =~ s/^\|*//;
 450             $col->{"left_line"} = length($&);
 451
 452             # main column description
 453             $description =~ s/^[clrp]//;
 454             if ($& eq "p") {
 455                 $description =~ s/^\{(.+)\}//; # eat the width
 456                 $col->{"pwidth"} = $1; # width without braces
 457                 # note: alignment is not applicable for 'p' columns
 458             } else {
 459                 $col->{"alignment"} = $&;
 460             }
 461
 462             # right line?
 463             $description =~ s/^\|*//;
 464             $col->{"right_line"} = length($&);
 465         }
 466
 467         bless $col, $class; #... and return it
 468     } # end sub new
 469
 470     sub print_info {
 471     # print out header information for this column
 472     # Note that we need to put "" around pwidth and special for multicol5 format
 473         my $col = shift;
 474         my $to_print = "";
 475         my @arr = ($TableAlignments{$col->{"alignment"}},
 476                       $col->{"left_line"},
 477                       $col->{"right_line"},
 478                       '"' . $col->{"pwidth"} . '"',
 479                       '"' . $col->{"special"} . '"'
 480                     );
 481         $to_print .= join(" ",@arr);
 482         $to_print .= "\n";
 483
 484         return $to_print;
 485     }
 486 } # end package RelyxTable::Column
 487
 488 ################################################################################
 489
 490 {
 491 package RelyxTable::Row;
 492 # Fields:
 493 #    top_line    - does this row have a top line?
 494 #    bottom_line - does this row have a bottom line?
 495 #    curr_col    - which column we're currently dealing with
 496 #    cells       - array containing references to this row's cells
 497
 498     sub new {
 499         my $class = shift;
 500         my $row;
 501         $row->{"top_line"} = 0;
 502         $row->{"bottom_line"} = 0;
 503         $row->{"is_cont_row"} = 0;
 504         $row->{"newpage"} = 0;
 505         $row->{"curr_col"} = 0;
 506
 507         bless $row, $class;
 508     } # end sub new
 509
 510     sub nextcol {
 511     # Go to next column on the current row
 512         my $row = shift;
 513         my $i = $row->{"curr_col"};
 514         $i++;
 515
 516         # What if it was a multicolumn?
 517         # $rcells holds a reference to the array of cells
 518         my $rcells = \@{$row->{"cells"}};
 519         # Paranoia check that we're not attempting to access beyond the
 520         # end of the array in case reLyX failed to parse the number of
 521         # columns correctly.
 522         $i++ while ($i < @{$rcells} &&
 523                     ${$rcells}[$i]->{"multicolumn"} eq "part");
 524
 525         $row->{"curr_col"} = $i;
 526     } # end of sub nextcol
 527
 528     sub multicolumn {
 529     # interpret a \multicolumn command
 530     # Arg0 is the row that the multicolumn is in
 531     # Arg 1 is the first argument to \multicolumn, simply a number (no braces)
 532     # Arg 2 is the second argument, which is a TT::Group column specification
 533         my $row = shift;
 534         my ($num_cols, $coldes) = (shift, shift);
 535
 536         # parse_cols warns about @{} expressions, which aren't WYSIWYG
 537         # and turns the description into a simple string
 538         my @dum = &RelyxTable::parse_cols($coldes);
 539         # LaTeX multicolumn description can only describe one column...
 540         warn "Strange multicolumn description $coldes" if $#dum;
 541         my $description = $dum[0];
 542
 543         # Set the first cell
 544         my $firstcell = $row->{"curr_col"};
 545         my $cell = $row->{"cells"}[$firstcell];
 546         $cell->{"multicolumn"} = "begin";
 547         # Simple descriptions use alignment field, others use special
 548         #    Special isn't WYSIWYG in LyX -- currently, LyX can't display
 549         #    '|' or @{} stuff in multicolumns
 550         if ($description =~ /^[clr]$/) {
 551             $cell->{"alignment"} = $description;
 552         } else {
 553             $cell->{"special"} = $description;
 554             print "\n'$description' multicolumn won't display WYSIWYG in LyX\n"
 555                                                          if $debug_on;
 556         }
 557
 558         # Set other cells
 559         my $i;
 560         foreach $i (1 .. $num_cols-1) {
 561             $cell = $row->{"cells"}[$firstcell + $i];
 562             $cell->{"multicolumn"} = "part";
 563         }
 564
 565     } # end sub multicolumn
 566
 567     sub print_info {
 568     # print information for this column
 569         my $row = shift;
 570         my $to_print = "";
 571         my @arr = ($row->{"top_line"},
 572                         $row->{"bottom_line"},
 573                         $row->{"is_cont_row"},
 574                         $row->{"newpage"}
 575                     );
 576         $to_print .= join(" ",@arr);
 577         $to_print .= "\n";
 578
 579         return $to_print;
 580     } # end sub print_info
 581
 582 } # end package RelyxTable::Row
 583
 584 ################################################################################
 585
 586 {
 587 package RelyxTable::Cell;
 588 # Fields:
 589 #    multicolumn - 0 (regular cell), 1 (beg. of multicol), 2 (part of multicol)
 590 #    alignment   - alignment of this cell
 591 #    top_line    - does the cell have a line on the top?
 592 #    bottom_line - does the cell have a line on the bottom?
 593 #    has_cont_row-
 594 #    rotate      - rotate cell?
 595 #    line_breaks - cell has line breaks in it (???)
 596 #    special     - does this multicol have a special description (@ commands?)
 597 #    pwidth      - pwidth of this cell for a parbox command (for linebreaks)
 598
 599     sub new {
 600     # args 1 and 2 are the parent row and column of this cell
 601         my $class = shift;
 602         my ($parent_row, $parent_col) = (shift, shift);
 603         my $cell;
 604         $cell->{"multicolumn"} = "normal"; # by default, it isn't a multicol
 605         $cell->{"alignment"} = "l"; # doesn't really matter: will be reset soon
 606         $cell->{"top_line"} = 0;
 607         $cell->{"bottom_line"} = 0;
 608         $cell->{"has_cont_row"} = 0;
 609         $cell->{"rotate"} = 0;
 610         $cell->{"line_breaks"} = 0;
 611         $cell->{"special"} = "";
 612         $cell->{"pwidth"} = "";
 613
 614         # Have to bless $cell here, so that we can call methods on it
 615         bless $cell, $class;
 616
 617         # The cell should inherit characteristics from its parent row & col
 618         $cell->row_inherit($parent_row);
 619         $cell->col_inherit($parent_col);
 620
 621         return $cell;
 622     } # end sub new
 623
 624     sub row_inherit {
 625     # Inherit fields from parent row
 626         my ($cell, $row) = (shift, shift);
 627         $cell->{"top_line"} = $row->{"top_line"};
 628         $cell->{"bottom_line"} = $row->{"bottom_line"};
 629     } # end sub row_inherit
 630
 631     sub col_inherit {
 632     # Inherit field(s) from parent column
 633         my ($cell, $col) = (shift, shift);
 634         $cell->{"alignment"} = $col->{"alignment"};
 635     }
 636
 637     sub print_info {
 638     # print information for this cell
 639     # Note that we need to put "" around pwidth and special for multicol5 format
 640         my $cell = shift;
 641         my $to_print = "";
 642         my @arr = ($MulticolumnTypes{$cell->{"multicolumn"}},
 643                         $TableAlignments{$cell->{"alignment"}},
 644                         $cell->{"top_line"},
 645                         $cell->{"bottom_line"},
 646                         $cell->{"has_cont_row"},
 647                         $cell->{"rotate"},
 648                         $cell->{"line_breaks"},
 649                       '"' . $cell->{"special"} . '"',
 650                       '"' . $cell->{"pwidth"} . '"',
 651                     );
 652         $to_print .= join(" ",@arr);
 653         $to_print .= "\n";
 654
 655         return $to_print;
 656     }
 657 } # end package RelyxTable::Cell
 658
 659 1; # return "true" to calling routine