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 # Subroutines to print out the table once it's created
 287     sub print_info {
 288         # print the header information for this table
 289         my $thistable = shift;
 290         my $to_print = "";
 291         $to_print .= "\n\\LyXTable\nmulticol5\n";
 292         my @arr = ($thistable->numrows,
 293                     $thistable->numcols,
 294                     $thistable->{"is_long_table"},
 295                     $thistable->{"rotate"},
 296                     $thistable->{"endhead"},
 297                     $thistable->{"end_first_head"},
 298                     $thistable->{"endfoot"},
 299                     $thistable->{"end_last_foot"}
 300                   );
 301         $to_print .= join(" ",@arr);
 302         $to_print .= "\n";
 303
 304         # Print row info
 305         my $row;
 306         foreach $row (@{$thistable->{"rows"}}) {
 307             $to_print .= $row->print_info;
 308         }
 309
 310         # Print column info
 311         my $col;
 312         foreach $col (@{$thistable->{"columns"}}) {
 313             $to_print .= $col->print_info;
 314         }
 315
 316         # Print cell info
 317         my $cell;
 318         foreach $row (@{$thistable->{"rows"}}) {
 319             my $count = 0;
 320             foreach $col (@{$thistable->{"columns"}}) {
 321                 $cell = $row->{"cells"}[$count];
 322                 $count++;
 323                 $to_print .= $cell->print_info;
 324             }
 325         }
 326
 327         $to_print .= "\n";
 328
 329         return $to_print;
 330     } # end sub print_info
 331
 332 # Convenient subroutines
 333     sub numrows {
 334         my $thistable = shift;
 335         return $#{$thistable->{"rows"}} + 1;
 336     } # end sub numrows
 337
 338     sub numcols {
 339         my $thistable = shift;
 340         return $#{$thistable->{"columns"}} + 1;
 341     } # end sub numrows
 342
 343     sub current_row {
 344     # Return the current row blessed as an RT::Row
 345         my $thistable = shift;
 346         my $row = $thistable->{"rows"}[-1];
 347         bless $row, "RelyxTable::Row"; #... and return it
 348     } # end sub current_row
 349
 350 } # end package RelyxTable::Table
 351
 352 ################################################################################
 353
 354 {
 355 # Column class
 356 package RelyxTable::Column;
 357
 358 # Fields:
 359 #    alignment - left, right, or center (l, r, or c)
 360 #    right_line- How many lines this column has to its right
 361 #    left_line - How many lines this column has to its left
 362 #                (only first column can have left lines!)
 363 #    pwidth    - width argument to a 'p' alignment command -- e.g., 10cm
 364 #    special   - special column description that lyx can't handle
 365
 366     sub new {
 367         my $class = shift;
 368         my $description = shift;
 369         my $col;
 370
 371         # Initially zero everything, since we set different
 372         # fields for @ and non-@ columns
 373         $col->{"alignment"} = "c";  # default
 374         $col->{"left_line"} = 0;
 375         $col->{"right_line"} = 0;
 376         $col->{"pwidth"} = "";
 377         $col->{"special"} = "";
 378
 379         # Any special (@) column should be handled differently
 380         if ($description =~ /\@/) {
 381            # Just put the whole description in "special" field --- this
 382            # corresponds the the "extra" field in LyX table popup
 383            # Note that LyX ignores alignment, r/l lines for a special column
 384            $col->{"special"} = $description;
 385            print "\n'$description' column won't display WYSIWYG in LyX\n"
 386                                                             if $debug_on;
 387
 388         # It's not a special @ column
 389         } else {
 390
 391             # left line?
 392             $description =~ s/^\|*//;
 393             $col->{"left_line"} = length($&);
 394
 395             # main column description
 396             $description =~ s/^[clrp]//;
 397             if ($& eq "p") {
 398                 $description =~ s/^\{(.+)\}//; # eat the width
 399                 $col->{"pwidth"} = $1; # width without braces
 400                 # note: alignment is not applicable for 'p' columns
 401             } else {
 402                 $col->{"alignment"} = $&;
 403             }
 404
 405             # right line?
 406             $description =~ s/^\|*//;
 407             $col->{"right_line"} = length($&);
 408         }
 409
 410         bless $col, $class; #... and return it
 411     } # end sub new
 412
 413     sub print_info {
 414     # print out header information for this column
 415     # Note that we need to put "" around pwidth and special for multicol5 format
 416         my $col = shift;
 417         my $to_print = "";
 418         my @arr = ($TableAlignments{$col->{"alignment"}},
 419                       $col->{"left_line"},
 420                       $col->{"right_line"},
 421                       '"' . $col->{"pwidth"} . '"',
 422                       '"' . $col->{"special"} . '"'
 423                     );
 424         $to_print .= join(" ",@arr);
 425         $to_print .= "\n";
 426
 427         return $to_print;
 428     }
 429 } # end package RelyxTable::Column
 430
 431 ################################################################################
 432
 433 {
 434 package RelyxTable::Row;
 435 # Fields:
 436 #    top_line    - does this row have a top line?
 437 #    bottom_line - does this row have a bottom line?
 438 #    curr_col    - which column we're currently dealing with
 439 #    cells       - array containing references to this row's cells
 440
 441     sub new {
 442         my $class = shift;
 443         my $row;
 444         $row->{"top_line"} = 0;
 445         $row->{"bottom_line"} = 0;
 446         $row->{"is_cont_row"} = 0;
 447         $row->{"newpage"} = 0;
 448         $row->{"curr_col"} = 0;
 449
 450         bless $row, $class;
 451     } # end sub new
 452
 453     sub nextcol {
 454     # Go to next column on the current row
 455         my $row = shift;
 456         my $i = $row->{"curr_col"};
 457         $i++;
 458
 459         # What if it was a multicolumn?
 460         $i++ while ${$row->{"cells"}}[$i]->{"multicolumn"} eq "part";
 461
 462         $row->{"curr_col"} = $i;
 463     } # end of sub nextcol
 464
 465     sub multicolumn {
 466     # interpret a \multicolumn command
 467     # Arg0 is the row that the multicolumn is in
 468     # Arg 1 is the first argument to \multicolumn, simply a number (no braces)
 469     # Arg 2 is the second argument, which is a TT::Group column specification
 470         my $row = shift;
 471         my ($num_cols, $coldes) = (shift, shift);
 472
 473         # parse_cols warns about @{} expressions, which aren't WYSIWYG
 474         # and turns the description into a simple string
 475         my @dum = &RelyxTable::parse_cols($coldes);
 476         # LaTeX multicolumn description can only describe one column...
 477         warn "Strange multicolumn description $coldes" if $#dum;
 478         my $description = $dum[0];
 479
 480         # Set the first cell
 481         my $firstcell = $row->{"curr_col"};
 482         my $cell = $row->{"cells"}[$firstcell];
 483         $cell->{"multicolumn"} = "begin";
 484         # Simple descriptions use alignment field, others use special
 485         #    Special isn't WYSIWYG in LyX -- currently, LyX can't display
 486         #    '|' or @{} stuff in multicolumns
 487         if ($description =~ /^[clr]$/) {
 488             $cell->{"alignment"} = $description;
 489         } else {
 490             $cell->{"special"} = $description;
 491             print "\n'$description' multicolumn won't display WYSIWYG in LyX\n"
 492                                                          if $debug_on;
 493         }
 494
 495         # Set other cells
 496         my $i;
 497         foreach $i (1 .. $num_cols-1) {
 498             $cell = $row->{"cells"}[$firstcell + $i];
 499             $cell->{"multicolumn"} = "part";
 500         }
 501
 502     } # end sub multicolumn
 503
 504     sub print_info {
 505     # print information for this column
 506         my $row = shift;
 507         my $to_print = "";
 508         my @arr = ($row->{"top_line"},
 509                         $row->{"bottom_line"},
 510                         $row->{"is_cont_row"},
 511                         $row->{"newpage"}
 512                     );
 513         $to_print .= join(" ",@arr);
 514         $to_print .= "\n";
 515
 516         return $to_print;
 517     } # end sub print_info
 518
 519 } # end package RelyxTable::Row
 520
 521 ################################################################################
 522
 523 {
 524 package RelyxTable::Cell;
 525 # Fields:
 526 #    multicolumn - 0 (regular cell), 1 (beg. of multicol), 2 (part of multicol)
 527 #    alignment   - alignment of this cell
 528 #    top_line    - does the cell have a line on the top?
 529 #    bottom_line - does the cell have a line on the bottom?
 530 #    has_cont_row-
 531 #    rotate      - rotate cell?
 532 #    line_breaks - cell has line breaks in it (???)
 533 #    special     - does this multicol have a special description (@ commands?)
 534 #    pwidth      - pwidth of this cell for a parbox command (for linebreaks)
 535
 536     sub new {
 537     # args 1 and 2 are the parent row and column of this cell
 538         my $class = shift;
 539         my ($parent_row, $parent_col) = (shift, shift);
 540         my $cell;
 541         $cell->{"multicolumn"} = "normal"; # by default, it isn't a multicol
 542         $cell->{"alignment"} = "l"; # doesn't really matter: will be reset soon
 543         $cell->{"top_line"} = 0;
 544         $cell->{"bottom_line"} = 0;
 545         $cell->{"has_cont_row"} = 0;
 546         $cell->{"rotate"} = 0;
 547         $cell->{"line_breaks"} = 0;
 548         $cell->{"special"} = "";
 549         $cell->{"pwidth"} = "";
 550
 551         # Have to bless $cell here, so that we can call methods on it
 552         bless $cell, $class;
 553
 554         # The cell should inherit characteristics from its parent row & col
 555         $cell->row_inherit($parent_row);
 556         $cell->col_inherit($parent_col);
 557
 558         return $cell;
 559     } # end sub new
 560
 561     sub row_inherit {
 562     # Inherit fields from parent row
 563         my ($cell, $row) = (shift, shift);
 564         $cell->{"top_line"} = $row->{"top_line"};
 565         $cell->{"bottom_line"} = $row->{"bottom_line"};
 566     } # end sub row_inherit
 567
 568     sub col_inherit {
 569     # Inherit field(s) from parent column
 570         my ($cell, $col) = (shift, shift);
 571         $cell->{"alignment"} = $col->{"alignment"};
 572     }
 573
 574     sub print_info {
 575     # print information for this cell
 576     # Note that we need to put "" around pwidth and special for multicol5 format
 577         my $cell = shift;
 578         my $to_print = "";
 579         my @arr = ($MulticolumnTypes{$cell->{"multicolumn"}},
 580                         $TableAlignments{$cell->{"alignment"}},
 581                         $cell->{"top_line"},
 582                         $cell->{"bottom_line"},
 583                         $cell->{"has_cont_row"},
 584                         $cell->{"rotate"},
 585                         $cell->{"line_breaks"},
 586                       '"' . $cell->{"special"} . '"',
 587                       '"' . $cell->{"pwidth"} . '"',
 588                     );
 589         $to_print .= join(" ",@arr);
 590         $to_print .= "\n";
 591
 592         return $to_print;
 593     }
 594 } # end package RelyxTable::Cell
 595
 596 1; # return "true" to calling routine