# -*-perl-*-
#+##############################################################################
#
# roff.init: convert to roff
#
# So much out of date that it may be considered unuseful.
#
#    Copyright (C) 2003-2008  Patrice Dumas <address@hidden>
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
#    02110-1301  USA
#
#-##############################################################################

main::load_init_file('', 'noheaders.init');

$SPLIT = 'none';
@EXPAND = ('info');
$USE_ISO = 0;
#$SHOW_MENU = 0;
$SMALL_RULE = '';
$DEFAULT_RULE = '';
$MIDDLE_RULE = '';
$BIG_RULE = '';
$NODE_FILE_EXTENSION = 'roff';
$EXTENSION = 'roff';
$MENU_SYMBOL = '*';
$AVOID_MENU_REDUNDANCY = 0;

$print_Top           = \&T2H_ROFF_print_Top;
$print_misc		     = \&T2H_ROFF_print_misc;
$print_page_head     = \&T2H_ROFF_print_page_head;
$print_page_foot     = \&T2H_ROFF_print_page_foot;
$toc_body            = \&T2H_ROFF_toc_body;
$titlepage           = \&T2H_ROFF_titlepage;

sub T2H_ROFF_print_page_head
{
    my $fh = shift;
    print $fh <<EOT;
.nr _- 0
.tr \\(is'
.tr \\(if`
.tr \\(pd"

$AFTER_BODY_OPEN

EOT
    print $fh $Texi2HTML::THISDOC{'copying_comment'} . "\n";
    print $fh "" . &$comment("Created on $Texi2HTML::THISDOC{today} by $Texi2HTML::THISDOC{program}\n");
    print $fh "" . &$comment($Texi2HTML::THISDOC{program_authors});
    # FIXME this should instead be done in print_title
    print $fh ".ds St " . protect_spaces($Texi2HTML::THISDOC{'title'}) . "\n";
    print $fh '.oh \'\\\\*(St\'\'%\'' ."\n".'.eh \'%\'\'\\\\*(St\'' . "\n";
}

sub T2H_ROFF_print_page_foot
{
    my $fh = shift;
    my $program_string = program_string();
    print $fh <<EOT;
.br
.pp
$program_string
EOT
}

sub T2H_ROFF_print_Top($$)
{
    my $fh = shift;
    my $has_top_heading = shift;

    my $buttons = address@hidden;
    &$print_head_navigation($fh, $buttons);
    # FIXME this is done in print_title now.
    # redo the titlepage with the actual state
    my ($titlepage_text, $titlepage_no_texi, $titlepage_simple_text) = main::do_special_region_lines('titlepage',$Texi2HTML::THISDOC{'state'});
    &$titlepage([],$titlepage_text, $titlepage_no_texi, $titlepage_simple_text); 
    print $fh $Texi2HTML::TITLEPAGE;
    main::print_lines($fh, $Texi2HTML::THIS_SECTION);
}

# FIXME: use the vanilla print_misc instead, and add a
# $heading_text
sub T2H_ROFF_print_misc
{
    my $fh = shift;
    &$print_misc_header($fh);
    main::print_lines($fh);
    &$print_misc_footer($fh);
}

# FIXME obsolete, main one is right now, need to do a heading_text
sub T2H_ROFF_titlepage ($$$$)
{
    my $titlepage_lines = shift;
    my $titlepage_text = shift;
    my $titlepage_no_texi = shift;
    my $titlepage_simple_text = shift;

    my $result = '';
    if (@{$Texi2HTML::THISDOC{'titles'}} 
        or @{$Texi2HTML::THISDOC{'subtitles'}} 
        or @{$Texi2HTML::THISDOC{'authors'}})
    {  
# FIXME obsolete, use $line_command instead
        foreach my $title (@{$Texi2HTML::THISDOC{'titles'}})
        {
            $result .= ".sz +10\n.ce\n" . protect_spaces($title) . "\n.sz -10\n";
        }    
        foreach my $subtitle (@{$Texi2HTML::THISDOC{'subtitles'}})
        {
            $result .= ".sz +4\n.ce\n" . protect_spaces($subtitle) . "\n.sz -4\n";
        }
        $result .= ".sp 4\n" if ($result ne '');
        foreach my $author (@{$Texi2HTML::THISDOC{'authors'}})
        {
            $result .= protect_spaces($author) . "\n.br\n";
        }
        $result .= ".sp 2\n" if (@{$Texi2HTML::THISDOC{'authors'}});
    }
    if (($result ne '') or ($Texi2HTML::TITLEPAGE ne ''))
    {
        $Texi2HTML::TITLEPAGE = ".tp\n" . $result . $titlepage_text . ".++ C\n";
    }
}

########################################################################
# Control of formatting:
# 1.) For some changes, it is often enough to change the value of
#     some global map. It might necessitate building a little
#     function along with the change in hash, if the change is the use
#     of another function (in style_map).
# 2.) For other changes, reimplement one of the t2h_default_<fnc>* routines,
#     give them another name, and assign them to the respective
#     $<fnc> variable (below).


#
# This hash should have keys corresponding with the nonletter command accent
# whose following character is considered to be the argument
# This hash associates an accent macro to the ISO name for the accent if any.
# The customary use of this map is to find the ISO name appearing in html
# entity (like &eacute;) associated with a texinfo accent macro.
#
# The keys of the hash are
# ": umlaut
# ~: tilda accent
# ^: circumflex accent
# `: grave accent
# ': acute accent
# =: macron accent
%accent_map = (
          '"',  ':',
          '~',  '~',
          '^',  '^',
          '`',  '`',
          ',',  ',',
          "'", "'",
          '=', '',
         );

#
# texinfo "simple things" (@foo) to HTML ones
#
%simple_map = (
#           "*", "\n.br\n",   
           ' ', '\ ',
           "\t", "\\\t",
           "\n", "\\\n",
     # "&#173;" or "&shy;" could also be possible for @-, but it seems
     # that some browser will consider this as an always visible hyphen mark
     # which is not what we want (see http://www.cs.tut.fi/~jkorpela/shy.html)
           '-', '',  # hyphenation hint
           '|', '',  # used in formatting commands @evenfooting and friends
           '/', '',
       # spacing commands
           ':', '',
           '!', '!',
           '?', '?',
           '.', '\&.',
           '@', '@',
           '}', '}',
           '{', '{',
          );

# this map is used in preformatted text
%simple_map_pre = %simple_map;

#
# texinfo "things" (@foo{}) to HTML ones
#
%things_map = (
               'TeX'          => 'TeX',
               'LaTeX'        => 'LaTeX',
               'bullet'       => '\(bu',
               'copyright'    => '\(co',
               'registeredsymbol' => '\(rg',
               'dots'         => '\&...',
               'enddots'      => '\&...',
               'equiv'        => '\(==',
# i18n
               'error'        => 'error->',
               'expansion'    => '\(->',
               'minus'        => '\-',
               'point'        => '*',
               'print'        => '-|',
               'result'       => '\(rh',
               # set in code using the language
               # 'today', &pretty_date,
               'aa'           => '\(oa',
               'AA'           => '\(oA',
               'ae'           => '\(ae',
               'oe'           => '\(oe',
               'AE'           => '\(AE',
               'OE'           => '\(OE', 
               'o'            =>  '\(/o',
               'O'            =>  '\(/O',
               'ss'           => '\(ss',
               'l'            => '\(/l',
               'L'            => '\(/L',
               'exclamdown'   => '\(r!',
               'questiondown' => '\(r?',
               'pounds'       => '\(Po',
               'ordm'         => '\(Om',
               'ordf'         => '\(Of',
               'euro'         => '\(eu',
             );

# This map is used in preformatted environments
%pre_map = %things_map;

#%style_map = (
#      'acronym',    '',
#      'asis',       '',
#      'b',          ['\fB', '\fR'],
#      'cite',       ['\fI', '\fR'],
#      'code',       ['\fR\&\f(CW', '\fR'],
#      'command',    ['\fR\&\f(CW', '\fR'],
#      'ctrl',       ['\fR\&\f(CW', '\fR'], 
#      'dfn',        ['\fI', '\fR'], 
#      'dmn',        '',
#      'email',      ['\fB', '\fR'], 
#      'emph',       ['\fI', '\fR'],
#      'env',        ['\fR\&\f(CW', '\fR'],
#      'file',       ['\fR\&\f(CW', '\fR', '"'], 
#      'i',          ['\fI', '\fR'],
#      'kbd',        ['\fR\&\f(CW', '\fR'],
#      'key',        ['\fR\&\f(CW', '\fR'],
#      'math',       ['\fR\&\f(CW', '\fR'],
#      'option',     ['\fR\&\f(CW', '\fR', '"'], 
#      'r',          ['\fR', ''],
#      'samp',       ['\fR\&\f(CW', '\fR', '"'], 
#      'sc',         '&roff_sc',
#      'strong',     ['\fB', '\fR'],
#      't',          ['\fR\&\f(CW', '\fR'],
#      'uref',       '&default_uref',
#      'url',        '&default_url',
#      'var',        ['\fI', '\fR'],
#      'verb',       ['\fR\&\f(CW', '\fR'],
#      'titlefont',  ["\n.sz +10\n.ce\n", "\n.sz -10\n"],
#      'w',          '',
#      'H',          '&roff_accent',
#      'dotaccent',  '&roff_accent',
#      'ringaccent', '&roff_accent',
#      'tieaccent',  '&roff_accent',
#      'u',          '&roff_accent',
#      'ubaraccent', '&roff_accent',
#      'udotaccent', '&roff_accent',
#      'v',          '&roff_accent',
#      ',',          '&roff_accent',
#      'dotless',    ''
#     );

my @bold_commands = ('strong', 'b', 'email');
my @italic_commands = ('cite', 'dfn', 'emph', 'i', 'var', 'slanted');
my @fixed_command = ('code', 'command', 'ctrl', 'env', 'file', 'kbd', 'key',
   'math', 'option', 'samp', 't', 'verb');

foreach my $accent_command ('tieaccent', 'dotless', keys(%unicode_accents), keys(%accent_map))
{
     #$style_map{$accent_command} = { 'function' => \&t2h_roff_accent };
     $style_map{$accent_command} = '&roff_accent';
}
#foreach my $accent (keys(%accent_map))
#{
#    $style_map{$accent} = '&roff_accent';
#}

foreach my $command (keys(%style_map))
{
    delete $style_map{$command}->{'attribute'} if (exists($style_map{$command}->{'attribute'}));
    if (grep {$_ eq $command} @bold_commands)
    {
        delete $style_map{$command}->{'function'} if (exists($style_map{$command}->{'function'}));
        $style_map{$command}->{'begin'} = '\fB';
        $style_map{$command}->{'end'} = '\fR';
        next;
    }
    elsif (grep {$_ eq $command} @italic_commands)
    {
        delete $style_map{$command}->{'function'} if (exists($style_map{$command}->{'function'}));
        $style_map{$command}->{'begin'} = '\fI';
        $style_map{$command}->{'end'} = '\fR';
        next;
    }
    elsif (grep {$_ eq $command} @fixed_commands)
    {
        delete $style_map{$command}->{'function'} if (exists($style_map{$command}->{'function'}));
        $style_map{$command}->{'begin'} = '\fR\&\f(CW';
        $style_map{$command}->{'end'} = '\fR';
        next;
    }
}

delete $style_map{'titlefont'}->{'function'} if (exists($style_map{'titlefont'}->{'function'}));
$style_map{'titlefont'}->{'begin'} = "\n.sz +10\n.ce\n";
$style_map{'titlefont'}->{'end'} = "\n.sz -10\n";

delete $style_map{'r'}->{'function'} if (exists($style_map{'r'}->{'function'}));
$style_map{'r'}->{'begin'} = '\r';
#$style_map{'r'}->{'end'} = '';

$style_map{'sc'} = '&roff_sc';

$style_map{'indicateurl'}->{'begin'} = '<';
$style_map{'indicateurl'}->{'end'} = '>';

foreach my $command (keys(%style_map))
{
    if (ref($style_map{$command}) ne 'HASH')
    {
         $style_map_pre{$command} = $style_map{$command};
         next;
    }
    $style_map_pre{$command} = {};
    foreach my $key (keys(%{$style_map{$command}}))
    {
        $style_map_pre{$command}->{$key} = $style_map{$command}->{$key};
    }
}

%special_accents = (
      'ringaccent' => 'aA',
      "'"          => 'aeiouyAEIOUY',
      ','          => 'cC',
      '^'          => 'aeiouAEIOU',
      '`'          => 'aeiouAEIOU',
      '~'          => 'nNaoAO',
      '"'          => 'aeiouyAEIOUY',
      'v'          => 'sSzZ',
);

sub roff_accent($$)
{
    my $text = shift;
    my $accent = shift;
    return $text if ($accent eq 'dotless');
    return "\\($accent_map{$accent}${text}" if (defined($accent_map{$accent}) and defined($special_accents{$accent}) and ($text =~ /^[$special_accents{$accent}]$/));
    return "\\(o${text}"  if (($accent eq 'ringaccent') and (defined($special_accents{$accent})) and ($text =~ /^[$special_accents{$accent}]$/));
    return "\\(v${text}" if (($accent eq 'v') and (defined($special_accents{$accent})) and ($text =~ /^[$special_accents{$accent}]$/));
#FIXME maybe we should protect the symbols such that they look like strings and
# not ponctuation marks ? Like it is done in texi2roff ? 
    return $text . '\\&.' if ($accent eq 'dotaccent');
    return '\\&.' . $text  if ($accent eq 'udotaccent');
    return ascii_accents($text, $accent);
}

sub roff_sc($$)
{
    return "\n.sz -6\n" . uc($_[0]) . "\n.sz +6\n" ;
}

sub roff_ctrl($$)
{
   return "\\*^$_[0]";
}

$format = \&T2H_ROFF_format;

sub T2H_ROFF_format($$$)
{
    my $tag = shift;
    my $element = shift;
    my $text = shift;
    return '' if (!defined($element) or ($text !~ /\S/));
    return $element->[0] . $text . $element->[1];
}

%format_map = (
       'quotation'   =>  [ ".(q\n", ".)q\n" ],
       'smallquotation'   =>  [ ".(q\n", ".)q\n" ],
       # lists
       'itemize'     =>  [ ".(l L F\n.ba +5\n", ".ba -5\n.)l\n" ],
       'enumerate'   =>  [ ".(l L F\n.ba +5\n", ".ba -5\n.)l\n" ],
       'multitable'  =>  [ ".(l M\n.nh\n", ".hy\n.)l\n" ],
       'table'       =>  [ ".(l L F\n.ba +5\n", ".ba -5\n.)l\n" ],
       'vtable'      =>   [ ".(l L F\n.ba +5\n", ".ba -5\n.)l\n" ],
       'ftable'      =>   [ ".(l L F\n.ba +5\n", ".ba -5\n.)l\n" ],
       );

%special_list_commands = (
       'table'        =>  {},
       'vtable'       =>  {},
       'ftable'       =>  {},
       'itemize'      =>  {}
       );
      
$complex_format_map =
(
 'example' =>
 {
  'begin' => "",
  'end' => "",
  'begin_region' => ".(l I\n\\&\\fR\\f(CW",
  'end_region' => "\\&\\fR\n.)l\n"
 },
 'smallexample' =>
 {
  'begin' => "",
  'end' => "",
  'begin_region' => ".(l I\n.size -2\n\\&\\fR\\f(CW",
  'end_region' => "\\&\\fR\n.size +2\n.)l\n"
 },
 'display' =>
 {
  'begin' => "",
  'end' => "",
  'begin_region' => ".(l I\n\\&\\fR\\f(CW",
  'end_region' => "\\&\\fR\n.)l\n"
 },
 'smalldisplay' =>
 {
  'begin' => "",
  'end' => "",
  'begin_region' => ".(l I\n.size -2\n\\&\\fR\\f(CW",
  'end_region' => "\\&\\fR\n.size +2\n.)l\n"
 },
 'menu-comment' => 
 {
  'begin' => "",
  'end' => "",
  'begin_region' => "",
  'end_region' => "\n"
 },
 'menu-preformatted' => 
 {
  'begin' => "",
  'end' => "",
  'begin_region' => "",
  'end_region' => "\n"
 }
);

# format shouldn't narrow the margins

$complex_format_map{'lisp'} =  $complex_format_map{'example'};
$complex_format_map{'smalllisp'} = $complex_format_map{'smallexample'};
$complex_format_map{'format'} = $complex_format_map{'display'};
$complex_format_map{'smallformat'} = $complex_format_map{'smalldisplay'};

sub protect_spaces($)
{
    my $text = shift;
    my $result = '';
    while($text)
    {
        if ($text =~ s/^([^\\]*)\\//o)
        {
            my $leading = $1;
            if (defined($leading))
            {
                 $leading =~ s/([\t ])/\\$1/go;
                 $result .= $leading . '\\';
            }
            if (($text =~ s/^(\s)//o) or ($text =~ s/^(.)//o))
            {
                 $result .= $1;
            }
        }
        else
        {
            $text =~ s/([\t ])/\\$1/go;
            $result .= $text;
            $text = '';
        }
    }
    return $result;
}

# formatting functions

$anchor            = \&t2h_roff_anchor;
$def_item          = \&t2h_roff_def_item;
$def               = \&t2h_roff_def;
$menu              = \&t2h_roff_menu;
$menu_link         = \&t2h_roff_menu_link;
$menu_comment      = \&t2h_roff_menu_comment;
$menu_description  = \&t2h_roff_menu_description;
$simple_menu_link  = \&t2h_roff_simple_menu_link;
$table_item        = \&t2h_roff_table_item;
$table_line        = \&t2h_roff_table_line;
$row               = \&t2h_roff_row;
$cell              = \&t2h_roff_cell;
$list_item         = \&t2h_roff_list_item;
$comment           = \&t2h_roff_comment;
$def_line	       = \&t2h_roff_def_line;
$raw               = \&t2h_roff_raw;
$heading           = \&t2h_roff_heading;
$paragraph         = \&t2h_roff_paragraph;
$preformatted      = \&t2h_roff_preformatted;
$foot_line_and_ref = \&t2h_roff_foot_line_and_ref;
$foot_section      = \&t2h_roff_foot_section;
$image             = \&t2h_roff_image;
$index_entry_label = \&t2h_roff_index_entry_label;
$index_summary     = \&t2h_roff_index_summary;
$print_index       = \&t2h_roff_print_index;
$protect_text      = \&t2h_roff_protect_text;
$cartouche         = \&t2h_roff_cartouche;
$sp                = \&t2h_roff_sp;
$normal_text       = \&t2h_roff_normal_text;
$empty_line        = \&t2h_roff_empty_line;
$unknown           = \&t2h_roff_unknown;
$float             = \&t2h_roff_float;
$listoffloats      = \&t2h_roff_listoffloats;
$listoffloats_entry = \&t2h_roff_listoffloats_entry;

# This function is used to protect characters which are special in html 
# in inline text:  &, ", <, and >. 
#
# argument:
# text to be protected
sub t2h_roff_protect_text($)
{
   my $text = shift;
   $text =~ s/\\/\\e/g;
#   $text =~ s/$;---$;/\\(em/g;
#   $text =~ s/$;--$;/-/g;
#   $text =~ s/$;-$;/\\-/g;
   $text =~ s/^\./\\&./;
   $text =~ s/([\s])\./$1\\&./g;
   return $text;
}

sub t2h_roff_normal_text($$$$$$$;$)
{
   my $text = shift;
   my $in_raw_text = shift;
   my $in_preformatted = shift;
   my $in_code =shift;
   my $in_math = shift;
   my $in_simple = shift;
   my $style_stack = shift;
   my $state = shift;

   $text = &$protect_text($text) unless($in_raw_text);
   if (! $in_code and !$in_preformatted and !$in_raw_text)
   {
       $text =~ s/---/\\(em/g;
       $text =~ s/--/\\(en/g;
       $text =~ s/-/\\-/g;
       $text =~ s/``/\\(lq/g;
       $text =~ s/''/\\(rq/g;
    }
    #$text =~ s/---/\\(em/g;
    #$text =~ s/(--?-?)/$;$1$;/go;
    return $text;
}

sub t2h_roff_unknown($$$)
{
    my $macro = shift;
    my $line = shift;
    my $pass = shift;

    if ($macro eq '*' and $pass == 2)
    {
        $line = '' if ($line =~ /^\s*$/);
        return ($line, 1, "\n.br\n", undef);
    }
    return ($line, 0, undef, undef);
}


# This function produces an anchor 
#
# arguments:
# $name           :   anchor name
# $href           :   anchor href
# text            :   text displayed
# extra_attribs   :   added to anchor attributes list
sub t2h_roff_anchor($;$$$)
{
    my $name = shift;
    my $href = shift;
    my $text = shift;
    my $attributes = shift;
    $href = '' if (!defined($href) or ($href !~ /\S/));
    $text = '' if (!defined($text));
    return $text if ($text ne '');
    return "[$href]" if ($href ne '');
    return '';
}

# This function is used to format the text associated with a @deff/@end deff
#
# argument:
# text
sub t2h_roff_def_item($)
{
    my $text = shift;
    if ($text =~ /\S/)
    {
        {
            #return ".ba +5\n.(l L F\n" . $text . ".)l\n.ba -5\n";
            return ".(l L F\n.ba +5\n" . $text . ".ba -5\n.)l\n";
        }
    }
    return '';
}

# format the container for the @deffn line and text
# 
# argument
# text of the whole @def, line and associated text.
sub t2h_roff_def($)
{
    my $text = shift;
    return $text;
}

# a whole menu
#
# argument:
# the whole menu text (entries and menu comments)
#
# argument:
# whole menu text.
sub t2h_roff_menu($)
{
    my $text = shift;
    chomp $text;
    return ".(l M\n\\&\\s8" . gdt('Menu:') . "\n" . $text . "\\&\\s0\n.)l\n";
}

# a simple menu entry ref in case we aren't in a standard menu context
sub t2h_roff_simple_menu_link($$$$$$$)
{
    my $entry = shift;
    my $preformatted = shift; # We assume this is true.
    my $href = shift;
    my $node = shift;
    my $title = shift;
    my $ending = shift;
    my $has_title = shift;
    $title = '' unless ($has_title);
    $title .= ':' if ($title ne '');
    return "$MENU_SYMBOL$title$node$ending";
}

# formats a menu entry link pointing to a node or section 
#
# arguments:
# the entry text
# the state, a hash reference holding informations about the context, with a 
#     usefull entry, 'preformatted', true if we are in a preformatted format
#     (a format keeping space between words). In that case a function
#     of the main program, main::do_preformatted($text, $state) might 
#     be used to format the text with the current format style.
# href is optionnal. It is the reference to the section or the node anchor
#     which should be used to make the link (typically it is the argument 
#     of a href= attribute in a <a> element).
sub t2h_roff_menu_link($$$$$$)
{
    my $entry = shift;
    my $state = shift;
    my $href = shift;
    my $node = shift;
    my $title = shift;
    my $ending = shift;
    my $has_title = shift;
    $title = '' unless ($has_title);
    $title .= ':' if ($title ne '');
    return "$MENU_SYMBOL$title$node$ending";
}

# formats a menu entry description, ie the text appearing after the node
# specification in a menu entry an spanning until there is another
# menu entry, an empty line or some text at the very beginning of the line
# (we consider that text at the beginning of the line begins a menu comment) 
#
# arguments:
# the description text
# the state. See menu_entry.
sub t2h_roff_menu_description($$)
{
   my $text = shift;
   my $state = shift;
   return $text;
}

# a menu comment (between menu lines)
# formats the container of a menu comment. A menu comment is any text 
# appearing between menu lines, either separated by an empty line from
# the preceding menu entry, or a text beginning at the first character
# of the line (text not at the very beginning of the line is considered to
# be the continuation of a menu entry description text).
#
# The text itself is considered to be in a preformatted environment
# with name 'menu-commment' and with style $MENU_PRE_STYLE.
#
# argument
# text contained in the menu comment.
sub t2h_roff_menu_comment($)
{
   my $text = shift;
   return $text;
}

# text after @item in table, vtable and ftable
sub t2h_roff_table_item($$$$$)
{
    my $text = shift;
    my $index_label = shift;
    my $format = shift;
    my $command = shift;
#    my $formatted_command = shift;
    my $style_stack = shift;
#    my $text_formatted = shift;
#    my $text_formatted_leading_spaces = shift;
#    my $text_formatted_trailing_spaces = shift;
    my $item_cmd = shift;


#    if (defined($text_formatted))
#    {   
#        $text = $text_formatted_leading_spaces . $text_formatted .$text_formatted_trailing_spaces;
#    }
#    $formatted_command = '' if (!defined($formatted_command) or 
#          exists($special_list_commands{$format}->{$command}));
    $text = '.ip ' . $formatted_command . protect_spaces($text) . "\n";
    $text .= $index_label  if (defined($index_label));
    return $text;
}

# format text on the line following @item (in table, vtable and ftable)
sub t2h_roff_table_line($)
{
    my $text = shift;
    return $text;
}

# row in multitable
sub t2h_roff_row($)
{
    my $text = shift;

    if ($text =~ /\S/)
    {
         return $text ."\n" ;
    }
    return '';
}

# cell in multitable
sub t2h_roff_cell($)
{
    my $text = shift;
    chomp $text;
    return  protect_spaces($text) . "\\\t";
}

# format an item in a list
#
# argument:
# text of the item
sub t2h_roff_list_item($$$$$$$)
{
    my $text = shift;
    my $format = shift;
    my $command = shift;
    my $formatted_command = shift;
    my $item_nr = shift;
    my $enumerate_style = shift;
    my $number = shift;
    $formatted_command = '' if (!defined($formatted_command) or 
          exists($special_list_commands{$format}->{$command}));
    if ($text =~ /\S/)
    {
        #return $formatted_command . $text;
        return $text . "\n";
    }
    return '';
}

# an comment
sub t2h_roff_comment($)
{
    my $text = shift;
    my $result = '';
    while ($text)
    {
        $text =~ s/$;---$;/--/g;
        $text =~ s/$;--$;/-/g;
        $text =~ s/$;-$;/-/g;
        $text =~ s/^(.*)//;
        $result .= ".\\\"$1";
        $result .= "\n" if ($text =~ s/^\n//);
    }
    return $result;
}

# a paragraph
sub t2h_roff_paragraph($$$$$$$$$$)
{
    my $text = shift;
    my $align = shift;
    my $indent = shift;
    my $paragraph_command = shift;
    my $paragraph_command_formatted = shift;
    my $paragraph_number = shift;
    my $format = shift;
    my $item_nr = shift;
    my $enumerate_style = shift;
    my $number = shift;
    return '' if ($text =~ /^\s*$/);
    if (defined($paragraph_number) and defined($$paragraph_number))
    {
         $$paragraph_number++;
         $paragraph_command_formatted = undef if ($$paragraph_number > 1);
    }
#    $paragraph_command_formatted = '' if (!defined($paragraph_command_formatted) or
#          exists($special_list_commands{$format}->{$paragraph_command}));
    #return $text if (defined($format) and $format eq 'multitable');
    return $text if (defined($format) and (($format eq 'multitable') or ($format eq 'quotation') or ($format eq 'smallquotation')));
    my $open = ".pp\n";
    if (defined($format) and (($format eq 'itemize') or ($format eq 'enumerate')) and
         defined($paragraph_number) and defined($$paragraph_number) and ($$paragraph_number == 1))
    {
         $open = ".lp\n";
    }
    my $close = '';
    if ($align)
    {
        if ($align eq 'flushleft')
        {
            $open .= ".ad l\n";
            $close .= ".ad b\n";
        }
        elsif ($align eq 'flushright')
        {
            $open .= ".ad r\n";
            $close .= ".ad b\n";
        }
        elsif ($align eq 'center')
        {
            $open .= ".ce\n";
        }
    }
    if (defined($format) and ($format eq 'enumerate') and
         defined($paragraph_number) and defined($$paragraph_number) and ($$paragraph_number == 1) and defined($number) and ($number ne ''))
    {
         $open .= "$number.";
    }
    chomp ($text);
    #return $open. $paragraph_command_formatted . $text . "\n" . $close;
    return $open. $text . "\n" . $close;
}

# a preformatted region
sub t2h_roff_preformatted($$$$$$$$$$)
{
    my $text = shift;
    my $pre_style = shift;
    my $class = shift;
    my $leading_command = shift;
    my $leading_command_formatted = shift;
    my $preformatted_number = shift;
    my $format = shift;
    my $item_nr = shift;
    my $enumerate_style = shift;
    my $number = shift;
    $leading_command_formatted = '' if (!defined($leading_command_formatted) or
        exists($special_list_commands{$format}->{$leading_command}));

    if (defined($format) and $format eq 'multitable')
    {
        my $chomped = chomp($text);
        my $result  = '\&\fR\f(CW' . $text . '\&\fR';
        $result .= "\n" if ($chomped); 
        return $result;
    }
    return '' if ($text eq '');
    if (defined($preformatted_number) and defined($$preformatted_number))
    {
         $$preformatted_number++;
         $leading_command_formatted = undef if ($$preformatted_number > 1);
    }
    $leading_command_formatted = '' if (!defined($leading_command_formatted));
    chomp $text;
    my $open = '';
    if (defined($format) and ($format eq 'enumerate') and
         defined($paragraph_number) and defined($$paragraph_number) and ($$paragraph_number == 1) and defined($number) and ($number ne ''))
    {
         $open = "$number. ";
    }
    return $complex_format_map{$class}->{'begin_region'} . $leading_command_formatted . $open . $text . $complex_format_map{$class}->{'end_region'};
}

# This function formats a heading for an element
#
# argument:
# an element. It is a hash reference for a node or a sectioning command.
# The interesting keys are:
# 'text': the heading text
# 'name': the heading text without section number
# 'node': true if it is a node
# 'level': level of the element. 0 for @top, 1 for chapter, heading, 
#      appendix..., 2 for section and so on...
# 'tag_level': the sectioning element name, raisesections and lowersections
#      taken into account
sub t2h_roff_heading($$$$$;$$)
{
    my $element = shift;
    my $command = shift;
    my $texi_line = shift;
    my $line = shift;
    my $in_preformatted = shift;
    my $one_section = shift;
    my $element_heading = shift;

    my $name = $element->{'text'};
    if (!$element->{'node'})
    {
        $name = $element->{'name'};
    }
    return '' if ($element->{'name'} !~ /\S/);
    my $class = $element->{'tag_level'};
    $class = 'unnumbered' if ($class eq 'top'); 
    $level = $element->{'level'};
    $level = 3 if (!defined($level));
    $level = 1 if ($level == 0);
    my $heading = '';
    $heading = ".bp\n" if ($level == 1);
    $heading .= '.if !\n(_- \{\\' . "\n.nr _- 1\n.nr \$1 0 1\n" . '.af $1 A\}' . "\n"
        if ($class =~ /^appendix/);
    $name = protect_spaces($name);
    my $toc_entry = '\&';
    if ($class =~ /^unnumbered/ or ($class eq 'node'))
    {
        $heading .= ".uh $name\n";
        $toc_entry .= ' ';
    }
    elsif (($class =~ /section$/) or ($class eq 'chapter') or ($class =~ /^appendix/))
    {
        $heading .= ".sh $level $name\n";
        my $number = 1;
        while ($number < $level)
        {
            $toc_entry .= "\\n(\$$number.";
            $number++;
        }
        $toc_entry .= "\\n(\$$number ";
    }
    $toc_entry .= $name;
    return $heading . "\n" if ($class eq 'node');
    return $heading . ".(x\n" . $toc_entry . "\n.)x\n\\&\\fR\n";
}

sub T2H_ROFF_toc_body($$$)
{
    my $elements_list = shift;
    my $do_contents = shift;
    my $do_scontents = shift;
    if ($do_contents or $do_scontents)
    {
        my $lines = ".pp\n.nr % 0 1\n.af % i\n.bp \\n%+1\n.ce\n\\&\\fB" . gdt('Table of Contents') . "\\fR\n.sp 2\n.xp\n";
        if (!$do_contents)
        {
            push @{$Texi2HTML::OVERVIEW}, $lines;
        }
        else
        {
            push @{$Texi2HTML::TOC_LINES}, $lines;
        }
    }
}

# formatting of raw regions
# ih L2H is true another mechanism is used for tex
sub t2h_roff_raw($$)
{
    my $style = shift;
    my $text = shift;
    my $expanded = 1 if (grep {$style eq $_} @EXPAND);
    if ($style eq 'verbatim' or $style eq 'verbatiminclude' or ($expanded and ($style eq 'tex' or $style eq 'html')))
    {
        chomp ($text);
        return ".(l M\n\\fR\\&\\f(CW" . &$protect_text($text) . "\\fR\n.)l\n" ;
    }
    elsif ($expanded)
    {
        main::msg_debug ("(bug) unknown style $style");
        return &$protect_text($text);
    }
    return '';
}

# This function formats a footnote reference and the footnote text associated
# with a given footnote.
# The footnote reference is the text appearing in the main document pointing
# to the footnote text.
#
# arguments:
# absolute number of the footnote (in the document)
# relative number of the footnote (in the page)
# identifier for the footnote
# identifier for the footnote reference in the main document
# main document file
# footnote text file
# array with the footnote text lines 
# the state. See menu entry.
#
# returns:
# reference on an array containing the footnote text lines which should
#     have been updated
# the text for the reference pointing on the footnote text
sub t2h_roff_foot_line_and_ref($$$$$$$)
{
    my $number_in_doc = shift;
    my $number_in_page = shift;
    my $footnote_id = shift;
    my $place_id = shift;
    my $document_file = shift;
    my $footnote_file = shift;
    my $lines = shift;
    my $state = shift;
    
    my $text = '';
    my $line;
    while (@$lines)
    {
         $line = shift @$lines;
         $text .= $line;
    }
    chomp $text;
    return ([], "\n.(f\n" . $text . "\n.)f\n" );
}

# formats a group of footnotes.
#
# argument:
# array reference on the footnotes texts lines 
#
# returns an array reference on the group of footnotes lines
sub t2h_roff_foot_section($)
{
    my $lines = shift;
    @$lines = ();
}

# format an image
#
# arguments:
# image file name
# image basename
# a boolean true if we are in a preformatted format
sub t2h_roff_image($$$$)
{
   my $file = shift;
   my $base = shift;
   my $preformatted = shift;
   my $file_name = shift;
   return "[$base src=$file_name]" if ($base ne $file_name);
   return "[$base]";
}

# format a target in the main document for an index entry.
#
# arguments:
# target identifier
# boolean true if in preformatted format
sub t2h_roff_index_entry_label($$$$$$$$$)
{
    my $identifier = shift;
    my $preformatted = shift;
    my $entry = shift;
    my $index_name = shift;
    my $index_command = shift;
    my $texi_entry = shift;
    my $formatted_entry = shift;
    my $in_region_not_in_output = shift;
    my $index_entry_ref = shift;

    return ".(x $index_name\n" . protect_spaces($entry) . "\n.)x\n";
}

# process definition commands line @deffn for example
sub t2h_roff_def_line($$$$$)
{
   my $category = shift;
   my $name = shift;
   my $type = shift;
   my $arguments = shift;
   my $index_label = shift;
   $index_label = '' if (!defined($index_label));
   $name = '' if (!defined($name) or ($name =~ /^\s*$/));
   $type = '' if (!defined($type) or $type =~ /^\s*$/);
   if (!defined($arguments) or $arguments =~ /^\s*$/)
   {
       $arguments = '';
   }
   else
   {
       $arguments = '\fI' . protect_spaces($arguments) . '\fR';
   }
   my $type_name = ' ';
   $type_name = " $type" if ($type ne '');
   
   $type_name .= '\fB' . protect_spaces($name) . '\fR' if ($name ne '');
   $type_name .= $arguments . "\n";
   return '\fI' . protect_spaces($category) . ':\fR' . $type_name . $index_label;
}

# a cartouche
sub t2h_roff_cartouche($$)
{
    my $text = shift;
    return $text;
} 

sub t2h_roff_sp($$)
{
   my $number = shift;
   my $preformatted = shift;
   return "\n.sp $number\n";
}

# format a whole index
#
# argument:
# index text
# index name
sub t2h_roff_print_index($$)
{
    my $text = shift;
    my $name = shift;
    return ".xp $name\n";
}

# format an index summary. This is a list of letters linking to the letter
# entries.
#
# arguments:
# array reference containing the formatted alphabetical letters
# array reference containing the formatted non lphabetical letters
sub t2h_roff_index_summary($$)
{
    my $alpha = shift;
    my $nonalpha = shift;
    my $join = '';
    my $nonalpha_text = '';
    my $alpha_text = '';
    return '';
}

# FIXME the following construct leads to something wrong ?
# something @c a comment
#
# other thing
sub t2h_roff_empty_line($)
{
    my $text = shift;
    return '';
}

sub t2h_roff_listoffloats_entry($$$$)
{
    my $style_texi = shift;
    my $float = shift;
    my $float_style = shift;
    my $caption = shift;
    my $href = shift;
	chomp ($caption);

    return '.ip ' . protect_spaces($float_style) . "\n" . $caption . "\n";
}

sub t2h_roff_listoffloats($$$)
{
    my $style_texi = shift;
    my $style = shift;
    my $float_entries = shift;

    my $result = ".(l L F\n.ba +5\n";
    foreach my $float_entry (@$float_entries)
    {
         $result .= $float_entry;
    }
    return $result . ".ba -5\n.)l\n";
} 

sub t2h_roff_float($$$$$)
{
    my $text = shift;
    my $float = shift;
    my $caption = shift;
    my $shortcaption = shift;
    
    my $caption_text = '';
    
    if (defined($float->{'caption_texi'}))
    {
         $caption_text = $caption;
    }
    elsif (defined($float->{'shortcaption_texi'}))
    {
         $caption_text = $shortcaption;
    }
    elsif (defined($caption))
    {
         $caption_text = $caption;
    }
    chomp ($caption_text);
    return  ".(b L F\n" . $text . $caption_text . "\n.b)\n";
}

1;