lyx_mirror/lib/reLyX/RelyxTable.pm

# This file is part of reLyX
# Copyright (c) 1998-9 Amir Karger karger@post.harvard.edu
# You are free to use and modify this code under the terms of
# the GNU General Public Licence version 2 or later.

package RelyxTable;

# This is a package to read LaTeX tables and print out LyX tables


# We declare here the sub-packages found in this package.
# This allows the parser to understand "indirect object" form of subroutines
{
package RelyxTable::Table;
package RelyxTable::Column;
package RelyxTable::Row;
}

use strict;

# Variables used by other packages
use vars qw(@table_array $TableBeginString $TableEndString);
# @table_array is the list of all arrays
# $TableBeginString is a string to write during one pass so that a later
#     pass knows to put the table info there
# $TableEndString is written at the end of the table so that we know
#     the table is done
$TableBeginString = '%%%%%Insert reLyX table here!';
$TableEndString =   '%%%%%End of reLyX table!';

# Debugging on?
my $debug_on;

# Are we currently inside a table?
# If we are, return the table
sub in_table {
    return "" unless defined(@table_array); # no tables exist
    my $thistable = $table_array[-1];
    if ($thistable->{"active"}) {
        return (bless $thistable, "RelyxTable::Table");
    } else {
        return "";
    }
}


# Global variables###############
# LyX' enums corresponding to table alignments
my %TableAlignments = ("l" => 2, "r" => 4, "c" => 8);
# LyX' enums corresponding to multicol types
#    normal (non-multicol) cell, beginning of a multicol, part of a multicol
my %MulticolumnTypes = ("normal" => 0, "begin" => 1, "part" => 2);

# Subroutines used by tables and rows, e.g.
sub parse_cols {
# parse a table's columns' description
# Returns an array where each element is one column description
# arg0 is the description -- a Text::TeX::Group
    my $groupref = shift;
    my (@cols, @new_cols);
    my ($tok, $description, $i);

    # tokens in the group, not including '{' and '}'
    my @group = $groupref->contents;

    # Loop over the token(s) in the group
    my $first = ""; my $tempfirst;
    while (@group) {

	$tok = shift(@group);
	# Each $tok will consist of /^[clr|]*[mp*@]?$/
	# (Except first may have | and/or @ expressions before it)
	# p*@ will end the $tok since after it comes a group in braces
	# @ will be a TT::Token, everything else will be in TT::Text
	$description = $tok->print;

	# Chop off left lines for first column if any
	($tempfirst = $description) =~ s/(\|*).*/$1/;
	if ($#cols == -1) { # |'s before any column description
	    $first .= $tempfirst;
	} else {
	    $cols[-1] .= $tempfirst; # add it to end of current col
	}

	# Greedy searches, so only 0th column can possibly have left line
	@new_cols = ($description =~ /[clr]\|*/g);
	push @cols, @new_cols;

	# parse a 'p', an 'm', a '*' or a '@' as necessary
	# use exact_print in case there's weird stuff in the @ descriptions
	$description = substr($description,-1);
	# The m and p descriptors have identical form.
	if ($description eq 'p' || $description eq 'm') {
	    $tok = shift(@group);
	    my $des = $description . $tok->exact_print; # 'p{foo}' or 'm{foo}'
	    push @cols, $des;

	} elsif ($description eq '@') {
	    $tok = shift(@group);
	    my $atdes = $description . $tok->exact_print;
	    if ($#cols == -1) { # it's an @ before any column description
	        $first .= $atdes;
	    } else {
		$cols[-1] .= $atdes; # add it to end of current col
	    }

	} elsif ($description eq '*') {

	    $tok = shift(@group); # TT::Group with number of repeats in it
	    my $rep = $tok->contents->print;
	    $tok = shift(@group); # Group to repeat $rep times
	    @new_cols = &parse_cols($tok);
	    foreach $i (1 .. $rep) {
		push @cols, @new_cols;
	    }
	}
    } # end loop over description tokens

    # this handles description like {|*{3}{c}}
    $cols[0] = $first . $cols[0];

    return @cols;
} # end sub parse_cols

################################################################################
# This package handles tables for reLyX

{
    package RelyxTable::Table;
    # Table class
    # Fields:
    #    columns - array containing references to RelyxTable::Columns
    #    rows    - array containing references to RelyxTable::Rows
    #    active  - are we currently reading this table?
    # Fields for printout
    #	 is_long_table
    #	 rotate
    #	 endhead
    #	 end_first_head
    #	 endfoot
    #	 end_last_foot


# Subroutines to read and create the table
    sub new {
    # 'new' takes an argument containing the LaTeX table description string,
    #    which is a Text::TeX::Group token

	my $class = shift; # should be "table"
	my $description = shift;
	my $thistable;
	# This seems like a convenient place to declare this...
	$debug_on= (defined($main::opt_d) && $main::opt_d);

	# Initialize fields - including ones we don't support yet
	$thistable->{"is_long_table"} = 0;
	$thistable->{"rotate"} = 0;
	$thistable->{"endhead"} = 0;
	$thistable->{"end_first_head"} = 0;
	$thistable->{"endfoot"} = 0;
	$thistable->{"end_last_foot"} = 0;
	$thistable->{"active"} = 1;

	bless $thistable, $class;

	# Parse the column descriptions: return an array, where each
	#    element is a (regular text) single column description
	my @cols = &RelyxTable::parse_cols($description);
	my $colref;
	my $col_description;
	foreach $col_description (@cols) {
	    $colref = new RelyxTable::Column $col_description;
	    push @{$thistable->{"columns"}}, $colref;
	}
	# put the table into the table array
	push @RelyxTable::table_array, $thistable;


	# Now that it's blessed, put the 0th row into the table 
	$thistable->addrow;

	return $thistable;
    } # end sub new

    sub addrow {
    # add a row to the table
    # Since we're starting the row, we're in the 0th column
	my $thistable = shift;
	my $row = new RelyxTable::Row;
	push (@{$thistable->{"rows"}}, $row);

	# Also initialize the cells for this row
	my $col;
	foreach $col (@{$thistable->{"columns"}}) {
	    push (@{$row->{"cells"}}, RelyxTable::Cell->new($row, $col));
	}
    } # end sub addrow

    sub nextcol {
    # Go to next column - this just involves calling RT::Row->nextcol
    #    on the current row
	my $thistable = shift;
	my $row = $thistable->current_row;
	$row->nextcol;
    } # end of sub nextcol

    sub hcline {
    # interpret an '\hline' or '\cline' command
    # (It's cline if there's an arg1)
    # hline:
    # Add a bottom line to the row *before* the current row, unless it's
    #    the top row. In that case, add a top line to the current (top) row
    # Change the row and all the cells that make up the row
    # cline:
    # Change the cells from the row in the range given in arg1
	my $thistable = shift;
	my $range = shift;
	my $is_cline = defined($range);
	my ($rownum, $line_str, $lastrow, $cell);

	if ($lastrow = $thistable->numrows - 1) { # not top row
	    $rownum = $lastrow - 1;
	    $line_str = "bottom_line";
	} else {
	    $rownum = $lastrow;
	    $line_str = "top_line";
	}

	my $row = $thistable->{"rows"}[$rownum];
	# Add a row line (only) if it's a \hline command
	unless ($is_cline) {
	    $row->{"$line_str"} +=1;
	    if (defined($main::opt_d) && $row->{"$line_str"} == 2) {
	        print "\nToo many \\hline's";
	    }
	}

	# Figure out which rows to change
	my ($r1, $r2);
	if ($is_cline) {
	    $range =~ /(\d+)-(\d+)/ or warn "weird \\cline range";
	    # LaTeX numbers columns from 1, we number from 0
	    ($r1, $r2) = ($1 - 1, $2 - 1);
	} else {
	    $r1 = 0;
	    $r2 = $thistable->numcols - 1;
	}

	my $i;
	foreach $i ($r1 .. $r2) {
	    $cell = $row->{"cells"}[$i];
	    $cell->{"$line_str"} +=1; # change the cells in the row
	}
    } # end sub hline

    sub multicolumn {
    # interpret a \multicolumn command
    # This really just needs to call RT::Row->multicolumn for the correct row
	my $thistable = shift;
        my $row = $thistable->current_row;
	$row->multicolumn(@_);
    } # end sub multicolumn

    sub done_reading {
    # Finished reading a table
        my $thistable = shift;
	# If we just had \hlines at the end, it's not a real row
	# But if numcols==1, curr_col *has* to be zero!
	# HACK HACK HACK. If numcols==1 but we need to subtract a row, we
	# won't know until LastLyX. At that point, we'll subtract a row.
        my $row = $thistable->current_row;
	if ($thistable->numcols > 1 && $row->{"curr_col"} == 0) {
	    pop @{$thistable->{"rows"}}
	}

	# We're no longer reading this table
	$thistable->{"active"} = 0;

	if ($debug_on) {
	    print "\nDone with table ",$#RelyxTable::table_array,", which has ",
		$thistable->numrows," rows and ",
		$thistable->numcols," columns";
	    print"\nNumber of rows may be 1 too high" if $thistable->numcols==1;
	}
    } # end sub done_reading

# Subroutines to print out the table once it's created
    sub print_info {
        # print the header information for this table
	my $thistable = shift;
        my $to_print = "";
	$to_print .= "\n\\LyXTable\nmulticol5\n";
	my @arr = ($thistable->numrows,
		    $thistable->numcols,
		    $thistable->{"is_long_table"},
		    $thistable->{"rotate"},
		    $thistable->{"endhead"},
		    $thistable->{"end_first_head"},
		    $thistable->{"endfoot"},
		    $thistable->{"end_last_foot"}
		  );
	$to_print .= join(" ",@arr);
	$to_print .= "\n";

	# Print row info
	my $row;
	foreach $row (@{$thistable->{"rows"}}) {
	    $to_print .= $row->print_info;
	}

	# Print column info
	my $col;
	foreach $col (@{$thistable->{"columns"}}) {
	    $to_print .= $col->print_info;
	}
		   
	# Print cell info
	my $cell;
	foreach $row (@{$thistable->{"rows"}}) {
	    my $count = 0;
	    foreach $col (@{$thistable->{"columns"}}) {
	        $cell = $row->{"cells"}[$count];
		$count++;
	        $to_print .= $cell->print_info;
	    }
	}

	$to_print .= "\n";

	return $to_print;
    } # end sub print_info

# Convenient subroutines
    sub numrows {
	my $thistable = shift;
        return $#{$thistable->{"rows"}} + 1;
    } # end sub numrows

    sub numcols {
	my $thistable = shift;
        return $#{$thistable->{"columns"}} + 1;
    } # end sub numrows

    sub current_row {
    # Return the current row blessed as an RT::Row
        my $thistable = shift;
	my $row = $thistable->{"rows"}[-1];
	bless $row, "RelyxTable::Row"; #... and return it
    } # end sub current_row

} # end package RelyxTable::Table

################################################################################

{
# Column class
package RelyxTable::Column;

# Fields:
#    alignment - left, right, or center (l, r, or c)
#    right_line- How many lines this column has to its right
#    left_line - How many lines this column has to its left
#                (only first column can have left lines!)
#    pwidth    - width argument to a 'p' alignment command -- e.g., 10cm
#    special   - special column description that lyx can't handle

    sub new {
	my $class = shift;
	my $description = shift;
	my $col;

	# Initially zero everything, since we set different 
	# fields for @ and non-@ columns
	$col->{"alignment"} = "c";  # default
	$col->{"left_line"} = 0;
	$col->{"right_line"} = 0;
	$col->{"pwidth"} = "";
	$col->{"special"} = "";

	# LyX does not know about '@' or 'm' column descriptors so, to
	# ensure that the LaTeX -> LyX -> LaTeX cycle is invariant,
	# these descriptors are placed in the 'special' field.
	if ($description =~ /\@/ || $description =~ /^m/ ) {
	    $col->{"special"} = $description;
	    print "\n'$description' column won't display WYSIWYG in LyX\n"
	                                                     if $debug_on;
	}

	# '@' columns really can't be displayed WYSIWYG in LyX,
	# but we can get visual feedback on 'm' columns.
	if (!($description =~ /\@/)) {
	    # left line?
	    $description =~ s/^\|*//;
	    $col->{"left_line"} = length($&);

	    # main column description
	    $description =~ s/^[clrpm]//;
	    if ($& eq 'p' || $& eq 'm') {
		$description =~ s/^\{(.+)\}//; # eat the width
		$col->{"pwidth"} = $1; # width without braces
		# note: alignment is not applicable for 'p' columns
	    } else {
		$col->{"alignment"} = $&;
	    }

	    # right line?
	    $description =~ s/^\|*//;
	    $col->{"right_line"} = length($&);
	}

	bless $col, $class; #... and return it
    } # end sub new

    sub print_info {
    # print out header information for this column
    # Note that we need to put "" around pwidth and special for multicol5 format
	my $col = shift;
        my $to_print = "";
	my @arr = ($TableAlignments{$col->{"alignment"}},
		      $col->{"left_line"},
		      $col->{"right_line"},
		      '"' . $col->{"pwidth"} . '"',
		      '"' . $col->{"special"} . '"'
		    );
	$to_print .= join(" ",@arr);
	$to_print .= "\n";
		   
	return $to_print;
    }
} # end package RelyxTable::Column

################################################################################

{
package RelyxTable::Row;
# Fields:
#    top_line    - does this row have a top line?
#    bottom_line - does this row have a bottom line?
#    curr_col    - which column we're currently dealing with
#    cells       - array containing references to this row's cells

    sub new {
	my $class = shift;
	my $row;
	$row->{"top_line"} = 0;
	$row->{"bottom_line"} = 0;
	$row->{"is_cont_row"} = 0;
	$row->{"newpage"} = 0;
	$row->{"curr_col"} = 0;

	bless $row, $class;
    } # end sub new

    sub nextcol {
    # Go to next column on the current row
	my $row = shift;
	my $i = $row->{"curr_col"};
	$i++;

	# What if it was a multicolumn?
	# $rcells holds a reference to the array of cells
	my $rcells = \@{$row->{"cells"}};
	# Paranoia check that we're not attempting to access beyond the
	# end of the array in case reLyX failed to parse the number of
	# columns correctly.
	$i++ while ($i < @{$rcells} &&
		    ${$rcells}[$i]->{"multicolumn"} eq "part");

	$row->{"curr_col"} = $i;
    } # end of sub nextcol

    sub multicolumn {
    # interpret a \multicolumn command
    # Arg0 is the row that the multicolumn is in
    # Arg 1 is the first argument to \multicolumn, simply a number (no braces)
    # Arg 2 is the second argument, which is a TT::Group column specification
        my $row = shift;
	my ($num_cols, $coldes) = (shift, shift);

	# parse_cols warns about @{} expressions, which aren't WYSIWYG
	# and turns the description into a simple string
	my @dum = &RelyxTable::parse_cols($coldes);
	# LaTeX multicolumn description can only describe one column...
	warn "Strange multicolumn description $coldes" if $#dum;
	my $description = $dum[0];

	# Set the first cell
	my $firstcell = $row->{"curr_col"};
	my $cell = $row->{"cells"}[$firstcell];
	$cell->{"multicolumn"} = "begin";
	# Simple descriptions use alignment field, others use special
	#    Special isn't WYSIWYG in LyX -- currently, LyX can't display
	#    '|' or @{} stuff in multicolumns
	if ($description =~ /^[clr]$/) {
	    $cell->{"alignment"} = $description;
	} else {
	    $cell->{"special"} = $description;
	    print "\n'$description' multicolumn won't display WYSIWYG in LyX\n"
	                                                 if $debug_on;
	}

	# Set other cells
	my $i;
	foreach $i (1 .. $num_cols-1) {
	    $cell = $row->{"cells"}[$firstcell + $i];
	    $cell->{"multicolumn"} = "part";
	}

    } # end sub multicolumn

    sub print_info {
    # print information for this column
	my $row = shift;
        my $to_print = "";
	my @arr = ($row->{"top_line"},
		        $row->{"bottom_line"},
			$row->{"is_cont_row"},
			$row->{"newpage"}
		    );
	$to_print .= join(" ",@arr);
	$to_print .= "\n";
		   
	return $to_print;
    } # end sub print_info

} # end package RelyxTable::Row

################################################################################

{
package RelyxTable::Cell;
# Fields:
#    multicolumn - 0 (regular cell), 1 (beg. of multicol), 2 (part of multicol)
#    alignment   - alignment of this cell
#    top_line    - does the cell have a line on the top?
#    bottom_line - does the cell have a line on the bottom?
#    has_cont_row- 
#    rotate      - rotate cell?
#    line_breaks - cell has line breaks in it (???)
#    special     - does this multicol have a special description (@ commands?)
#    pwidth      - pwidth of this cell for a parbox command (for linebreaks)

    sub new {
    # args 1 and 2 are the parent row and column of this cell
	my $class = shift;
	my ($parent_row, $parent_col) = (shift, shift);
	my $cell;
	$cell->{"multicolumn"} = "normal"; # by default, it isn't a multicol
	$cell->{"alignment"} = "l"; # doesn't really matter: will be reset soon
	$cell->{"top_line"} = 0;
	$cell->{"bottom_line"} = 0;
	$cell->{"has_cont_row"} = 0;
	$cell->{"rotate"} = 0;
	$cell->{"line_breaks"} = 0;
	$cell->{"special"} = "";
	$cell->{"pwidth"} = "";

	# Have to bless $cell here, so that we can call methods on it
        bless $cell, $class;

	# The cell should inherit characteristics from its parent row & col
	$cell->row_inherit($parent_row);
	$cell->col_inherit($parent_col);

	return $cell;
    } # end sub new

    sub row_inherit {
    # Inherit fields from parent row
        my ($cell, $row) = (shift, shift);
	$cell->{"top_line"} = $row->{"top_line"};
	$cell->{"bottom_line"} = $row->{"bottom_line"};
    } # end sub row_inherit

    sub col_inherit {
    # Inherit field(s) from parent column
        my ($cell, $col) = (shift, shift);
	$cell->{"alignment"} = $col->{"alignment"};
    }

    sub print_info {
    # print information for this cell
    # Note that we need to put "" around pwidth and special for multicol5 format
	my $cell = shift;
        my $to_print = "";
	my @arr = ($MulticolumnTypes{$cell->{"multicolumn"}},
	                $TableAlignments{$cell->{"alignment"}},
	                $cell->{"top_line"},
		        $cell->{"bottom_line"},
			$cell->{"has_cont_row"},
			$cell->{"rotate"},
			$cell->{"line_breaks"},
		      '"' . $cell->{"special"} . '"',
		      '"' . $cell->{"pwidth"} . '"',
		    );
	$to_print .= join(" ",@arr);
	$to_print .= "\n";
		   
	return $to_print;
    }
} # end package RelyxTable::Cell

1; # return "true" to calling routine