xml.pm 34 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277
  1. # vim: set filetype=perl:
  2. #
  3. # Convert to texinfo xml.
  4. #
  5. # This file is in the public domain. Thus it may easily be used as an
  6. # example for further customizations.
  7. #
  8. # Originally written by Patrice Dumas in 2009.
  9. use strict;
  10. my @xml_multitable_stack = ();
  11. my @xml_table_stack = ();
  12. my @xml_ignored_misc_commands;
  13. my %xml_misc_command_output;
  14. my %xml_misc_elements_with_arg_map;
  15. my @xml_misc_elements_with_arg;
  16. my %def_format_xml;
  17. my $xml_current_section;
  18. sub xml_default_load(;$)
  19. {
  20. my $from_command_line = shift;
  21. t2h_default_set_variables_xml();
  22. set_default('DOCTYPE', '<!DOCTYPE texinfo PUBLIC "-//GNU//DTD TexinfoML V4.12//EN" "http://www.gnu.org/software/texinfo/dtd/4.12/texinfo.dtd">');
  23. set_default('SIMPLE_MENU', 0);
  24. set_default('SEPARATE_DESCRIPTION', 1);
  25. @T2H_FORMAT_EXPAND = ('xml', 'direntry');
  26. set_default('HEADERS', 0);
  27. set_default('INLINE_INSERTCOPYING', 0);
  28. set_default('SHOW_MENU', 1);
  29. set_default('SHOW_TITLE', 0);
  30. set_default('NUMBER_SECTIONS', 0);
  31. set_default('USE_NODES', 1);
  32. set_default('USE_SECTIONS', 1);
  33. set_default('SPLIT', '');
  34. t2h_default_push_handler(\&xml_init_variables, \@command_handler_init);
  35. $colon_command_punctuation_characters{'.'} = '&period;';
  36. $colon_command_punctuation_characters{':'} = '&colon;';
  37. $colon_command_punctuation_characters{'?'} = '&quest;';
  38. $colon_command_punctuation_characters{'!'} = '&excl;';
  39. $simple_map{'*'} = '&linebreak;';
  40. $simple_map{' '} = '&space;';
  41. $simple_map{"\t"} = '&space;';
  42. $simple_map{"\n"} = '&space;';
  43. $simple_map{'.'} = '&eosperiod;';
  44. $simple_map{'!'} = '&eosexcl;';
  45. $simple_map{'?'} = '&eosquest;';
  46. %simple_map_pre = %simple_map;
  47. # FIXME right?
  48. $things_map{'l'} = '/l';
  49. $things_map{'L'} = '/L';
  50. $things_map{'enddots'} = '&enddots;';
  51. $things_map{'dots'} = '&dots;';
  52. # FIXME equiv, point, expansion could be ameliorated
  53. $things_map{'equiv'} = '==';
  54. $things_map{'point'} = '-!-';
  55. $things_map{'expansion'} = '==&gt;'; # &rarr;?
  56. $things_map{'minus'} = '&minus;';
  57. $things_map{'result'} = '&rArr;';
  58. $things_map{'bullet'} = '&bullet;';
  59. $things_map{'copyright'} = '&copyright;';
  60. $things_map{'registeredsymbol'} = '&registered;';
  61. $things_map{'arrow'} = '&rarr;';
  62. $things_map{'TeX'} = '&tex;';
  63. $things_map{'LaTeX'} = '&latex;';
  64. %pre_map = %things_map;
  65. $stop_paragraph_command{'caption'} = 1;
  66. $stop_paragraph_command{'shortcaption'} = 1;
  67. %line_command_map = ();
  68. foreach my $command ('contents', 'shortcontents', 'summarycontents')
  69. {
  70. $line_command_map{$command} = $command;
  71. }
  72. %format_map = ();
  73. $format_map{'copying'} = '';
  74. $format_map{'titlepage'} = 'titlepage';
  75. $format_map{'documentdescription'} = 'documentdescription';
  76. $format_map{'group'} = 'group';
  77. $format_map{'raggedright'} = 'raggedright';
  78. foreach my $region ('titlepage', 'documentdescription', 'copying')
  79. {
  80. $region_formats_kept{$region} = 1;
  81. }
  82. %style_map = ();
  83. t2h_default_copy_style_map (\%default_style_map, \%style_map);
  84. foreach my $style (keys(%style_map))
  85. {
  86. next if grep {$style eq $_} ('asis', 'ctrl', 'w');
  87. if (grep {$style eq $_} ('tieaccent', 'dotless', keys(%unicode_accents)))
  88. {
  89. $style_map{$style} = { 'function' => \&xml_default_accent };
  90. }
  91. elsif (!exists($style_map{$style}->{'args'}) or (scalar(@{$style_map{$style}->{'args'}}) eq 1 and ($style_map{$style}->{'args'}->[0] eq 'code' or $style_map{$style}->{'args'}->[0] eq 'normal')))
  92. {
  93. $style_map{$style}->{'inline_attribute'} = $style;
  94. delete ($style_map{$style}->{'quote'});
  95. delete ($style_map{$style}->{'begin'});
  96. delete ($style_map{$style}->{'end'});
  97. delete ($style_map{$style}->{'function'});
  98. }
  99. }
  100. foreach my $complex_format (keys(%complex_format_map))
  101. {
  102. my $style = $complex_format_map{$complex_format}->{'style'};
  103. delete $complex_format_map{$complex_format};
  104. $complex_format_map{$complex_format}->{'begin'} = "<$complex_format xml:space=\"preserve\">";
  105. $complex_format_map{$complex_format}->{'end'} = "</$complex_format>";
  106. $complex_format_map{$complex_format}->{'style'} = $style if (defined($style));
  107. }
  108. foreach my $menu_command('menu', 'detailmenu', 'direntry', 'menu_comment')
  109. {
  110. $complex_format_map{$menu_command} = undef;
  111. delete $complex_format_map{$menu_command};
  112. }
  113. # this is not needed because normal_text isn't the same than in html
  114. #t2h_remove_text_substitutions("'", 1, 0, 0, 1);
  115. #t2h_remove_text_substitutions('`', 1, 0, 0, 1);
  116. $style_map{'w'}->{'end'} = '<!-- /@w -->';
  117. $style_map{'='}->{'function'} = \&xml_macron;
  118. $style_map{'email'}->{'function'} = \&xml_email;
  119. $style_map{'titlefont'}->{'function'} = \&xml_titlefont;
  120. $style_map{'math'}->{'function'} = \&xml_math;
  121. $style_map{'uref'}->{'function'} = \&xml_uref;
  122. $style_map{'url'}->{'function'} = \&xml_uref;
  123. $style_map{'t'}->{'inline_attribute'} = 'tt';
  124. # FIXME
  125. delete $special_accents{'ringaccent'};
  126. $special_accents{'ogonek'} = 'aeiuAEIU';
  127. %style_map_pre = %style_map;
  128. $no_paragraph_commands{'cindex'} = 0;
  129. #my @xml_ignored_misc_commands = ('bye', 'sp', 'verbatiminclude');
  130. @xml_ignored_misc_commands = ('bye', 'sp', 'verbatiminclude', 'clickstyle',
  131. 'defcodeindex',
  132. 'syncodeindex', 'paragraphindent', 'shorttitlepage', 'refill', 'noindent');
  133. # we want to proceed all the misc commands
  134. # makeinfo ignores clickstyle, changes setfilename. Not sure it is right.
  135. foreach my $misc_command (keys(%misc_command))
  136. {
  137. next if (grep {$misc_command eq $_} @xml_ignored_misc_commands);
  138. $xml_misc_command_output{$misc_command} = 1;
  139. }
  140. $format_map{'menu'} = 'menu';
  141. # checked on bug-texinfo, only node is in code_style, as with makeinfo --xml
  142. #$format_code_style{'menu'} = 1;
  143. #$format_code_style{'menu_name'} = 1;
  144. #$format_code_style{'menu_description'} = 1;
  145. $format_map{'detailmenu'} = 'detailmenu';
  146. $format_map{'direntry'} = 'direntry';
  147. $format_map{'menu_comment'} = '';
  148. $menu_description = \&xml_menu_description;
  149. $menu_link = \&xml_menu_link;
  150. $element_heading = \&xml_heading;
  151. $heading = \&xml_heading;
  152. $paragraph = \&xml_paragraph;
  153. $preformatted = \&xml_preformatted;
  154. $misc_element_label = \&xml_noop;
  155. $element_label = \&xml_noop;
  156. $anchor_label = \&xml_anchor_label;
  157. $index_entry_label = \&xml_index_entry_label;
  158. $index_entry_command = \&xml_index_entry_command;
  159. $listoffloats = \&xml_listoffloats;
  160. $acronym_like = \&xml_acronym_like;
  161. $foot_line_and_ref = \&xml_foot_line_and_ref;
  162. $image = \&xml_image;
  163. $sp = \&xml_sp;
  164. $quotation = \&xml_quotation;
  165. $table_list = \&xml_table_list;
  166. $row = \&xml_row;
  167. $cell = \&xml_cell;
  168. $list_item = \&xml_list_item;
  169. $format_list_item_texi = \&xml_format_list_item_texi;
  170. $misc_command_line = \&xml_misc_commands;
  171. $begin_format_texi = \&xml_begin_format_texi;
  172. $def_line = \&xml_def_line;
  173. $def = \&xml_def;
  174. $def_item = \&xml_def_item;
  175. $printindex = \&xml_printindex;
  176. $index_summary = \&xml_index_summary;
  177. $external_ref = \&xml_external_ref;
  178. $internal_ref = \&xml_internal_ref;
  179. $table_item = \&xml_table_item;
  180. $table_line = \&xml_table_line;
  181. $float = \&xml_float;
  182. $caption_shortcaption = \&xml_caption_shortcaption;
  183. $caption_shortcaption_command = \&xml_caption_shortcaption_command;
  184. $normal_text = \&xml_normal_text;
  185. $protect_text = \&xml_default_protect_text;
  186. $paragraph_style_command = \&xml_paragraph_style_command;
  187. $raw = \&xml_raw;
  188. $cartouche = \&xml_cartouche;
  189. $print_Top = \&xml_print_Top;
  190. $print_Top_footer = \&xml_print_Top_footer;
  191. $print_page_head = \&xml_print_page_head;
  192. $print_foot_navigation = \&xml_noop;
  193. $toc_body = \&xml_noop;
  194. $about_body = \&xml_noop;
  195. $print_page_foot = \&xml_print_page_foot;
  196. $end_section = \&xml_end_section;
  197. $one_section = \&xml_one_section;
  198. %xml_misc_elements_with_arg_map = (
  199. 'title' => 'booktitle',
  200. 'subtitle' => 'booksubtitle'
  201. );
  202. @xml_misc_elements_with_arg = ('author',
  203. 'dircategory', 'settitle');
  204. #my @xml_misc_elements_with_arg = ('author', 'shorttitlepage',
  205. # 'vskip', 'dircategory', 'settitle');
  206. %def_format_xml = (
  207. 'deffn' => [ ['category', 'category'], ['function', 'name'] ],
  208. 'defvr' => [ ['category', 'category'], ['variable', 'name'] ],
  209. 'deftypefn' => [ ['category', 'category'], ['type', 'type'], ['function', 'name'] ],
  210. 'deftypeop' => [ ['category', 'category'], ['type', 'type'], ['operation', 'name'] ],
  211. 'deftypevr' => [ ['category', 'category'], ['type', 'type'], ['variable', 'name'] ],
  212. 'defcv' => [ ['category' , 'category'], ['class', 'class'], ['classvar', 'name'] ],
  213. 'deftypecv' => [ ['category', 'category'], ['type', 'type'], ['classvar', 'name'] ],
  214. 'defop' => [ ['category', 'category'], ['class', 'class'], ['operation', 'name'] ],
  215. 'deftp' => [ ['category', 'category'], ['datatype', 'name'] ]
  216. );
  217. }
  218. sub xml_macron($$)
  219. {
  220. my $accent = shift;
  221. my $args = shift;
  222. return $args->[0] . "&macr;";
  223. }
  224. sub xml_email($$)
  225. {
  226. my $command = shift;
  227. my $args = shift;
  228. my $mail = shift @$args;
  229. my $text = shift @$args;
  230. $mail = main::normalise_space($mail);
  231. my $result = "<email><emailaddress>$mail</emailaddress>";
  232. if (defined($text) and $text =~ /\S/)
  233. {
  234. $result .= "<emailname>".main::normalise_space($text)."</emailname>";
  235. }
  236. return $result . '</email>';
  237. }
  238. sub xml_uref($$)
  239. {
  240. shift;
  241. my $args = shift;
  242. my $url = shift @$args;
  243. my $text = shift @$args;
  244. my $replacement = shift @$args;
  245. $url = main::normalise_space($url);
  246. $replacement = '' if (!defined($replacement));
  247. $replacement = main::normalise_space($replacement);
  248. $text = '' if (!defined($text));
  249. $text = main::normalise_space($text);
  250. my $result = "<uref><urefurl>$url</urefurl>";
  251. $result .= "<urefdesc>$text</urefdesc>" if ($text ne '');
  252. $result .= "<urefreplacement>$replacement</urefreplacement>" if ($replacement ne '');
  253. return $result.'</uref>';
  254. }
  255. sub xml_titlefont($$)
  256. {
  257. shift;
  258. my $args = shift;
  259. return "<titlefont>$args->[0]</titlefont>";
  260. }
  261. sub xml_math($$)
  262. {
  263. shift;
  264. my $args = shift;
  265. my $text = shift @$args;
  266. return "<math>$text</math>";
  267. }
  268. sub xml_menu_description($$$)
  269. {
  270. my $text = shift;
  271. my $state = shift;
  272. my $element_text = shift;
  273. return "<menucomment>$text</menucomment>\n</menuentry>";
  274. }
  275. sub xml_menu_link($$$$$$$$$$)
  276. {
  277. my $entry = shift;
  278. my $state = shift;
  279. my $href = shift;
  280. my $menunode = shift;
  281. my $menutitle = shift;
  282. my $ending = shift;
  283. my $has_title = shift;
  284. my $command_stack = shift;
  285. my $in_preformatted = shift;
  286. my $menunode_normalized = shift;
  287. return "<menuentry>\n<menunode>$menunode_normalized</menunode>\n<menutitle>$menutitle</menutitle>\n";
  288. }
  289. sub xml_print_page_head($)
  290. {
  291. my $fh = shift;
  292. my $setfilename = '';
  293. $setfilename = "<setfilename>$Texi2HTML::THISDOC{'file_base_name'}.".get_conf('EXTENSION')."</setfilename>"
  294. unless (defined(get_conf('setfilename')) and get_conf('setfilename') ne '');
  295. my $language = get_conf('documentlanguage');
  296. my $doctype = get_conf('DOCTYPE');
  297. print $fh <<EOT;
  298. <?xml version="1.0"?>
  299. $doctype
  300. <texinfo xml:lang="$language">
  301. $setfilename
  302. EOT
  303. }
  304. sub xml_print_page_foot($)
  305. {
  306. my $fh = shift;
  307. print $fh "". xml_close_section();
  308. print $fh <<EOT;
  309. </texinfo>
  310. EOT
  311. }
  312. sub xml_one_section($$)
  313. {
  314. my $fh = shift;
  315. my $element = shift;
  316. main::print_lines($fh);
  317. #print $fh "". xml_footing($element);
  318. &$print_foot_navigation($fh);
  319. &$print_page_foot($fh);
  320. }
  321. sub xml_heading($$$$$)
  322. {
  323. my $element = shift;
  324. my $command = shift;
  325. my $texi_line = shift;
  326. my $line = shift;
  327. my $in_preformatted = shift;
  328. #print STDERR "'$command' $line";
  329. if (defined($command) and $command =~ /heading/)
  330. {
  331. my $text = '';
  332. if (defined($line))
  333. {
  334. $text = $line;
  335. # this isn't done in main program in that case...
  336. chomp ($text);
  337. $text =~ s/^\s*//;
  338. }
  339. return "<${command}>$text</${command}>\n";
  340. }
  341. elsif (defined($command) and $command eq 'node')
  342. {
  343. #print STDERR "node $command $node_element->{'texi'}\n";
  344. my $result = '';
  345. $result .= xml_close_section();
  346. $result .= "<node>\n";
  347. $result .= "<nodename>$element->{'text'}</nodename>\n";
  348. foreach my $direction('nodenext', 'nodeprev', 'nodeup')
  349. {
  350. if ($element->{$direction})
  351. {
  352. $result .= "<${direction}>$element->{$direction}->{'text'}</${direction}>\n";
  353. }
  354. }
  355. $result .= "</node>\n";
  356. return $result;
  357. }
  358. else
  359. {
  360. my $result = '';
  361. $result .= xml_close_section();
  362. $result .= "<".xml_element_tag($element).">\n<title>$element->{'text'}</title>\n";
  363. $xml_current_section = $element;
  364. return $result;
  365. }
  366. }
  367. sub xml_element_tag($)
  368. {
  369. my $element = shift;
  370. my $class = $element->{'tag_level'};
  371. return $class;
  372. }
  373. sub xml_close_section()
  374. {
  375. my $element = $xml_current_section;
  376. if (!defined($element))
  377. {
  378. return '';
  379. }
  380. my $result = '';
  381. $xml_current_section = undef;
  382. # there is a special case for a @chapter that is a child of @top
  383. # but should not be considered as is, since it is also toplevel.
  384. # @part, however may have other toplevel elements as children.
  385. return '' if ($element->{'child'} and (!$element->{'child'}->{'toplevel'} or $element->{'tag'} ne 'top'));
  386. $result .= '</'.xml_element_tag($element).">\n";
  387. my $current = $element;
  388. # the second condition is such that top is closed only if it has
  389. # sub-elements below chapter.
  390. # the third condition is such that elements with a next element are
  391. # only closed for the last element, except when the next element is
  392. # toplevel and below top, such that @top is closed before the first
  393. # @chapter if there are @section or the like below @top
  394. while ($current->{'sectionup'} and !($current->{'sectionup'}->{'tag'} eq 'top' and $current->{'toplevel'}) and (!$current->{'childnext'} or ($current->{'childnext'}->{'toplevel'} and $current->{'sectionup'}->{'tag'} eq 'top')))
  395. {
  396. $current = $current->{'sectionup'};
  397. $result .= '</'.xml_element_tag($current).">\n";
  398. }
  399. return $result;
  400. ## there is a special case for a @chapter that is a child of @top
  401. ## but should not be considered as is, since it is also toplevel.
  402. #return '' if ($element->{'child'} and !$element->{'child'}->{'toplevel'});
  403. #$result .= '</'.xml_element_tag($element).">\n";
  404. #return $result if ($element->{'sectionnext'} or $element->{'level'} <= 1);
  405. #my $current = $element;
  406. #while ($current->{'level'} != 1 and $current->{'sectionup'} and !$current->{'sectionnext'})
  407. #{
  408. # $current = $current->{'sectionup'};
  409. # $result .= '</'.xml_element_tag($current).">\n";
  410. #}
  411. #return $result;
  412. }
  413. sub xml_end_section($$$)
  414. {
  415. my $fh = shift;
  416. my $end_foot_navigation = shift;
  417. my $element = shift;
  418. }
  419. sub xml_print_Top($$$)
  420. {
  421. my $fh = shift;
  422. my $has_top_heading = shift;
  423. my $element = shift;
  424. main::print_lines($fh, $Texi2HTML::THIS_SECTION);
  425. }
  426. sub xml_print_Top_footer($$)
  427. {
  428. my $fh = shift;
  429. my $end_page = shift;
  430. my $element = shift;
  431. }
  432. # FIXME warning:
  433. #
  434. # @samp{first para
  435. #
  436. # second para}.
  437. #
  438. # maybe should lead to:
  439. # <para><samp>first para second para</samp>.</para>
  440. #
  441. # But it leads to
  442. # <para><samp>first para
  443. # </samp></para>
  444. # <para><samp>second para</samp>.
  445. # </para>
  446. sub xml_paragraph($$$$$$$$$$$$)
  447. {
  448. my $text = shift;
  449. my $align = shift;
  450. my $indent = shift;
  451. my $paragraph_command = shift;
  452. my $paragraph_command_formatted = shift;
  453. my $paragraph_number = shift;
  454. my $format = shift;
  455. my $item_nr = shift;
  456. my $enumerate_style = shift;
  457. my $number = shift;
  458. my $command_stack_at_end = shift;
  459. my $command_stack_at_begin = shift;
  460. # no para in multitables, caption and shortcaptions.
  461. my $top_stack = '';
  462. $top_stack = $command_stack_at_begin->[-1] if (scalar (@$command_stack_at_begin));
  463. return $text if ($top_stack eq 'multitable' or $top_stack eq 'shortcaption' or $top_stack eq 'caption' or $top_stack eq 'documentdescription');
  464. if ($text =~ /\S/)
  465. {
  466. return "<para>$text</para>";
  467. }
  468. return $text;
  469. }
  470. sub xml_preformatted($$$$$$$$$$$$)
  471. {
  472. my $text = shift;
  473. my $pre_style = shift;
  474. my $class = shift;
  475. my $leading_command = shift;
  476. my $leading_command_formatted = shift;
  477. my $preformatted_number = shift;
  478. my $format = shift;
  479. my $item_nr = shift;
  480. my $enumerate_style = shift;
  481. my $number = shift;
  482. my $command_stack_at_end = shift;
  483. my $command_stack_at_begin = shift;
  484. return $text;
  485. }
  486. sub xml_misc_commands($$$$$)
  487. {
  488. my $macro = shift;
  489. my $line = shift;
  490. my $args = shift;
  491. my $stack = shift;
  492. my $state = shift;
  493. #print STDERR "$macro $line";
  494. #print STDERR "ARGS @$args\n" if defined ($args);
  495. return ($macro, $line, undef) unless($xml_misc_command_output{$macro});
  496. my $value_name = '';
  497. my $value = '';
  498. if ($macro eq 'set' or $macro eq 'clear')
  499. {
  500. my $value_line = $line;
  501. if ($value_line =~ s/^\s+([\w\-]+)//)
  502. {
  503. $value_name = $1;
  504. if ($macro eq 'set')
  505. {
  506. $value = $value_line;
  507. chomp ($value);
  508. $value =~ s/^\s*//;
  509. }
  510. }
  511. }
  512. my $result_text = "<${macro}></${macro}>";
  513. if ($macro eq 'set' or $macro eq 'clear')
  514. {
  515. $result_text = "<${macro}value name=\"$value_name\">$value</${macro}value>\n";
  516. }
  517. if ($macro eq 'c' or $macro eq 'comment' and scalar(@$args))
  518. {
  519. my $comment_line = $args->[0];
  520. chomp ($comment_line);
  521. # makeinfo remove all the leading spaces
  522. $comment_line =~ s/^\s//;
  523. $result_text = &$comment ($comment_line);
  524. }
  525. if ($macro eq 'frenchspacing')
  526. {
  527. my $value = $args->[0];
  528. $value =~ s/\s*//g;
  529. $result_text = "<${macro} var=\"$value\"></${macro}>";
  530. }
  531. if (grep {$macro eq $_} @xml_misc_elements_with_arg)
  532. {
  533. my $arg = $args->[0];
  534. $arg =~ s/^\s*//;
  535. chomp($arg);
  536. $result_text = "<${macro}>".main::substitute_line($arg, "\@$macro")."</${macro}>\n";
  537. }
  538. if (exists($xml_misc_elements_with_arg_map{$macro}))
  539. {
  540. my $arg = $args->[0];
  541. $arg =~ s/^\s*//;
  542. chomp($arg);
  543. $result_text = "<$xml_misc_elements_with_arg_map{$macro}>".main::substitute_line($arg, "\@$macro")."</$xml_misc_elements_with_arg_map{$macro}>\n";
  544. }
  545. if ($macro eq 'setfilename')
  546. {
  547. my $arg = $args->[0];
  548. #$arg =~ s/^\s*//;
  549. #$arg =~ s/\s*$//;
  550. #$arg = main::substitute_line($arg, "\@$macro");
  551. if ($arg =~ /\S/)
  552. {
  553. $arg = get_conf('setfilename');
  554. $arg =~ s/\.[^\.]*$//;
  555. $result_text = "<${macro}>${arg}.xml</${macro}>\n";
  556. }
  557. }
  558. return ($macro, $line, $result_text);
  559. }
  560. sub xml_anchor_label($$)
  561. {
  562. my $id = shift;
  563. my $anchor_text = shift;
  564. return '<anchor name="'. &$protect_text($anchor_text) . '"></anchor>';
  565. }
  566. sub xml_index_entry_command($$$$$)
  567. {
  568. my $command = shift;
  569. my $index_name = shift;
  570. my $label = shift;
  571. my $entry_texi = shift;
  572. my $entry_formatted = shift;
  573. return $label if (defined($label) and $label ne '');
  574. return xml_index_entry_label('','','',$main::index_prefix_to_name{$index_name}, '', '', $entry_formatted, {});
  575. }
  576. sub xml_index_entry_label($$$$$$$$$)
  577. {
  578. my $identifier = shift;
  579. my $preformatted = shift;
  580. my $formatted_entry = shift;
  581. my $index_name = shift;
  582. my $index_command = shift;
  583. my $texi_entry = shift;
  584. my $formatted_entry_reference = shift;
  585. my $in_region_not_in_output = shift;
  586. my $index_entry_ref = shift;
  587. return "<indexterm index=\"${index_name}\">${formatted_entry_reference}</indexterm>";
  588. }
  589. sub xml_listoffloats($$$)
  590. {
  591. my $style_texi = shift;
  592. my $style = shift;
  593. my $float_entries = shift;
  594. # FIXME style, style_texi? Protected?
  595. return "<listoffloats type=\"$style\"></listoffloats>";
  596. }
  597. sub xml_acronym_like($$$$$$)
  598. {
  599. my $command = shift;
  600. my $acronym_texi = shift;
  601. my $acronym_text = shift;
  602. my $with_explanation = shift;
  603. my $explanation_lines = shift;
  604. my $explanation_text = shift;
  605. my $explanation_simply_formatted = shift;
  606. $command = 'abbrev' if ($command eq 'abbr');
  607. my $opening = "<${command}><${command}word>$acronym_text</${command}word>";
  608. if ($with_explanation)
  609. {
  610. $opening .= "<${command}desc>$explanation_text</${command}desc>";
  611. }
  612. return $opening . "</${command}>";
  613. }
  614. sub xml_foot_line_and_ref($$$$$$$)
  615. {
  616. my $number_in_doc = shift;
  617. my $number_in_page = shift;
  618. my $footnote_id = shift;
  619. my $place_id = shift;
  620. my $document_file = shift;
  621. my $footnote_file = shift;
  622. my $lines = shift;
  623. my $state = shift;
  624. my $result = '<footnote>';
  625. foreach my $line (@$lines)
  626. {
  627. $result .= $line;
  628. }
  629. return ([], $result . '</footnote>');
  630. }
  631. sub xml_image($$$$$$$$$$$$$)
  632. {
  633. my $file = shift;
  634. my $base = shift;
  635. my $preformatted = shift;
  636. my $file_name = shift;
  637. my $alt = shift;
  638. my $width = shift;
  639. my $height = shift;
  640. my $raw_alt = shift;
  641. my $extension = shift;
  642. my $working_dir = shift;
  643. my $file_path = shift;
  644. my $in_paragraph = shift;
  645. my $file_locations = shift;
  646. $alt = '' if (!defined($alt));
  647. # dirty hack to avoid " that can be here because of a @verb
  648. $alt =~ s/"/&quot;/g;
  649. $width = '' if (!defined($width));
  650. $height = '' if (!defined($height));
  651. my $tag = 'inlineimage';
  652. $tag = 'image' if ($preformatted or !$in_paragraph);
  653. return "<$tag width=\"$width\" height=\"$height\" name=\"". &$protect_text($base)."\" extension=\"$extension\"><alttext>$alt</alttext></$tag>";
  654. }
  655. sub xml_sp($$)
  656. {
  657. my $number = shift;
  658. my $preformatted = shift;
  659. return "<sp lines=\"$number\"></sp>\n";
  660. }
  661. sub xml_quotation($$$$$)
  662. {
  663. my $command = shift;
  664. my $text = shift;
  665. my $argument_text = shift;
  666. my $argument_text_texi = shift;
  667. my $authors = shift;
  668. return "<$command>\n" . $text . "</$command>\n";
  669. }
  670. sub xml_format_list_item_texi($$$$)
  671. {
  672. my $format = shift;
  673. my $line = shift;
  674. my $prepended = shift;
  675. my $command = shift;
  676. my $result_line = undef;
  677. if (defined($command) and $command ne '' and !exists $special_list_commands{$format}->{$command} and $format ne 'itemize')
  678. {
  679. #@*table
  680. $line =~ s/^\s*//;
  681. $line =~ s/\s*$//;
  682. if (exists ($style_map{$command}))
  683. {
  684. $result_line = "\@$command\{$line\}\n";
  685. }
  686. elsif (exists ($things_map{$command}))
  687. {
  688. $result_line = "\@$command\{\} $line\n";
  689. }
  690. else
  691. {
  692. $result_line = "\@$command $line\n";
  693. }
  694. }
  695. return ($result_line, 0);
  696. }
  697. sub xml_list_item($$$$$$$$$)
  698. {
  699. my $text = shift;
  700. my $format = shift;
  701. my $command = shift;
  702. my $formatted_command = shift;
  703. my $item_nr = shift;
  704. my $enumerate_style = shift;
  705. my $number = shift;
  706. my $prepended = shift;
  707. my $prepended_formatted = shift;
  708. return '<item>' . $text . "</item>\n";
  709. }
  710. sub xml_init_variables()
  711. {
  712. @xml_multitable_stack = ();
  713. @xml_table_stack = ();
  714. $xml_current_section = undef;
  715. }
  716. # row in multitable
  717. sub xml_row($$;$$)
  718. {
  719. my $text = shift;
  720. my $macro = shift;
  721. my $columnfractions = shift;
  722. my $prototype_row = shift;
  723. my $prototype_lengths = shift;
  724. my $column_number = shift;
  725. my $result = '';
  726. if ($macro eq 'headitem')
  727. {
  728. if ($xml_multitable_stack[-1] != 0)
  729. {
  730. $result .= "<thead>";
  731. $result = "</tbody>" . $result if ($xml_multitable_stack[-1] == 1);
  732. $xml_multitable_stack[-1] = 0;
  733. }
  734. }
  735. elsif ($xml_multitable_stack[-1] != 1)
  736. {
  737. $result .= "<tbody>";
  738. $result = "</thead>" . $result if ($xml_multitable_stack[-1] == 0);
  739. $xml_multitable_stack[-1] = 1;
  740. }
  741. $result .= "<row>$text</row>";
  742. return $result;
  743. }
  744. # cell in multitable
  745. sub xml_cell($$;$$)
  746. {
  747. my $text = shift;
  748. my $row_macro = shift;
  749. my $columnfractions = shift;
  750. my $prototype_row = shift;
  751. my $prototype_lengths = shift;
  752. my $column_number = shift;
  753. return "<entry>" . $text . '</entry>';
  754. }
  755. sub xml_table_list($$$$$$$$$)
  756. {
  757. my $format_command = shift;
  758. my $text = shift;
  759. my $command = shift;
  760. my $formatted_command = shift;
  761. # enumerate
  762. my $item_nr = shift;
  763. my $enumerate_style = shift;
  764. # itemize
  765. my $prepended = shift;
  766. my $prepended_formatted = shift;
  767. # multitable
  768. my $columnfractions = shift;
  769. my $prototype_row = shift;
  770. my $prototype_lengths = shift;
  771. my $number = shift;
  772. my $result = "<$format_command>";
  773. if ($format_command eq 'itemize')
  774. {
  775. my $itemfunction;
  776. $prepended_formatted =~ s/^\s*// if (defined($prepended_formatted));
  777. if (defined($formatted_command) and $formatted_command ne '')
  778. {
  779. $itemfunction = $formatted_command;
  780. $itemfunction .= " $prepended_formatted" if (defined($prepended_formatted) and $prepended_formatted ne '');
  781. }
  782. elsif (defined($prepended_formatted))
  783. {
  784. $itemfunction = $prepended_formatted;
  785. }
  786. $itemfunction = "&bullet;" if (!defined($itemfunction) or
  787. $itemfunction eq '');
  788. $result .= "<itemfunction>$itemfunction</itemfunction>";
  789. }
  790. elsif ($format_command eq 'enumerate')
  791. {
  792. $result = "<$format_command first=\"$enumerate_style\">";
  793. }
  794. elsif ($format_command eq 'multitable')
  795. {
  796. my $fractions;
  797. my $multiply = 1;
  798. if (defined($columnfractions) and (ref($columnfractions) eq 'ARRAY')
  799. and scalar(@$columnfractions))
  800. {
  801. $fractions = [ @$columnfractions ];
  802. $multiply = 100;
  803. }
  804. elsif (defined($prototype_lengths) and (ref($prototype_lengths) eq 'ARRAY')
  805. and scalar(@$prototype_lengths))
  806. {
  807. $fractions = [ @$prototype_lengths ];
  808. }
  809. if (defined ($fractions))
  810. {
  811. foreach my $fraction (@$fractions)
  812. {
  813. $result .= "<columnfraction>".($fraction*$multiply)."</columnfraction>\n";
  814. }
  815. }
  816. $text .= "</tbody>" if ($xml_multitable_stack[-1] == 1);
  817. $text .= "</thead>" if ($xml_multitable_stack[-1] == 0);
  818. pop @xml_multitable_stack;
  819. }
  820. elsif ($format_command =~ /^(v|f)?table$/)
  821. {
  822. $result = '<table>';
  823. $text .= '</tableitem>' if ($xml_table_stack[-1] == 1);
  824. pop @xml_table_stack;
  825. return $result . "$text</table>\n";
  826. }
  827. return $result . "$text</$format_command>\n";
  828. }
  829. sub xml_begin_format_texi($$$)
  830. {
  831. my $command = shift;
  832. my $line = shift;
  833. my $state = shift;
  834. push (@xml_multitable_stack, -1) if ($command eq 'multitable');
  835. push (@xml_table_stack, 0) if ($command =~ /^(v|f)?table/);
  836. return $line;
  837. }
  838. sub xml_def_line($$$$$$$$$$$$$$$)
  839. {
  840. my $category_prepared = shift;
  841. my $name = shift;
  842. my $type = shift;
  843. my $arguments = shift;
  844. my $index_label = shift;
  845. my $arguments_array = shift;
  846. my $arguments_type_array = shift;
  847. my $unformatted_arguments_array = shift;
  848. my $command = shift;
  849. my $class_name = shift;
  850. my $category = shift;
  851. my $class = shift;
  852. my $style = shift;
  853. my $original_command = shift;
  854. my $result = "<definitionterm><indexterm index=\""
  855. .$main::index_prefix_to_name{$style}."\">$class_name</indexterm>";
  856. my %arguments = ( 'prepared_category' => $category_prepared,
  857. 'category' => $category,
  858. 'name' => $name,
  859. 'type' => $type,
  860. 'class' => $class
  861. );
  862. foreach my $type (keys(%arguments))
  863. {
  864. $arguments{$type} = '' if (!defined($arguments{$type}));
  865. }
  866. foreach my $mandatory_arg (@{$def_format_xml{$command}})
  867. {
  868. my $elem = $mandatory_arg->[0];
  869. $result .= "<def$elem>$arguments{$mandatory_arg->[1]}</def$elem>";
  870. }
  871. my $params = '';
  872. my @types = @$arguments_type_array;
  873. foreach my $arg (@$arguments_array)
  874. {
  875. my $type = shift @types;
  876. if (grep {$_ eq $type} ('param', 'paramtype', 'delimiter'))
  877. {
  878. $result .= "<def$type>$arg</def$type>";
  879. }
  880. }
  881. $result .= "</definitionterm>\n";
  882. return $result;
  883. }
  884. # FIXME
  885. # @deffn
  886. # @c comment
  887. # @end deffn
  888. # leads to the creation of a <definitionitem> with a comment within,
  889. # while there should be no definitionitem
  890. sub xml_def_item($$)
  891. {
  892. my $text = shift;
  893. my $only_inter_item_commands = shift;
  894. if ($text =~ /\S/)
  895. {
  896. return '<definitionitem>' . $text . '</definitionitem>' unless $only_inter_item_commands;
  897. return $text;
  898. }
  899. return '';
  900. }
  901. sub xml_def($)
  902. {
  903. my $text = shift;
  904. return '<definition>'.$text.'</definition>';
  905. }
  906. sub xml_index_summary($$)
  907. {
  908. my $alpha = shift;
  909. my $nonalpha = shift;
  910. return '';
  911. }
  912. sub xml_printindex($$)
  913. {
  914. my $name = shift;
  915. my $printindex = shift;
  916. return "<printindex>$name</printindex>\n";
  917. }
  918. sub xml_any_ref($$)
  919. {
  920. my $type = shift;
  921. my $args = shift;
  922. my $result = '';
  923. if ($type eq 'pxref')
  924. {
  925. $result = gdt('see ',{'duplicate'=>1});
  926. }
  927. elsif ($type eq 'xref' or $type eq 'inforef')
  928. {
  929. $result = gdt('See ',{'duplicate'=>1});
  930. }
  931. if ($type eq 'inforef')
  932. {
  933. $result .= "<inforef><inforefnodename>$args->[0]</inforefnodename>";
  934. $result .= "<inforefrefname>$args->[1]</inforefrefname>" if ($args->[1] ne '');
  935. $result .= "<inforefinfoname>$args->[2]</inforefinfoname></inforef>"
  936. }
  937. else
  938. {
  939. $result .= "<xref><xrefnodename>$args->[0]</xrefnodename>";
  940. $result .= "<xrefinfoname>$args->[1]</xrefinfoname>" if ($args->[1] ne '');
  941. $result .= "<xrefprinteddesc>$args->[2]</xrefprinteddesc>" if ($args->[2] ne '');
  942. $result .= "<xrefinfofile>$args->[3]</xrefinfofile>" if ($args->[3] ne '');
  943. $result .= "<xrefprintedname>$args->[4]</xrefprintedname>" if ($args->[4] ne '');
  944. $result .= '</xref>';
  945. }
  946. return $result;
  947. }
  948. sub xml_external_ref($$$$$$$$$)
  949. {
  950. my $type = shift;
  951. my $section = shift;
  952. my $book = shift;
  953. my $file = shift;
  954. my $href = shift;
  955. my $cross_ref = shift;
  956. my $args_texi = shift;
  957. my $formatted_args = shift;
  958. my $node = shift;
  959. return xml_any_ref ($type, $formatted_args);
  960. }
  961. sub xml_internal_ref($$$$$)
  962. {
  963. my $type = shift;
  964. my $href = shift;
  965. my $short_name = shift;
  966. my $name = shift;
  967. my $is_section = shift;
  968. my $args_texi = shift;
  969. my $formatted_args = shift;
  970. return xml_any_ref ($type, $formatted_args);
  971. }
  972. sub xml_table_item($$$$$$$)
  973. {
  974. my $text = shift;
  975. my $index_label = shift;
  976. my $format = shift;
  977. my $command = shift;
  978. # my $formatted_command = shift;
  979. my $style_stack = shift;
  980. # my $text_formatted = shift;
  981. # my $text_formatted_leading_spaces = shift;
  982. # my $text_formatted_trailing_spaces = shift;
  983. my $item_cmd = shift;
  984. my $formatted_index_entry = shift;
  985. # $formatted_command = '' if (!defined($formatted_command));
  986. #
  987. # if (defined($text_formatted))
  988. # {
  989. # $text_item = $text_formatted_leading_spaces . $text_formatted .$text_formatted_trailing_spaces;
  990. # }
  991. # else
  992. # {
  993. # $text_item = $text;
  994. # }
  995. my $result = '';
  996. if ($item_cmd eq 'item')
  997. {
  998. $result .= '</tableitem>' if ($xml_table_stack[-1] == 1);
  999. $xml_table_stack[-1] = 1;
  1000. $result .= '<tableitem>';
  1001. }
  1002. $result .= '<tableterm>';
  1003. #print STDERR "$text | $format | $command | $formatted_command | $text_formatted | $item_cmd \n";
  1004. my $indexterm = '';
  1005. #print STDERR "FFFFFFFFFFFFFFFFf `$index_label' `$text'\n";
  1006. if ($format =~ /^(v|f)/)
  1007. {
  1008. # my $index_prefix = $1;
  1009. # $indexterm = $text;
  1010. # $indexterm =~ s/^\s*//;
  1011. # $result .= "<indexterm index=\"$main::index_prefix_to_name{$index_prefix}\">$formatted_index_entry</indexterm>";
  1012. $result .= "$index_label";
  1013. }
  1014. $result .= $text ."</tableterm>\n";
  1015. return $result;
  1016. }
  1017. sub xml_table_line($)
  1018. {
  1019. my $text = shift;
  1020. my $only_inter_item_commands = shift;
  1021. my $before_items = shift;
  1022. if ($text =~ /\S/)
  1023. {
  1024. return "<item>$text</item>" unless $only_inter_item_commands;
  1025. return $text;
  1026. }
  1027. else
  1028. {
  1029. return '';
  1030. }
  1031. }
  1032. sub xml_caption_shortcaption($)
  1033. {
  1034. my $float = shift;
  1035. my $caption_lines;
  1036. my $shortcaption_lines;
  1037. if (defined($float->{'caption_texi'}))
  1038. {
  1039. @$caption_lines = @{$float->{'caption_texi'}};
  1040. }
  1041. if (defined($float->{'shortcaption_texi'}))
  1042. {
  1043. @$shortcaption_lines = @{$float->{'shortcaption_texi'}};
  1044. }
  1045. return ($caption_lines, $shortcaption_lines);
  1046. }
  1047. sub xml_caption_shortcaption_command($$$)
  1048. {
  1049. my $command = shift;
  1050. my $text = shift;
  1051. my $texi_lines = shift;
  1052. my $float_element = shift;
  1053. if ($text =~ /\S/)
  1054. {
  1055. return "<$command>$text</$command>";
  1056. }
  1057. return '';
  1058. }
  1059. sub xml_float($$$$$)
  1060. {
  1061. my $text = shift;
  1062. my $float = shift;
  1063. my $caption = shift;
  1064. my $shortcaption = shift;
  1065. # FIXME don't use the texi, but a normalized node name
  1066. my $label_texi = $float->{'texi'};
  1067. $label_texi = '' if (!defined($label_texi));
  1068. my $result = "<float name=\"$label_texi\">\n";
  1069. my $style = $float->{'style'};
  1070. $style = '' if (!defined($style));
  1071. $result .= "<floattype>$style</floattype>\n";
  1072. $result .= "<floatpos></floatpos>\n";
  1073. $result .= $text;
  1074. return $result."</float>\n";
  1075. }
  1076. sub xml_normal_text($$$$$$$;$)
  1077. {
  1078. my $text = shift;
  1079. my $in_raw_text = shift;
  1080. my $in_preformatted = shift;
  1081. my $in_code = shift;
  1082. my $in_math = shift;
  1083. my $in_simple = shift;
  1084. #print STDERR "Bug: in_raw_text in_simple $text\n" if ($in_raw_text and $in_simple);
  1085. my $style_stack = shift;
  1086. my $state = shift;
  1087. $text = &$protect_text($text) unless($in_raw_text);
  1088. if (! $in_code and !$in_preformatted and !$in_raw_text)
  1089. {
  1090. $text =~ s/---/\&mdash\;/g;
  1091. $text =~ s/--/\&ndash\;/g;
  1092. $text =~ s/``/\&ldquo\;/g;
  1093. $text =~ s/''/\&rdquo\;/g;
  1094. }
  1095. return $text;
  1096. }
  1097. sub xml_paragraph_style_command($$)
  1098. {
  1099. my $format = shift;
  1100. my $text = shift;
  1101. return "<$format>$text</$format>" if ($format eq 'center');
  1102. return $text;
  1103. }
  1104. sub xml_raw($$)
  1105. {
  1106. my $style = shift;
  1107. my $text = shift;
  1108. if ($style eq 'verbatim' or $style eq 'verbatiminclude')
  1109. {
  1110. return '<verbatim xml:space="preserve">' . &$protect_text($text) . '</verbatim>';
  1111. }
  1112. return '' unless (grep {$style eq $_} @EXPAND);
  1113. if ($style eq 'xml')
  1114. {
  1115. chomp ($text);
  1116. return $text;
  1117. }
  1118. else
  1119. {
  1120. main::msg_warn ("Raw style $style not handled", $Texi2HTML::THISDOC{'line_nr'});
  1121. return &$protect_text($text);
  1122. }
  1123. }
  1124. sub xml_cartouche($$)
  1125. {
  1126. my $text = shift;
  1127. return "<cartouche>$text</cartouche>";
  1128. }
  1129. sub xml_noop
  1130. {
  1131. return '';
  1132. }
  1133. 1;