home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / lyx21041.zip / XFree86 / lib / X11 / lyx / reLyX / RelyxTable.pm < prev    next >
Text File  |  1999-03-21  |  18KB  |  597 lines
  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
  597.