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|]*[mp*@]?$/
  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', an 'm', a '*' or a '@' as necessary
  90         # use exact_print in case there's weird stuff in the @ descriptions
  91         $description = substr($description,-1);
  92         # The m and p descriptors have identical form.
  93         if ($description eq 'p' || $description eq 'm') {
  94             $tok = shift(@group);
  95             my $des = $description . $tok->exact_print; # 'p{foo}' or 'm{foo}'
  96             push @cols, $des;
  97
  98         } elsif ($description eq '@') {
  99             $tok = shift(@group);
 100             my $atdes = $description . $tok->exact_print;
 101             if ($#cols == -1) { # it's an @ before any column description
 102                 $first .= $atdes;
 103             } else {
 104                 $cols[-1] .= $atdes; # add it to end of current col
 105             }
 106
 107         } elsif ($description eq '*') {
 108
 109             $tok = shift(@group); # TT::Group with number of repeats in it
 110             my $rep = $tok->contents->print;
 111             $tok = shift(@group); # Group to repeat $rep times
 112             @new_cols = &parse_cols($tok);
 113             foreach $i (1 .. $rep) {
 114                 push @cols, @new_cols;
 115             }
 116         }
 117     } # end loop over description tokens
 118
 119     # this handles description like {|*{3}{c}}
 120     $cols[0] = $first . $cols[0];
 121
 122     return @cols;
 123 } # end sub parse_cols
 124
 125 ################################################################################
 126 # This package handles tables for reLyX
 127
 128 {
 129     package RelyxTable::Table;
 130     # Table class
 131     # Fields:
 132     #    columns - array containing references to RelyxTable::Columns
 133     #    rows    - array containing references to RelyxTable::Rows
 134     #    active  - are we currently reading this table?
 135     # Fields for printout
 136     #    is_long_table
 137     #    rotate
 138     #    endhead
 139     #    end_first_head
 140     #    endfoot
 141     #    end_last_foot
 142
 143
 144 # Subroutines to read and create the table
 145     sub new {
 146     # 'new' takes an argument containing the LaTeX table description string,
 147     #    which is a Text::TeX::Group token
 148
 149         my $class = shift; # should be "table"
 150         my $description = shift;
 151         my $thistable;
 152         # This seems like a convenient place to declare this...
 153         $debug_on= (defined($main::opt_d) && $main::opt_d);
 154
 155         # Initialize fields - including ones we don't support yet
 156         $thistable->{"is_long_table"} = 0;
 157         $thistable->{"rotate"} = 0;
 158         $thistable->{"endhead"} = 0;
 159         $thistable->{"end_first_head"} = 0;
 160         $thistable->{"endfoot"} = 0;
 161         $thistable->{"end_last_foot"} = 0;
 162         $thistable->{"active"} = 1;
 163
 164         bless $thistable, $class;
 165
 166         # Parse the column descriptions: return an array, where each
 167         #    element is a (regular text) single column description
 168         my @cols = &RelyxTable::parse_cols($description);
 169         my $colref;
 170         my $col_description;
 171         foreach $col_description (@cols) {
 172             $colref = new RelyxTable::Column $col_description;
 173             push @{$thistable->{"columns"}}, $colref;
 174         }
 175         # put the table into the table array
 176         push @RelyxTable::table_array, $thistable;
 177
 178
 179         # Now that it's blessed, put the 0th row into the table
 180         $thistable->addrow;
 181
 182         return $thistable;
 183     } # end sub new
 184
 185     sub addrow {
 186     # add a row to the table
 187     # Since we're starting the row, we're in the 0th column
 188         my $thistable = shift;
 189         my $row = new RelyxTable::Row;
 190         push (@{$thistable->{"rows"}}, $row);
 191
 192         # Also initialize the cells for this row
 193         my $col;
 194         foreach $col (@{$thistable->{"columns"}}) {
 195             push (@{$row->{"cells"}}, RelyxTable::Cell->new($row, $col));
 196         }
 197     } # end sub addrow
 198
 199     sub nextcol {
 200     # Go to next column - this just involves calling RT::Row->nextcol
 201     #    on the current row
 202         my $thistable = shift;
 203         my $row = $thistable->current_row;
 204         $row->nextcol;
 205     } # end of sub nextcol
 206
 207     sub hcline {
 208     # interpret an '\hline' or '\cline' command
 209     # (It's cline if there's an arg1)
 210     # hline:
 211     # Add a bottom line to the row *before* the current row, unless it's
 212     #    the top row. In that case, add a top line to the current (top) row
 213     # Change the row and all the cells that make up the row
 214     # cline:
 215     # Change the cells from the row in the range given in arg1
 216         my $thistable = shift;
 217         my $range = shift;
 218         my $is_cline = defined($range);
 219         my ($rownum, $line_str, $lastrow, $cell);
 220
 221         if ($lastrow = $thistable->numrows - 1) { # not top row
 222             $rownum = $lastrow - 1;
 223             $line_str = "bottom_line";
 224         } else {
 225             $rownum = $lastrow;
 226             $line_str = "top_line";
 227         }
 228
 229         my $row = $thistable->{"rows"}[$rownum];
 230         # Add a row line (only) if it's a \hline command
 231         unless ($is_cline) {
 232             $row->{"$line_str"} +=1;
 233             if (defined($main::opt_d) && $row->{"$line_str"} == 2) {
 234                 print "\nToo many \\hline's";
 235             }
 236         }
 237
 238         # Figure out which rows to change
 239         my ($r1, $r2);
 240         if ($is_cline) {
 241             $range =~ /(\d+)-(\d+)/ or warn "weird \\cline range";
 242             # LaTeX numbers columns from 1, we number from 0
 243             ($r1, $r2) = ($1 - 1, $2 - 1);
 244         } else {
 245             $r1 = 0;
 246             $r2 = $thistable->numcols - 1;
 247         }
 248
 249         my $i;
 250         foreach $i ($r1 .. $r2) {
 251             $cell = $row->{"cells"}[$i];
 252             $cell->{"$line_str"} +=1; # change the cells in the row
 253         }
 254     } # end sub hline
 255
 256     sub multicolumn {
 257     # interpret a \multicolumn command
 258     # This really just needs to call RT::Row->multicolumn for the correct row
 259         my $thistable = shift;
 260         my $row = $thistable->current_row;
 261         $row->multicolumn(@_);
 262     } # end sub multicolumn
 263
 264     sub done_reading {
 265     # Finished reading a table
 266         my $thistable = shift;
 267         # If we just had \hlines at the end, it's not a real row
 268         # But if numcols==1, curr_col *has* to be zero!
 269         # HACK HACK HACK. If numcols==1 but we need to subtract a row, we
 270         # won't know until LastLyX. At that point, we'll subtract a row.
 271         my $row = $thistable->current_row;
 272         if ($thistable->numcols > 1 && $row->{"curr_col"} == 0) {
 273             pop @{$thistable->{"rows"}}
 274         }
 275
 276         # We're no longer reading this table
 277         $thistable->{"active"} = 0;
 278
 279         if ($debug_on) {
 280             print "\nDone with table ",$#RelyxTable::table_array,", which has ",
 281                 $thistable->numrows," rows and ",
 282                 $thistable->numcols," columns";
 283             print"\nNumber of rows may be 1 too high" if $thistable->numcols==1;
 284         }
 285     } # end sub done_reading
 286
 287 # Subroutines to print out the table once it's created
 288     sub print_info {
 289         # print the header information for this table
 290         my $thistable = shift;
 291         my $to_print = "";
 292         $to_print .= "\n\\LyXTable\nmulticol5\n";
 293         my @arr = ($thistable->numrows,
 294                     $thistable->numcols,
 295                     $thistable->{"is_long_table"},
 296                     $thistable->{"rotate"},
 297                     $thistable->{"endhead"},
 298                     $thistable->{"end_first_head"},
 299                     $thistable->{"endfoot"},
 300                     $thistable->{"end_last_foot"}
 301                   );
 302         $to_print .= join(" ",@arr);
 303         $to_print .= "\n";
 304
 305         # Print row info
 306         my $row;
 307         foreach $row (@{$thistable->{"rows"}}) {
 308             $to_print .= $row->print_info;
 309         }
 310
 311         # Print column info
 312         my $col;
 313         foreach $col (@{$thistable->{"columns"}}) {
 314             $to_print .= $col->print_info;
 315         }
 316
 317         # Print cell info
 318         my $cell;
 319         foreach $row (@{$thistable->{"rows"}}) {
 320             my $count = 0;
 321             foreach $col (@{$thistable->{"columns"}}) {
 322                 $cell = $row->{"cells"}[$count];
 323                 $count++;
 324                 $to_print .= $cell->print_info;
 325             }
 326         }
 327
 328         $to_print .= "\n";
 329
 330         return $to_print;
 331     } # end sub print_info
 332
 333 # Convenient subroutines
 334     sub numrows {
 335         my $thistable = shift;
 336         return $#{$thistable->{"rows"}} + 1;
 337     } # end sub numrows
 338
 339     sub numcols {
 340         my $thistable = shift;
 341         return $#{$thistable->{"columns"}} + 1;
 342     } # end sub numrows
 343
 344     sub current_row {
 345     # Return the current row blessed as an RT::Row
 346         my $thistable = shift;
 347         my $row = $thistable->{"rows"}[-1];
 348         bless $row, "RelyxTable::Row"; #... and return it
 349     } # end sub current_row
 350
 351 } # end package RelyxTable::Table
 352
 353 ################################################################################
 354
 355 {
 356 # Column class
 357 package RelyxTable::Column;
 358
 359 # Fields:
 360 #    alignment - left, right, or center (l, r, or c)
 361 #    right_line- How many lines this column has to its right
 362 #    left_line - How many lines this column has to its left
 363 #                (only first column can have left lines!)
 364 #    pwidth    - width argument to a 'p' alignment command -- e.g., 10cm
 365 #    special   - special column description that lyx can't handle
 366
 367     sub new {
 368         my $class = shift;
 369         my $description = shift;
 370         my $col;
 371
 372         # Initially zero everything, since we set different
 373         # fields for @ and non-@ columns
 374         $col->{"alignment"} = "c";  # default
 375         $col->{"left_line"} = 0;
 376         $col->{"right_line"} = 0;
 377         $col->{"pwidth"} = "";
 378         $col->{"special"} = "";
 379
 380         # LyX does not know about '@' or 'm' column descriptors so, to
 381         # ensure that the LaTeX -> LyX -> LaTeX cycle is invariant,
 382         # these descriptors are placed in the 'special' field.
 383         if ($description =~ /\@/ || $description =~ /^m/ ) {
 384             $col->{"special"} = $description;
 385             print "\n'$description' column won't display WYSIWYG in LyX\n"
 386                                                              if $debug_on;
 387         }
 388
 389         # '@' columns really can't be displayed WYSIWYG in LyX,
 390         # but we can get visual feedback on 'm' columns.
 391         if (!($description =~ /\@/)) {
 392             # left line?
 393             $description =~ s/^\|*//;
 394             $col->{"left_line"} = length($&);
 395
 396             # main column description
 397             $description =~ s/^[clrpm]//;
 398             if ($& eq 'p' || $& eq 'm') {
 399                 $description =~ s/^\{(.+)\}//; # eat the width
 400                 $col->{"pwidth"} = $1; # width without braces
 401                 # note: alignment is not applicable for 'p' columns
 402             } else {
 403                 $col->{"alignment"} = $&;
 404             }
 405
 406             # right line?
 407             $description =~ s/^\|*//;
 408             $col->{"right_line"} = length($&);
 409         }
 410
 411         bless $col, $class; #... and return it
 412     } # end sub new
 413
 414     sub print_info {
 415     # print out header information for this column
 416     # Note that we need to put "" around pwidth and special for multicol5 format
 417         my $col = shift;
 418         my $to_print = "";
 419         my @arr = ($TableAlignments{$col->{"alignment"}},
 420                       $col->{"left_line"},
 421                       $col->{"right_line"},
 422                       '"' . $col->{"pwidth"} . '"',
 423                       '"' . $col->{"special"} . '"'
 424                     );
 425         $to_print .= join(" ",@arr);
 426         $to_print .= "\n";
 427
 428         return $to_print;
 429     }
 430 } # end package RelyxTable::Column
 431
 432 ################################################################################
 433
 434 {
 435 package RelyxTable::Row;
 436 # Fields:
 437 #    top_line    - does this row have a top line?
 438 #    bottom_line - does this row have a bottom line?
 439 #    curr_col    - which column we're currently dealing with
 440 #    cells       - array containing references to this row's cells
 441
 442     sub new {
 443         my $class = shift;
 444         my $row;
 445         $row->{"top_line"} = 0;
 446         $row->{"bottom_line"} = 0;
 447         $row->{"is_cont_row"} = 0;
 448         $row->{"newpage"} = 0;
 449         $row->{"curr_col"} = 0;
 450
 451         bless $row, $class;
 452     } # end sub new
 453
 454     sub nextcol {
 455     # Go to next column on the current row
 456         my $row = shift;
 457         my $i = $row->{"curr_col"};
 458         $i++;
 459
 460         # What if it was a multicolumn?
 461         # $rcells holds a reference to the array of cells
 462         my $rcells = \@{$row->{"cells"}};
 463         # Paranoia check that we're not attempting to access beyond the
 464         # end of the array in case reLyX failed to parse the number of
 465         # columns correctly.
 466         $i++ while ($i < @{$rcells} &&
 467                     ${$rcells}[$i]->{"multicolumn"} eq "part");
 468
 469         $row->{"curr_col"} = $i;
 470     } # end of sub nextcol
 471
 472     sub multicolumn {
 473     # interpret a \multicolumn command
 474     # Arg0 is the row that the multicolumn is in
 475     # Arg 1 is the first argument to \multicolumn, simply a number (no braces)
 476     # Arg 2 is the second argument, which is a TT::Group column specification
 477         my $row = shift;
 478         my ($num_cols, $coldes) = (shift, shift);
 479
 480         # parse_cols warns about @{} expressions, which aren't WYSIWYG
 481         # and turns the description into a simple string
 482         my @dum = &RelyxTable::parse_cols($coldes);
 483         # LaTeX multicolumn description can only describe one column...
 484         warn "Strange multicolumn description $coldes" if $#dum;
 485         my $description = $dum[0];
 486
 487         # Set the first cell
 488         my $firstcell = $row->{"curr_col"};
 489         my $cell = $row->{"cells"}[$firstcell];
 490         $cell->{"multicolumn"} = "begin";
 491         # Simple descriptions use alignment field, others use special
 492         #    Special isn't WYSIWYG in LyX -- currently, LyX can't display
 493         #    '|' or @{} stuff in multicolumns
 494         if ($description =~ /^[clr]$/) {
 495             $cell->{"alignment"} = $description;
 496         } else {
 497             $cell->{"special"} = $description;
 498             print "\n'$description' multicolumn won't display WYSIWYG in LyX\n"
 499                                                          if $debug_on;
 500         }
 501
 502         # Set other cells
 503         my $i;
 504         foreach $i (1 .. $num_cols-1) {
 505             $cell = $row->{"cells"}[$firstcell + $i];
 506             $cell->{"multicolumn"} = "part";
 507         }
 508
 509     } # end sub multicolumn
 510
 511     sub print_info {
 512     # print information for this column
 513         my $row = shift;
 514         my $to_print = "";
 515         my @arr = ($row->{"top_line"},
 516                         $row->{"bottom_line"},
 517                         $row->{"is_cont_row"},
 518                         $row->{"newpage"}
 519                     );
 520         $to_print .= join(" ",@arr);
 521         $to_print .= "\n";
 522
 523         return $to_print;
 524     } # end sub print_info
 525
 526 } # end package RelyxTable::Row
 527
 528 ################################################################################
 529
 530 {
 531 package RelyxTable::Cell;
 532 # Fields:
 533 #    multicolumn - 0 (regular cell), 1 (beg. of multicol), 2 (part of multicol)
 534 #    alignment   - alignment of this cell
 535 #    top_line    - does the cell have a line on the top?
 536 #    bottom_line - does the cell have a line on the bottom?
 537 #    has_cont_row-
 538 #    rotate      - rotate cell?
 539 #    line_breaks - cell has line breaks in it (???)
 540 #    special     - does this multicol have a special description (@ commands?)
 541 #    pwidth      - pwidth of this cell for a parbox command (for linebreaks)
 542
 543     sub new {
 544     # args 1 and 2 are the parent row and column of this cell
 545         my $class = shift;
 546         my ($parent_row, $parent_col) = (shift, shift);
 547         my $cell;
 548         $cell->{"multicolumn"} = "normal"; # by default, it isn't a multicol
 549         $cell->{"alignment"} = "l"; # doesn't really matter: will be reset soon
 550         $cell->{"top_line"} = 0;
 551         $cell->{"bottom_line"} = 0;
 552         $cell->{"has_cont_row"} = 0;
 553         $cell->{"rotate"} = 0;
 554         $cell->{"line_breaks"} = 0;
 555         $cell->{"special"} = "";
 556         $cell->{"pwidth"} = "";
 557
 558         # Have to bless $cell here, so that we can call methods on it
 559         bless $cell, $class;
 560
 561         # The cell should inherit characteristics from its parent row & col
 562         $cell->row_inherit($parent_row);
 563         $cell->col_inherit($parent_col);
 564
 565         return $cell;
 566     } # end sub new
 567
 568     sub row_inherit {
 569     # Inherit fields from parent row
 570         my ($cell, $row) = (shift, shift);
 571         $cell->{"top_line"} = $row->{"top_line"};
 572         $cell->{"bottom_line"} = $row->{"bottom_line"};
 573     } # end sub row_inherit
 574
 575     sub col_inherit {
 576     # Inherit field(s) from parent column
 577         my ($cell, $col) = (shift, shift);
 578         $cell->{"alignment"} = $col->{"alignment"};
 579     }
 580
 581     sub print_info {
 582     # print information for this cell
 583     # Note that we need to put "" around pwidth and special for multicol5 format
 584         my $cell = shift;
 585         my $to_print = "";
 586         my @arr = ($MulticolumnTypes{$cell->{"multicolumn"}},
 587                         $TableAlignments{$cell->{"alignment"}},
 588                         $cell->{"top_line"},
 589                         $cell->{"bottom_line"},
 590                         $cell->{"has_cont_row"},
 591                         $cell->{"rotate"},
 592                         $cell->{"line_breaks"},
 593                       '"' . $cell->{"special"} . '"',
 594                       '"' . $cell->{"pwidth"} . '"',
 595                     );
 596         $to_print .= join(" ",@arr);
 597         $to_print .= "\n";
 598
 599         return $to_print;
 600     }
 601 } # end package RelyxTable::Cell
 602
 603 1; # return "true" to calling routine