12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241 |
- # -*-perl-*-
- #+##############################################################################
- #
- # roff.pm: convert to roff
- #
- # So much out of date that it may be considered unuseful.
- #
- # Copyright (C) 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
- #
- # 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 3 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, see <http://www.gnu.org/licenses/>.
- #
- # Originally written by Patrice Dumas.
- #
- #-##############################################################################
- # FIXME obsolete
- main::load_init_file('', 'noheaders.pm');
- set_default('SPLIT', 0);
- @EXPAND = ('info');
- set_default('USE_ISO', 0);
- $SMALL_RULE = '';
- $DEFAULT_RULE = '';
- $MIDDLE_RULE = '';
- $BIG_RULE = '';
- set_default('NODE_FILE_EXTENSION', 'roff');
- set_default('EXTENSION', 'roff');
- $MENU_SYMBOL = '*';
- set_default('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
- my $today = get_conf('today');
- print $fh $Texi2HTML::THISDOC{'copying_comment'} . "\n";
- print $fh "" . &$comment("Created by $Texi2HTML::THISDOC{'program_version'}, $Texi2HTML::THISDOC{'program_homepage'}\n");
- # 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 = \@MISC_BUTTONS;
- &$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 é) 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",
- # "­" or "­" 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;
|