Merge lp:~mitya57/ubuntu/saucy/texinfo/5.1.dfsg.1-4ubuntu1 into lp:ubuntu/saucy/texinfo
- Saucy (13.10)
- 5.1.dfsg.1-4ubuntu1
- Merge into saucy
Proposed by
Dmitry Shachnev
Status: | Merged |
---|---|
Merged at revision: | 19 |
Proposed branch: | lp:~mitya57/ubuntu/saucy/texinfo/5.1.dfsg.1-4ubuntu1 |
Merge into: | lp:ubuntu/saucy/texinfo |
Diff against target: |
9678 lines (+9582/-3) 10 files modified
.pc/applied-patches (+1/-0) .pc/maybe-upstream-fix-itemize-start/tp/Texinfo/Common.pm (+2530/-0) .pc/maybe-upstream-fix-itemize-start/tp/Texinfo/Parser.pm (+6996/-0) debian/changelog (+16/-0) debian/control (+2/-1) debian/patches/maybe-upstream-fix-itemize-start (+31/-0) debian/patches/series (+1/-0) debian/rules (+2/-0) tp/Texinfo/Common.pm (+1/-1) tp/Texinfo/Parser.pm (+2/-1) |
To merge this branch: | bzr merge lp:~mitya57/ubuntu/saucy/texinfo/5.1.dfsg.1-4ubuntu1 |
Related bugs: |
Reviewer | Review Type | Date Requested | Status |
---|---|---|---|
Daniel Holbach (community) | Approve | ||
Ubuntu branches | Pending | ||
Review via email: mp+174617@code.launchpad.net |
Commit message
Description of the change
A trivial merge from Debian, which fixes a "Severity: serious" bug.
To post a comment you must log in.
Revision history for this message
Dmitry Shachnev (mitya57) wrote : | # |
Thanks Daniel, marking as merged.
Preview Diff
[H/L] Next/Prev Comment, [J/K] Next/Prev File, [N/P] Next/Prev Hunk
1 | === modified file '.pc/applied-patches' | |||
2 | --- .pc/applied-patches 2013-01-20 20:25:10 +0000 | |||
3 | +++ .pc/applied-patches 2013-07-14 15:17:24 +0000 | |||
4 | @@ -3,3 +3,4 @@ | |||
5 | 3 | numerical-signal-names | 3 | numerical-signal-names |
6 | 4 | info_universal_argument | 4 | info_universal_argument |
7 | 5 | dont_build_info | 5 | dont_build_info |
8 | 6 | maybe-upstream-fix-itemize-start | ||
9 | 6 | 7 | ||
10 | === added directory '.pc/maybe-upstream-fix-itemize-start' | |||
11 | === added directory '.pc/maybe-upstream-fix-itemize-start/tp' | |||
12 | === added directory '.pc/maybe-upstream-fix-itemize-start/tp/Texinfo' | |||
13 | === added file '.pc/maybe-upstream-fix-itemize-start/tp/Texinfo/Common.pm' | |||
14 | --- .pc/maybe-upstream-fix-itemize-start/tp/Texinfo/Common.pm 1970-01-01 00:00:00 +0000 | |||
15 | +++ .pc/maybe-upstream-fix-itemize-start/tp/Texinfo/Common.pm 2013-07-14 15:17:24 +0000 | |||
16 | @@ -0,0 +1,2530 @@ | |||
17 | 1 | # Common.pm: definition of commands. Common code of other Texinfo modules. | ||
18 | 2 | # | ||
19 | 3 | # Copyright 2010, 2011, 2012 Free Software Foundation, Inc. | ||
20 | 4 | # | ||
21 | 5 | # This program is free software; you can redistribute it and/or modify | ||
22 | 6 | # it under the terms of the GNU General Public License as published by | ||
23 | 7 | # the Free Software Foundation; either version 3 of the License, | ||
24 | 8 | # or (at your option) any later version. | ||
25 | 9 | # | ||
26 | 10 | # This program is distributed in the hope that it will be useful, | ||
27 | 11 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
28 | 12 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
29 | 13 | # GNU General Public License for more details. | ||
30 | 14 | # | ||
31 | 15 | # You should have received a copy of the GNU General Public License | ||
32 | 16 | # along with this program. If not, see <http://www.gnu.org/licenses/>. | ||
33 | 17 | # | ||
34 | 18 | # Original author: Patrice Dumas <pertusus@free.fr> | ||
35 | 19 | # Parts (also from Patrice Dumas) come from texi2html.pl or texi2html.init. | ||
36 | 20 | |||
37 | 21 | package Texinfo::Common; | ||
38 | 22 | |||
39 | 23 | use strict; | ||
40 | 24 | |||
41 | 25 | # for unicode/layer support in binmode | ||
42 | 26 | use 5.006; | ||
43 | 27 | |||
44 | 28 | # to determine the null file | ||
45 | 29 | use Config; | ||
46 | 30 | use File::Spec; | ||
47 | 31 | |||
48 | 32 | use Texinfo::Documentlanguages; | ||
49 | 33 | |||
50 | 34 | # debugging | ||
51 | 35 | use Carp qw(cluck); | ||
52 | 36 | |||
53 | 37 | require Exporter; | ||
54 | 38 | use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); | ||
55 | 39 | @ISA = qw(Exporter); | ||
56 | 40 | |||
57 | 41 | # Items to export into callers namespace by default. Note: do not export | ||
58 | 42 | # names by default without a very good reason. Use EXPORT_OK instead. | ||
59 | 43 | # Do not simply export all your public functions/methods/constants. | ||
60 | 44 | |||
61 | 45 | # This allows declaration use Texinfo::Covert::Text ':all'; | ||
62 | 46 | # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK | ||
63 | 47 | # will save memory. | ||
64 | 48 | %EXPORT_TAGS = ( 'all' => [ qw( | ||
65 | 49 | expand_verbatiminclude | ||
66 | 50 | definition_category | ||
67 | 51 | expand_today | ||
68 | 52 | numbered_heading | ||
69 | 53 | trim_spaces_comment_from_content | ||
70 | 54 | float_name_caption | ||
71 | 55 | normalize_top_node_name | ||
72 | 56 | protect_comma_in_tree | ||
73 | 57 | protect_first_parenthesis | ||
74 | 58 | protect_hashchar_at_line_beginning | ||
75 | 59 | protect_colon_in_tree | ||
76 | 60 | protect_node_after_label_in_tree | ||
77 | 61 | valid_tree_transformation | ||
78 | 62 | move_index_entries_after_items_in_tree | ||
79 | 63 | ) ] ); | ||
80 | 64 | |||
81 | 65 | @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); | ||
82 | 66 | |||
83 | 67 | @EXPORT = qw( | ||
84 | 68 | ); | ||
85 | 69 | |||
86 | 70 | $VERSION = '5.0'; | ||
87 | 71 | |||
88 | 72 | # i18n | ||
89 | 73 | sub N__($) | ||
90 | 74 | { | ||
91 | 75 | return $_[0]; | ||
92 | 76 | } | ||
93 | 77 | |||
94 | 78 | # determine the null devices | ||
95 | 79 | my $default_null_device = File::Spec->devnull(); | ||
96 | 80 | our %null_device_file = ( | ||
97 | 81 | $default_null_device => 1 | ||
98 | 82 | ); | ||
99 | 83 | # special case, djgpp recognizes both null devices | ||
100 | 84 | if ($Config{osname} eq 'dos' and $Config{osvers} eq 'djgpp') { | ||
101 | 85 | $null_device_file{'/dev/null'} = 1; | ||
102 | 86 | $null_device_file{'NUL'} = 1; | ||
103 | 87 | } | ||
104 | 88 | |||
105 | 89 | # these are the default values for the parser state that may be | ||
106 | 90 | # initialized to values given by the user. | ||
107 | 91 | # They are defined here, because they are used below and we | ||
108 | 92 | # don't want Texinfo::Common to use Texinfo::Parser. | ||
109 | 93 | our %default_parser_state_configuration = ( | ||
110 | 94 | # this is the initial context. It is put at the bottom of the | ||
111 | 95 | # 'context_stack'. It is not clear if this is really useful to be | ||
112 | 96 | # able to customize that value. | ||
113 | 97 | 'context' => '_root', | ||
114 | 98 | 'expanded_formats' => [], | ||
115 | 99 | 'gettext' => sub {return $_[0];}, | ||
116 | 100 | 'pgettext' => sub {return $_[1];}, | ||
117 | 101 | 'include_directories' => [ '.' ], | ||
118 | 102 | # these are the user-added indices. May be an array reference on names | ||
119 | 103 | # or an hash reference in the same format than %index_names below | ||
120 | 104 | 'indices' => [], | ||
121 | 105 | # the following are dynamically modified during the document parsing. | ||
122 | 106 | 'aliases' => {}, # key is a command name value is the alias | ||
123 | 107 | 'clickstyle' => 'arrow', | ||
124 | 108 | 'documentlanguage' => undef, | ||
125 | 109 | # Current documentlanguage set by | ||
126 | 110 | # @documentlanguage | ||
127 | 111 | 'explained_commands' => {}, # the key is a command name, either acronym | ||
128 | 112 | # or abbr, the value is a hash. The key hash | ||
129 | 113 | # is a normalized first argument of the | ||
130 | 114 | # corresponding command, the value is the | ||
131 | 115 | # contents array of the previous command with | ||
132 | 116 | # this first arg and a second arg. | ||
133 | 117 | 'kbdinputstyle' => 'distinct', | ||
134 | 118 | 'labels' => {}, # keys are normalized label names, as described | ||
135 | 119 | # in the `HTML Xref' node. Value should be | ||
136 | 120 | # a node/anchor or float in the tree. | ||
137 | 121 | 'macros' => {}, # the key is the user-defined macro name. The | ||
138 | 122 | # value is the reference on a macro element | ||
139 | 123 | # as obtained by parsing the @macro | ||
140 | 124 | 'merged_indices' => {}, # the key is merged in the value | ||
141 | 125 | 'novalidate' => 0, # same as setting @novalidate. | ||
142 | 126 | 'sections_level' => 0, # modified by raise/lowersections | ||
143 | 127 | 'values' => {'txicommandconditionals' => 1}, | ||
144 | 128 | # the key is the name, the value the @set name | ||
145 | 129 | # argument. A Texinfo tree may also be used. | ||
146 | 130 | ); | ||
147 | 131 | |||
148 | 132 | # command-line options | ||
149 | 133 | #my @command_line_settable_at_commands = ('footnotestyle', 'novalidate', | ||
150 | 134 | # 'documentlanguage', 'paragraphindent'); | ||
151 | 135 | |||
152 | 136 | |||
153 | 137 | # FIXME maybe this should better be set as texinfo passed to texi2any as | ||
154 | 138 | # texi2dvi --command | ||
155 | 139 | |||
156 | 140 | # customization options | ||
157 | 141 | our %document_settable_at_commands = ( | ||
158 | 142 | 'allowcodebreaks' => 'true', | ||
159 | 143 | 'clickstyle' => '@arrow', | ||
160 | 144 | 'codequotebacktick' => 'off', | ||
161 | 145 | 'codequoteundirected' => 'off', | ||
162 | 146 | 'contents' => 0, | ||
163 | 147 | 'deftypefnnewline' => 'off', | ||
164 | 148 | 'documentencoding' => 'us-ascii', | ||
165 | 149 | 'documentlanguage' => 'en', | ||
166 | 150 | # is N ems in TeX, 0.4 in. | ||
167 | 151 | 'exampleindent' => 5, | ||
168 | 152 | 'firstparagraphindent' => 'none', | ||
169 | 153 | 'frenchspacing' => 'off', | ||
170 | 154 | 'headings' => 'on', | ||
171 | 155 | 'kbdinputstyle' => 'distinct', | ||
172 | 156 | 'paragraphindent' => 3, | ||
173 | 157 | 'shortcontents' => 0, | ||
174 | 158 | 'urefbreakstyle' => 'after', | ||
175 | 159 | 'xrefautomaticsectiontitle' => 'off', | ||
176 | 160 | ); | ||
177 | 161 | |||
178 | 162 | # those should be unique | ||
179 | 163 | our %document_settable_unique_at_commands = ( | ||
180 | 164 | # when passed through a configuration variable, documentdescription | ||
181 | 165 | # should be already formatted for HTML | ||
182 | 166 | 'documentdescription' => undef, | ||
183 | 167 | 'evenfootingmarks' => undef, | ||
184 | 168 | 'evenheadingmarks' => undef, | ||
185 | 169 | 'everyfootingmarks' => 'bottom', | ||
186 | 170 | 'everyheadingmarks' => 'bottom', | ||
187 | 171 | 'fonttextsize' => 11, | ||
188 | 172 | 'footnotestyle' => 'end', | ||
189 | 173 | 'novalidate' => 0, | ||
190 | 174 | 'oddfootingmarks' => undef, | ||
191 | 175 | 'oddheadingmarks' => undef, | ||
192 | 176 | # FIXME not clear here. | ||
193 | 177 | 'pagesizes' => undef, | ||
194 | 178 | 'setchapternewpage' => 'on', | ||
195 | 179 | 'setcontentsaftertitlepage' => 0, | ||
196 | 180 | 'setfilename' => undef, | ||
197 | 181 | 'setshortcontentsaftertitlepage' => 0, | ||
198 | 182 | 'everyheading' => undef, | ||
199 | 183 | 'everyfooting' => undef, | ||
200 | 184 | 'evenheading' => undef, | ||
201 | 185 | 'evenfooting' => undef, | ||
202 | 186 | 'oddheading' => undef, | ||
203 | 187 | 'oddfooting' => undef, | ||
204 | 188 | ); | ||
205 | 189 | |||
206 | 190 | my @command_line_settables = ('FILLCOLUMN', 'SPLIT', 'SPLIT_SIZE', | ||
207 | 191 | 'HEADERS', | ||
208 | 192 | 'MACRO_EXPAND', 'NUMBER_SECTIONS', | ||
209 | 193 | 'NUMBER_FOOTNOTES', 'NODE_FILES', | ||
210 | 194 | 'NO_WARN', 'VERBOSE', | ||
211 | 195 | 'TRANSLITERATE_FILE_NAMES', 'ERROR_LIMIT', 'ENABLE_ENCODING', | ||
212 | 196 | 'FORCE', 'INTERNAL_LINKS', 'OUTFILE', 'SUBDIR', 'OUT', | ||
213 | 197 | 'SILENT', 'CASE_INSENSITIVE_FILENAMES', | ||
214 | 198 | ); | ||
215 | 199 | |||
216 | 200 | # documented in the Texinfo::Parser pod section | ||
217 | 201 | # all are lower cased in texi2any.pl | ||
218 | 202 | my @parser_options = map {uc($_)} (keys(%default_parser_state_configuration)); | ||
219 | 203 | |||
220 | 204 | my @obsolete_variables = ('TOP_HEADING_AT_BEGINNING', 'USE_SECTIONS', | ||
221 | 205 | 'IDX_SUMMARY', 'I18N_PERL_HASH', 'USE_UNICODE', 'USE_NLS', | ||
222 | 206 | 'USE_UP_FOR_ADJACENT_NODES', 'SEPARATE_DESCRIPTION', | ||
223 | 207 | 'NEW_CROSSREF_STYLE', 'SHORT_REF', 'IGNORE_PREAMBLE_TEXT', | ||
224 | 208 | 'OUT_ENCODING', | ||
225 | 209 | 'IN_ENCODING', 'DEFAULT_ENCODING'); | ||
226 | 210 | |||
227 | 211 | my @variable_settables_not_used = ('COMPLETE_IMAGE_PATHS', 'TOC_FILE', | ||
228 | 212 | 'SPLIT_INDEX'); | ||
229 | 213 | |||
230 | 214 | my @formats_settable = ( | ||
231 | 215 | ); | ||
232 | 216 | |||
233 | 217 | my @variable_string_settables = ( | ||
234 | 218 | 'DEBUG', 'FRAMES', 'FRAMESET_DOCTYPE', 'DOCTYPE', 'TEST', 'DUMP_TEXI', | ||
235 | 219 | 'TOP_FILE', 'SHOW_MENU', 'USE_NODES', 'TOC_LINKS', 'SHORTEXTN', | ||
236 | 220 | 'PREFIX', 'DEF_TABLE', 'L2H', 'MONOLITHIC', | ||
237 | 221 | 'L2H_L2H', 'L2H_SKIP', 'L2H_TMP', 'L2H_FILE', 'L2H_CLEAN', | ||
238 | 222 | 'L2H_HTML_VERSION', 'EXTERNAL_DIR', 'USE_ISO', | ||
239 | 223 | 'VERTICAL_HEAD_NAVIGATION', 'INLINE_CONTENTS', 'NODE_FILE_EXTENSION', | ||
240 | 224 | 'NO_CSS', 'INLINE_CSS_STYLE', 'USE_TITLEPAGE_FOR_TITLE', | ||
241 | 225 | 'SIMPLE_MENU', 'EXTENSION', 'INLINE_INSERTCOPYING', 'USE_NUMERIC_ENTITY', | ||
242 | 226 | 'ENABLE_ENCODING_USE_ENTITY', 'ICONS', | ||
243 | 227 | 'USE_UNIDECODE', 'DATE_IN_HEADER', 'OPEN_QUOTE_SYMBOL', | ||
244 | 228 | 'CLOSE_QUOTE_SYMBOL', 'TOP_NODE_UP', 'TOP_NODE_UP_URL', 'TOP_NODE_FILE', | ||
245 | 229 | 'TOP_NODE_FILE_TARGET', 'SHOW_TITLE', 'WORDS_IN_PAGE', | ||
246 | 230 | 'HEADER_IN_TABLE', 'USE_ACCESSKEY', 'USE_REL_REV', 'USE_LINKS', | ||
247 | 231 | 'OVERVIEW_LINK_TO_TOC', 'AVOID_MENU_REDUNDANCY', 'NODE_NAME_IN_MENU', | ||
248 | 232 | 'NODE_NAME_IN_INDEX', 'NO_USE_SETFILENAME', 'USE_SETFILENAME_EXTENSION', | ||
249 | 233 | 'COMPLEX_FORMAT_IN_TABLE', | ||
250 | 234 | 'IGNORE_BEFORE_SETFILENAME', 'IGNORE_SPACE_AFTER_BRACED_COMMAND_NAME', | ||
251 | 235 | 'USE_NODE_TARGET', | ||
252 | 236 | 'PROGRAM_NAME_IN_FOOTER', 'NODE_FILENAMES', | ||
253 | 237 | 'EXTERNAL_CROSSREF_SPLIT', 'BODYTEXT', | ||
254 | 238 | 'CSS_LINES', 'RENAMED_NODES_REDIRECTIONS', 'RENAMED_NODES_FILE', | ||
255 | 239 | 'CPP_LINE_DIRECTIVES', | ||
256 | 240 | 'TEXI2DVI', 'DUMP_TREE', 'MAX_MACRO_CALL_NESTING', | ||
257 | 241 | 'INPUT_ENCODING_NAME', 'INPUT_PERL_ENCODING', | ||
258 | 242 | 'OUTPUT_ENCODING_NAME', 'OUTPUT_PERL_ENCODING', | ||
259 | 243 | 'PACKAGE_VERSION', | ||
260 | 244 | 'PACKAGE_AND_VERSION', 'PACKAGE_URL', 'PACKAGE', 'PACKAGE_NAME', 'PROGRAM', | ||
261 | 245 | 'PRE_BODY_CLOSE', 'AFTER_BODY_OPEN', 'PRE_ABOUT', 'AFTER_ABOUT', | ||
262 | 246 | 'EXTRA_HEAD', 'DO_ABOUT', | ||
263 | 247 | 'DEFAULT_RULE', 'BIG_RULE', | ||
264 | 248 | 'MENU_ENTRY_COLON', 'INDEX_ENTRY_COLON', 'MENU_SYMBOL', | ||
265 | 249 | 'MAX_HEADER_LEVEL', 'CHAPTER_HEADER_LEVEL', | ||
266 | 250 | 'FOOTNOTE_END_HEADER_LEVEL', 'FOOTNOTE_SEPARATE_HEADER_LEVEL', | ||
267 | 251 | 'USE_UP_NODE_FOR_ELEMENT_UP', | ||
268 | 252 | 'BEFORE_OVERVIEW', 'AFTER_OVERVIEW', | ||
269 | 253 | 'BEFORE_TOC_LINES', 'AFTER_TOC_LINES', | ||
270 | 254 | 'SORT_ELEMENT_COUNT', 'SORT_ELEMENT_COUNT_WORDS', | ||
271 | 255 | 'KEEP_TOP_EXTERNAL_REF', | ||
272 | 256 | 'TEXI2HTML', 'IMAGE_LINK_PREFIX', 'FIX_TEXINFO', | ||
273 | 257 | 'TREE_TRANSFORMATIONS', 'BASEFILENAME_LENGTH', | ||
274 | 258 | 'TEXTCONTENT_COMMENT', 'XREF_USE_FLOAT_LABEL', 'XREF_USE_NODE_NAME_ARG', | ||
275 | 259 | 'MACRO_BODY_IGNORES_LEADING_SPACE', 'CHECK_HTMLXREF', | ||
276 | 260 | 'TEXINFO_DTD_VERSION', 'TEXINFO_COLUMN_FOR_DESCRIPTION', | ||
277 | 261 | 'TEXINFO_OUTPUT_FORMAT', | ||
278 | 262 | ); | ||
279 | 263 | # Not strings. | ||
280 | 264 | # FIXME To be documented somewhere, but where? | ||
281 | 265 | my @variable_other_settables = ( | ||
282 | 266 | 'LINKS_BUTTONS', 'TOP_BUTTONS', 'SECTION_BUTTONS', 'BUTTONS_TEXT', | ||
283 | 267 | 'BUTTONS_ACCESSKEY', 'BUTTONS_REL', 'BUTTONS_GOTO', | ||
284 | 268 | 'CHAPTER_FOOTER_BUTTONS', 'SECTION_FOOTER_BUTTONS', | ||
285 | 269 | 'NODE_FOOTER_BUTTONS', | ||
286 | 270 | 'MISC_BUTTONS', 'CHAPTER_BUTTONS', 'BUTTONS_NAME', | ||
287 | 271 | 'BUTTONS_EXAMPLE', 'SPECIAL_ELEMENTS_NAME', 'SPECIAL_ELEMENTS_CLASS', | ||
288 | 272 | 'ACTIVE_ICONS', 'PASSIVE_ICONS', | ||
289 | 273 | 'CSS_FILES', 'CSS_REFS', | ||
290 | 274 | 'GLOBAL_COMMANDS', | ||
291 | 275 | ); | ||
292 | 276 | |||
293 | 277 | my %valid_options; | ||
294 | 278 | foreach my $var (keys(%document_settable_at_commands), | ||
295 | 279 | keys(%document_settable_unique_at_commands), | ||
296 | 280 | @command_line_settables, @variable_string_settables, | ||
297 | 281 | @variable_other_settables, @parser_options, | ||
298 | 282 | @formats_settable, | ||
299 | 283 | @obsolete_variables, @variable_settables_not_used) { | ||
300 | 284 | $valid_options{$var} = 1; | ||
301 | 285 | } | ||
302 | 286 | |||
303 | 287 | my %obsolete_options; | ||
304 | 288 | foreach my $var (@obsolete_variables) { | ||
305 | 289 | $obsolete_options{$var} = 1; | ||
306 | 290 | } | ||
307 | 291 | |||
308 | 292 | sub valid_option($) | ||
309 | 293 | { | ||
310 | 294 | my $option = shift; | ||
311 | 295 | return $valid_options{$option}; | ||
312 | 296 | } | ||
313 | 297 | |||
314 | 298 | sub obsolete_option($) | ||
315 | 299 | { | ||
316 | 300 | my $option = shift; | ||
317 | 301 | return $obsolete_options{$option}; | ||
318 | 302 | } | ||
319 | 303 | |||
320 | 304 | my %customization_variable_classes = ( | ||
321 | 305 | 'document_settable_at_commands' => [ sort(keys(%document_settable_at_commands)) ], | ||
322 | 306 | 'document_settable_unique_at_commands' => [ sort(keys(%document_settable_unique_at_commands)) ], | ||
323 | 307 | 'command_line_settables' => \@command_line_settables, | ||
324 | 308 | 'variable_string_settables' => \@variable_string_settables, | ||
325 | 309 | 'variable_other_settables' => \@variable_other_settables, | ||
326 | 310 | 'parser_options' => \@parser_options, | ||
327 | 311 | #'formats_settable' => \@formats_settable, | ||
328 | 312 | 'obsolete_variables' => \@obsolete_variables, | ||
329 | 313 | 'variable_settables_not_used' => \@variable_settables_not_used, | ||
330 | 314 | ); | ||
331 | 315 | |||
332 | 316 | my @secondary_customization_variables = ( | ||
333 | 317 | 'obsolete_variables', 'variable_settables_not_used' | ||
334 | 318 | ); | ||
335 | 319 | sub _customization_variable_classes(;$) | ||
336 | 320 | { | ||
337 | 321 | my $print_all = shift; | ||
338 | 322 | my $result = ''; | ||
339 | 323 | foreach my $type (sort(keys(%customization_variable_classes))) { | ||
340 | 324 | next if (!$print_all | ||
341 | 325 | and grep {$_ eq $type} @secondary_customization_variables); | ||
342 | 326 | foreach my $variable (@{$customization_variable_classes{$type}}) { | ||
343 | 327 | $result .= "$variable\t$type\n"; | ||
344 | 328 | } | ||
345 | 329 | } | ||
346 | 330 | return $result; | ||
347 | 331 | } | ||
348 | 332 | |||
349 | 333 | my %valid_tree_transformations; | ||
350 | 334 | foreach my $valid_transformation ('simple_menus', | ||
351 | 335 | 'fill_gaps_in_sectioning', 'move_index_entries_after_items', | ||
352 | 336 | 'insert_nodes_for_sectioning_commands', | ||
353 | 337 | 'complete_tree_nodes_menus', 'regenerate_master_menu', | ||
354 | 338 | 'indent_menu_descriptions') { | ||
355 | 339 | $valid_tree_transformations{$valid_transformation} = 1; | ||
356 | 340 | } | ||
357 | 341 | |||
358 | 342 | sub valid_tree_transformation ($) | ||
359 | 343 | { | ||
360 | 344 | my $transformation = shift; | ||
361 | 345 | return 1 if (defined($transformation) | ||
362 | 346 | and $valid_tree_transformations{$transformation}); | ||
363 | 347 | return 0; | ||
364 | 348 | } | ||
365 | 349 | |||
366 | 350 | our %no_brace_commands; # commands never taking braces | ||
367 | 351 | %no_brace_commands = ( | ||
368 | 352 | '*', "\n", | ||
369 | 353 | ' ', ' ', | ||
370 | 354 | "\t", ' ', | ||
371 | 355 | "\n", ' ', | ||
372 | 356 | '-', '', # hyphenation hint | ||
373 | 357 | '|', '', # used in formatting commands @evenfooting and friends | ||
374 | 358 | '/', '', | ||
375 | 359 | ':', '', | ||
376 | 360 | '!', '!', | ||
377 | 361 | '?', '?', | ||
378 | 362 | '.', '.', | ||
379 | 363 | '@', '@', | ||
380 | 364 | '}', '}', | ||
381 | 365 | '{', '{', | ||
382 | 366 | '\\', '\\', # should only appear in math | ||
383 | 367 | ); | ||
384 | 368 | |||
385 | 369 | |||
386 | 370 | # commands taking a line as argument or no argument. | ||
387 | 371 | # sectioning commands and def* commands are added below. | ||
388 | 372 | # index commands are added dynamically. | ||
389 | 373 | # | ||
390 | 374 | # The values signification is: | ||
391 | 375 | # special: no value and macro expansion, all the line is used, and | ||
392 | 376 | # analysed during parsing (_parse_special_misc_command) | ||
393 | 377 | # lineraw: no value and macro expansion, the line is kept as-is, not | ||
394 | 378 | # analysed | ||
395 | 379 | # skipline: no argument, everything else on the line is skipped | ||
396 | 380 | # skipspace: no argument, following spaces are skipped. | ||
397 | 381 | # noarg: no argument | ||
398 | 382 | # text: the line is parsed as texinfo, and the argument is converted | ||
399 | 383 | # to simple text (in _end_line) | ||
400 | 384 | # line: the line is parsed as texinfo | ||
401 | 385 | # a number: the line is parsed as texinfo and the result should be plain | ||
402 | 386 | # text maybe followed by a comment; the result is analysed | ||
403 | 387 | # during parsing (_parse_line_command_args). | ||
404 | 388 | # The number is an indication of the number of arguments of | ||
405 | 389 | # the command. | ||
406 | 390 | # | ||
407 | 391 | # Beware that @item and @itemx may be like 'line' or 'skipspace' depending | ||
408 | 392 | # on the context. | ||
409 | 393 | our %misc_commands = ( | ||
410 | 394 | 'node' => 'line', # special arg | ||
411 | 395 | 'bye' => 'skipline', # no arg | ||
412 | 396 | 'end' => 'text', | ||
413 | 397 | # set, clear | ||
414 | 398 | 'set' => 'special', # special arg | ||
415 | 399 | 'clear' => 'special', # special arg | ||
416 | 400 | 'unmacro' => 'special', | ||
417 | 401 | # comments | ||
418 | 402 | 'comment' => 'lineraw', | ||
419 | 403 | 'c' => 'lineraw', | ||
420 | 404 | # special | ||
421 | 405 | 'definfoenclose' => 3, | ||
422 | 406 | 'alias' => 2, | ||
423 | 407 | # number of arguments is not known in advance. | ||
424 | 408 | 'columnfractions' => 1, | ||
425 | 409 | # file names | ||
426 | 410 | 'setfilename' => 'text', | ||
427 | 411 | 'verbatiminclude' => 'text', | ||
428 | 412 | 'include' => 'text', | ||
429 | 413 | |||
430 | 414 | 'raisesections' => 'skipline', # no arg | ||
431 | 415 | 'lowersections' => 'skipline', # no arg | ||
432 | 416 | 'contents' => 'skipline', # no arg | ||
433 | 417 | 'shortcontents' => 'skipline', # no arg | ||
434 | 418 | 'summarycontents' => 'skipline', # no arg | ||
435 | 419 | 'insertcopying' => 'noarg', # no arg | ||
436 | 420 | 'clickstyle' => 'special', # arg should be an @-command | ||
437 | 421 | # more relevant in preamble | ||
438 | 422 | 'setcontentsaftertitlepage' => 'skipline', # no arg | ||
439 | 423 | 'setshortcontentsaftertitlepage' => 'skipline', # no arg | ||
440 | 424 | 'documentencoding' => 'text', # or 1? | ||
441 | 425 | 'novalidate' => 'skipline', # no arg | ||
442 | 426 | 'dircategory' => 'line', # line. Position with regard | ||
443 | 427 | # with direntry is significant | ||
444 | 428 | 'pagesizes' => 'line', # can have 2 args | ||
445 | 429 | # or one? 200mm,150mm 11.5in | ||
446 | 430 | 'finalout' => 'skipline', # no arg | ||
447 | 431 | 'paragraphindent' => 1, # arg none asis | ||
448 | 432 | # or a number and forbids anything else on the line | ||
449 | 433 | 'firstparagraphindent' => 1, # none insert | ||
450 | 434 | 'frenchspacing' => 1, # on off | ||
451 | 435 | 'codequoteundirected' => 1, # on off | ||
452 | 436 | 'codequotebacktick' => 1, # on off | ||
453 | 437 | 'xrefautomaticsectiontitle' => 1, # on off | ||
454 | 438 | 'deftypefnnewline' => 1, # on off | ||
455 | 439 | 'fonttextsize' => 1, # 10 11 | ||
456 | 440 | 'allowcodebreaks' => 1, # false or true | ||
457 | 441 | 'exampleindent' => 1, # asis or a number | ||
458 | 442 | 'footnotestyle' => 1, # end and separate, nothing else on the line | ||
459 | 443 | 'urefbreakstyle' => 1, # after|before|none | ||
460 | 444 | 'afourpaper' => 'skipline', # no arg | ||
461 | 445 | 'afivepaper' => 'skipline', # no arg | ||
462 | 446 | 'afourlatex' => 'skipline', # no arg | ||
463 | 447 | 'afourwide' => 'skipline', # no arg | ||
464 | 448 | 'headings' => 1, #off on single double singleafter doubleafter | ||
465 | 449 | # interacts with setchapternewpage | ||
466 | 450 | 'setchapternewpage' => 1, # off on odd | ||
467 | 451 | |||
468 | 452 | # only relevant in TeX, and special | ||
469 | 453 | 'everyheading' => 'lineraw', # @*heading @*footing use @| | ||
470 | 454 | 'everyfooting' => 'lineraw', # + @thispage @thissectionname | ||
471 | 455 | 'evenheading' => 'lineraw', # @thissectionnum @thissection | ||
472 | 456 | 'evenfooting' => 'lineraw', # @thischaptername @thischapternum | ||
473 | 457 | 'oddheading' => 'lineraw', # @thischapter @thistitle @thisfile | ||
474 | 458 | 'oddfooting' => 'lineraw', | ||
475 | 459 | |||
476 | 460 | 'smallbook' => 'skipline', # no arg | ||
477 | 461 | 'syncodeindex' => 2, # args are index identifiers | ||
478 | 462 | 'synindex' => 2, | ||
479 | 463 | 'defindex' => 1, # one identifier arg | ||
480 | 464 | 'defcodeindex' => 1, # one identifier arg | ||
481 | 465 | 'documentlanguage' => 'text', # language code arg | ||
482 | 466 | 'kbdinputstyle' => 1, # code example distinct | ||
483 | 467 | 'everyheadingmarks' => 1, # top bottom | ||
484 | 468 | 'everyfootingmarks' => 1, | ||
485 | 469 | 'evenheadingmarks' => 1, | ||
486 | 470 | 'oddheadingmarks' => 1, | ||
487 | 471 | 'evenfootingmarks' => 1, | ||
488 | 472 | 'oddfootingmarks' => 1, | ||
489 | 473 | # not valid for info (should be in @iftex) | ||
490 | 474 | 'cropmarks' => 'skipline', # no arg | ||
491 | 475 | |||
492 | 476 | # formatting | ||
493 | 477 | 'center' => 'line', | ||
494 | 478 | 'printindex' => 1, | ||
495 | 479 | 'listoffloats' => 'line', | ||
496 | 480 | # especially in titlepage | ||
497 | 481 | # 'shorttitle' => 'line', | ||
498 | 482 | 'shorttitlepage' => 'line', | ||
499 | 483 | 'settitle' => 'line', | ||
500 | 484 | 'author' => 'line', | ||
501 | 485 | 'subtitle' => 'line', | ||
502 | 486 | 'title' => 'line', | ||
503 | 487 | 'sp' => 1, # numerical arg | ||
504 | 488 | 'page' => 'skipline', # no arg (pagebreak) | ||
505 | 489 | 'need' => 1, # one numerical/real arg | ||
506 | 490 | # formatting | ||
507 | 491 | 'noindent' => 'skipspace', # no arg | ||
508 | 492 | 'indent' => 'skipspace', | ||
509 | 493 | 'exdent' => 'line', | ||
510 | 494 | 'headitem' => 'skipspace', | ||
511 | 495 | 'item' => 'skipspace', # or line, depending on the context | ||
512 | 496 | 'itemx' => 'skipspace', # or line, depending on the context | ||
513 | 497 | 'tab' => 'skipspace', | ||
514 | 498 | # only valid in heading or footing | ||
515 | 499 | 'thischapter' => 'noarg', | ||
516 | 500 | 'thischaptername' => 'noarg', | ||
517 | 501 | 'thischapternum' => 'noarg', | ||
518 | 502 | 'thisfile' => 'noarg', | ||
519 | 503 | 'thispage' => 'noarg', | ||
520 | 504 | 'thistitle' => 'noarg', | ||
521 | 505 | # not valid for info (should be in @iftex) | ||
522 | 506 | 'vskip' => 'lineraw', # arg line in TeX | ||
523 | 507 | # obsolete @-commands. | ||
524 | 508 | 'refill' => 'noarg', # no arg (obsolete, to be ignored) | ||
525 | 509 | # Remove spaces and end of lines after the | ||
526 | 510 | # commands? If no, they can lead to empty lines | ||
527 | 511 | 'quote-arg' => 'skipline', | ||
528 | 512 | 'allow-recursion' => 'skipline', | ||
529 | 513 | ); | ||
530 | 514 | |||
531 | 515 | # key is index name, keys of the reference value are the prefixes. | ||
532 | 516 | # value associated with the prefix is 0 if the prefix is not a code-like | ||
533 | 517 | # prefix, 1 if it is a code-like prefix (set by defcodeindex/syncodeindex). | ||
534 | 518 | #our %index_names = ( | ||
535 | 519 | # 'cp' => {'cp' => 0, 'c' => 0}, | ||
536 | 520 | # 'fn' => {'fn' => 1, 'f' => 1}, | ||
537 | 521 | # 'vr' => {'vr' => 1, 'v' => 1}, | ||
538 | 522 | # 'ky' => {'ky' => 1, 'k' => 1}, | ||
539 | 523 | # 'pg' => {'pg' => 1, 'p' => 1}, | ||
540 | 524 | # 'tp' => {'tp' => 1, 't' => 1} | ||
541 | 525 | #); | ||
542 | 526 | |||
543 | 527 | our %index_names = ( | ||
544 | 528 | 'cp' => {'prefix' => ['c'], 'in_code' => 0}, | ||
545 | 529 | 'fn' => {'prefix' => ['f'], 'in_code' => 1}, | ||
546 | 530 | 'vr' => {'prefix' => ['v'], 'in_code' => 1}, | ||
547 | 531 | 'ky' => {'prefix' => ['k'], 'in_code' => 1}, | ||
548 | 532 | 'pg' => {'prefix' => ['p'], 'in_code' => 1}, | ||
549 | 533 | 'tp' => {'prefix' => ['t'], 'in_code' => 1}, | ||
550 | 534 | ); | ||
551 | 535 | |||
552 | 536 | foreach my $index(keys(%index_names)) { | ||
553 | 537 | $index_names{$index}->{'name'} = $index; | ||
554 | 538 | push @{$index_names{$index}->{'prefix'}}, $index; | ||
555 | 539 | } | ||
556 | 540 | |||
557 | 541 | our %default_index_commands; | ||
558 | 542 | # all the commands are readded dynamically in the Parser. | ||
559 | 543 | foreach my $index_name (keys (%index_names)) { | ||
560 | 544 | foreach my $index_prefix (@{$index_names{$index_name}->{'prefix'}}) { | ||
561 | 545 | next if ($index_prefix eq $index_name); | ||
562 | 546 | # only put the one letter versions in the hash. | ||
563 | 547 | $misc_commands{$index_prefix.'index'} = 'line'; | ||
564 | 548 | $default_index_commands{$index_prefix.'index'} = 1; | ||
565 | 549 | } | ||
566 | 550 | } | ||
567 | 551 | |||
568 | 552 | # command with braces. Value is the max number of arguments. | ||
569 | 553 | our %brace_commands; | ||
570 | 554 | |||
571 | 555 | our %letter_no_arg_commands; | ||
572 | 556 | foreach my $letter_no_arg_command ('aa','AA','ae','oe','AE','OE','o','O', | ||
573 | 557 | 'ss','l','L','DH','dh','TH','th') { | ||
574 | 558 | $letter_no_arg_commands{$letter_no_arg_command} = 1; | ||
575 | 559 | $brace_commands{$letter_no_arg_command} = 0; | ||
576 | 560 | } | ||
577 | 561 | |||
578 | 562 | foreach my $no_arg_command ('TeX','LaTeX','bullet','copyright', | ||
579 | 563 | 'registeredsymbol','dots','enddots','equiv','error','expansion','arrow', | ||
580 | 564 | 'minus','point','print','result','today', | ||
581 | 565 | 'exclamdown','questiondown','pounds','ordf','ordm', | ||
582 | 566 | 'atchar', 'lbracechar', 'rbracechar', 'backslashchar', 'hashchar', 'comma', | ||
583 | 567 | 'euro', 'geq','leq','tie','textdegree','click', | ||
584 | 568 | 'quotedblleft','quotedblright','quoteleft','quoteright','quotedblbase', | ||
585 | 569 | 'quotesinglbase','guillemetleft','guillemetright','guillemotleft', | ||
586 | 570 | 'guillemotright','guilsinglleft','guilsinglright') { | ||
587 | 571 | $brace_commands{$no_arg_command} = 0; | ||
588 | 572 | } | ||
589 | 573 | |||
590 | 574 | # accent commands. They may be called with and without braces. | ||
591 | 575 | our %accent_commands; | ||
592 | 576 | foreach my $accent_command ('"','~','^','`',"'",',','=', | ||
593 | 577 | 'ringaccent','H','dotaccent','u','ubaraccent', | ||
594 | 578 | 'udotaccent','v','ogonek','tieaccent', 'dotless') { | ||
595 | 579 | $accent_commands{$accent_command} = 1; | ||
596 | 580 | $brace_commands{$accent_command} = 1; | ||
597 | 581 | } | ||
598 | 582 | |||
599 | 583 | our %style_commands; | ||
600 | 584 | foreach my $style_command ('asis','cite','clicksequence', | ||
601 | 585 | 'dfn', 'emph', | ||
602 | 586 | 'sc', 't', 'var', | ||
603 | 587 | 'headitemfont', 'code', 'command', 'env', 'file', 'kbd', | ||
604 | 588 | 'option', 'samp', 'strong') { | ||
605 | 589 | $brace_commands{$style_command} = 1; | ||
606 | 590 | $style_commands{$style_command} = 1; | ||
607 | 591 | } | ||
608 | 592 | |||
609 | 593 | our %regular_font_style_commands; | ||
610 | 594 | foreach my $command ('r', 'i', 'b', 'sansserif', 'slanted') { | ||
611 | 595 | $regular_font_style_commands{$command} = 1; | ||
612 | 596 | $brace_commands{$command} = 1; | ||
613 | 597 | $style_commands{$command} = 1; | ||
614 | 598 | } | ||
615 | 599 | |||
616 | 600 | foreach my $one_arg_command ( | ||
617 | 601 | 'ctrl','dmn', 'w', 'key', | ||
618 | 602 | 'titlefont','hyphenation','anchor','errormsg') { | ||
619 | 603 | $brace_commands{$one_arg_command} = 1; | ||
620 | 604 | } | ||
621 | 605 | |||
622 | 606 | our %code_style_commands; | ||
623 | 607 | foreach my $command ('code', 'command', 'env', 'file', 'kbd', 'key', 'option', | ||
624 | 608 | 'samp', 'indicateurl', 'verb', 't') { | ||
625 | 609 | $code_style_commands{$command} = 1; | ||
626 | 610 | $brace_commands{$command} = 1; | ||
627 | 611 | } | ||
628 | 612 | |||
629 | 613 | |||
630 | 614 | # Commands that enclose full texts | ||
631 | 615 | our %context_brace_commands; | ||
632 | 616 | foreach my $context_brace_command ('footnote', 'caption', 'shortcaption', 'math') { | ||
633 | 617 | $context_brace_commands{$context_brace_command} = $context_brace_command; | ||
634 | 618 | $brace_commands{$context_brace_command} = 1; | ||
635 | 619 | } | ||
636 | 620 | |||
637 | 621 | our %explained_commands; | ||
638 | 622 | foreach my $explained_command ('abbr', 'acronym') { | ||
639 | 623 | $explained_commands{$explained_command} = 1; | ||
640 | 624 | $brace_commands{$explained_command} = 2; | ||
641 | 625 | } | ||
642 | 626 | |||
643 | 627 | our %inline_format_commands; | ||
644 | 628 | foreach my $inline_format_command ('inlineraw', 'inlinefmt') { | ||
645 | 629 | $inline_format_commands{$inline_format_command} = 1; | ||
646 | 630 | $brace_commands{$inline_format_command} = 2; | ||
647 | 631 | } | ||
648 | 632 | |||
649 | 633 | foreach my $two_arg_command('email') { | ||
650 | 634 | $brace_commands{$two_arg_command} = 2; | ||
651 | 635 | } | ||
652 | 636 | |||
653 | 637 | foreach my $three_arg_command('uref','url','inforef') { | ||
654 | 638 | $brace_commands{$three_arg_command} = 3; | ||
655 | 639 | } | ||
656 | 640 | |||
657 | 641 | foreach my $five_arg_command('xref','ref','pxref','image') { | ||
658 | 642 | $brace_commands{$five_arg_command} = 5; | ||
659 | 643 | } | ||
660 | 644 | |||
661 | 645 | |||
662 | 646 | # some classification to help converters | ||
663 | 647 | our %ref_commands; | ||
664 | 648 | foreach my $ref_command ('xref','ref','pxref','inforef') { | ||
665 | 649 | $ref_commands{$ref_command} = 1; | ||
666 | 650 | } | ||
667 | 651 | |||
668 | 652 | |||
669 | 653 | our %in_heading_commands; | ||
670 | 654 | foreach my $in_heading_command ('thischapter', 'thischaptername', | ||
671 | 655 | 'thischapternum', 'thisfile', 'thispage', 'thistitle') { | ||
672 | 656 | $in_heading_commands{$in_heading_command} = 1; | ||
673 | 657 | } | ||
674 | 658 | |||
675 | 659 | # commands delimiting blocks, with an @end. | ||
676 | 660 | # Value is either the number of arguments on the line separated by | ||
677 | 661 | # commas or the type of command, 'raw', 'def' or 'multitable'. | ||
678 | 662 | our %block_commands; | ||
679 | 663 | |||
680 | 664 | # commands that have a possible content before an item | ||
681 | 665 | our %block_item_commands; | ||
682 | 666 | |||
683 | 667 | sub gdt($) | ||
684 | 668 | { | ||
685 | 669 | return $_[0]; | ||
686 | 670 | } | ||
687 | 671 | |||
688 | 672 | our %def_map = ( | ||
689 | 673 | # basic commands. | ||
690 | 674 | # 'arg' and 'argtype' are for everything appearing after the other | ||
691 | 675 | # arguments. | ||
692 | 676 | 'deffn', [ 'category', 'name', 'arg' ], | ||
693 | 677 | 'defvr', [ 'category', 'name' ], | ||
694 | 678 | 'deftypefn', [ 'category', 'type', 'name', 'argtype' ], | ||
695 | 679 | 'deftypeop', [ 'category', 'class' , 'type', 'name', 'argtype' ], | ||
696 | 680 | 'deftypevr', [ 'category', 'type', 'name' ], | ||
697 | 681 | 'defcv', [ 'category', 'class' , 'name' ], | ||
698 | 682 | 'deftypecv', [ 'category', 'class' , 'type', 'name' ], | ||
699 | 683 | 'defop', [ 'category', 'class' , 'name', 'arg' ], | ||
700 | 684 | 'deftp', [ 'category', 'name', 'argtype' ], | ||
701 | 685 | # shortcuts | ||
702 | 686 | 'defun', {'deffn' => gdt('Function')}, | ||
703 | 687 | 'defmac', {'deffn' => gdt('Macro')}, | ||
704 | 688 | 'defspec', {'deffn' => '{'.gdt('Special Form').'}'}, | ||
705 | 689 | 'defvar', {'defvr' => gdt('Variable')}, | ||
706 | 690 | 'defopt', {'defvr' => '{'.gdt('User Option').'}'}, | ||
707 | 691 | 'deftypefun', {'deftypefn' => gdt('Function')}, | ||
708 | 692 | 'deftypevar', {'deftypevr' => gdt('Variable')}, | ||
709 | 693 | 'defivar', {'defcv' => '{'.gdt('Instance Variable').'}'}, | ||
710 | 694 | 'deftypeivar', {'deftypecv' => '{'.gdt('Instance Variable').'}'}, | ||
711 | 695 | 'defmethod', {'defop' => gdt('Method')}, | ||
712 | 696 | 'deftypemethod', {'deftypeop' => gdt('Method')}, | ||
713 | 697 | ); | ||
714 | 698 | |||
715 | 699 | # the type of index, f: function, v: variable, t: type | ||
716 | 700 | my %index_type_def = ( | ||
717 | 701 | 'f' => ['deffn', 'deftypefn', 'deftypeop', 'defop'], | ||
718 | 702 | 'v' => ['defvr', 'deftypevr', 'defcv', 'deftypecv' ], | ||
719 | 703 | 't' => ['deftp'] | ||
720 | 704 | ); | ||
721 | 705 | |||
722 | 706 | our %command_index_prefix; | ||
723 | 707 | |||
724 | 708 | $command_index_prefix{'vtable'} = 'v'; | ||
725 | 709 | $command_index_prefix{'ftable'} = 'f'; | ||
726 | 710 | |||
727 | 711 | foreach my $index_type (keys %index_type_def) { | ||
728 | 712 | foreach my $def (@{$index_type_def{$index_type}}) { | ||
729 | 713 | $command_index_prefix{$def} = $index_type; | ||
730 | 714 | } | ||
731 | 715 | } | ||
732 | 716 | |||
733 | 717 | our %def_commands; | ||
734 | 718 | our %def_aliases; | ||
735 | 719 | foreach my $def_command(keys %def_map) { | ||
736 | 720 | if (ref($def_map{$def_command}) eq 'HASH') { | ||
737 | 721 | my ($real_command) = keys (%{$def_map{$def_command}}); | ||
738 | 722 | $command_index_prefix{$def_command} = $command_index_prefix{$real_command}; | ||
739 | 723 | $def_aliases{$def_command} = $real_command; | ||
740 | 724 | } | ||
741 | 725 | $block_commands{$def_command} = 'def'; | ||
742 | 726 | $misc_commands{$def_command.'x'} = 'line'; | ||
743 | 727 | $def_commands{$def_command} = 1; | ||
744 | 728 | $def_commands{$def_command.'x'} = 1; | ||
745 | 729 | $command_index_prefix{$def_command.'x'} = $command_index_prefix{$def_command}; | ||
746 | 730 | } | ||
747 | 731 | |||
748 | 732 | #print STDERR "".Data::Dumper->Dump([\%def_aliases]); | ||
749 | 733 | #print STDERR "".Data::Dumper->Dump([\%def_prepended_content]); | ||
750 | 734 | |||
751 | 735 | $block_commands{'multitable'} = 'multitable'; | ||
752 | 736 | $block_item_commands{'multitable'} = 1; | ||
753 | 737 | |||
754 | 738 | # block commands in which menu entry and menu comments appear | ||
755 | 739 | our %menu_commands; | ||
756 | 740 | foreach my $menu_command ('menu', 'detailmenu', 'direntry') { | ||
757 | 741 | $menu_commands{$menu_command} = 1; | ||
758 | 742 | $block_commands{$menu_command} = 0; | ||
759 | 743 | }; | ||
760 | 744 | |||
761 | 745 | our %align_commands; | ||
762 | 746 | foreach my $align_command('raggedright', 'flushleft', 'flushright') { | ||
763 | 747 | $block_commands{$align_command} = 0; | ||
764 | 748 | $align_commands{$align_command} = 1; | ||
765 | 749 | } | ||
766 | 750 | $align_commands{'center'} = 1; | ||
767 | 751 | |||
768 | 752 | foreach my $block_command( | ||
769 | 753 | 'cartouche', 'group', 'indentedblock', 'smallindentedblock') { | ||
770 | 754 | $block_commands{$block_command} = 0; | ||
771 | 755 | } | ||
772 | 756 | |||
773 | 757 | our %region_commands; | ||
774 | 758 | foreach my $block_command('titlepage', 'copying', 'documentdescription') { | ||
775 | 759 | $block_commands{$block_command} = 0; | ||
776 | 760 | $region_commands{$block_command} = 1; | ||
777 | 761 | } | ||
778 | 762 | |||
779 | 763 | our %preformatted_commands; | ||
780 | 764 | our %preformatted_code_commands; | ||
781 | 765 | foreach my $preformatted_command( | ||
782 | 766 | 'example', 'smallexample', 'lisp', 'smalllisp') { | ||
783 | 767 | $block_commands{$preformatted_command} = 0; | ||
784 | 768 | $preformatted_commands{$preformatted_command} = 1; | ||
785 | 769 | $preformatted_code_commands{$preformatted_command} = 1; | ||
786 | 770 | } | ||
787 | 771 | |||
788 | 772 | foreach my $preformatted_command( | ||
789 | 773 | 'display', 'smalldisplay', 'format', 'smallformat') { | ||
790 | 774 | $block_commands{$preformatted_command} = 0; | ||
791 | 775 | $preformatted_commands{$preformatted_command} = 1; | ||
792 | 776 | } | ||
793 | 777 | |||
794 | 778 | our %format_raw_commands; | ||
795 | 779 | foreach my $format_raw_command('html', 'tex', 'xml', 'docbook') { | ||
796 | 780 | $block_commands{$format_raw_command} = 0; | ||
797 | 781 | $format_raw_commands{$format_raw_command} = 1; | ||
798 | 782 | } | ||
799 | 783 | |||
800 | 784 | our %raw_commands; | ||
801 | 785 | # macro/rmacro are special | ||
802 | 786 | foreach my $raw_command ('verbatim', | ||
803 | 787 | 'ignore', 'macro', 'rmacro') { | ||
804 | 788 | $block_commands{$raw_command} = 'raw'; | ||
805 | 789 | $raw_commands{$raw_command} = 1; | ||
806 | 790 | } | ||
807 | 791 | |||
808 | 792 | our %texinfo_output_formats; | ||
809 | 793 | foreach my $command (keys(%format_raw_commands), 'info', 'plaintext') { | ||
810 | 794 | $block_commands{'if' . $command} = 'conditional'; | ||
811 | 795 | $block_commands{'ifnot' . $command} = 'conditional'; | ||
812 | 796 | $texinfo_output_formats{$command} = $command; | ||
813 | 797 | } | ||
814 | 798 | |||
815 | 799 | $block_commands{'ifset'} = 'conditional'; | ||
816 | 800 | $block_commands{'ifclear'} = 'conditional'; | ||
817 | 801 | |||
818 | 802 | $block_commands{'ifcommanddefined'} = 'conditional'; | ||
819 | 803 | $block_commands{'ifcommandnotdefined'} = 'conditional'; | ||
820 | 804 | |||
821 | 805 | # 'macro' ? | ||
822 | 806 | foreach my $block_command_one_arg('table', 'ftable', 'vtable', | ||
823 | 807 | 'itemize', 'enumerate', 'quotation', 'smallquotation') { | ||
824 | 808 | $block_commands{$block_command_one_arg} = 1; | ||
825 | 809 | $block_item_commands{$block_command_one_arg} = 1 | ||
826 | 810 | unless ($block_command_one_arg =~ /quotation/); | ||
827 | 811 | } | ||
828 | 812 | |||
829 | 813 | $block_commands{'float'} = 2; | ||
830 | 814 | |||
831 | 815 | # commands that forces closing an opened paragraph. | ||
832 | 816 | our %close_paragraph_commands; | ||
833 | 817 | |||
834 | 818 | foreach my $block_command (keys(%block_commands)) { | ||
835 | 819 | $close_paragraph_commands{$block_command} = 1 | ||
836 | 820 | unless ($block_commands{$block_command} eq 'raw' or | ||
837 | 821 | $block_commands{$block_command} eq 'conditional' | ||
838 | 822 | or $format_raw_commands{$block_command}); | ||
839 | 823 | } | ||
840 | 824 | |||
841 | 825 | $close_paragraph_commands{'verbatim'} = 1; | ||
842 | 826 | |||
843 | 827 | foreach my $close_paragraph_command ('titlefont', 'insertcopying', 'sp', | ||
844 | 828 | 'verbatiminclude', 'page', 'item', 'itemx', 'tab', 'headitem', | ||
845 | 829 | 'printindex', 'listoffloats', 'center', 'dircategory', 'contents', | ||
846 | 830 | 'shortcontents', 'summarycontents', 'caption', 'shortcaption', | ||
847 | 831 | 'setfilename', 'exdent') { | ||
848 | 832 | $close_paragraph_commands{$close_paragraph_command} = 1; | ||
849 | 833 | } | ||
850 | 834 | |||
851 | 835 | foreach my $close_paragraph_command (keys(%def_commands)) { | ||
852 | 836 | $close_paragraph_commands{$close_paragraph_command} = 1; | ||
853 | 837 | } | ||
854 | 838 | |||
855 | 839 | our %item_container_commands; | ||
856 | 840 | foreach my $item_container_command ('itemize', 'enumerate') { | ||
857 | 841 | $item_container_commands{$item_container_command} = 1; | ||
858 | 842 | } | ||
859 | 843 | our %item_line_commands; | ||
860 | 844 | foreach my $item_line_command ('table', 'ftable', 'vtable') { | ||
861 | 845 | $item_line_commands{$item_line_command} = 1; | ||
862 | 846 | } | ||
863 | 847 | |||
864 | 848 | our %deprecated_commands = ( | ||
865 | 849 | 'ctrl' => '', | ||
866 | 850 | 'allow-recursion' => N__('recursion is always allowed'), | ||
867 | 851 | 'quote-arg' => N__('arguments are quoted by default'), | ||
868 | 852 | ); | ||
869 | 853 | |||
870 | 854 | # commands that should only appear at the root level and contain up to | ||
871 | 855 | # the next root command. @node and sectioning commands. | ||
872 | 856 | our %root_commands; | ||
873 | 857 | |||
874 | 858 | our %command_structuring_level = ( | ||
875 | 859 | 'top', 0, | ||
876 | 860 | 'chapter', 1, | ||
877 | 861 | 'unnumbered', 1, | ||
878 | 862 | 'chapheading', 1, | ||
879 | 863 | 'appendix', 1, | ||
880 | 864 | 'section', 2, | ||
881 | 865 | 'unnumberedsec', 2, | ||
882 | 866 | 'heading', 2, | ||
883 | 867 | 'appendixsec', 2, | ||
884 | 868 | 'subsection', 3, | ||
885 | 869 | 'unnumberedsubsec', 3, | ||
886 | 870 | 'subheading', 3, | ||
887 | 871 | 'appendixsubsec', 3, | ||
888 | 872 | 'subsubsection', 4, | ||
889 | 873 | 'unnumberedsubsubsec', 4, | ||
890 | 874 | 'subsubheading', 4, | ||
891 | 875 | 'appendixsubsubsec', 4, | ||
892 | 876 | ); | ||
893 | 877 | |||
894 | 878 | our %level_to_structuring_command; | ||
895 | 879 | |||
896 | 880 | { | ||
897 | 881 | my $sections = [ ]; | ||
898 | 882 | my $appendices = [ ]; | ||
899 | 883 | my $unnumbered = [ ]; | ||
900 | 884 | my $headings = [ ]; | ||
901 | 885 | foreach my $command (keys (%command_structuring_level)) { | ||
902 | 886 | if ($command =~ /^appendix/) { | ||
903 | 887 | $level_to_structuring_command{$command} = $appendices; | ||
904 | 888 | } elsif ($command =~ /^unnumbered/ or $command eq 'top') { | ||
905 | 889 | $level_to_structuring_command{$command} = $unnumbered; | ||
906 | 890 | } elsif ($command =~ /section$/ or $command eq 'chapter') { | ||
907 | 891 | $level_to_structuring_command{$command} = $sections; | ||
908 | 892 | } else { | ||
909 | 893 | $level_to_structuring_command{$command} = $headings; | ||
910 | 894 | } | ||
911 | 895 | $level_to_structuring_command{$command}->[$command_structuring_level{$command}] | ||
912 | 896 | = $command; | ||
913 | 897 | } | ||
914 | 898 | $level_to_structuring_command{'appendixsection'} = $appendices; | ||
915 | 899 | $level_to_structuring_command{'majorheading'} = $headings; | ||
916 | 900 | $level_to_structuring_command{'centerchap'} = $unnumbered; | ||
917 | 901 | } | ||
918 | 902 | |||
919 | 903 | |||
920 | 904 | # out of the main hierarchy | ||
921 | 905 | $command_structuring_level{'part'} = 0; | ||
922 | 906 | # this are synonyms | ||
923 | 907 | $command_structuring_level{'appendixsection'} = 2; | ||
924 | 908 | # command_structuring_level{'majorheading'} is also 1 and not 0 | ||
925 | 909 | $command_structuring_level{'majorheading'} = 1; | ||
926 | 910 | $command_structuring_level{'centerchap'} = 1; | ||
927 | 911 | |||
928 | 912 | our %sectioning_commands; | ||
929 | 913 | |||
930 | 914 | foreach my $sectioning_command (keys (%command_structuring_level)) { | ||
931 | 915 | $misc_commands{$sectioning_command} = 'line'; | ||
932 | 916 | if ($sectioning_command =~ /heading/) { | ||
933 | 917 | $close_paragraph_commands{$sectioning_command} = 1; | ||
934 | 918 | } else { | ||
935 | 919 | $root_commands{$sectioning_command} = 1; | ||
936 | 920 | } | ||
937 | 921 | $sectioning_commands{$sectioning_command} = 1; | ||
938 | 922 | } | ||
939 | 923 | |||
940 | 924 | $root_commands{'node'} = 1; | ||
941 | 925 | |||
942 | 926 | our %all_commands; | ||
943 | 927 | foreach my $command ( | ||
944 | 928 | keys(%Texinfo::Common::block_commands), | ||
945 | 929 | keys(%Texinfo::Common::brace_commands), | ||
946 | 930 | keys(%Texinfo::Common::misc_commands), | ||
947 | 931 | keys(%Texinfo::Common::no_brace_commands), | ||
948 | 932 | qw(value), | ||
949 | 933 | ) { | ||
950 | 934 | $all_commands{$command} = 1; | ||
951 | 935 | } | ||
952 | 936 | |||
953 | 937 | our @MONTH_NAMES = | ||
954 | 938 | ( | ||
955 | 939 | 'January', 'February', 'March', 'April', 'May', | ||
956 | 940 | 'June', 'July', 'August', 'September', 'October', | ||
957 | 941 | 'November', 'December' | ||
958 | 942 | ); | ||
959 | 943 | |||
960 | 944 | sub locate_include_file($$) | ||
961 | 945 | { | ||
962 | 946 | my $self = shift; | ||
963 | 947 | my $text = shift; | ||
964 | 948 | my $file; | ||
965 | 949 | |||
966 | 950 | my $ignore_include_directories = 0; | ||
967 | 951 | |||
968 | 952 | my ($volume, $directories, $filename) = File::Spec->splitpath($text); | ||
969 | 953 | my @directories = File::Spec->splitdir($directories); | ||
970 | 954 | |||
971 | 955 | #print STDERR "$self $text @{$self->{'include_directories'}}\n"; | ||
972 | 956 | # If the path is absolute or begins with . or .., do not search in | ||
973 | 957 | # include directories. | ||
974 | 958 | if (File::Spec->file_name_is_absolute($text)) { | ||
975 | 959 | $ignore_include_directories = 1; | ||
976 | 960 | } else { | ||
977 | 961 | foreach my $dir (@directories) { | ||
978 | 962 | if ($dir eq File::Spec->updir() or $dir eq File::Spec->curdir()) { | ||
979 | 963 | $ignore_include_directories = 1; | ||
980 | 964 | last; | ||
981 | 965 | } elsif ($dir ne '') { | ||
982 | 966 | last; | ||
983 | 967 | } | ||
984 | 968 | } | ||
985 | 969 | } | ||
986 | 970 | |||
987 | 971 | #if ($text =~ m,^(/|\./|\.\./),) { | ||
988 | 972 | if ($ignore_include_directories) { | ||
989 | 973 | $file = $text if (-e $text and -r $text); | ||
990 | 974 | } else { | ||
991 | 975 | my @dirs; | ||
992 | 976 | if ($self) { | ||
993 | 977 | @dirs = @{$self->{'include_directories'}}; | ||
994 | 978 | } else { | ||
995 | 979 | # no object with directory list and not an absolute path, never succeed | ||
996 | 980 | return undef; | ||
997 | 981 | } | ||
998 | 982 | foreach my $include_dir (@{$self->{'include_directories'}}) { | ||
999 | 983 | my ($include_volume, $include_directories, $include_filename) | ||
1000 | 984 | = File::Spec->splitpath($include_dir, 1); | ||
1001 | 985 | |||
1002 | 986 | my $possible_file = File::Spec->catpath($include_volume, | ||
1003 | 987 | File::Spec->catdir(File::Spec->splitdir($include_directories), | ||
1004 | 988 | @directories), $filename); | ||
1005 | 989 | #$file = "$include_dir/$text" if (-e "$include_dir/$text" and -r "$include_dir/$text"); | ||
1006 | 990 | $file = "$possible_file" if (-e "$possible_file" and -r "$possible_file"); | ||
1007 | 991 | last if (defined($file)); | ||
1008 | 992 | } | ||
1009 | 993 | } | ||
1010 | 994 | return $file; | ||
1011 | 995 | } | ||
1012 | 996 | |||
1013 | 997 | sub open_out($$;$) | ||
1014 | 998 | { | ||
1015 | 999 | my $self = shift; | ||
1016 | 1000 | my $file = shift; | ||
1017 | 1001 | my $encoding = shift; | ||
1018 | 1002 | |||
1019 | 1003 | if (!defined($encoding) and $self | ||
1020 | 1004 | and defined($self->get_conf('OUTPUT_PERL_ENCODING'))) { | ||
1021 | 1005 | $encoding = $self->get_conf('OUTPUT_PERL_ENCODING'); | ||
1022 | 1006 | } | ||
1023 | 1007 | |||
1024 | 1008 | if ($file eq '-') { | ||
1025 | 1009 | binmode(STDOUT, ":encoding($encoding)") if ($encoding); | ||
1026 | 1010 | if ($self) { | ||
1027 | 1011 | $self->{'unclosed_files'}->{$file} = \*STDOUT; | ||
1028 | 1012 | } | ||
1029 | 1013 | return \*STDOUT; | ||
1030 | 1014 | } | ||
1031 | 1015 | my $filehandle = do { local *FH }; | ||
1032 | 1016 | if (!open ($filehandle, '>', $file)) { | ||
1033 | 1017 | return undef; | ||
1034 | 1018 | } | ||
1035 | 1019 | if ($encoding) { | ||
1036 | 1020 | if ($encoding eq 'utf8' or $encoding eq 'utf-8-strict') { | ||
1037 | 1021 | binmode($filehandle, ':utf8'); | ||
1038 | 1022 | } else { # FIXME also right for shiftijs or similar encodings? | ||
1039 | 1023 | binmode($filehandle, ':bytes'); | ||
1040 | 1024 | } | ||
1041 | 1025 | binmode($filehandle, ":encoding($encoding)"); | ||
1042 | 1026 | } | ||
1043 | 1027 | if ($self) { | ||
1044 | 1028 | push @{$self->{'opened_files'}}, $file; | ||
1045 | 1029 | $self->{'unclosed_files'}->{$file} = $filehandle; | ||
1046 | 1030 | #print STDERR "OOOOOOO $file ".join('|',@{$self->{'opened_files'}})."\n"; | ||
1047 | 1031 | #cluck; | ||
1048 | 1032 | } | ||
1049 | 1033 | return $filehandle; | ||
1050 | 1034 | } | ||
1051 | 1035 | |||
1052 | 1036 | sub warn_unknown_language($$) { | ||
1053 | 1037 | my $lang = shift; | ||
1054 | 1038 | my $gettext = shift; | ||
1055 | 1039 | |||
1056 | 1040 | my @messages = (); | ||
1057 | 1041 | my $lang_code = $lang; | ||
1058 | 1042 | my $region_code; | ||
1059 | 1043 | |||
1060 | 1044 | if ($lang =~ /^([a-z]+)_([A-Z]+)/) { | ||
1061 | 1045 | $lang_code = $1; | ||
1062 | 1046 | $region_code = $2; | ||
1063 | 1047 | } | ||
1064 | 1048 | |||
1065 | 1049 | if (! $Texinfo::Documentlanguages::language_codes{$lang_code}) { | ||
1066 | 1050 | push @messages, sprintf(&$gettext(N__("%s is not a valid language code")), | ||
1067 | 1051 | $lang_code); | ||
1068 | 1052 | } | ||
1069 | 1053 | if (defined($region_code) | ||
1070 | 1054 | and ! $Texinfo::Documentlanguages::region_codes{$region_code}) { | ||
1071 | 1055 | push @messages, sprintf(&$gettext(N__("%s is not a valid region code")), | ||
1072 | 1056 | $region_code); | ||
1073 | 1057 | } | ||
1074 | 1058 | return @messages; | ||
1075 | 1059 | } | ||
1076 | 1060 | |||
1077 | 1061 | my %possible_split = ( | ||
1078 | 1062 | 'chapter' => 1, | ||
1079 | 1063 | 'section' => 1, | ||
1080 | 1064 | 'node' => 1, | ||
1081 | 1065 | ); | ||
1082 | 1066 | |||
1083 | 1067 | sub warn_unknown_split($$) { | ||
1084 | 1068 | my $split = shift; | ||
1085 | 1069 | my $gettext = shift; | ||
1086 | 1070 | |||
1087 | 1071 | my @messages = (); | ||
1088 | 1072 | if ($split and !$possible_split{$split}) { | ||
1089 | 1073 | push @messages, sprintf(&$gettext(N__("%s is not a valid split possibility")), | ||
1090 | 1074 | $split); | ||
1091 | 1075 | } | ||
1092 | 1076 | return @messages; | ||
1093 | 1077 | } | ||
1094 | 1078 | |||
1095 | 1079 | # This should do the job, or at least don't do wrong if $self | ||
1096 | 1080 | # is not defined, as could be the case if called from | ||
1097 | 1081 | # Texinfo::Convert::Text. | ||
1098 | 1082 | sub expand_verbatiminclude($$) | ||
1099 | 1083 | { | ||
1100 | 1084 | my $self = shift; | ||
1101 | 1085 | my $current = shift; | ||
1102 | 1086 | |||
1103 | 1087 | return unless ($current->{'extra'} and defined($current->{'extra'}->{'text_arg'})); | ||
1104 | 1088 | my $text = $current->{'extra'}->{'text_arg'}; | ||
1105 | 1089 | my $file = locate_include_file($self, $text); | ||
1106 | 1090 | |||
1107 | 1091 | my $verbatiminclude; | ||
1108 | 1092 | |||
1109 | 1093 | if (defined($file)) { | ||
1110 | 1094 | if (!open(VERBINCLUDE, $file)) { | ||
1111 | 1095 | if ($self) { | ||
1112 | 1096 | $self->line_error(sprintf($self->__("could not read %s: %s"), $file, $!), | ||
1113 | 1097 | $current->{'line_nr'}); | ||
1114 | 1098 | } | ||
1115 | 1099 | } else { | ||
1116 | 1100 | if ($self and defined($self->get_conf('INPUT_PERL_ENCODING'))) { | ||
1117 | 1101 | binmode(VERBINCLUDE, ":encoding(". | ||
1118 | 1102 | $self->get_conf('INPUT_PERL_ENCODING').")"); | ||
1119 | 1103 | } | ||
1120 | 1104 | $verbatiminclude = { 'cmdname' => 'verbatim', | ||
1121 | 1105 | 'parent' => $current->{'parent'}, | ||
1122 | 1106 | 'extra' => | ||
1123 | 1107 | {'text_arg' => $current->{'extra'}->{'text_arg'}} }; | ||
1124 | 1108 | while (<VERBINCLUDE>) { | ||
1125 | 1109 | push @{$verbatiminclude->{'contents'}}, | ||
1126 | 1110 | {'type' => 'raw', 'text' => $_ }; | ||
1127 | 1111 | } | ||
1128 | 1112 | if (!close (VERBINCLUDE)) { | ||
1129 | 1113 | $self->document_warn(sprintf($self->__( | ||
1130 | 1114 | "error on closing \@verbatiminclude file %s: %s"), | ||
1131 | 1115 | $file, $!)); | ||
1132 | 1116 | } | ||
1133 | 1117 | } | ||
1134 | 1118 | } elsif ($self) { | ||
1135 | 1119 | $self->line_error(sprintf($self->__("\@%s: could not find %s"), | ||
1136 | 1120 | $current->{'cmdname'}, $text), $current->{'line_nr'}); | ||
1137 | 1121 | } | ||
1138 | 1122 | return $verbatiminclude; | ||
1139 | 1123 | } | ||
1140 | 1124 | |||
1141 | 1125 | sub definition_category($$) | ||
1142 | 1126 | { | ||
1143 | 1127 | my $self = shift; | ||
1144 | 1128 | my $current = shift; | ||
1145 | 1129 | |||
1146 | 1130 | return undef if (!$current->{'extra'} or !$current->{'extra'}->{'def_args'}); | ||
1147 | 1131 | |||
1148 | 1132 | my $arg_category = $current->{'extra'}->{'def_parsed_hash'}->{'category'}; | ||
1149 | 1133 | my $arg_class = $current->{'extra'}->{'def_parsed_hash'}->{'class'}; | ||
1150 | 1134 | |||
1151 | 1135 | return $arg_category | ||
1152 | 1136 | if (!defined($arg_class)); | ||
1153 | 1137 | |||
1154 | 1138 | my $style = | ||
1155 | 1139 | $command_index_prefix{$current->{'extra'}->{'def_command'}}; | ||
1156 | 1140 | if ($style eq 'f') { | ||
1157 | 1141 | if ($self) { | ||
1158 | 1142 | return $self->gdt('{category} on {class}', { 'category' => $arg_category, | ||
1159 | 1143 | 'class' => $arg_class }); | ||
1160 | 1144 | } else { | ||
1161 | 1145 | return {'contents' => [$arg_category, {'text' => ' on '}, $arg_class]}; | ||
1162 | 1146 | } | ||
1163 | 1147 | } elsif ($style eq 'v') { | ||
1164 | 1148 | if ($self) { | ||
1165 | 1149 | return $self->gdt('{category} of {class}', { 'category' => $arg_category, | ||
1166 | 1150 | 'class' => $arg_class }); | ||
1167 | 1151 | } else { | ||
1168 | 1152 | return {'contents' => [$arg_category, {'text' => ' of '}, $arg_class]}; | ||
1169 | 1153 | } | ||
1170 | 1154 | } | ||
1171 | 1155 | } | ||
1172 | 1156 | |||
1173 | 1157 | sub expand_today($) | ||
1174 | 1158 | { | ||
1175 | 1159 | my $self = shift; | ||
1176 | 1160 | if ($self->get_conf('TEST')) { | ||
1177 | 1161 | return {'text' => 'a sunny day'}; | ||
1178 | 1162 | } | ||
1179 | 1163 | my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) | ||
1180 | 1164 | = localtime(time); | ||
1181 | 1165 | $year += ($year < 70) ? 2000 : 1900; | ||
1182 | 1166 | return $self->gdt('{month} {day}, {year}', | ||
1183 | 1167 | { 'month' => $self->gdt($MONTH_NAMES[$mon]), | ||
1184 | 1168 | 'day' => $mday, 'year' => $year }); | ||
1185 | 1169 | } | ||
1186 | 1170 | |||
1187 | 1171 | sub translated_command_tree($$) | ||
1188 | 1172 | { | ||
1189 | 1173 | my $self = shift; | ||
1190 | 1174 | my $cmdname = shift; | ||
1191 | 1175 | if ($self->{'translated_commands'}->{$cmdname}) { | ||
1192 | 1176 | return $self->gdt($self->{'translated_commands'}->{$cmdname}); | ||
1193 | 1177 | } | ||
1194 | 1178 | return undef; | ||
1195 | 1179 | } | ||
1196 | 1180 | |||
1197 | 1181 | sub numbered_heading($$$;$) | ||
1198 | 1182 | { | ||
1199 | 1183 | my $self = shift; | ||
1200 | 1184 | my $current = shift; | ||
1201 | 1185 | my $text = shift; | ||
1202 | 1186 | my $numbered = shift; | ||
1203 | 1187 | |||
1204 | 1188 | my $number; | ||
1205 | 1189 | if (defined($current->{'number'}) and ($numbered or !defined($numbered))) { | ||
1206 | 1190 | $number = $current->{'number'}; | ||
1207 | 1191 | } | ||
1208 | 1192 | |||
1209 | 1193 | my $result; | ||
1210 | 1194 | if ($self) { | ||
1211 | 1195 | if (defined($number)) { | ||
1212 | 1196 | if ($current->{'cmdname'} eq 'appendix' and $current->{'level'} == 1) { | ||
1213 | 1197 | $result = $self->gdt('Appendix {number} {section_title}', | ||
1214 | 1198 | {'number' => $number, 'section_title' => $text}, | ||
1215 | 1199 | 'translated_text'); | ||
1216 | 1200 | } else { | ||
1217 | 1201 | $result = $self->gdt('{number} {section_title}', | ||
1218 | 1202 | {'number' => $number, 'section_title' => $text}, | ||
1219 | 1203 | 'translated_text'); | ||
1220 | 1204 | } | ||
1221 | 1205 | } else { | ||
1222 | 1206 | $result = $text; | ||
1223 | 1207 | } | ||
1224 | 1208 | } else { | ||
1225 | 1209 | $result = $text; | ||
1226 | 1210 | $result = $number.' '.$result if (defined($number)); | ||
1227 | 1211 | if ($current->{'cmdname'} eq 'appendix' and $current->{'level'} == 1) { | ||
1228 | 1212 | $result = 'Appendix '.$result; | ||
1229 | 1213 | } | ||
1230 | 1214 | } | ||
1231 | 1215 | chomp ($result); | ||
1232 | 1216 | return $result; | ||
1233 | 1217 | } | ||
1234 | 1218 | |||
1235 | 1219 | sub definition_arguments_content($) | ||
1236 | 1220 | { | ||
1237 | 1221 | my $root = shift; | ||
1238 | 1222 | my $result; | ||
1239 | 1223 | |||
1240 | 1224 | return undef if (!defined($root->{'extra'}) | ||
1241 | 1225 | or !defined($root->{'extra'}->{'def_args'})); | ||
1242 | 1226 | my @args = @{$root->{'extra'}->{'def_args'}}; | ||
1243 | 1227 | while (@args) { | ||
1244 | 1228 | last if ($args[0]->[0] ne 'spaces' | ||
1245 | 1229 | and !$root->{'extra'}->{'def_parsed_hash'}->{$args[0]->[0]}); | ||
1246 | 1230 | shift @args; | ||
1247 | 1231 | } | ||
1248 | 1232 | if (@args) { | ||
1249 | 1233 | foreach my $arg (@args) { | ||
1250 | 1234 | push @$result, $arg->[1]; | ||
1251 | 1235 | } | ||
1252 | 1236 | } | ||
1253 | 1237 | return $result; | ||
1254 | 1238 | } | ||
1255 | 1239 | |||
1256 | 1240 | # find the accent commands stack and the innermost text contents | ||
1257 | 1241 | sub find_innermost_accent_contents($;$) | ||
1258 | 1242 | { | ||
1259 | 1243 | my $current = shift; | ||
1260 | 1244 | my $encoding = shift; | ||
1261 | 1245 | my @accent_commands = (); | ||
1262 | 1246 | my $debug = 0; | ||
1263 | 1247 | ACCENT: | ||
1264 | 1248 | while (1) { | ||
1265 | 1249 | # the following can happen if called with a bad tree | ||
1266 | 1250 | if (!$current->{'cmdname'} | ||
1267 | 1251 | or !$accent_commands{$current->{'cmdname'}}) { | ||
1268 | 1252 | #print STDERR "BUG: Not an accent command in accent\n"; | ||
1269 | 1253 | cluck "BUG: Not an accent command in accent\n"; | ||
1270 | 1254 | #print STDERR Texinfo::Convert::Texinfo::convert($current)."\n"; | ||
1271 | 1255 | #print STDERR Data::Dumper->Dump([$current]); | ||
1272 | 1256 | last; | ||
1273 | 1257 | } | ||
1274 | 1258 | push @accent_commands, $current; | ||
1275 | 1259 | # A bogus accent, that may happen | ||
1276 | 1260 | if (!$current->{'args'}) { | ||
1277 | 1261 | return ([], \@accent_commands); | ||
1278 | 1262 | } | ||
1279 | 1263 | my $arg = $current->{'args'}->[0]; | ||
1280 | 1264 | if (!$arg->{'contents'}) { | ||
1281 | 1265 | print STDERR "BUG: No content in accent command\n"; | ||
1282 | 1266 | #print STDERR Data::Dumper->Dump([$current]); | ||
1283 | 1267 | #print STDERR Texinfo::Convert::Texinfo::convert($current)."\n"; | ||
1284 | 1268 | return ([], \@accent_commands); | ||
1285 | 1269 | } | ||
1286 | 1270 | # inside the argument of an accent | ||
1287 | 1271 | my $text_contents = []; | ||
1288 | 1272 | foreach my $content (@{$arg->{'contents'}}) { | ||
1289 | 1273 | if (!($content->{'extra'} and $content->{'extra'}->{'invalid_nesting'}) | ||
1290 | 1274 | and !($content->{'cmdname'} and ($content->{'cmdname'} eq 'c' | ||
1291 | 1275 | or $content->{'cmdname'} eq 'comment'))) { | ||
1292 | 1276 | if ($content->{'cmdname'} and $accent_commands{$content->{'cmdname'}}) { | ||
1293 | 1277 | $current = $content; | ||
1294 | 1278 | next ACCENT; | ||
1295 | 1279 | } else { | ||
1296 | 1280 | push @$text_contents, $content; | ||
1297 | 1281 | } | ||
1298 | 1282 | } | ||
1299 | 1283 | } | ||
1300 | 1284 | # we go here if there was no nested accent | ||
1301 | 1285 | return ($text_contents, \@accent_commands); | ||
1302 | 1286 | } | ||
1303 | 1287 | } | ||
1304 | 1288 | |||
1305 | 1289 | sub trim_spaces_comment_from_content($) | ||
1306 | 1290 | { | ||
1307 | 1291 | my $contents = shift; | ||
1308 | 1292 | shift @$contents | ||
1309 | 1293 | if ($contents->[0] and $contents->[0]->{'type'} | ||
1310 | 1294 | and ($contents->[0]->{'type'} eq 'empty_line_after_command' | ||
1311 | 1295 | or $contents->[0]->{'type'} eq 'empty_spaces_after_command' | ||
1312 | 1296 | or $contents->[0]->{'type'} eq 'empty_spaces_before_argument' | ||
1313 | 1297 | or $contents->[0]->{'type'} eq 'empty_space_at_end_def_bracketed' | ||
1314 | 1298 | or $contents->[0]->{'type'} eq 'empty_spaces_after_close_brace')); | ||
1315 | 1299 | |||
1316 | 1300 | while (@$contents | ||
1317 | 1301 | and (($contents->[-1]->{'cmdname'} | ||
1318 | 1302 | and ($contents->[-1]->{'cmdname'} eq 'c' | ||
1319 | 1303 | or $contents->[-1]->{'cmdname'} eq 'comment')) | ||
1320 | 1304 | or ($contents->[-1]->{'type'} | ||
1321 | 1305 | and ($contents->[-1]->{'type'} eq 'spaces_at_end' | ||
1322 | 1306 | or $contents->[-1]->{'type'} eq 'space_at_end_block_command')))) { | ||
1323 | 1307 | pop @$contents; | ||
1324 | 1308 | } | ||
1325 | 1309 | } | ||
1326 | 1310 | |||
1327 | 1311 | sub float_name_caption($$) | ||
1328 | 1312 | { | ||
1329 | 1313 | my $self = shift; | ||
1330 | 1314 | my $root = shift; | ||
1331 | 1315 | |||
1332 | 1316 | my $caption; | ||
1333 | 1317 | if ($root->{'extra'}->{'caption'}) { | ||
1334 | 1318 | $caption = $root->{'extra'}->{'caption'}; | ||
1335 | 1319 | } elsif ($root->{'extra'}->{'shortcaption'}) { | ||
1336 | 1320 | $caption = $root->{'extra'}->{'shortcaption'}; | ||
1337 | 1321 | } | ||
1338 | 1322 | #if ($self->get_conf('DEBUG')) { | ||
1339 | 1323 | # my $caption_texi = | ||
1340 | 1324 | # Texinfo::Convert::Texinfo::convert({ 'contents' => $caption->{'contents'}}); | ||
1341 | 1325 | # print STDERR " CAPTION: $caption_texi\n"; | ||
1342 | 1326 | #} | ||
1343 | 1327 | my $type; | ||
1344 | 1328 | if ($root->{'extra'}->{'type'}->{'normalized'} ne '') { | ||
1345 | 1329 | $type = {'contents' => $root->{'extra'}->{'type'}->{'content'}}; | ||
1346 | 1330 | } | ||
1347 | 1331 | |||
1348 | 1332 | my $prepended; | ||
1349 | 1333 | if ($type) { | ||
1350 | 1334 | if ($caption) { | ||
1351 | 1335 | if (defined($root->{'number'})) { | ||
1352 | 1336 | $prepended = $self->gdt('{float_type} {float_number}: ', | ||
1353 | 1337 | {'float_type' => $type, | ||
1354 | 1338 | 'float_number' => $root->{'number'}}); | ||
1355 | 1339 | } else { | ||
1356 | 1340 | $prepended = $self->gdt('{float_type}: ', | ||
1357 | 1341 | {'float_type' => $type}); | ||
1358 | 1342 | } | ||
1359 | 1343 | } else { | ||
1360 | 1344 | if (defined($root->{'number'})) { | ||
1361 | 1345 | $prepended = $self->gdt("{float_type} {float_number}\n", | ||
1362 | 1346 | {'float_type' => $type, | ||
1363 | 1347 | 'float_number' => $root->{'number'}}); | ||
1364 | 1348 | } else { | ||
1365 | 1349 | $prepended = $self->gdt("{float_type}\n", | ||
1366 | 1350 | {'float_type' => $type}); | ||
1367 | 1351 | } | ||
1368 | 1352 | } | ||
1369 | 1353 | } elsif (defined($root->{'number'})) { | ||
1370 | 1354 | if ($caption) { | ||
1371 | 1355 | $prepended = $self->gdt('{float_number}: ', | ||
1372 | 1356 | {'float_number' => $root->{'number'}}); | ||
1373 | 1357 | } else { | ||
1374 | 1358 | $prepended = $self->gdt("{float_number}\n", | ||
1375 | 1359 | {'float_number' => $root->{'number'}}); | ||
1376 | 1360 | } | ||
1377 | 1361 | } | ||
1378 | 1362 | return ($caption, $prepended); | ||
1379 | 1363 | } | ||
1380 | 1364 | |||
1381 | 1365 | # decompose a decimal number on a given base. | ||
1382 | 1366 | sub _decompose_integer($$) | ||
1383 | 1367 | { | ||
1384 | 1368 | my $number = shift; | ||
1385 | 1369 | my $base = shift; | ||
1386 | 1370 | my @result = (); | ||
1387 | 1371 | |||
1388 | 1372 | while ($number >= 0) { | ||
1389 | 1373 | my $factor = $number % $base; | ||
1390 | 1374 | push (@result, $factor); | ||
1391 | 1375 | $number = int(($number - $factor) / $base) - 1; | ||
1392 | 1376 | } | ||
1393 | 1377 | return @result; | ||
1394 | 1378 | } | ||
1395 | 1379 | |||
1396 | 1380 | sub enumerate_item_representation($$) | ||
1397 | 1381 | { | ||
1398 | 1382 | my $specification = shift; | ||
1399 | 1383 | my $number = shift; | ||
1400 | 1384 | |||
1401 | 1385 | if ($specification =~ /^[0-9]$/) { | ||
1402 | 1386 | return $specification + $number -1; | ||
1403 | 1387 | } | ||
1404 | 1388 | |||
1405 | 1389 | my $result = ''; | ||
1406 | 1390 | my $base_letter = ord('a'); | ||
1407 | 1391 | $base_letter = ord('A') if (ucfirst($specification) eq $specification); | ||
1408 | 1392 | my @letter_ords = _decompose_integer(ord($specification) - $base_letter + $number - 1, 26); | ||
1409 | 1393 | foreach my $ord (@letter_ords) { | ||
1410 | 1394 | $result = chr($base_letter + $ord) . $result; | ||
1411 | 1395 | } | ||
1412 | 1396 | return $result; | ||
1413 | 1397 | } | ||
1414 | 1398 | |||
1415 | 1399 | |||
1416 | 1400 | our %htmlxref_entries = ( | ||
1417 | 1401 | 'node' => [ 'node', 'section', 'chapter', 'mono' ], | ||
1418 | 1402 | 'section' => [ 'section', 'chapter','node', 'mono' ], | ||
1419 | 1403 | 'chapter' => [ 'chapter', 'section', 'node', 'mono' ], | ||
1420 | 1404 | 'mono' => [ 'mono', 'chapter', 'section', 'node' ], | ||
1421 | 1405 | ); | ||
1422 | 1406 | |||
1423 | 1407 | sub parse_htmlxref_files($$) | ||
1424 | 1408 | { | ||
1425 | 1409 | my $self = shift; | ||
1426 | 1410 | my $files = shift; | ||
1427 | 1411 | my $htmlxref; | ||
1428 | 1412 | |||
1429 | 1413 | foreach my $file (@$files) { | ||
1430 | 1414 | print STDERR "html refs config file: $file\n" if ($self->get_conf('DEBUG')); | ||
1431 | 1415 | unless (open (HTMLXREF, $file)) { | ||
1432 | 1416 | $self->document_warn( | ||
1433 | 1417 | sprintf($self->__("could not open html refs config file %s: %s"), | ||
1434 | 1418 | $file, $!)); | ||
1435 | 1419 | next; | ||
1436 | 1420 | } | ||
1437 | 1421 | my $line_nr = 0; | ||
1438 | 1422 | my %variables; | ||
1439 | 1423 | while (my $hline = <HTMLXREF>) { | ||
1440 | 1424 | my $line = $hline; | ||
1441 | 1425 | $line_nr++; | ||
1442 | 1426 | next if $hline =~ /^\s*#/; | ||
1443 | 1427 | #$hline =~ s/[#]\s.*//; | ||
1444 | 1428 | $hline =~ s/^\s*//; | ||
1445 | 1429 | next if $hline =~ /^\s*$/; | ||
1446 | 1430 | chomp ($hline); | ||
1447 | 1431 | if ($hline =~ s/^\s*(\w+)\s*=\s*//) { | ||
1448 | 1432 | # handle variables | ||
1449 | 1433 | my $var = $1; | ||
1450 | 1434 | my $re = join '|', map { quotemeta $_ } keys %variables; | ||
1451 | 1435 | $hline =~ s/\$\{($re)\}/defined $variables{$1} ? $variables{$1} | ||
1452 | 1436 | : "\${$1}"/ge; | ||
1453 | 1437 | $variables{$var} = $hline; | ||
1454 | 1438 | next; | ||
1455 | 1439 | } | ||
1456 | 1440 | my @htmlxref = split /\s+/, $hline; | ||
1457 | 1441 | my $manual = shift @htmlxref; | ||
1458 | 1442 | my $split_or_mono = shift @htmlxref; | ||
1459 | 1443 | #print STDERR "$split_or_mono $Texi2HTML::Config::htmlxref_entries{$split_or_mono} $line_nr\n"; | ||
1460 | 1444 | if (!defined($split_or_mono)) { | ||
1461 | 1445 | $self->file_line_warn($self->__("missing type"), $file, $line_nr); | ||
1462 | 1446 | next; | ||
1463 | 1447 | } elsif (!defined($htmlxref_entries{$split_or_mono})) { | ||
1464 | 1448 | $self->file_line_warn(sprintf($self->__("unrecognized type: %s"), | ||
1465 | 1449 | $split_or_mono), $file, $line_nr); | ||
1466 | 1450 | next; | ||
1467 | 1451 | } | ||
1468 | 1452 | my $href = shift @htmlxref; | ||
1469 | 1453 | next if (exists($htmlxref->{$manual}->{$split_or_mono})); | ||
1470 | 1454 | |||
1471 | 1455 | if (defined($href)) { # substitute 'variables' | ||
1472 | 1456 | my $re = join '|', map { quotemeta $_ } keys %variables; | ||
1473 | 1457 | $href =~ s/\$\{($re)\}/defined $variables{$1} ? $variables{$1} | ||
1474 | 1458 | : "\${$1}"/ge; | ||
1475 | 1459 | $href =~ s/\/*$// if ($split_or_mono ne 'mono'); | ||
1476 | 1460 | } | ||
1477 | 1461 | $htmlxref->{$manual}->{$split_or_mono} = $href; | ||
1478 | 1462 | } | ||
1479 | 1463 | if (!close (HTMLXREF)) { | ||
1480 | 1464 | $self->document_warn(sprintf($self->__( | ||
1481 | 1465 | "error on closing html refs config file %s: %s"), | ||
1482 | 1466 | $file, $!)); | ||
1483 | 1467 | } | ||
1484 | 1468 | } | ||
1485 | 1469 | return $htmlxref; | ||
1486 | 1470 | } | ||
1487 | 1471 | |||
1488 | 1472 | sub parse_renamed_nodes_file($$;$$) | ||
1489 | 1473 | { | ||
1490 | 1474 | my $self = shift; | ||
1491 | 1475 | my $renamed_nodes_file = shift; | ||
1492 | 1476 | # if not given they are automatically created | ||
1493 | 1477 | my $renamed_nodes = shift; | ||
1494 | 1478 | my $renamed_nodes_lines = shift; | ||
1495 | 1479 | |||
1496 | 1480 | if (open(RENAMEDFILE, "<$renamed_nodes_file")) { | ||
1497 | 1481 | if ($self->get_conf('INPUT_PERL_ENCODING')) { | ||
1498 | 1482 | binmode(RENAMEDFILE, ":encoding(". | ||
1499 | 1483 | $self->get_conf('INPUT_PERL_ENCODING').")"); | ||
1500 | 1484 | } | ||
1501 | 1485 | my $renamed_nodes_line_nr = 0; | ||
1502 | 1486 | my @old_names = (); | ||
1503 | 1487 | while (<RENAMEDFILE>) { | ||
1504 | 1488 | $renamed_nodes_line_nr++; | ||
1505 | 1489 | next unless (/\S/); | ||
1506 | 1490 | next if (/^\s*\@c\b/); | ||
1507 | 1491 | if (s/^\s*\@\@\{\}\s+(\S)/$1/) { | ||
1508 | 1492 | chomp; | ||
1509 | 1493 | if (scalar(@old_names)) { | ||
1510 | 1494 | foreach my $old_node_name (@old_names) { | ||
1511 | 1495 | $renamed_nodes->{$old_node_name} = $_; | ||
1512 | 1496 | } | ||
1513 | 1497 | $renamed_nodes_lines->{$_} = $renamed_nodes_line_nr; | ||
1514 | 1498 | @old_names = (); | ||
1515 | 1499 | } else { | ||
1516 | 1500 | $self->file_line_warn($self->__("no node to be renamed"), | ||
1517 | 1501 | $renamed_nodes_file, $renamed_nodes_line_nr); | ||
1518 | 1502 | } | ||
1519 | 1503 | } else { | ||
1520 | 1504 | chomp; | ||
1521 | 1505 | s/^\s*//; | ||
1522 | 1506 | $renamed_nodes_lines->{$_} = $renamed_nodes_line_nr; | ||
1523 | 1507 | push @old_names, $_; | ||
1524 | 1508 | } | ||
1525 | 1509 | } | ||
1526 | 1510 | if (scalar(@old_names)) { | ||
1527 | 1511 | $self->file_line_warn($self->__("nodes without a new name at the end of file"), | ||
1528 | 1512 | $renamed_nodes_file, $renamed_nodes_line_nr); | ||
1529 | 1513 | } | ||
1530 | 1514 | if (!close(RENAMEDFILE)) { | ||
1531 | 1515 | $self->document_warn(sprintf($self->__p( | ||
1532 | 1516 | "see HTML Xref Link Preservation in the Texinfo manual for context", | ||
1533 | 1517 | "error on closing node-renaming configuration file %s: %s"), | ||
1534 | 1518 | $renamed_nodes_file, $!)); | ||
1535 | 1519 | } | ||
1536 | 1520 | } else { | ||
1537 | 1521 | $self->document_warn(sprintf($self->__("could not open %s: %s"), | ||
1538 | 1522 | $renamed_nodes_file, $!)); | ||
1539 | 1523 | } | ||
1540 | 1524 | return ($renamed_nodes, $renamed_nodes_lines); | ||
1541 | 1525 | } | ||
1542 | 1526 | |||
1543 | 1527 | sub collect_renamed_nodes($$;$$) | ||
1544 | 1528 | { | ||
1545 | 1529 | my $self = shift; | ||
1546 | 1530 | my $basename = shift; | ||
1547 | 1531 | my $renamed_nodes = shift; | ||
1548 | 1532 | my $renamed_nodes_lines = shift; | ||
1549 | 1533 | |||
1550 | 1534 | my $renamed_nodes_file; | ||
1551 | 1535 | if (defined($self->get_conf('RENAMED_NODES_FILE'))) { | ||
1552 | 1536 | $renamed_nodes_file = $self->get_conf('RENAMED_NODES_FILE'); | ||
1553 | 1537 | } elsif (-f $basename . '-noderename.cnf') { | ||
1554 | 1538 | $renamed_nodes_file = $basename . '-noderename.cnf'; | ||
1555 | 1539 | } | ||
1556 | 1540 | if (defined($renamed_nodes_file)) { | ||
1557 | 1541 | my ($renamed_nodes, $renamed_nodes_lines) | ||
1558 | 1542 | = parse_renamed_nodes_file($self, $renamed_nodes_file, $renamed_nodes, | ||
1559 | 1543 | $renamed_nodes_lines); | ||
1560 | 1544 | return ($renamed_nodes, $renamed_nodes_lines, $renamed_nodes_file); | ||
1561 | 1545 | } | ||
1562 | 1546 | return (undef, undef, undef); | ||
1563 | 1547 | } | ||
1564 | 1548 | |||
1565 | 1549 | sub normalize_top_node_name($) | ||
1566 | 1550 | { | ||
1567 | 1551 | my $node = shift; | ||
1568 | 1552 | if ($node =~ /^top$/i) { | ||
1569 | 1553 | return 'Top'; | ||
1570 | 1554 | } | ||
1571 | 1555 | return $node; | ||
1572 | 1556 | } | ||
1573 | 1557 | |||
1574 | 1558 | sub _convert_text_options($) | ||
1575 | 1559 | { | ||
1576 | 1560 | my $self = shift; | ||
1577 | 1561 | my %options; | ||
1578 | 1562 | if ($self->get_conf('ENABLE_ENCODING')) { | ||
1579 | 1563 | if ($self->get_conf('OUTPUT_ENCODING_NAME')) { | ||
1580 | 1564 | $options{'enabled_encoding'} = $self->get_conf('OUTPUT_ENCODING_NAME'); | ||
1581 | 1565 | } elsif ($self->get_conf('INPUT_ENCODING_NAME')) { | ||
1582 | 1566 | $options{'enabled_encoding'} = $self->get_conf('INPUT_ENCODING_NAME'); | ||
1583 | 1567 | } | ||
1584 | 1568 | } | ||
1585 | 1569 | $options{'TEST'} = 1 if ($self->get_conf('TEST')); | ||
1586 | 1570 | $options{'NUMBER_SECTIONS'} = $self->get_conf('NUMBER_SECTIONS'); | ||
1587 | 1571 | $options{'converter'} = $self; | ||
1588 | 1572 | $options{'expanded_formats_hash'} = $self->{'expanded_formats_hash'}; | ||
1589 | 1573 | return %options; | ||
1590 | 1574 | } | ||
1591 | 1575 | |||
1592 | 1576 | sub count_bytes($$;$) | ||
1593 | 1577 | { | ||
1594 | 1578 | my $self = shift; | ||
1595 | 1579 | my $string = shift; | ||
1596 | 1580 | my $encoding = shift; | ||
1597 | 1581 | |||
1598 | 1582 | if (!defined($encoding) and $self and $self->get_conf('OUTPUT_PERL_ENCODING')) { | ||
1599 | 1583 | $encoding = $self->get_conf('OUTPUT_PERL_ENCODING'); | ||
1600 | 1584 | } | ||
1601 | 1585 | |||
1602 | 1586 | if ($encoding and $encoding ne 'ascii') { | ||
1603 | 1587 | return length(Encode::encode($encoding, $string)); | ||
1604 | 1588 | } else { | ||
1605 | 1589 | return length($string); | ||
1606 | 1590 | } | ||
1607 | 1591 | # FIXME is the following required for correct count of end of lines? | ||
1608 | 1592 | #if ($encoding) { | ||
1609 | 1593 | # return length(Encode::encode($encoding, $string)); | ||
1610 | 1594 | #} else { | ||
1611 | 1595 | # return length(Encode::encode('ascii', $string)); | ||
1612 | 1596 | #} | ||
1613 | 1597 | } | ||
1614 | 1598 | |||
1615 | 1599 | # TODO | ||
1616 | 1600 | # also recurse into | ||
1617 | 1601 | # extra->misc_args, extra->args_index | ||
1618 | 1602 | # extra->index_entry extra->type | ||
1619 | 1603 | # | ||
1620 | 1604 | # extra that should point to other elements: | ||
1621 | 1605 | # command_as_argument | ||
1622 | 1606 | # @block_command_line_contents @brace_command_contents @misc_content end_command | ||
1623 | 1607 | # associated_section part_associated_section associated_node associated_part | ||
1624 | 1608 | # @prototypes @columnfractions titlepage quotation @author command | ||
1625 | 1609 | # menu_entry_description menu_entry_name | ||
1626 | 1610 | # | ||
1627 | 1611 | # should point to other elements, or be copied. And some should be recursed | ||
1628 | 1612 | # into too. | ||
1629 | 1613 | # extra->type->content | ||
1630 | 1614 | # extra->nodes_manuals->[] | ||
1631 | 1615 | # extra->node_content | ||
1632 | 1616 | # extra->node_argument | ||
1633 | 1617 | # extra->explanation_contents | ||
1634 | 1618 | # extra->menu_entry_node | ||
1635 | 1619 | # extra->def_arg | ||
1636 | 1620 | |||
1637 | 1621 | |||
1638 | 1622 | sub _copy_tree($$$); | ||
1639 | 1623 | sub _copy_tree($$$) | ||
1640 | 1624 | { | ||
1641 | 1625 | my $current = shift; | ||
1642 | 1626 | my $parent = shift; | ||
1643 | 1627 | my $reference_associations = shift; | ||
1644 | 1628 | my $new = {}; | ||
1645 | 1629 | $reference_associations->{$current} = $new; | ||
1646 | 1630 | $new->{'parent'} = $parent if ($parent); | ||
1647 | 1631 | foreach my $key ('type', 'cmdname', 'text') { | ||
1648 | 1632 | $new->{$key} = $current->{$key} if (exists($current->{$key})); | ||
1649 | 1633 | } | ||
1650 | 1634 | foreach my $key ('args', 'contents') { | ||
1651 | 1635 | if ($current->{$key}) { | ||
1652 | 1636 | if (ref($current->{$key}) ne 'ARRAY') { | ||
1653 | 1637 | my $command_or_type = ''; | ||
1654 | 1638 | if ($new->{'cmdname'}) { | ||
1655 | 1639 | $command_or_type = '@'.$new->{'cmdname'}; | ||
1656 | 1640 | } elsif ($new->{'type'}) { | ||
1657 | 1641 | $command_or_type = $new->{'type'}; | ||
1658 | 1642 | } | ||
1659 | 1643 | print STDERR "Not an array [$command_or_type] $key ".ref($current->{$key})."\n"; | ||
1660 | 1644 | } | ||
1661 | 1645 | $new->{$key} = []; | ||
1662 | 1646 | $reference_associations->{$current->{$key}} = $new->{$key}; | ||
1663 | 1647 | foreach my $child (@{$current->{$key}}) { | ||
1664 | 1648 | push @{$new->{$key}}, _copy_tree($child, $new, $reference_associations); | ||
1665 | 1649 | } | ||
1666 | 1650 | } | ||
1667 | 1651 | } | ||
1668 | 1652 | if ($current->{'extra'}) { | ||
1669 | 1653 | $new->{'extra'} = {}; | ||
1670 | 1654 | foreach my $key (keys %{$current->{'extra'}}) { | ||
1671 | 1655 | if ($current->{'cmdname'} and $current->{'cmdname'} eq 'multitable' | ||
1672 | 1656 | and $key eq 'prototypes') { | ||
1673 | 1657 | $new->{'extra'}->{$key} = []; | ||
1674 | 1658 | $reference_associations->{$current->{'extra'}->{$key}} = $new->{$key}; | ||
1675 | 1659 | foreach my $child (@{$current->{'extra'}->{$key}}) { | ||
1676 | 1660 | push @{$new->{'extra'}->{$key}}, | ||
1677 | 1661 | _copy_tree($child, $new, $reference_associations); | ||
1678 | 1662 | } | ||
1679 | 1663 | } elsif (!ref($current->{'extra'}->{$key})) { | ||
1680 | 1664 | $new->{'extra'}->{$key} = $current->{'extra'}->{$key}; | ||
1681 | 1665 | } | ||
1682 | 1666 | } | ||
1683 | 1667 | } | ||
1684 | 1668 | return $new; | ||
1685 | 1669 | } | ||
1686 | 1670 | |||
1687 | 1671 | # Not used. | ||
1688 | 1672 | sub _collect_references($$); | ||
1689 | 1673 | sub _collect_references($$) | ||
1690 | 1674 | { | ||
1691 | 1675 | my $current = shift; | ||
1692 | 1676 | my $references = shift; | ||
1693 | 1677 | foreach my $key ('args', 'contents') { | ||
1694 | 1678 | if ($current->{$key}) { | ||
1695 | 1679 | $references->{$current->{$key}} = $current->{$key}; | ||
1696 | 1680 | foreach my $child (@{$current->{$key}}) { | ||
1697 | 1681 | $references->{$child} = $child; | ||
1698 | 1682 | _collect_references($child, $references); | ||
1699 | 1683 | } | ||
1700 | 1684 | } | ||
1701 | 1685 | } | ||
1702 | 1686 | } | ||
1703 | 1687 | |||
1704 | 1688 | sub _substitute_references_in_array($$$); | ||
1705 | 1689 | sub _substitute_references_in_array($$$) | ||
1706 | 1690 | { | ||
1707 | 1691 | my $array = shift; | ||
1708 | 1692 | my $reference_associations = shift; | ||
1709 | 1693 | my $context = shift; | ||
1710 | 1694 | |||
1711 | 1695 | my $result = []; | ||
1712 | 1696 | my $index = 0; | ||
1713 | 1697 | foreach my $item (@{$array}) { | ||
1714 | 1698 | if (!ref($item)) { | ||
1715 | 1699 | push @{$result}, $item; | ||
1716 | 1700 | } elsif ($reference_associations->{$item}) { | ||
1717 | 1701 | push @{$result}, $reference_associations->{$item}; | ||
1718 | 1702 | } elsif (ref($item) eq 'ARRAY') { | ||
1719 | 1703 | push @$result, | ||
1720 | 1704 | _substitute_references_in_array($item, $reference_associations, | ||
1721 | 1705 | "$context [$index]"); | ||
1722 | 1706 | } elsif (defined($item->{'text'})) { | ||
1723 | 1707 | my $new_text = _copy_tree($item, undef, $reference_associations); | ||
1724 | 1708 | substitute_references($item, $new_text, $reference_associations); | ||
1725 | 1709 | push @{$result}, $new_text; | ||
1726 | 1710 | } else { | ||
1727 | 1711 | print STDERR "Trouble with $context [$index] (".ref($item).")\n"; | ||
1728 | 1712 | push @{$result}, undef; | ||
1729 | 1713 | } | ||
1730 | 1714 | $index++; | ||
1731 | 1715 | } | ||
1732 | 1716 | return $result; | ||
1733 | 1717 | } | ||
1734 | 1718 | |||
1735 | 1719 | sub substitute_references($$$); | ||
1736 | 1720 | sub substitute_references($$$) | ||
1737 | 1721 | { | ||
1738 | 1722 | my $current = shift; | ||
1739 | 1723 | my $new = shift; | ||
1740 | 1724 | my $reference_associations = shift; | ||
1741 | 1725 | |||
1742 | 1726 | foreach my $key ('args', 'contents') { | ||
1743 | 1727 | if ($new->{$key}) { | ||
1744 | 1728 | my $index = 0; | ||
1745 | 1729 | foreach my $child (@{$new->{$key}}) { | ||
1746 | 1730 | substitute_references($child, $current->{$key}->[$index], | ||
1747 | 1731 | $reference_associations); | ||
1748 | 1732 | $index++; | ||
1749 | 1733 | } | ||
1750 | 1734 | } | ||
1751 | 1735 | } | ||
1752 | 1736 | if ($current->{'extra'}) { | ||
1753 | 1737 | foreach my $key (keys %{$current->{'extra'}}) { | ||
1754 | 1738 | if (ref($current->{'extra'}->{$key})) { | ||
1755 | 1739 | my $command_or_type = ''; | ||
1756 | 1740 | if ($new->{'cmdname'}) { | ||
1757 | 1741 | $command_or_type = '@'.$new->{'cmdname'}; | ||
1758 | 1742 | } elsif ($new->{'type'}) { | ||
1759 | 1743 | $command_or_type = $new->{'type'}; | ||
1760 | 1744 | } | ||
1761 | 1745 | |||
1762 | 1746 | if ($current->{'cmdname'} and $current->{'cmdname'} eq 'multitable' | ||
1763 | 1747 | and $key eq 'prototypes') { | ||
1764 | 1748 | my $index = 0; | ||
1765 | 1749 | foreach my $child (@{$new->{'extra'}->{$key}}) { | ||
1766 | 1750 | substitute_references($child, $current->{'extra'}->{$key}->[$index], | ||
1767 | 1751 | $reference_associations); | ||
1768 | 1752 | $index++; | ||
1769 | 1753 | } | ||
1770 | 1754 | } elsif ($reference_associations->{$current->{'extra'}->{$key}}) { | ||
1771 | 1755 | $new->{'extra'}->{$key} | ||
1772 | 1756 | = $reference_associations->{$current->{'extra'}->{$key}}; | ||
1773 | 1757 | #print STDERR "Done [$command_or_type]: $key\n"; | ||
1774 | 1758 | } else { | ||
1775 | 1759 | if (ref($current->{'extra'}->{$key}) eq 'ARRAY') { | ||
1776 | 1760 | |||
1777 | 1761 | #print STDERR "Array $command_or_type -> $key\n"; | ||
1778 | 1762 | $new->{'extra'}->{$key} = _substitute_references_in_array( | ||
1779 | 1763 | $current->{'extra'}->{$key}, $reference_associations, | ||
1780 | 1764 | "[$command_or_type]{$key}"); | ||
1781 | 1765 | } else { | ||
1782 | 1766 | if (($current->{'cmdname'} | ||
1783 | 1767 | and ($current->{'cmdname'} eq 'listoffloats' | ||
1784 | 1768 | or $current->{'cmdname'} eq 'float') | ||
1785 | 1769 | and $key eq 'type') | ||
1786 | 1770 | or ($key eq 'index_entry') | ||
1787 | 1771 | or ($current->{'type'} | ||
1788 | 1772 | and $current->{'type'} eq 'menu_entry' | ||
1789 | 1773 | and $key eq 'menu_entry_node')) { | ||
1790 | 1774 | foreach my $type_key (keys(%{$current->{'extra'}->{$key}})) { | ||
1791 | 1775 | if (!ref($current->{'extra'}->{$key}->{$type_key})) { | ||
1792 | 1776 | $new->{'extra'}->{$key}->{$type_key} | ||
1793 | 1777 | = $current->{'extra'}->{$key}->{$type_key}; | ||
1794 | 1778 | } elsif ($reference_associations->{$current->{'extra'}->{$key}->{$type_key}}) { | ||
1795 | 1779 | $new->{'extra'}->{$key}->{$type_key} | ||
1796 | 1780 | = $reference_associations->{$current->{'extra'}->{$key}->{$type_key}}; | ||
1797 | 1781 | } elsif (ref($current->{'extra'}->{$key}->{$type_key}) eq 'ARRAY') { | ||
1798 | 1782 | $new->{'extra'}->{$key}->{$type_key} | ||
1799 | 1783 | = _substitute_references_in_array( | ||
1800 | 1784 | $current->{'extra'}->{$key}->{$type_key}, | ||
1801 | 1785 | $reference_associations, | ||
1802 | 1786 | "[$command_or_type]{$key}{$type_key}"); | ||
1803 | 1787 | } else { | ||
1804 | 1788 | print STDERR "Not substituting [$command_or_type]{$key}: $type_key\n"; | ||
1805 | 1789 | } | ||
1806 | 1790 | } | ||
1807 | 1791 | } else { | ||
1808 | 1792 | print STDERR "Not substituting [$command_or_type]: $key ($current->{'extra'}->{$key})\n"; | ||
1809 | 1793 | } | ||
1810 | 1794 | } | ||
1811 | 1795 | } | ||
1812 | 1796 | } | ||
1813 | 1797 | } | ||
1814 | 1798 | } | ||
1815 | 1799 | } | ||
1816 | 1800 | |||
1817 | 1801 | sub copy_tree($;$) | ||
1818 | 1802 | { | ||
1819 | 1803 | my $current = shift; | ||
1820 | 1804 | my $parent = shift; | ||
1821 | 1805 | my $reference_associations = {}; | ||
1822 | 1806 | my $copy = _copy_tree($current, $parent, $reference_associations); | ||
1823 | 1807 | substitute_references($current, $copy, $reference_associations); | ||
1824 | 1808 | return $copy; | ||
1825 | 1809 | } | ||
1826 | 1810 | |||
1827 | 1811 | sub modify_tree($$$;$); | ||
1828 | 1812 | sub modify_tree($$$;$) | ||
1829 | 1813 | { | ||
1830 | 1814 | my $self = shift; | ||
1831 | 1815 | my $tree = shift; | ||
1832 | 1816 | my $operation = shift; | ||
1833 | 1817 | my $argument = shift; | ||
1834 | 1818 | #print STDERR "modify_tree tree: $tree\n"; | ||
1835 | 1819 | |||
1836 | 1820 | if ($tree->{'args'}) { | ||
1837 | 1821 | my @args = @{$tree->{'args'}}; | ||
1838 | 1822 | for (my $i = 0; $i <= $#args; $i++) { | ||
1839 | 1823 | my @new_args = &$operation($self, 'arg', $args[$i], $argument); | ||
1840 | 1824 | modify_tree($self, $args[$i], $operation, $argument); | ||
1841 | 1825 | # this puts the new args at the place of the old arg using the | ||
1842 | 1826 | # offset from the end of the array | ||
1843 | 1827 | splice (@{$tree->{'args'}}, $i - $#args -1, 1, @new_args); | ||
1844 | 1828 | #foreach my $arg (@new_args) { | ||
1845 | 1829 | # modify_tree($self, $arg, $operation); | ||
1846 | 1830 | #} | ||
1847 | 1831 | } | ||
1848 | 1832 | } | ||
1849 | 1833 | if ($tree->{'contents'}) { | ||
1850 | 1834 | my @contents = @{$tree->{'contents'}}; | ||
1851 | 1835 | for (my $i = 0; $i <= $#contents; $i++) { | ||
1852 | 1836 | my @new_contents = &$operation($self, 'content', $contents[$i], $argument); | ||
1853 | 1837 | modify_tree($self, $contents[$i], $operation, $argument); | ||
1854 | 1838 | # this puts the new contents at the place of the old content using the | ||
1855 | 1839 | # offset from the end of the array | ||
1856 | 1840 | splice (@{$tree->{'contents'}}, $i - $#contents -1, 1, @new_contents); | ||
1857 | 1841 | #foreach my $content (@new_contents) { | ||
1858 | 1842 | # modify_tree($self, $content, $operation); | ||
1859 | 1843 | #} | ||
1860 | 1844 | } | ||
1861 | 1845 | } | ||
1862 | 1846 | return $tree; | ||
1863 | 1847 | } | ||
1864 | 1848 | |||
1865 | 1849 | sub _protect_comma($$$) | ||
1866 | 1850 | { | ||
1867 | 1851 | my $self = shift; | ||
1868 | 1852 | my $type = shift; | ||
1869 | 1853 | my $current = shift; | ||
1870 | 1854 | |||
1871 | 1855 | return _protect_text($current, quotemeta(',')); | ||
1872 | 1856 | } | ||
1873 | 1857 | |||
1874 | 1858 | sub protect_comma_in_tree($) | ||
1875 | 1859 | { | ||
1876 | 1860 | my $tree = shift; | ||
1877 | 1861 | return modify_tree(undef, $tree, \&_protect_comma); | ||
1878 | 1862 | } | ||
1879 | 1863 | |||
1880 | 1864 | sub _new_asis_command_with_text($$;$) | ||
1881 | 1865 | { | ||
1882 | 1866 | my $text = shift; | ||
1883 | 1867 | my $parent = shift; | ||
1884 | 1868 | my $text_type = shift; | ||
1885 | 1869 | my $new_command = {'cmdname' => 'asis', 'parent' => $parent }; | ||
1886 | 1870 | push @{$new_command->{'args'}}, {'type' => 'brace_command_arg', | ||
1887 | 1871 | 'parent' => $new_command}; | ||
1888 | 1872 | push @{$new_command->{'args'}->[0]->{'contents'}}, { | ||
1889 | 1873 | 'text' => $text, | ||
1890 | 1874 | 'parent' => $new_command->{'args'}->[0]}; | ||
1891 | 1875 | if (defined($text_type)) { | ||
1892 | 1876 | $new_command->{'args'}->[0]->{'contents'}->[0]->{'type'} = $text_type; | ||
1893 | 1877 | } | ||
1894 | 1878 | return $new_command; | ||
1895 | 1879 | } | ||
1896 | 1880 | |||
1897 | 1881 | sub _protect_text($$) | ||
1898 | 1882 | { | ||
1899 | 1883 | my $current = shift; | ||
1900 | 1884 | my $to_protect = shift; | ||
1901 | 1885 | |||
1902 | 1886 | #print STDERR "$to_protect: $current "._print_current($current)."\n"; | ||
1903 | 1887 | if (defined($current->{'text'}) and $current->{'text'} =~ /$to_protect/ | ||
1904 | 1888 | and !(defined($current->{'type'}) and $current->{'type'} eq 'raw')) { | ||
1905 | 1889 | my @result = (); | ||
1906 | 1890 | my $remaining_text = $current->{'text'}; | ||
1907 | 1891 | while ($remaining_text) { | ||
1908 | 1892 | if ($remaining_text =~ s/^(.*?)(($to_protect)+)//) { | ||
1909 | 1893 | if ($1 ne '') { | ||
1910 | 1894 | push @result, {'text' => $1, 'parent' => $current->{'parent'}}; | ||
1911 | 1895 | $result[-1]->{'type'} = $current->{'type'} | ||
1912 | 1896 | if defined($current->{'type'}); | ||
1913 | 1897 | } | ||
1914 | 1898 | if ($to_protect eq quotemeta(',')) { | ||
1915 | 1899 | for (my $i = 0; $i < length($2); $i++) { | ||
1916 | 1900 | push @result, {'cmdname' => 'comma', 'parent' => $current->{'parent'}, | ||
1917 | 1901 | 'args' => [{'type' => 'brace_command_arg'}]}; | ||
1918 | 1902 | } | ||
1919 | 1903 | } else { | ||
1920 | 1904 | push @result, _new_asis_command_with_text($2, $current->{'parent'}, | ||
1921 | 1905 | $current->{'type'}); | ||
1922 | 1906 | } | ||
1923 | 1907 | } else { | ||
1924 | 1908 | push @result, {'text' => $remaining_text, 'parent' => $current->{'parent'}}; | ||
1925 | 1909 | $result[-1]->{'type'} = $current->{'type'} | ||
1926 | 1910 | if defined($current->{'type'}); | ||
1927 | 1911 | last; | ||
1928 | 1912 | } | ||
1929 | 1913 | } | ||
1930 | 1914 | #print STDERR "Result: @result\n"; | ||
1931 | 1915 | return @result; | ||
1932 | 1916 | } else { | ||
1933 | 1917 | #print STDERR "No change: $current\n"; | ||
1934 | 1918 | return ($current); | ||
1935 | 1919 | } | ||
1936 | 1920 | } | ||
1937 | 1921 | |||
1938 | 1922 | sub _protect_colon($$$) | ||
1939 | 1923 | { | ||
1940 | 1924 | my $self = shift; | ||
1941 | 1925 | my $type = shift; | ||
1942 | 1926 | my $current = shift; | ||
1943 | 1927 | |||
1944 | 1928 | return _protect_text ($current, quotemeta(':')); | ||
1945 | 1929 | } | ||
1946 | 1930 | |||
1947 | 1931 | sub protect_colon_in_tree($) | ||
1948 | 1932 | { | ||
1949 | 1933 | my $tree = shift; | ||
1950 | 1934 | return modify_tree(undef, $tree, \&_protect_colon); | ||
1951 | 1935 | } | ||
1952 | 1936 | |||
1953 | 1937 | sub _protect_node_after_label($$$) | ||
1954 | 1938 | { | ||
1955 | 1939 | my $self = shift; | ||
1956 | 1940 | my $type = shift; | ||
1957 | 1941 | my $current = shift; | ||
1958 | 1942 | |||
1959 | 1943 | return _protect_text ($current, '['. quotemeta(".\t,") .']'); | ||
1960 | 1944 | } | ||
1961 | 1945 | |||
1962 | 1946 | sub protect_node_after_label_in_tree($) | ||
1963 | 1947 | { | ||
1964 | 1948 | my $tree = shift; | ||
1965 | 1949 | return modify_tree(undef, $tree, \&_protect_node_after_label); | ||
1966 | 1950 | } | ||
1967 | 1951 | |||
1968 | 1952 | sub _is_cpp_line($) | ||
1969 | 1953 | { | ||
1970 | 1954 | my $text = shift; | ||
1971 | 1955 | return 1 if ($text =~ /^\s*#\s*(line)? (\d+)(( "([^"]+)")(\s+\d+)*)?\s*$/); | ||
1972 | 1956 | return 0; | ||
1973 | 1957 | } | ||
1974 | 1958 | |||
1975 | 1959 | sub _protect_hashchar_at_line_beginning($$$) | ||
1976 | 1960 | { | ||
1977 | 1961 | my $self = shift; | ||
1978 | 1962 | my $type = shift; | ||
1979 | 1963 | my $current = shift; | ||
1980 | 1964 | |||
1981 | 1965 | #print STDERR "$type $current "._print_current($current)."\n"; | ||
1982 | 1966 | # if the next is a hash character at line beginning, mark it | ||
1983 | 1967 | if (defined($current->{'text'}) and $current->{'text'} =~ /\n$/ | ||
1984 | 1968 | and $current->{'parent'} and $current->{'parent'}->{'contents'}) { | ||
1985 | 1969 | my $parent = $current->{'parent'}; | ||
1986 | 1970 | #print STDERR "End of line in $current, parent $parent: (@{$parent->{'contents'}})\n"; | ||
1987 | 1971 | my $current_found = 0; | ||
1988 | 1972 | foreach my $content (@{$parent->{'contents'}}) { | ||
1989 | 1973 | if ($current_found) { | ||
1990 | 1974 | #print STDERR "after $current: $content $content->{'text'}\n"; | ||
1991 | 1975 | if ($content->{'text'} and _is_cpp_line($content->{'text'})) { | ||
1992 | 1976 | $content->{'extra'}->{'_protect_hashchar'} = 1; | ||
1993 | 1977 | } | ||
1994 | 1978 | last; | ||
1995 | 1979 | } elsif ($content eq $current) { | ||
1996 | 1980 | $current_found = 1; | ||
1997 | 1981 | } | ||
1998 | 1982 | } | ||
1999 | 1983 | } | ||
2000 | 1984 | |||
2001 | 1985 | my $protect_hash = 0; | ||
2002 | 1986 | # if marked, or first and a cpp_line protect a leading hash character | ||
2003 | 1987 | if ($current->{'extra'} and $current->{'extra'}->{'_protect_hashchar'}) { | ||
2004 | 1988 | delete $current->{'extra'}->{'_protect_hashchar'}; | ||
2005 | 1989 | if (!scalar(keys(%{$current->{'extra'}}))) { | ||
2006 | 1990 | delete $current->{'extra'}; | ||
2007 | 1991 | } | ||
2008 | 1992 | $protect_hash = 1; | ||
2009 | 1993 | } elsif ($current->{'parent'} and $current->{'parent'}->{'contents'} | ||
2010 | 1994 | and $current->{'parent'}->{'contents'}->[0] | ||
2011 | 1995 | and $current->{'parent'}->{'contents'}->[0] eq $current | ||
2012 | 1996 | and $current->{'text'} | ||
2013 | 1997 | and _is_cpp_line($current->{'text'})) { | ||
2014 | 1998 | $protect_hash = 1; | ||
2015 | 1999 | } | ||
2016 | 2000 | if ($protect_hash) { | ||
2017 | 2001 | my @result = (); | ||
2018 | 2002 | if ($current->{'type'} and $current->{'type'} eq 'raw') { | ||
2019 | 2003 | if ($self) { | ||
2020 | 2004 | my $parent = $current->{'parent'}; | ||
2021 | 2005 | while ($parent) { | ||
2022 | 2006 | if ($parent->{'cmdname'} and $parent->{'line_nr'}) { | ||
2023 | 2007 | $self->line_warn(sprintf($self->__( | ||
2024 | 2008 | "could not protect hash character in \@%s"), | ||
2025 | 2009 | $parent->{'cmdname'}), $parent->{'line_nr'}); | ||
2026 | 2010 | last; | ||
2027 | 2011 | } | ||
2028 | 2012 | $parent = $parent->{'parent'}; | ||
2029 | 2013 | } | ||
2030 | 2014 | } | ||
2031 | 2015 | } else { | ||
2032 | 2016 | $current->{'text'} =~ s/^(\s*)#//; | ||
2033 | 2017 | if ($1 ne '') { | ||
2034 | 2018 | push @result, {'text' => $1, 'parent' => $current->{'parent'}}; | ||
2035 | 2019 | } | ||
2036 | 2020 | push @result, {'cmdname' => 'hashchar', 'parent' => $current->{'parent'}, | ||
2037 | 2021 | 'args' => [{'type' => 'brace_command_arg'}]}; | ||
2038 | 2022 | } | ||
2039 | 2023 | push @result, $current; | ||
2040 | 2024 | return @result; | ||
2041 | 2025 | } else { | ||
2042 | 2026 | return ($current); | ||
2043 | 2027 | } | ||
2044 | 2028 | } | ||
2045 | 2029 | |||
2046 | 2030 | sub protect_hashchar_at_line_beginning($$) | ||
2047 | 2031 | { | ||
2048 | 2032 | my $self = shift; | ||
2049 | 2033 | my $tree = shift; | ||
2050 | 2034 | return modify_tree($self, $tree, \&_protect_hashchar_at_line_beginning); | ||
2051 | 2035 | } | ||
2052 | 2036 | |||
2053 | 2037 | sub protect_first_parenthesis($) | ||
2054 | 2038 | { | ||
2055 | 2039 | my $contents = shift; | ||
2056 | 2040 | return undef if (!defined ($contents)); | ||
2057 | 2041 | my @contents = @$contents; | ||
2058 | 2042 | my $brace; | ||
2059 | 2043 | if ($contents[0] and $contents->[0]{'text'} and $contents[0]->{'text'} =~ /^\(/) { | ||
2060 | 2044 | if ($contents[0]->{'text'} !~ /^\($/) { | ||
2061 | 2045 | $brace = shift @contents; | ||
2062 | 2046 | my $brace_text = $brace->{'text'}; | ||
2063 | 2047 | $brace_text =~ s/^\(//; | ||
2064 | 2048 | unshift @contents, { 'text' => $brace_text, 'type' => $brace->{'type'}, | ||
2065 | 2049 | 'parent' => $brace->{'parent'} } if $brace_text ne ''; | ||
2066 | 2050 | } else { | ||
2067 | 2051 | $brace = shift @contents; | ||
2068 | 2052 | } | ||
2069 | 2053 | unshift @contents, _new_asis_command_with_text('(', $brace->{'parent'}, | ||
2070 | 2054 | $brace->{'type'}); | ||
2071 | 2055 | } | ||
2072 | 2056 | return \@contents; | ||
2073 | 2057 | } | ||
2074 | 2058 | |||
2075 | 2059 | sub find_parent_root_command($$) | ||
2076 | 2060 | { | ||
2077 | 2061 | my $parser = shift; | ||
2078 | 2062 | my $current = shift; | ||
2079 | 2063 | |||
2080 | 2064 | my $root_command; | ||
2081 | 2065 | while (1) { | ||
2082 | 2066 | if ($current->{'cmdname'}) { | ||
2083 | 2067 | if ($root_commands{$current->{'cmdname'}}) { | ||
2084 | 2068 | return $current; | ||
2085 | 2069 | } elsif ($region_commands{$current->{'cmdname'}}) { | ||
2086 | 2070 | if ($current->{'cmdname'} eq 'copying' and $parser | ||
2087 | 2071 | and $parser->{'extra'} and $parser->{'extra'}->{'insertcopying'}) { | ||
2088 | 2072 | foreach my $insertcopying(@{$parser->{'extra'}->{'insertcopying'}}) { | ||
2089 | 2073 | my $root_command | ||
2090 | 2074 | = $parser->find_parent_root_command($insertcopying); | ||
2091 | 2075 | return $root_command if (defined($root_command)); | ||
2092 | 2076 | } | ||
2093 | 2077 | } else { | ||
2094 | 2078 | return undef; | ||
2095 | 2079 | } | ||
2096 | 2080 | } | ||
2097 | 2081 | } | ||
2098 | 2082 | if ($current->{'parent'}) { | ||
2099 | 2083 | $current = $current->{'parent'}; | ||
2100 | 2084 | } else { | ||
2101 | 2085 | return undef; | ||
2102 | 2086 | } | ||
2103 | 2087 | } | ||
2104 | 2088 | # Should never get there | ||
2105 | 2089 | return undef; | ||
2106 | 2090 | } | ||
2107 | 2091 | |||
2108 | 2092 | # for debugging | ||
2109 | 2093 | sub _print_current($) | ||
2110 | 2094 | { | ||
2111 | 2095 | my $current = shift; | ||
2112 | 2096 | if (ref($current) ne 'HASH') { | ||
2113 | 2097 | return "_print_current: $current not a hash\n"; | ||
2114 | 2098 | } | ||
2115 | 2099 | my $type = ''; | ||
2116 | 2100 | my $cmd = ''; | ||
2117 | 2101 | my $parent_string = ''; | ||
2118 | 2102 | my $text = ''; | ||
2119 | 2103 | $type = "($current->{'type'})" if (defined($current->{'type'})); | ||
2120 | 2104 | $cmd = "\@$current->{'cmdname'}" if (defined($current->{'cmdname'})); | ||
2121 | 2105 | $cmd .= "($current->{'level'})" if (defined($current->{'level'})); | ||
2122 | 2106 | $text = "[text: $current->{'text'}]" if (defined($current->{'text'})); | ||
2123 | 2107 | if ($current->{'parent'}) { | ||
2124 | 2108 | my $parent = $current->{'parent'}; | ||
2125 | 2109 | my $parent_cmd = ''; | ||
2126 | 2110 | my $parent_type = ''; | ||
2127 | 2111 | $parent_cmd = "\@$parent->{'cmdname'}" if (defined($parent->{'cmdname'})); | ||
2128 | 2112 | $parent_type = "($parent->{'type'})" if (defined($parent->{'type'})); | ||
2129 | 2113 | $parent_string = " <- $parent_cmd$parent_type\n"; | ||
2130 | 2114 | } | ||
2131 | 2115 | my $args = ''; | ||
2132 | 2116 | my $contents = ''; | ||
2133 | 2117 | $args = "args(".scalar(@{$current->{'args'}}).')' if $current->{'args'}; | ||
2134 | 2118 | $contents = "contents(".scalar(@{$current->{'contents'}}).')' | ||
2135 | 2119 | if $current->{'contents'}; | ||
2136 | 2120 | if ("$cmd$type" ne '') { | ||
2137 | 2121 | return "$cmd$type : $text $args $contents\n$parent_string"; | ||
2138 | 2122 | } else { | ||
2139 | 2123 | return "$text $args $contents\n$parent_string"; | ||
2140 | 2124 | } | ||
2141 | 2125 | } | ||
2142 | 2126 | |||
2143 | 2127 | sub move_index_entries_after_items($) { | ||
2144 | 2128 | # enumerate or itemize | ||
2145 | 2129 | my $current = shift; | ||
2146 | 2130 | |||
2147 | 2131 | return unless ($current->{'contents'}); | ||
2148 | 2132 | |||
2149 | 2133 | my $previous; | ||
2150 | 2134 | foreach my $item (@{$current->{'contents'}}) { | ||
2151 | 2135 | #print STDERR "Before proceeding: $previous $item->{'cmdname'} (@{$previous->{'contents'}})\n" if ($previous and $previous->{'contents'}); | ||
2152 | 2136 | if (defined($previous) and $item->{'cmdname'} | ||
2153 | 2137 | and $item->{'cmdname'} eq 'item' | ||
2154 | 2138 | and $previous->{'contents'} and scalar(@{$previous->{'contents'}})) { | ||
2155 | 2139 | |||
2156 | 2140 | my $previous_ending_container; | ||
2157 | 2141 | if ($previous->{'contents'}->[-1]->{'type'} | ||
2158 | 2142 | and ($previous->{'contents'}->[-1]->{'type'} eq 'paragraph' | ||
2159 | 2143 | or $previous->{'contents'}->[-1]->{'type'} eq 'preformatted')) { | ||
2160 | 2144 | $previous_ending_container = $previous->{'contents'}->[-1]; | ||
2161 | 2145 | } else { | ||
2162 | 2146 | $previous_ending_container = $previous; | ||
2163 | 2147 | } | ||
2164 | 2148 | |||
2165 | 2149 | my @gathered_index_entries; | ||
2166 | 2150 | |||
2167 | 2151 | #print STDERR "Gathering for item $item in previous $previous ($previous_ending_container)\n"; | ||
2168 | 2152 | while ($previous_ending_container->{'contents'}->[-1] | ||
2169 | 2153 | and (($previous_ending_container->{'contents'}->[-1]->{'type'} | ||
2170 | 2154 | and $previous_ending_container->{'contents'}->[-1]->{'type'} eq 'index_entry_command') | ||
2171 | 2155 | or ($previous_ending_container->{'contents'}->[-1]->{'cmdname'} | ||
2172 | 2156 | and ($previous_ending_container->{'contents'}->[-1]->{'cmdname'} eq 'c' | ||
2173 | 2157 | or $previous_ending_container->{'contents'}->[-1]->{'cmdname'} eq 'comment')))) { | ||
2174 | 2158 | unshift @gathered_index_entries, pop @{$previous_ending_container->{'contents'}}; | ||
2175 | 2159 | } | ||
2176 | 2160 | #print STDERR "Gathered: @gathered_index_entries\n"; | ||
2177 | 2161 | if (scalar(@gathered_index_entries)) { | ||
2178 | 2162 | # put back leading comments | ||
2179 | 2163 | while ($gathered_index_entries[0] | ||
2180 | 2164 | and (!$gathered_index_entries[0]->{'type'} | ||
2181 | 2165 | or $gathered_index_entries[0]->{'type'} ne 'index_entry_command')) { | ||
2182 | 2166 | #print STDERR "Putting back $gathered_index_entries[0] $gathered_index_entries[0]->{'cmdname'}\n"; | ||
2183 | 2167 | push @{$previous_ending_container->{'contents'}}, | ||
2184 | 2168 | shift @gathered_index_entries; | ||
2185 | 2169 | } | ||
2186 | 2170 | |||
2187 | 2171 | # We have the index entries of the previous @item or before item. | ||
2188 | 2172 | # Now put them right after the current @item command. | ||
2189 | 2173 | if (scalar(@gathered_index_entries)) { | ||
2190 | 2174 | my $item_container; | ||
2191 | 2175 | if ($item->{'contents'} and $item->{'contents'}->[0] | ||
2192 | 2176 | and $item->{'contents'}->[0]->{'type'} | ||
2193 | 2177 | and $item->{'contents'}->[0]->{'type'} eq 'preformatted') { | ||
2194 | 2178 | $item_container = $item->{'contents'}->[0]; | ||
2195 | 2179 | } else { | ||
2196 | 2180 | $item_container = $item; | ||
2197 | 2181 | } | ||
2198 | 2182 | foreach my $entry(@gathered_index_entries) { | ||
2199 | 2183 | $entry->{'parent'} = $item_container; | ||
2200 | 2184 | } | ||
2201 | 2185 | if ($item_container->{'contents'} | ||
2202 | 2186 | and $item_container->{'contents'}->[0] | ||
2203 | 2187 | and $item_container->{'contents'}->[0]->{'type'}) { | ||
2204 | 2188 | if ($item_container->{'contents'}->[0]->{'type'} eq 'empty_line_after_command') { | ||
2205 | 2189 | |||
2206 | 2190 | unshift @gathered_index_entries, shift @{$item_container->{'contents'}}; | ||
2207 | 2191 | } elsif ($item_container->{'contents'}->[0]->{'type'} eq 'empty_spaces_after_command') { | ||
2208 | 2192 | unshift @gathered_index_entries, shift @{$item_container->{'contents'}}; | ||
2209 | 2193 | $gathered_index_entries[0]->{'type'} = 'empty_line_after_command'; | ||
2210 | 2194 | $gathered_index_entries[0]->{'text'} .= "\n"; | ||
2211 | 2195 | } | ||
2212 | 2196 | } | ||
2213 | 2197 | unshift @{$item_container->{'contents'}}, @gathered_index_entries; | ||
2214 | 2198 | } | ||
2215 | 2199 | } | ||
2216 | 2200 | } | ||
2217 | 2201 | $previous = $item; | ||
2218 | 2202 | } | ||
2219 | 2203 | } | ||
2220 | 2204 | |||
2221 | 2205 | sub _move_index_entries_after_items($$$) | ||
2222 | 2206 | { | ||
2223 | 2207 | my $self = shift; | ||
2224 | 2208 | my $type = shift; | ||
2225 | 2209 | my $current = shift; | ||
2226 | 2210 | |||
2227 | 2211 | if ($current->{'cmdname'} and ($current->{'cmdname'} eq 'enumerate' | ||
2228 | 2212 | or $current->{'cmdname'} eq 'itemize')) { | ||
2229 | 2213 | move_index_entries_after_items($current); | ||
2230 | 2214 | } | ||
2231 | 2215 | return ($current); | ||
2232 | 2216 | } | ||
2233 | 2217 | |||
2234 | 2218 | sub move_index_entries_after_items_in_tree($) | ||
2235 | 2219 | { | ||
2236 | 2220 | my $tree = shift; | ||
2237 | 2221 | return modify_tree(undef, $tree, \&_move_index_entries_after_items); | ||
2238 | 2222 | } | ||
2239 | 2223 | |||
2240 | 2224 | 1; | ||
2241 | 2225 | |||
2242 | 2226 | __END__ | ||
2243 | 2227 | |||
2244 | 2228 | =head1 NAME | ||
2245 | 2229 | |||
2246 | 2230 | Texinfo::Common - Classification of commands and miscellaneous methods | ||
2247 | 2231 | |||
2248 | 2232 | =head1 SYNOPSIS | ||
2249 | 2233 | |||
2250 | 2234 | use Texinfo::Common qw(expand_today expand_verbatiminclude); | ||
2251 | 2235 | if ($Texinfo::Common::accent_commands{$a_command}) { | ||
2252 | 2236 | print STDERR "$a_command is an accent command\n"; | ||
2253 | 2237 | } | ||
2254 | 2238 | |||
2255 | 2239 | my $today_tree = expand_today($converter); | ||
2256 | 2240 | my $verbatiminclude_tree | ||
2257 | 2241 | = expand_verbatiminclude(undef, $verbatiminclude); | ||
2258 | 2242 | |||
2259 | 2243 | =head1 DESCRIPTION | ||
2260 | 2244 | |||
2261 | 2245 | Texinfo::Common holds interesting hashes classifying Texinfo @-commands, | ||
2262 | 2246 | as well as miscellaneous methods that may be useful for any backend | ||
2263 | 2247 | converting texinfo trees. | ||
2264 | 2248 | |||
2265 | 2249 | It also defines, as our variable a hash for default indices, | ||
2266 | 2250 | named C<%index_names>. The format of this hash is described in | ||
2267 | 2251 | L<Texinfo::Parser/indices_information>. | ||
2268 | 2252 | |||
2269 | 2253 | =head1 COMMAND CLASSES | ||
2270 | 2254 | |||
2271 | 2255 | Hashes are defined as C<our> variables, and are therefore available | ||
2272 | 2256 | outside of the module. | ||
2273 | 2257 | |||
2274 | 2258 | The key of the hashes are @-command names without the @. The | ||
2275 | 2259 | following hashes are available: | ||
2276 | 2260 | |||
2277 | 2261 | =over | ||
2278 | 2262 | |||
2279 | 2263 | =item %all_commands | ||
2280 | 2264 | |||
2281 | 2265 | All the @-commands. | ||
2282 | 2266 | |||
2283 | 2267 | =item %no_brace_commands | ||
2284 | 2268 | |||
2285 | 2269 | Commands without brace with a single character as name, like C<*> | ||
2286 | 2270 | or C<:>. The value is an ascii representation of the command. It | ||
2287 | 2271 | may be an empty string. | ||
2288 | 2272 | |||
2289 | 2273 | =item %misc_commands | ||
2290 | 2274 | |||
2291 | 2275 | Command that do not take braces and are not block commands either, like | ||
2292 | 2276 | C<@node>, C<@chapter>, C<@cindex>, C<@deffnx>, C<@end>, C<@footnotestyle>, | ||
2293 | 2277 | C<@set>, C<@settitle>, C<@indent>, C<@definfoenclose>, C<@comment> and many | ||
2294 | 2278 | others. | ||
2295 | 2279 | |||
2296 | 2280 | =item %default_index_commands | ||
2297 | 2281 | |||
2298 | 2282 | Index entry commands corresponding to default indices. For example | ||
2299 | 2283 | C<@cindex>. | ||
2300 | 2284 | |||
2301 | 2285 | =item %root_commands | ||
2302 | 2286 | |||
2303 | 2287 | Commands that are at the root of a Texinfo document, namely | ||
2304 | 2288 | C<@node> and sectioning commands, except heading commands. | ||
2305 | 2289 | |||
2306 | 2290 | =item %sectioning_commands | ||
2307 | 2291 | |||
2308 | 2292 | All the sectioning and heading commands. | ||
2309 | 2293 | |||
2310 | 2294 | =item %brace_commands | ||
2311 | 2295 | |||
2312 | 2296 | The commands that take braces. The associated value is the maximum | ||
2313 | 2297 | number of arguments. | ||
2314 | 2298 | |||
2315 | 2299 | =item %letter_no_arg_commands | ||
2316 | 2300 | |||
2317 | 2301 | @-commands with braces but no argument corresponding to letters, | ||
2318 | 2302 | like C<@AA{}> or C<@ss{}> or C<@o{}>. | ||
2319 | 2303 | |||
2320 | 2304 | =item %accent_commands | ||
2321 | 2305 | |||
2322 | 2306 | Accent @-commands taking an argument, like C<@'> or C<@ringaccent> | ||
2323 | 2307 | including C<@dotless> and C<@tieaccent>. | ||
2324 | 2308 | |||
2325 | 2309 | =item %style_commands | ||
2326 | 2310 | |||
2327 | 2311 | Commands that mark a fragment of texinfo, like C<@strong>, | ||
2328 | 2312 | C<@cite>, C<@code> or C<@asis>. | ||
2329 | 2313 | |||
2330 | 2314 | =item %code_style_commands | ||
2331 | 2315 | |||
2332 | 2316 | I<style_commands> that have their argument in code style, like | ||
2333 | 2317 | C<@code>. | ||
2334 | 2318 | |||
2335 | 2319 | =item %regular_font_style_commands | ||
2336 | 2320 | |||
2337 | 2321 | I<style_commands> that have their argument in regular font, like | ||
2338 | 2322 | C<@r> or C<@slanted>. | ||
2339 | 2323 | |||
2340 | 2324 | =item %context_brace_commands | ||
2341 | 2325 | |||
2342 | 2326 | @-commands with brace like C<@footnote>, C<@caption> and C<@math> | ||
2343 | 2327 | whose argument is outside of the main text flow in one way or another. | ||
2344 | 2328 | |||
2345 | 2329 | =item %ref_commands | ||
2346 | 2330 | |||
2347 | 2331 | Cross reference @-command referencing nodes, like C<@xref>. | ||
2348 | 2332 | |||
2349 | 2333 | =item %explained_commands | ||
2350 | 2334 | |||
2351 | 2335 | @-commands whose second argument explain first argument and further | ||
2352 | 2336 | @-command call without first argument, as C<@abbr> and C<@acronym>. | ||
2353 | 2337 | |||
2354 | 2338 | =item %block commands | ||
2355 | 2339 | |||
2356 | 2340 | Commands delimiting a block with a closing C<@end>. The value | ||
2357 | 2341 | is I<conditional> for C<@if> commands, I<def> for definition | ||
2358 | 2342 | commands like C<@deffn>, I<raw> for @-commands that have no expansion | ||
2359 | 2343 | of @-commands in their bodies and I<multitable> for C<@multitable>. | ||
2360 | 2344 | Otherwise it is set to the number of arguments separated by commas | ||
2361 | 2345 | that may appear on the @-command line. That means 0 in most cases, | ||
2362 | 2346 | 1 for C<@quotation> and 2 for C<@float>. | ||
2363 | 2347 | |||
2364 | 2348 | =item %raw_commands | ||
2365 | 2349 | |||
2366 | 2350 | @-commands that have no expansion of @-commands in their bodies, | ||
2367 | 2351 | as C<@macro>, C<@verbatim> or C<@ignore>. | ||
2368 | 2352 | |||
2369 | 2353 | =item %format_raw_commands | ||
2370 | 2354 | |||
2371 | 2355 | @-commands associated with raw output format, like C<@html>, or | ||
2372 | 2356 | C<@docbook>. | ||
2373 | 2357 | |||
2374 | 2358 | =item %texinfo_output_formats | ||
2375 | 2359 | |||
2376 | 2360 | Cannonical output formats that have associated conditionals. In | ||
2377 | 2361 | practice C<%format_raw_commands> plus C<info> and C<plaintext>. | ||
2378 | 2362 | |||
2379 | 2363 | =item %def_commands | ||
2380 | 2364 | |||
2381 | 2365 | =item %def_aliases | ||
2382 | 2366 | |||
2383 | 2367 | Definition commands. C<%def_aliases> associates an aliased command | ||
2384 | 2368 | to the original command, for example C<defun> is associated to C<deffn>. | ||
2385 | 2369 | |||
2386 | 2370 | =item %menu_commands | ||
2387 | 2371 | |||
2388 | 2372 | @-commands with menu entries. | ||
2389 | 2373 | |||
2390 | 2374 | =item %align_commands | ||
2391 | 2375 | |||
2392 | 2376 | @-commands related with alignement of text. | ||
2393 | 2377 | |||
2394 | 2378 | =item %region_commands | ||
2395 | 2379 | |||
2396 | 2380 | Block @-commands that enclose full text regions, like C<@titlepage>. | ||
2397 | 2381 | |||
2398 | 2382 | =item %preformatted_commands | ||
2399 | 2383 | |||
2400 | 2384 | =item %preformatted_code_commands | ||
2401 | 2385 | |||
2402 | 2386 | I<%preformatted_commands> is for commands whose content should not | ||
2403 | 2387 | be filled, like C<@example> or C<@display>. If the command is meant | ||
2404 | 2388 | for code, it is also in I<%preformatted_code_commands>, like C<@example>. | ||
2405 | 2389 | |||
2406 | 2390 | =item %item_container_commands | ||
2407 | 2391 | |||
2408 | 2392 | Commands holding C<@item> with C<@item> that contains blocks of text, | ||
2409 | 2393 | like C<@itemize>. | ||
2410 | 2394 | |||
2411 | 2395 | =item %item_line_commands | ||
2412 | 2396 | |||
2413 | 2397 | Commands with C<@item> that have their arguments on their lines, like | ||
2414 | 2398 | C<@ftable>. | ||
2415 | 2399 | |||
2416 | 2400 | =back | ||
2417 | 2401 | |||
2418 | 2402 | =head1 METHODS | ||
2419 | 2403 | |||
2420 | 2404 | No method is exported in the default case. | ||
2421 | 2405 | |||
2422 | 2406 | Most methods takes a I<$converter> as argument, sometime optionally, | ||
2423 | 2407 | to get some information and use methods for error reporting, | ||
2424 | 2408 | see L<Texinfo::Convert::Converter> and L<Texinfo::Report>. | ||
2425 | 2409 | |||
2426 | 2410 | =over | ||
2427 | 2411 | |||
2428 | 2412 | =item $tree = expand_today($converter) | ||
2429 | 2413 | |||
2430 | 2414 | Expand today's date, as a texinfo tree with translations. | ||
2431 | 2415 | |||
2432 | 2416 | =item $tree = expand_verbatiminclude($converter, $verbatiminclude) | ||
2433 | 2417 | |||
2434 | 2418 | The I<$converter> argument may be undef. I<$verbatiminclude> is a | ||
2435 | 2419 | C<@verbatiminclude> tree element. This function returns a | ||
2436 | 2420 | C<@verbatim> tree elements after finding the included file and | ||
2437 | 2421 | reading it. | ||
2438 | 2422 | |||
2439 | 2423 | =item $tree = definition_category($converter, $def_line) | ||
2440 | 2424 | |||
2441 | 2425 | The I<$converter> argument may be undef. I<$def_line> is a | ||
2442 | 2426 | C<def_line> texinfo tree container. This function | ||
2443 | 2427 | returns a texinfo tree corresponding to the category of the | ||
2444 | 2428 | I<$def_line> taking the class into account, if there is one. | ||
2445 | 2429 | |||
2446 | 2430 | =item $result = numbered_heading ($converter, $heading_element, $heading_text, $do_number) | ||
2447 | 2431 | |||
2448 | 2432 | The I<$converter> argument may be undef. I<$heading_element> is | ||
2449 | 2433 | a heading command tree element. I<$heading_text> is the already | ||
2450 | 2434 | formatted heading text. if the I<$do_number> optional argument is | ||
2451 | 2435 | defined and false, no number is used and the text is returned as is. | ||
2452 | 2436 | This function returns the heading with a number and the appendix | ||
2453 | 2437 | part if needed. | ||
2454 | 2438 | |||
2455 | 2439 | =item ($caption, $prepended) = float_name_caption ($converter, $float) | ||
2456 | 2440 | |||
2457 | 2441 | I<$float> is a texinfo tree C<@float> element. This function | ||
2458 | 2442 | returns the caption that should be used for the float formatting | ||
2459 | 2443 | and the I<$prepended> texinfo tree combining the type and label | ||
2460 | 2444 | of the float. | ||
2461 | 2445 | |||
2462 | 2446 | =item $text = enumerate_item_representation($specification, $number) | ||
2463 | 2447 | |||
2464 | 2448 | This function returns the number or letter correponding to item | ||
2465 | 2449 | number I<$number> for an C<@enumerate> specification I<$specification>, | ||
2466 | 2450 | appearing on an C<@enumerate> line. For example | ||
2467 | 2451 | |||
2468 | 2452 | enumerate_item_representation('c', 3) | ||
2469 | 2453 | |||
2470 | 2454 | is C<e>. | ||
2471 | 2455 | |||
2472 | 2456 | =item trim_spaces_comment_from_content($contents) | ||
2473 | 2457 | |||
2474 | 2458 | Remove empty spaces after commands or braces at begin and | ||
2475 | 2459 | spaces and comments at end from a content array, modifying it. | ||
2476 | 2460 | |||
2477 | 2461 | =item $normalized_name = normalize_top_node_name ($node_string) | ||
2478 | 2462 | |||
2479 | 2463 | Normalize the node name string given in argument, by normalizing | ||
2480 | 2464 | Top node case. | ||
2481 | 2465 | |||
2482 | 2466 | =item protect_comma_in_tree($tree) | ||
2483 | 2467 | |||
2484 | 2468 | Protect comma characters, replacing C<,> with @comma{} in tree. | ||
2485 | 2469 | |||
2486 | 2470 | =item protect_colon_in_tree($tree) | ||
2487 | 2471 | |||
2488 | 2472 | =item protect_node_after_label_in_tree($tree) | ||
2489 | 2473 | |||
2490 | 2474 | Protect colon with C<protect_colon_in_tree> and characters that | ||
2491 | 2475 | are special in node names after a label in menu entries (tab | ||
2492 | 2476 | dot and comma) with C<protect_node_after_label_in_tree>. | ||
2493 | 2477 | The protection is achieved by putting protected characters | ||
2494 | 2478 | in C<@asis{}>. | ||
2495 | 2479 | |||
2496 | 2480 | =item $contents_result = protect_first_parenthesis ($contents) | ||
2497 | 2481 | |||
2498 | 2482 | Return a contents array reference with first parenthesis in the | ||
2499 | 2483 | contents array reference protected. | ||
2500 | 2484 | |||
2501 | 2485 | =item protect_hashchar_at_line_beginning($parser, $tree) | ||
2502 | 2486 | |||
2503 | 2487 | Protect hash character at beginning of line if the line is a cpp | ||
2504 | 2488 | line directive. The I<$parser> argument maybe undef, if it is | ||
2505 | 2489 | defined it is used for error reporting in case an hash character | ||
2506 | 2490 | could not be protected because it appeared in a raw environment. | ||
2507 | 2491 | |||
2508 | 2492 | =item move_index_entries_after_items_in_tree($tree) | ||
2509 | 2493 | |||
2510 | 2494 | In C<@enumerate> and C<@itemize> from the tree, move index entries | ||
2511 | 2495 | appearing just before C<@item> after the C<@item>. Comment lines | ||
2512 | 2496 | between index entries are moved too. | ||
2513 | 2497 | |||
2514 | 2498 | =item $command = find_parent_root_command($parser, $tree_element) | ||
2515 | 2499 | |||
2516 | 2500 | Find the parent root command of a tree element (sectioning command or node). | ||
2517 | 2501 | The C<$parser> argument is optional, it is used to continue | ||
2518 | 2502 | through C<@insertcopying> if in a C<@copying>. | ||
2519 | 2503 | |||
2520 | 2504 | =item valid_tree_transformation($name) | ||
2521 | 2505 | |||
2522 | 2506 | Return true if the I<$name> is a known tree transformation name | ||
2523 | 2507 | that may be passed with C<TREE_TRANSFORMATIONS> to modify a texinfo | ||
2524 | 2508 | tree. | ||
2525 | 2509 | |||
2526 | 2510 | =back | ||
2527 | 2511 | |||
2528 | 2512 | =head1 SEE ALSO | ||
2529 | 2513 | |||
2530 | 2514 | L<Texinfo::Parser>, L<Texinfo::Convert::Converter> and L<Texinfo::Report>. | ||
2531 | 2515 | |||
2532 | 2516 | =head1 AUTHOR | ||
2533 | 2517 | |||
2534 | 2518 | Patrice Dumas, E<lt>pertusus@free.frE<gt> | ||
2535 | 2519 | |||
2536 | 2520 | =head1 COPYRIGHT AND LICENSE | ||
2537 | 2521 | |||
2538 | 2522 | Copyright 2010, 2011, 2012 Free Software Foundation, Inc. | ||
2539 | 2523 | |||
2540 | 2524 | This library is free software; you can redistribute it and/or modify | ||
2541 | 2525 | it under the terms of the GNU General Public License as published by | ||
2542 | 2526 | the Free Software Foundation; either version 3 of the License, | ||
2543 | 2527 | or (at your option) any later version. | ||
2544 | 2528 | |||
2545 | 2529 | =cut | ||
2546 | 2530 | |||
2547 | 0 | 2531 | ||
2548 | === added file '.pc/maybe-upstream-fix-itemize-start/tp/Texinfo/Parser.pm' | |||
2549 | --- .pc/maybe-upstream-fix-itemize-start/tp/Texinfo/Parser.pm 1970-01-01 00:00:00 +0000 | |||
2550 | +++ .pc/maybe-upstream-fix-itemize-start/tp/Texinfo/Parser.pm 2013-07-14 15:17:24 +0000 | |||
2551 | @@ -0,0 +1,6996 @@ | |||
2552 | 1 | # Parser.pm: parse texinfo code into a tree. | ||
2553 | 2 | # | ||
2554 | 3 | # Copyright 2010, 2011, 2012 Free Software Foundation, Inc. | ||
2555 | 4 | # | ||
2556 | 5 | # This program is free software; you can redistribute it and/or modify | ||
2557 | 6 | # it under the terms of the GNU General Public License as published by | ||
2558 | 7 | # the Free Software Foundation; either version 3 of the License, | ||
2559 | 8 | # or (at your option) any later version. | ||
2560 | 9 | # | ||
2561 | 10 | # This program is distributed in the hope that it will be useful, | ||
2562 | 11 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
2563 | 12 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
2564 | 13 | # GNU General Public License for more details. | ||
2565 | 14 | # | ||
2566 | 15 | # You should have received a copy of the GNU General Public License | ||
2567 | 16 | # along with this program. If not, see <http://www.gnu.org/licenses/>. | ||
2568 | 17 | # | ||
2569 | 18 | # Original author: Patrice Dumas <pertusus@free.fr> | ||
2570 | 19 | # Parts (also from Patrice Dumas) come from texi2html.pl or texi2html.init. | ||
2571 | 20 | |||
2572 | 21 | # The organization of the file is the following: | ||
2573 | 22 | # module definitions. | ||
2574 | 23 | # default parser state. With explanation of the internal structures. | ||
2575 | 24 | # initializations, determination of command types. | ||
2576 | 25 | # user visible subroutines. | ||
2577 | 26 | # internal subroutines, doing the parsing. | ||
2578 | 27 | |||
2579 | 28 | package Texinfo::Parser; | ||
2580 | 29 | |||
2581 | 30 | # We need the unicode stuff. | ||
2582 | 31 | use 5.006; | ||
2583 | 32 | use strict; | ||
2584 | 33 | |||
2585 | 34 | # debug | ||
2586 | 35 | use Carp qw(cluck); | ||
2587 | 36 | |||
2588 | 37 | use Data::Dumper; | ||
2589 | 38 | |||
2590 | 39 | # to detect if an encoding may be used to open the files | ||
2591 | 40 | use Encode; | ||
2592 | 41 | |||
2593 | 42 | # for fileparse | ||
2594 | 43 | use File::Basename; | ||
2595 | 44 | |||
2596 | 45 | #use POSIX qw(setlocale LC_ALL LC_CTYPE LC_MESSAGES); | ||
2597 | 46 | |||
2598 | 47 | # commands definitions | ||
2599 | 48 | use Texinfo::Common; | ||
2600 | 49 | # Error reporting and counting, translation of strings. | ||
2601 | 50 | use Texinfo::Report; | ||
2602 | 51 | # encoding_alias | ||
2603 | 52 | use Texinfo::Encoding; | ||
2604 | 53 | |||
2605 | 54 | # to expand file names in @include and similar @-commands | ||
2606 | 55 | use Texinfo::Convert::Text; | ||
2607 | 56 | # to normalize node name, anchor, float arg, listoffloats and first *ref argument. | ||
2608 | 57 | use Texinfo::Convert::NodeNameNormalization; | ||
2609 | 58 | # in error messages, and for macro body expansion | ||
2610 | 59 | use Texinfo::Convert::Texinfo; | ||
2611 | 60 | |||
2612 | 61 | require Exporter; | ||
2613 | 62 | use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); | ||
2614 | 63 | @ISA = qw(Exporter Texinfo::Report); | ||
2615 | 64 | |||
2616 | 65 | # Items to export into callers namespace by default. Note: do not export | ||
2617 | 66 | # names by default without a very good reason. Use EXPORT_OK instead. | ||
2618 | 67 | # Do not simply export all your public functions/methods/constants. | ||
2619 | 68 | |||
2620 | 69 | # This allows declaration use Texinfo::Parser ':all'; | ||
2621 | 70 | # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK | ||
2622 | 71 | # will save memory. | ||
2623 | 72 | %EXPORT_TAGS = ( 'all' => [ qw( | ||
2624 | 73 | parser | ||
2625 | 74 | parse_texi_text | ||
2626 | 75 | parse_texi_line | ||
2627 | 76 | parse_texi_file | ||
2628 | 77 | indices_information | ||
2629 | 78 | floats_information | ||
2630 | 79 | internal_references_information | ||
2631 | 80 | labels_information | ||
2632 | 81 | global_commands_information | ||
2633 | 82 | global_informations | ||
2634 | 83 | ) ] ); | ||
2635 | 84 | |||
2636 | 85 | @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); | ||
2637 | 86 | |||
2638 | 87 | @EXPORT = qw( | ||
2639 | 88 | ); | ||
2640 | 89 | |||
2641 | 90 | $VERSION = '5.0'; | ||
2642 | 91 | |||
2643 | 92 | sub N__($) | ||
2644 | 93 | { | ||
2645 | 94 | return $_[0]; | ||
2646 | 95 | } | ||
2647 | 96 | |||
2648 | 97 | #sub __($$) | ||
2649 | 98 | #{ | ||
2650 | 99 | # my $self = shift; | ||
2651 | 100 | # return &{$self->{'gettext'}}(@_); | ||
2652 | 101 | #} | ||
2653 | 102 | |||
2654 | 103 | # Customization variables obeyed by the Parser, and the default values. | ||
2655 | 104 | our %default_customization_values = ( | ||
2656 | 105 | 'TEST' => 0, | ||
2657 | 106 | 'DEBUG' => 0, # if >= 10, tree is printed in texi2any.pl after parsing. | ||
2658 | 107 | # If >= 100 tree is printed every line. | ||
2659 | 108 | 'SHOW_MENU' => 1, # if false no menu error related. | ||
2660 | 109 | 'INLINE_INSERTCOPYING' => 0, | ||
2661 | 110 | 'IGNORE_BEFORE_SETFILENAME' => 1, | ||
2662 | 111 | 'MACRO_BODY_IGNORES_LEADING_SPACE' => 0, | ||
2663 | 112 | 'IGNORE_SPACE_AFTER_BRACED_COMMAND_NAME' => 1, | ||
2664 | 113 | 'INPUT_PERL_ENCODING' => undef, # input perl encoding name, set from | ||
2665 | 114 | # @documentencoding in the default case | ||
2666 | 115 | 'INPUT_ENCODING_NAME' => undef, # encoding name normalized as preferred | ||
2667 | 116 | # IANA, set from @documentencoding in the default | ||
2668 | 117 | # case | ||
2669 | 118 | 'CPP_LINE_DIRECTIVES' => 1, # handle cpp like synchronization lines | ||
2670 | 119 | 'MAX_MACRO_CALL_NESTING' => 100000, # max number of nested macro calls | ||
2671 | 120 | 'GLOBAL_COMMANDS' => [], # list of commands registered | ||
2672 | 121 | # This is not used directly, but passed to Convert::Text through | ||
2673 | 122 | # Texinfo::Common::_convert_text_options | ||
2674 | 123 | 'ENABLE_ENCODING' => 1, # output accented and special characters | ||
2675 | 124 | # based on @documentencoding | ||
2676 | 125 | # following are used in Texinfo::Structuring | ||
2677 | 126 | 'TOP_NODE_UP' => '(dir)', # up node of Top node | ||
2678 | 127 | 'SIMPLE_MENU' => 0, # not used in the parser but in structuring | ||
2679 | 128 | 'USE_UP_NODE_FOR_ELEMENT_UP' => 0, # Use node up for Up if there is no | ||
2680 | 129 | # section up. | ||
2681 | 130 | ); | ||
2682 | 131 | |||
2683 | 132 | my %parser_default_configuration = (%Texinfo::Common::default_parser_state_configuration, | ||
2684 | 133 | %default_customization_values); | ||
2685 | 134 | |||
2686 | 135 | # the other possible keys for the parser state are: | ||
2687 | 136 | # | ||
2688 | 137 | # expanded_formats_hash each key comes from expanded_formats value is 1 | ||
2689 | 138 | # index_names a structure holding the link between index | ||
2690 | 139 | # names, prefixes, merged indices, | ||
2691 | 140 | # initial value is %index_names in Texinfo::Common. | ||
2692 | 141 | # context_stack stack of the contexts, more recent on top. | ||
2693 | 142 | # 'line' is added when on a line or | ||
2694 | 143 | # block @-command line, | ||
2695 | 144 | # 'def' is added instead if on a definition line. | ||
2696 | 145 | # 'preformatted' is added in block commands | ||
2697 | 146 | # where there is no paragraphs and spaces are kept | ||
2698 | 147 | # (format, example, display...) | ||
2699 | 148 | # 'rawpreformatted' is added in raw block commands | ||
2700 | 149 | # (html, xml, docbook...) | ||
2701 | 150 | # 'menu' is added in menu commands | ||
2702 | 151 | # 'math', 'footnote', 'caption', 'shortcaption', | ||
2703 | 152 | # 'inlineraw' are also added when in those commands | ||
2704 | 153 | # conditionals_stack a stack of conditional commands that are expanded. | ||
2705 | 154 | # raw_formats_stack a stack of 1 or 0 for raw formats (@html... or | ||
2706 | 155 | # @inlineraw), is 0 if within a raw format that is | ||
2707 | 156 | # not expanded. | ||
2708 | 157 | # macro_stack stack of macros being expanded (more recent first) | ||
2709 | 158 | # definfoenclose an hash, key is the command name, value is an array | ||
2710 | 159 | # reference with 2 values, beginning and ending. | ||
2711 | 160 | # input a stack, with last at bottom. Holds the opened files | ||
2712 | 161 | # or text. Pending macro expansion or text expansion | ||
2713 | 162 | # is also in that structure. | ||
2714 | 163 | # misc_commands the same than %misc_commands in Texinfo::Common, | ||
2715 | 164 | # but with index entry commands dynamically added | ||
2716 | 165 | # close_paragraph_commands same than %close_paragraph_commands, but with | ||
2717 | 166 | # insertcopying removed if INLINE_INSERTCOPYING | ||
2718 | 167 | # close_preformatted_commands same than %close_preformatted_commands, but with | ||
2719 | 168 | # insertcopying removed if INLINE_INSERTCOPYING | ||
2720 | 169 | # no_paragraph_commands the same than %default_no_paragraph_commands | ||
2721 | 170 | # below, with index | ||
2722 | 171 | # entry commands dynamically added | ||
2723 | 172 | # simple_text_commands the same than %simple_text_commands below, but | ||
2724 | 173 | # with index entry commands dynamically added | ||
2725 | 174 | # current_node last seen node. | ||
2726 | 175 | # current_section last seen section. | ||
2727 | 176 | # nodes list of nodes. | ||
2728 | 177 | # command_index_prefix associate a command name to an index prefix. | ||
2729 | 178 | # prefix_to_index_name associate an index prefix to the index name. | ||
2730 | 179 | # floats key is the normalized float type, value is an array | ||
2731 | 180 | # reference holding all the floats. | ||
2732 | 181 | # internal_references an array holding all the internal references. | ||
2733 | 182 | |||
2734 | 183 | # set points to the value set when initializing, for | ||
2735 | 184 | # configuration items that are not to be overriden | ||
2736 | 185 | # by @-commands. For example documentlanguage. | ||
2737 | 186 | |||
2738 | 187 | # A line information is an hash reference with the keys: | ||
2739 | 188 | # line_nr the line number | ||
2740 | 189 | # file_name the file name | ||
2741 | 190 | # macro if in a macro expansion, the name of the macro | ||
2742 | 191 | # | ||
2743 | 192 | # A text fragment information is a 2 element array reference, the first is the | ||
2744 | 193 | # text fragment, the second is the line information. | ||
2745 | 194 | |||
2746 | 195 | # The input structure is an array, the first is the most recently included | ||
2747 | 196 | # file. The last element may be a file if the parsing is done on a file, | ||
2748 | 197 | # with parse_texi_file, or simply pending text, if called as parse_texi_text. | ||
2749 | 198 | # each element of the array is a hash reference. The key are: | ||
2750 | 199 | # pending an array reference containing pending text fragments, either the | ||
2751 | 200 | # text given as parse_texi_text or macro expansion text. | ||
2752 | 201 | # name file name | ||
2753 | 202 | # line_nr current line number in the file | ||
2754 | 203 | # fh filehandle for the file | ||
2755 | 204 | |||
2756 | 205 | # content is not copied but reference is copied when duplicating a parser. | ||
2757 | 206 | my %tree_informations; | ||
2758 | 207 | foreach my $tree_information ('values', 'macros', 'explained_commands', 'labels') { | ||
2759 | 208 | $tree_informations{$tree_information} = 1; | ||
2760 | 209 | } | ||
2761 | 210 | |||
2762 | 211 | # The commands in initialization_overrides are not set in the document if | ||
2763 | 212 | # set at the parser initialization. | ||
2764 | 213 | my %initialization_overrides = ( | ||
2765 | 214 | 'INPUT_ENCODING_NAME' => 1, | ||
2766 | 215 | 'documentlanguage' => 1, | ||
2767 | 216 | ); | ||
2768 | 217 | |||
2769 | 218 | my %no_brace_commands = %Texinfo::Common::no_brace_commands; | ||
2770 | 219 | my %misc_commands = %Texinfo::Common::misc_commands; | ||
2771 | 220 | my %brace_commands = %Texinfo::Common::brace_commands; | ||
2772 | 221 | my %accent_commands = %Texinfo::Common::accent_commands; | ||
2773 | 222 | my %context_brace_commands = %Texinfo::Common::context_brace_commands; | ||
2774 | 223 | my %block_commands = %Texinfo::Common::block_commands; | ||
2775 | 224 | my %block_item_commands = %Texinfo::Common::block_item_commands; | ||
2776 | 225 | my %close_paragraph_commands = %Texinfo::Common::close_paragraph_commands; | ||
2777 | 226 | my %def_map = %Texinfo::Common::def_map; | ||
2778 | 227 | my %def_commands = %Texinfo::Common::def_commands; | ||
2779 | 228 | my %def_aliases = %Texinfo::Common::def_aliases; | ||
2780 | 229 | my %menu_commands = %Texinfo::Common::menu_commands; | ||
2781 | 230 | my %preformatted_commands = %Texinfo::Common::preformatted_commands; | ||
2782 | 231 | my %format_raw_commands = %Texinfo::Common::format_raw_commands; | ||
2783 | 232 | my %item_container_commands = %Texinfo::Common::item_container_commands; | ||
2784 | 233 | my %item_line_commands = %Texinfo::Common::item_line_commands; | ||
2785 | 234 | my %deprecated_commands = %Texinfo::Common::deprecated_commands; | ||
2786 | 235 | my %root_commands = %Texinfo::Common::root_commands; | ||
2787 | 236 | my %sectioning_commands = %Texinfo::Common::sectioning_commands; | ||
2788 | 237 | my %command_index_prefix = %Texinfo::Common::command_index_prefix; | ||
2789 | 238 | my %command_structuring_level = %Texinfo::Common::command_structuring_level; | ||
2790 | 239 | my %ref_commands = %Texinfo::Common::ref_commands; | ||
2791 | 240 | my %region_commands = %Texinfo::Common::region_commands; | ||
2792 | 241 | my %code_style_commands = %Texinfo::Common::code_style_commands; | ||
2793 | 242 | my %in_heading_commands = %Texinfo::Common::in_heading_commands; | ||
2794 | 243 | my %explained_commands = %Texinfo::Common::explained_commands; | ||
2795 | 244 | my %inline_format_commands = %Texinfo::Common::inline_format_commands; | ||
2796 | 245 | my %all_commands = %Texinfo::Common::all_commands; | ||
2797 | 246 | |||
2798 | 247 | # equivalence between a @set flag and an @@-command | ||
2799 | 248 | my %set_flag_command_equivalent = ( | ||
2800 | 249 | 'txicodequoteundirected' => 'codequoteundirected', | ||
2801 | 250 | 'txicodequotebacktick' => 'codequotebacktick', | ||
2802 | 251 | # 'txideftypefnnl' => 'deftypefnnewline', | ||
2803 | 252 | ); | ||
2804 | 253 | |||
2805 | 254 | |||
2806 | 255 | # keep line information for those commands. | ||
2807 | 256 | my %keep_line_nr_brace_commands = %context_brace_commands; | ||
2808 | 257 | foreach my $keep_line_nr_brace_command ('titlefont', 'anchor') { | ||
2809 | 258 | $keep_line_nr_brace_commands{$keep_line_nr_brace_command} = 1; | ||
2810 | 259 | } | ||
2811 | 260 | foreach my $brace_command (keys (%brace_commands)) { | ||
2812 | 261 | $keep_line_nr_brace_commands{$brace_command} = 1 | ||
2813 | 262 | if ($brace_commands{$brace_command} > 1); | ||
2814 | 263 | } | ||
2815 | 264 | |||
2816 | 265 | my %type_with_paragraph; | ||
2817 | 266 | foreach my $type ('before_item', 'text_root', 'document_root', | ||
2818 | 267 | 'brace_command_context') { | ||
2819 | 268 | $type_with_paragraph{$type} = 1; | ||
2820 | 269 | } | ||
2821 | 270 | |||
2822 | 271 | my %command_ignore_space_after; | ||
2823 | 272 | foreach my $command ('anchor', 'hyphenation', 'caption', 'shortcaption') { | ||
2824 | 273 | $command_ignore_space_after{$command} = 1; | ||
2825 | 274 | } | ||
2826 | 275 | |||
2827 | 276 | my %global_multiple_commands; | ||
2828 | 277 | foreach my $global_multiple_command ( | ||
2829 | 278 | 'author', 'footnote', 'hyphenation', 'insertcopying', 'printindex', | ||
2830 | 279 | 'subtitle','titlefont', 'listoffloats', 'detailmenu', | ||
2831 | 280 | keys(%Texinfo::Common::document_settable_at_commands), ) { | ||
2832 | 281 | $global_multiple_commands{$global_multiple_command} = 1; | ||
2833 | 282 | } | ||
2834 | 283 | |||
2835 | 284 | my %global_unique_commands; | ||
2836 | 285 | foreach my $global_unique_command ( | ||
2837 | 286 | 'copying', 'settitle', | ||
2838 | 287 | 'shorttitlepage', 'title', 'titlepage', 'top', | ||
2839 | 288 | keys(%Texinfo::Common::document_settable_unique_at_commands), ) { | ||
2840 | 289 | $global_unique_commands{$global_unique_command} = 1; | ||
2841 | 290 | } | ||
2842 | 291 | |||
2843 | 292 | my %index_names = %Texinfo::Common::index_names; | ||
2844 | 293 | |||
2845 | 294 | # index names that cannot be set by the user. | ||
2846 | 295 | my %forbidden_index_name = (); | ||
2847 | 296 | |||
2848 | 297 | foreach my $name(keys(%index_names)) { | ||
2849 | 298 | foreach my $prefix (@{$index_names{$name}->{'prefix'}}) { | ||
2850 | 299 | $forbidden_index_name{$prefix} = 1; | ||
2851 | 300 | } | ||
2852 | 301 | } | ||
2853 | 302 | |||
2854 | 303 | foreach my $other_forbidden_index_name ('info','ps','pdf','htm', | ||
2855 | 304 | 'html', 'log','aux','dvi','texi','txi','texinfo','tex','bib') { | ||
2856 | 305 | $forbidden_index_name{$other_forbidden_index_name} = 1; | ||
2857 | 306 | } | ||
2858 | 307 | |||
2859 | 308 | # @-commands that do not start a paragraph | ||
2860 | 309 | my %default_no_paragraph_commands; | ||
2861 | 310 | # @-commands that should be at a line beginning | ||
2862 | 311 | my %begin_line_commands; | ||
2863 | 312 | |||
2864 | 313 | foreach my $command ('node', 'end') { | ||
2865 | 314 | $begin_line_commands{$command} = $command; | ||
2866 | 315 | } | ||
2867 | 316 | |||
2868 | 317 | foreach my $no_paragraph_command ('titlefont', 'caption', 'shortcaption', | ||
2869 | 318 | 'image', '*', 'hyphenation', 'anchor', 'errormsg') { | ||
2870 | 319 | $default_no_paragraph_commands{$no_paragraph_command} = 1; | ||
2871 | 320 | } | ||
2872 | 321 | |||
2873 | 322 | foreach my $no_paragraph_command (keys(%misc_commands)) { | ||
2874 | 323 | $default_no_paragraph_commands{$no_paragraph_command} = 1; | ||
2875 | 324 | $begin_line_commands{$no_paragraph_command} = 1; | ||
2876 | 325 | } | ||
2877 | 326 | |||
2878 | 327 | # verbatiminclude is not said to begin at the beginning of the line | ||
2879 | 328 | # in the manual | ||
2880 | 329 | foreach my $misc_not_begin_line ('comment', 'c', 'sp', 'refill', | ||
2881 | 330 | 'noindent', 'indent', 'columnfractions', | ||
2882 | 331 | 'tab', 'item', 'headitem', 'verbatiminclude', | ||
2883 | 332 | 'set', 'clear', | ||
2884 | 333 | 'vskip', keys(%in_heading_commands)) { | ||
2885 | 334 | delete $begin_line_commands{$misc_not_begin_line}; | ||
2886 | 335 | } | ||
2887 | 336 | |||
2888 | 337 | my %block_arg_commands; | ||
2889 | 338 | foreach my $block_command (keys(%block_commands)) { | ||
2890 | 339 | $begin_line_commands{$block_command} = 1; | ||
2891 | 340 | $default_no_paragraph_commands{$block_command} = 1; | ||
2892 | 341 | $block_arg_commands{$block_command} = 1 | ||
2893 | 342 | if ($block_commands{$block_command} ne 'raw'); | ||
2894 | 343 | # and ! $format_raw_commands{$block_command}); | ||
2895 | 344 | } | ||
2896 | 345 | |||
2897 | 346 | my %close_preformatted_commands = %close_paragraph_commands; | ||
2898 | 347 | foreach my $no_close_preformatted('sp') { | ||
2899 | 348 | delete $close_preformatted_commands{$no_close_preformatted}; | ||
2900 | 349 | } | ||
2901 | 350 | # FIXME to close preformated or not to close? | ||
2902 | 351 | #foreach my $format_raw_command(keys(%format_raw_commands)) { | ||
2903 | 352 | # $close_preformatted_commands{$format_raw_command} = 1; | ||
2904 | 353 | #} | ||
2905 | 354 | |||
2906 | 355 | # commands that may appear in accents | ||
2907 | 356 | my %in_accent_commands = %accent_commands; | ||
2908 | 357 | foreach my $brace_command(keys(%brace_commands)) { | ||
2909 | 358 | $in_accent_commands{$brace_command} = 1 if (!$brace_commands{$brace_command}); | ||
2910 | 359 | } | ||
2911 | 360 | foreach my $no_brace_command (keys(%no_brace_commands)) { | ||
2912 | 361 | $in_accent_commands{$no_brace_command} = 1; | ||
2913 | 362 | } | ||
2914 | 363 | $in_accent_commands{'c'} = 1; | ||
2915 | 364 | $in_accent_commands{'comment'} = 1; | ||
2916 | 365 | |||
2917 | 366 | # commands that may appear in texts arguments | ||
2918 | 367 | my %in_full_text_commands; | ||
2919 | 368 | foreach my $command (keys(%brace_commands), keys(%no_brace_commands)) { | ||
2920 | 369 | $in_full_text_commands{$command} = 1; | ||
2921 | 370 | } | ||
2922 | 371 | foreach my $misc_command_in_full_text('c', 'comment', 'refill', 'noindent', | ||
2923 | 372 | 'indent', 'columnfractions', 'set', 'clear', 'end') { | ||
2924 | 373 | $in_full_text_commands{$misc_command_in_full_text} = 1; | ||
2925 | 374 | } | ||
2926 | 375 | |||
2927 | 376 | foreach my $out_format (keys(%format_raw_commands)) { | ||
2928 | 377 | $in_full_text_commands{$out_format} = 1; | ||
2929 | 378 | } | ||
2930 | 379 | delete $in_full_text_commands{'caption'}; | ||
2931 | 380 | delete $in_full_text_commands{'shortcaption'}; | ||
2932 | 381 | foreach my $block_command (keys(%block_commands)) { | ||
2933 | 382 | $in_full_text_commands{$block_command} = 1 | ||
2934 | 383 | if ($block_commands{$block_command} eq 'conditional'); | ||
2935 | 384 | } | ||
2936 | 385 | |||
2937 | 386 | # commands that may happen on lines where everything is | ||
2938 | 387 | # permitted | ||
2939 | 388 | my %in_full_line_commands = %in_full_text_commands; | ||
2940 | 389 | foreach my $not_in_full_line_commands('noindent', 'indent') { | ||
2941 | 390 | delete $in_full_line_commands{$not_in_full_line_commands}; | ||
2942 | 391 | } | ||
2943 | 392 | |||
2944 | 393 | # commands that may happen on sectioning commands | ||
2945 | 394 | my %in_full_line_commands_no_refs = %in_full_line_commands; | ||
2946 | 395 | foreach my $not_in_full_line_commands_no_refs ('titlefont', | ||
2947 | 396 | 'anchor', 'footnote', 'verb') { | ||
2948 | 397 | delete $in_full_line_commands_no_refs{$not_in_full_line_commands_no_refs}; | ||
2949 | 398 | } | ||
2950 | 399 | |||
2951 | 400 | # commands that may happen in simple text arguments | ||
2952 | 401 | my %in_simple_text_commands = %in_full_line_commands_no_refs; | ||
2953 | 402 | foreach my $not_in_simple_text_command('xref', 'ref', 'pxref', 'inforef') { | ||
2954 | 403 | delete $in_simple_text_commands{$not_in_simple_text_command}; | ||
2955 | 404 | } | ||
2956 | 405 | |||
2957 | 406 | # commands that only accept simple text as argument in any context. | ||
2958 | 407 | my %simple_text_commands; | ||
2959 | 408 | foreach my $misc_command(keys(%misc_commands)) { | ||
2960 | 409 | if ($misc_commands{$misc_command} =~ /^\d+$/ | ||
2961 | 410 | or ($misc_commands{$misc_command} eq 'line' | ||
2962 | 411 | and !($sectioning_commands{$misc_command} | ||
2963 | 412 | or $def_commands{$misc_command})) | ||
2964 | 413 | or $misc_commands{$misc_command} eq 'text') { | ||
2965 | 414 | $simple_text_commands{$misc_command} = 1; | ||
2966 | 415 | } | ||
2967 | 416 | } | ||
2968 | 417 | |||
2969 | 418 | my %full_line_commands_no_refs = (%sectioning_commands, | ||
2970 | 419 | %def_commands); | ||
2971 | 420 | |||
2972 | 421 | delete $simple_text_commands{'center'}; | ||
2973 | 422 | delete $simple_text_commands{'exdent'}; | ||
2974 | 423 | foreach my $command ('titlefont', 'anchor', 'xref','ref','pxref', | ||
2975 | 424 | 'inforef', 'shortcaption', 'math', 'indicateurl', | ||
2976 | 425 | 'email', 'uref', 'url', 'image', 'abbr', 'acronym', | ||
2977 | 426 | 'dmn', 'ctrl', 'errormsg') { | ||
2978 | 427 | $simple_text_commands{$command} = 1; | ||
2979 | 428 | } | ||
2980 | 429 | |||
2981 | 430 | # commands that accept full text, but no block or top-level commands | ||
2982 | 431 | my %full_text_commands; | ||
2983 | 432 | foreach my $brace_command (keys (%brace_commands)) { | ||
2984 | 433 | if ($brace_commands{$brace_command} == 1 | ||
2985 | 434 | and !$simple_text_commands{$brace_command} | ||
2986 | 435 | and !$context_brace_commands{$brace_command} | ||
2987 | 436 | and !$accent_commands{$brace_command}) { | ||
2988 | 437 | $full_text_commands{$brace_command} = 1; | ||
2989 | 438 | } | ||
2990 | 439 | } | ||
2991 | 440 | |||
2992 | 441 | # commands that accept almost the same than in full text, except | ||
2993 | 442 | # what do not make sense on a line. | ||
2994 | 443 | my %full_line_commands; | ||
2995 | 444 | $full_line_commands{'center'} = 1; | ||
2996 | 445 | $full_line_commands{'exdent'} = 1; | ||
2997 | 446 | $full_line_commands{'item'} = 1; | ||
2998 | 447 | $full_line_commands{'itemx'} = 1; | ||
2999 | 448 | |||
3000 | 449 | # Fill the valid nestings hash. All commands not in that hash | ||
3001 | 450 | # are considered to accept anything within. There are additional | ||
3002 | 451 | # context tests, to make sure, for instance that we are testing | ||
3003 | 452 | # @-commands on the block, misc or node @-command line and not | ||
3004 | 453 | # in the content. | ||
3005 | 454 | # index entry commands are dynamically set as in_simple_text_commands | ||
3006 | 455 | my %default_valid_nestings; | ||
3007 | 456 | |||
3008 | 457 | foreach my $command (keys(%accent_commands)) { | ||
3009 | 458 | $default_valid_nestings{$command} = \%in_accent_commands; | ||
3010 | 459 | } | ||
3011 | 460 | foreach my $command (keys(%full_text_commands)) { | ||
3012 | 461 | $default_valid_nestings{$command} = \%in_full_text_commands; | ||
3013 | 462 | } | ||
3014 | 463 | foreach my $command (keys(%simple_text_commands)) { | ||
3015 | 464 | $default_valid_nestings{$command} = \%in_simple_text_commands; | ||
3016 | 465 | } | ||
3017 | 466 | foreach my $command (keys(%full_line_commands)) { | ||
3018 | 467 | $default_valid_nestings{$command} = \%in_full_line_commands; | ||
3019 | 468 | } | ||
3020 | 469 | foreach my $command (keys(%full_line_commands_no_refs)) { | ||
3021 | 470 | $default_valid_nestings{$command} = \%in_full_line_commands_no_refs; | ||
3022 | 471 | } | ||
3023 | 472 | # Only for block commands with line arguments | ||
3024 | 473 | foreach my $command (keys(%block_commands)) { | ||
3025 | 474 | if ($block_commands{$command} and $block_commands{$command} ne 'raw' | ||
3026 | 475 | and $block_commands{$command} ne 'conditional' | ||
3027 | 476 | and !$def_commands{$command}) { | ||
3028 | 477 | $default_valid_nestings{$command} = \%in_simple_text_commands; | ||
3029 | 478 | } | ||
3030 | 479 | } | ||
3031 | 480 | |||
3032 | 481 | |||
3033 | 482 | my @preformatted_contexts = ('preformatted', 'rawpreformatted'); | ||
3034 | 483 | my %preformatted_contexts; | ||
3035 | 484 | foreach my $preformatted_context (@preformatted_contexts) { | ||
3036 | 485 | $preformatted_contexts{$preformatted_context} = 1; | ||
3037 | 486 | } | ||
3038 | 487 | |||
3039 | 488 | # contexts on the context_stack stack where empty line don't trigger | ||
3040 | 489 | # paragraph | ||
3041 | 490 | my %no_paragraph_contexts; | ||
3042 | 491 | foreach my $no_paragraph_context ('math', 'menu', @preformatted_contexts, | ||
3043 | 492 | 'def', 'inlineraw') { | ||
3044 | 493 | $no_paragraph_contexts{$no_paragraph_context} = 1; | ||
3045 | 494 | }; | ||
3046 | 495 | |||
3047 | 496 | |||
3048 | 497 | |||
3049 | 0 | 498 | ||
3050 | 499 | # Format a bug message | ||
3051 | 500 | sub _bug_message($$;$$) | ||
3052 | 501 | { | ||
3053 | 502 | my $self = shift; | ||
3054 | 503 | my $message = shift; | ||
3055 | 504 | my $line_number = shift; | ||
3056 | 505 | my $current = shift; | ||
3057 | 506 | |||
3058 | 507 | my $line_message = ''; | ||
3059 | 508 | if ($line_number) { | ||
3060 | 509 | my $file = $line_number->{'file_name'}; | ||
3061 | 510 | $line_message | ||
3062 | 511 | = "last location: $line_number->{'file_name'}:$line_number->{'line_nr'}"; | ||
3063 | 512 | if ($line_number->{'macro'} ne '') { | ||
3064 | 513 | $line_message .= " (possibly involving $line_number->{'macro'})"; | ||
3065 | 514 | } | ||
3066 | 515 | $line_message .= "\n"; | ||
3067 | 516 | } | ||
3068 | 517 | my $message_context_stack = "context_stack: (@{$self->{'context_stack'}})\n"; | ||
3069 | 518 | my $current_element_message = ''; | ||
3070 | 519 | if ($current) { | ||
3071 | 520 | $current_element_message = "current: ". _print_current($current); | ||
3072 | 521 | } | ||
3073 | 522 | warn "You found a bug: $message\n\n". | ||
3074 | 523 | "Additional informations:\n". | ||
3075 | 524 | $line_message.$message_context_stack.$current_element_message; | ||
3076 | 525 | |||
3077 | 526 | } | ||
3078 | 527 | |||
3079 | 528 | # simple deep copy of a structure | ||
3080 | 529 | sub _deep_copy($) | ||
3081 | 530 | { | ||
3082 | 531 | my $struct = shift; | ||
3083 | 532 | my $string = Data::Dumper->Dump([$struct], ['struct']); | ||
3084 | 533 | eval $string; | ||
3085 | 534 | return $struct; | ||
3086 | 535 | } | ||
3087 | 536 | |||
3088 | 537 | # return true if effect of global commands should be ignored. | ||
3089 | 538 | sub _ignore_global_commands($) | ||
3090 | 539 | { | ||
3091 | 540 | my $self = shift; | ||
3092 | 541 | return !$self->{'raw_formats_stack'}->[-1]; | ||
3093 | 542 | } | ||
3094 | 543 | |||
3095 | 544 | # enter all the commands associated with an index name using the prefix | ||
3096 | 545 | # list | ||
3097 | 546 | sub _register_index_commands($$) | ||
3098 | 547 | { | ||
3099 | 548 | my $self = shift; | ||
3100 | 549 | my $index_name = shift; | ||
3101 | 550 | if (!$self->{'index_names'}->{$index_name}->{'prefix'}) { | ||
3102 | 551 | $self->{'index_names'}->{$index_name}->{'prefix'} = [$index_name]; | ||
3103 | 552 | } | ||
3104 | 553 | if (!exists($self->{'index_names'}->{$index_name}->{'name'})) { | ||
3105 | 554 | $self->{'index_names'}->{$index_name}->{'name'} = $index_name; | ||
3106 | 555 | } | ||
3107 | 556 | if (!exists($self->{'index_names'}->{$index_name}->{'contained_indices'})) { | ||
3108 | 557 | $self->{'index_names'}->{$index_name}->{'contained_indices'}->{$index_name} = 1; | ||
3109 | 558 | } | ||
3110 | 559 | foreach my $prefix (@{$self->{'index_names'}->{$index_name}->{'prefix'}}) { | ||
3111 | 560 | $self->{'misc_commands'}->{$prefix.'index'} = 'line'; | ||
3112 | 561 | $self->{'no_paragraph_commands'}->{$prefix.'index'} = 1; | ||
3113 | 562 | $self->{'valid_nestings'}->{$prefix.'index'} = \%in_simple_text_commands; | ||
3114 | 563 | $self->{'command_index_prefix'}->{$prefix.'index'} = $prefix; | ||
3115 | 564 | $self->{'prefix_to_index_name'}->{$prefix} = $index_name; | ||
3116 | 565 | } | ||
3117 | 566 | } | ||
3118 | 567 | |||
3119 | 568 | # initialization entry point. Set up a parser. | ||
3120 | 569 | # The last argument, optional, is a hash provided by the user to change | ||
3121 | 570 | # the default values for what is present in %parser_default_configuration. | ||
3122 | 571 | # The exact arguments of the function depend on how it was called, | ||
3123 | 572 | # in a object oriented way or not. | ||
3124 | 573 | sub parser(;$$) | ||
3125 | 574 | { | ||
3126 | 575 | my $class = shift; | ||
3127 | 576 | my $conf; | ||
3128 | 577 | |||
3129 | 578 | my $parser = _deep_copy(\%parser_default_configuration); | ||
3130 | 579 | # _deep_copy doesn't handle subs | ||
3131 | 580 | $parser->{'gettext'} = $parser_default_configuration{'gettext'}; | ||
3132 | 581 | $parser->{'pgettext'} = $parser_default_configuration{'pgettext'}; | ||
3133 | 582 | |||
3134 | 583 | # called not object-oriented | ||
3135 | 584 | if (ref($class) eq 'HASH') { | ||
3136 | 585 | #print STDERR "Not oo\n" | ||
3137 | 586 | $conf = $class; | ||
3138 | 587 | bless $parser; | ||
3139 | 588 | |||
3140 | 589 | } elsif (ref($class)) { | ||
3141 | 590 | # called on an existing parser, interpreted as a duplication | ||
3142 | 591 | my $old_parser = $class; | ||
3143 | 592 | $class = ref($class); | ||
3144 | 593 | foreach my $key (keys(%parser_default_configuration)) { | ||
3145 | 594 | if ($tree_informations{$key}) { | ||
3146 | 595 | if (defined($old_parser->{$key})) { | ||
3147 | 596 | foreach my $info_key (keys(%{$old_parser->{$key}})) { | ||
3148 | 597 | $parser->{$key}->{$info_key} | ||
3149 | 598 | = $old_parser->{$key}->{$info_key}; | ||
3150 | 599 | } | ||
3151 | 600 | } | ||
3152 | 601 | } else { | ||
3153 | 602 | $parser->{$key} = _deep_copy($old_parser->{$key}); | ||
3154 | 603 | } | ||
3155 | 604 | } | ||
3156 | 605 | #$parser = _deep_copy($old_parser); | ||
3157 | 606 | $parser->{'gettext'} = $old_parser->{'gettext'}; | ||
3158 | 607 | $parser->{'pgettext'} = $old_parser->{'pgettext'}; | ||
3159 | 608 | bless $parser, $class; | ||
3160 | 609 | $conf = shift; | ||
3161 | 610 | |||
3162 | 611 | } elsif (defined($class)) { | ||
3163 | 612 | bless $parser, $class; | ||
3164 | 613 | $conf = shift; | ||
3165 | 614 | } else { | ||
3166 | 615 | bless $parser; | ||
3167 | 616 | $conf = shift; | ||
3168 | 617 | } | ||
3169 | 618 | |||
3170 | 619 | if (defined($conf)) { | ||
3171 | 620 | foreach my $key (keys(%$conf)) { | ||
3172 | 621 | if (exists($parser_default_configuration{$key})) { | ||
3173 | 622 | if (ref($conf->{$key}) ne 'CODE' and $key ne 'values') { | ||
3174 | 623 | $parser->{$key} = _deep_copy($conf->{$key}); | ||
3175 | 624 | } else { | ||
3176 | 625 | $parser->{$key} = $conf->{$key}; | ||
3177 | 626 | } | ||
3178 | 627 | if ($initialization_overrides{$key}) { | ||
3179 | 628 | $parser->{'set'}->{$key} = $parser->{$key}; | ||
3180 | 629 | } | ||
3181 | 630 | } else { | ||
3182 | 631 | warn "$key not a possible customization in Texinfo::Parser::parser\n"; | ||
3183 | 632 | } | ||
3184 | 633 | } | ||
3185 | 634 | } | ||
3186 | 635 | #foreach my $value (keys %{$parser->{'values'}}) { | ||
3187 | 636 | # print STDERR " -> $value $parser->{'values'}->{$value}\n"; | ||
3188 | 637 | #} | ||
3189 | 638 | # Now initialize command hash that are dynamically modified, notably | ||
3190 | 639 | # those for index commands, and lists, based on defaults and user provided. | ||
3191 | 640 | $parser->{'misc_commands'} = _deep_copy (\%misc_commands); | ||
3192 | 641 | $parser->{'valid_nestings'} = _deep_copy (\%default_valid_nestings); | ||
3193 | 642 | $parser->{'no_paragraph_commands'} = { %default_no_paragraph_commands }; | ||
3194 | 643 | $parser->{'index_names'} = _deep_copy (\%index_names); | ||
3195 | 644 | $parser->{'command_index_prefix'} = {%command_index_prefix}; | ||
3196 | 645 | $parser->{'close_paragraph_commands'} = {%close_paragraph_commands}; | ||
3197 | 646 | $parser->{'close_preformatted_commands'} = {%close_preformatted_commands}; | ||
3198 | 647 | if ($parser->{'INLINE_INSERTCOPYING'}) { | ||
3199 | 648 | delete $parser->{'close_paragraph_commands'}->{'insercopying'}; | ||
3200 | 649 | delete $parser->{'close_preformatted_commands'}->{'insercopying'}; | ||
3201 | 650 | } | ||
3202 | 651 | # a hash is simply concatenated. It should be like %index_names. | ||
3203 | 652 | if (ref($parser->{'indices'}) eq 'HASH') { | ||
3204 | 653 | %{$parser->{'index_names'}} = (%{$parser->{'index_names'}}, | ||
3205 | 654 | %{$parser->{'indices'}}); | ||
3206 | 655 | } else { # an array holds index names defined with @defindex | ||
3207 | 656 | foreach my $name (@{$parser->{'indices'}}) { | ||
3208 | 657 | $parser->{'index_names'}->{$name} = {'in_code' => 0}; | ||
3209 | 658 | } | ||
3210 | 659 | } | ||
3211 | 660 | foreach my $index (keys (%{$parser->{'index_names'}})) { | ||
3212 | 661 | $parser->_register_index_commands($index); | ||
3213 | 662 | } | ||
3214 | 663 | if ($parser->{'merged_indices'}) { | ||
3215 | 664 | foreach my $index_from (keys (%{$parser->{'merged_indices'}})) { | ||
3216 | 665 | my $index_to = $parser->{'merged_indices'}->{$index_from}; | ||
3217 | 666 | if (defined($parser->{'index_names'}->{$index_from}) | ||
3218 | 667 | and defined($parser->{'index_names'}->{$index_to})) { | ||
3219 | 668 | $parser->{'index_names'}->{$index_from}->{'merged_in'} = $index_to; | ||
3220 | 669 | $parser->{'index_names'}->{$index_to}->{'contained_indices'}->{$index_from} = 1; | ||
3221 | 670 | } | ||
3222 | 671 | } | ||
3223 | 672 | } | ||
3224 | 673 | foreach my $explained_command(keys(%explained_commands)) { | ||
3225 | 674 | if (!defined($parser->{'explained_commands'}->{$explained_command})) { | ||
3226 | 675 | $parser->{'explained_commands'}->{$explained_command} = {}; | ||
3227 | 676 | } | ||
3228 | 677 | } | ||
3229 | 678 | $parser->{'context_stack'} = [ $parser->{'context'} ]; | ||
3230 | 679 | $parser->{'regions_stack'} = []; | ||
3231 | 680 | $parser->{'macro_stack'} = []; | ||
3232 | 681 | $parser->{'conditionals_stack'} = []; | ||
3233 | 682 | $parser->{'raw_formats_stack'} = [1]; | ||
3234 | 683 | |||
3235 | 684 | # turn the array to a hash for speed. Not sure it really matters for such | ||
3236 | 685 | # a small array. | ||
3237 | 686 | foreach my $expanded_format(@{$parser->{'expanded_formats'}}) { | ||
3238 | 687 | $parser->{'expanded_formats_hash'}->{$expanded_format} = 1; | ||
3239 | 688 | } | ||
3240 | 689 | |||
3241 | 690 | %{$parser->{'global_commands'}} = %global_multiple_commands; | ||
3242 | 691 | |||
3243 | 692 | foreach my $global_command (@{$parser->{'GLOBAL_COMMANDS'}}) { | ||
3244 | 693 | $parser->{'global_commands'}->{$global_command} = 1; | ||
3245 | 694 | } | ||
3246 | 695 | |||
3247 | 696 | $parser->Texinfo::Report::new; | ||
3248 | 697 | |||
3249 | 698 | return $parser; | ||
3250 | 699 | } | ||
3251 | 700 | |||
3252 | 701 | sub get_conf($$) | ||
3253 | 702 | { | ||
3254 | 703 | my $self = shift; | ||
3255 | 704 | my $var = shift; | ||
3256 | 705 | return $self->{$var}; | ||
3257 | 706 | } | ||
3258 | 707 | |||
3259 | 708 | # split a scalar text in an array lines. | ||
3260 | 709 | sub _text_to_lines($) | ||
3261 | 710 | { | ||
3262 | 711 | my $text = shift; | ||
3263 | 712 | die if (!defined($text)); | ||
3264 | 713 | my $had_final_end_line = chomp($text); | ||
3265 | 714 | my $lines = [ map {$_."\n"} split (/\n/, $text, -1) ]; | ||
3266 | 715 | $lines = [''] if (!@$lines); | ||
3267 | 716 | chomp($lines->[-1]) unless ($had_final_end_line); | ||
3268 | 717 | return $lines; | ||
3269 | 718 | } | ||
3270 | 719 | |||
3271 | 720 | # construct a text fragments array matching a lines array, based on information | ||
3272 | 721 | # supplied. | ||
3273 | 722 | # If $fixed_line_number is set the line number is not increased, otherwise | ||
3274 | 723 | # it is increased, beginning at $first_line. | ||
3275 | 724 | sub _complete_line_nr($$;$$$) | ||
3276 | 725 | { | ||
3277 | 726 | my $lines = shift; | ||
3278 | 727 | my $first_line = shift; | ||
3279 | 728 | my $file = shift; | ||
3280 | 729 | my $macro = shift; | ||
3281 | 730 | my $fixed_line_number = shift; | ||
3282 | 731 | |||
3283 | 732 | $macro = '' if (!defined($macro)); | ||
3284 | 733 | $file = '' if (!defined($file)); | ||
3285 | 734 | my $new_lines = []; | ||
3286 | 735 | |||
3287 | 736 | if (defined($first_line)) { | ||
3288 | 737 | my $line_index = $first_line; | ||
3289 | 738 | foreach my $index(0..scalar(@$lines)-1) { | ||
3290 | 739 | $line_index = $index+$first_line if (!$fixed_line_number); | ||
3291 | 740 | $new_lines->[$index] = [ $lines->[$index], | ||
3292 | 741 | { 'line_nr' => $line_index, | ||
3293 | 742 | 'file_name' => $file, 'macro' => $macro } ]; | ||
3294 | 743 | } | ||
3295 | 744 | } else { | ||
3296 | 745 | foreach my $line (@$lines) { | ||
3297 | 746 | push @$new_lines, [ $line ]; | ||
3298 | 747 | } | ||
3299 | 748 | } | ||
3300 | 749 | return $new_lines; | ||
3301 | 750 | } | ||
3302 | 751 | |||
3303 | 752 | # entry point for text fragments. | ||
3304 | 753 | # Used in tests. | ||
3305 | 754 | # Note that it has no associated root type a opposed to parse_texi_line | ||
3306 | 755 | # and parse_texi_file. | ||
3307 | 756 | sub parse_texi_text($$;$$$$) | ||
3308 | 757 | { | ||
3309 | 758 | my $self = shift; | ||
3310 | 759 | my $text = shift; | ||
3311 | 760 | my $lines_nr = shift; | ||
3312 | 761 | my $file = shift; | ||
3313 | 762 | my $macro = shift; | ||
3314 | 763 | my $fixed_line_number = shift; | ||
3315 | 764 | |||
3316 | 765 | return undef if (!defined($text)); | ||
3317 | 766 | |||
3318 | 767 | my $lines_array = []; | ||
3319 | 768 | if (!ref($text)) { | ||
3320 | 769 | $text = _text_to_lines($text); | ||
3321 | 770 | } | ||
3322 | 771 | $lines_nr = [] if (!defined($lines_nr)); | ||
3323 | 772 | if (!ref($lines_nr)) { | ||
3324 | 773 | #$file =~ s/^.*\/// if (defined($file) and $self->{'TEST'}); | ||
3325 | 774 | $lines_array = _complete_line_nr($text, $lines_nr, $file, | ||
3326 | 775 | $macro, $fixed_line_number); | ||
3327 | 776 | } else { | ||
3328 | 777 | while (@$text) { | ||
3329 | 778 | my $line_nr = shift @$lines_nr; | ||
3330 | 779 | my $line = shift @$text; | ||
3331 | 780 | push @$lines_array, [$line, $line_nr]; | ||
3332 | 781 | } | ||
3333 | 782 | } | ||
3334 | 783 | |||
3335 | 784 | $self = parser() if (!defined($self)); | ||
3336 | 785 | $self->{'input'} = [{'pending' => $lines_array}]; | ||
3337 | 786 | my $tree = $self->_parse_texi(); | ||
3338 | 787 | return $tree; | ||
3339 | 788 | } | ||
3340 | 789 | |||
3341 | 790 | # Not used for now, as a @contents after the first sectioning command | ||
3342 | 791 | # is correct if not using TeX. | ||
3343 | 792 | sub _check_contents_location($$) | ||
3344 | 793 | { | ||
3345 | 794 | my $self = shift; | ||
3346 | 795 | my $tree = shift; | ||
3347 | 796 | |||
3348 | 797 | my $commands = $self->global_commands_information(); | ||
3349 | 798 | return unless ($commands); | ||
3350 | 799 | # Find the last sectioning command | ||
3351 | 800 | my $index = -1; | ||
3352 | 801 | my %ending_root_commands; | ||
3353 | 802 | my $found = 0; | ||
3354 | 803 | while ($tree->{'contents'}->[$index]) { | ||
3355 | 804 | if (defined($tree->{'contents'}->[$index]->{'cmdname'})) { | ||
3356 | 805 | $ending_root_commands{$tree->{'contents'}->[$index]} = 1; | ||
3357 | 806 | if ($sectioning_commands{$tree->{'contents'}->[$index]->{'cmdname'}}) { | ||
3358 | 807 | $found = 1; | ||
3359 | 808 | last; | ||
3360 | 809 | } | ||
3361 | 810 | } | ||
3362 | 811 | $index--; | ||
3363 | 812 | } | ||
3364 | 813 | return if (!$found); | ||
3365 | 814 | |||
3366 | 815 | #print STDERR "ending_root_commands ".join('|',keys(%ending_root_commands))."\n"; | ||
3367 | 816 | #print STDERR "tree contents: ".join('|', @{$tree->{'contents'}})."\n"; | ||
3368 | 817 | foreach my $command ('contents', 'shortcontents', 'summarycontents') { | ||
3369 | 818 | if ($commands->{$command}) { | ||
3370 | 819 | foreach my $current (@{$commands->{$command}}) { | ||
3371 | 820 | my $root_command = $self->Texinfo::Common::find_parent_root_command($current); | ||
3372 | 821 | #print STDERR "root_command for $current->{'cmdname'}: $root_command\n"; | ||
3373 | 822 | if (defined($root_command) | ||
3374 | 823 | and !$ending_root_commands{$root_command}) { | ||
3375 | 824 | $self->line_warn(sprintf($self->__( | ||
3376 | 825 | "\@%s should only appear at beginning or end of document"), | ||
3377 | 826 | $current->{'cmdname'}), $current->{'line_nr'}); | ||
3378 | 827 | } | ||
3379 | 828 | } | ||
3380 | 829 | } | ||
3381 | 830 | } | ||
3382 | 831 | } | ||
3383 | 832 | |||
3384 | 833 | # parse a texi file | ||
3385 | 834 | sub parse_texi_file($$) | ||
3386 | 835 | { | ||
3387 | 836 | my $self = shift; | ||
3388 | 837 | my $file_name = shift; | ||
3389 | 838 | |||
3390 | 839 | my $filehandle = do { local *FH }; | ||
3391 | 840 | if (! open($filehandle, $file_name)) { | ||
3392 | 841 | $self->document_error(sprintf($self->__("could not open %s: %s"), | ||
3393 | 842 | $file_name, $!)); | ||
3394 | 843 | return undef; | ||
3395 | 844 | } | ||
3396 | 845 | my $line_nr = 0; | ||
3397 | 846 | my $line; | ||
3398 | 847 | my @first_lines; | ||
3399 | 848 | |||
3400 | 849 | my $pending_first_texi_line; | ||
3401 | 850 | # the first line not empty and not with \input is kept in | ||
3402 | 851 | # $pending_first_texi_line and put in the pending lines just below | ||
3403 | 852 | while ($line = <$filehandle>) { | ||
3404 | 853 | $line_nr++; | ||
3405 | 854 | if ($line =~ /^ *\\input/ or $line =~ /^\s*$/) { | ||
3406 | 855 | $line =~ s/\x{7F}.*\s*//; | ||
3407 | 856 | push @first_lines, $line; | ||
3408 | 857 | } else { | ||
3409 | 858 | $pending_first_texi_line = $line; | ||
3410 | 859 | last; | ||
3411 | 860 | } | ||
3412 | 861 | } | ||
3413 | 862 | my $root = { 'contents' => [], 'type' => 'text_root' }; | ||
3414 | 863 | if (@first_lines) { | ||
3415 | 864 | push @{$root->{'contents'}}, { 'type' => 'preamble', 'contents' => [] }; | ||
3416 | 865 | foreach my $line (@first_lines) { | ||
3417 | 866 | push @{$root->{'contents'}->[-1]->{'contents'}}, | ||
3418 | 867 | { 'text' => $line, | ||
3419 | 868 | 'type' => 'preamble_text' }; | ||
3420 | 869 | } | ||
3421 | 870 | } | ||
3422 | 871 | my ($directories, $suffix); | ||
3423 | 872 | ($file_name, $directories, $suffix) = fileparse($file_name) | ||
3424 | 873 | if ($self->{'TEST'}); | ||
3425 | 874 | $self = parser() if (!defined($self)); | ||
3426 | 875 | $self->{'input'} = [{ | ||
3427 | 876 | 'pending' => [[$pending_first_texi_line, {'line_nr' => $line_nr, | ||
3428 | 877 | 'macro' => '', 'file_name' => $file_name}]], | ||
3429 | 878 | 'name' => $file_name, | ||
3430 | 879 | 'line_nr' => $line_nr, | ||
3431 | 880 | 'fh' => $filehandle | ||
3432 | 881 | }]; | ||
3433 | 882 | $self->{'info'}->{'input_file_name'} = $file_name; | ||
3434 | 883 | my $tree = $self->_parse_texi($root); | ||
3435 | 884 | |||
3436 | 885 | # Find 'text_root', which contains everything before first node/section. | ||
3437 | 886 | # if there are elements, 'text_root' is the first content, otherwise it | ||
3438 | 887 | # is the root. | ||
3439 | 888 | my $text_root; | ||
3440 | 889 | if ($tree->{'type'} eq 'text_root') { | ||
3441 | 890 | $text_root = $tree; | ||
3442 | 891 | } elsif ($tree->{'contents'} and $tree->{'contents'}->[0] | ||
3443 | 892 | and $tree->{'contents'}->[0]->{'type'} eq 'text_root') { | ||
3444 | 893 | $text_root = $tree->{'contents'}->[0]; | ||
3445 | 894 | } | ||
3446 | 895 | |||
3447 | 896 | # Put everything before @setfilename in a special type. This allows to | ||
3448 | 897 | # ignore everything before @setfilename. | ||
3449 | 898 | if ($self->{'IGNORE_BEFORE_SETFILENAME'} and $text_root and | ||
3450 | 899 | $self->{'extra'} and $self->{'extra'}->{'setfilename'} | ||
3451 | 900 | and $self->{'extra'}->{'setfilename'}->{'parent'} eq $text_root) { | ||
3452 | 901 | my $before_setfilename = {'type' => 'preamble_before_setfilename', | ||
3453 | 902 | 'parent' => $text_root, | ||
3454 | 903 | 'contents' => []}; | ||
3455 | 904 | while ($text_root->{'contents'}->[0] ne $self->{'extra'}->{'setfilename'}) { | ||
3456 | 905 | my $content = shift @{$text_root->{'contents'}}; | ||
3457 | 906 | $content->{'parent'} = $before_setfilename; | ||
3458 | 907 | push @{$before_setfilename->{'contents'}}, $content; | ||
3459 | 908 | } | ||
3460 | 909 | unshift (@{$text_root->{'contents'}}, $before_setfilename) | ||
3461 | 910 | if (@{$before_setfilename->{'contents'}}); | ||
3462 | 911 | } | ||
3463 | 912 | #$self->_check_contents_location($tree); | ||
3464 | 913 | |||
3465 | 914 | return $tree; | ||
3466 | 915 | } | ||
3467 | 916 | |||
3468 | 917 | sub parse_texi_line($$;$$$$) | ||
3469 | 918 | { | ||
3470 | 919 | my $self = shift; | ||
3471 | 920 | my $text = shift; | ||
3472 | 921 | my $lines_nr = shift; | ||
3473 | 922 | my $file = shift; | ||
3474 | 923 | my $macro = shift; | ||
3475 | 924 | my $fixed_line_number = shift; | ||
3476 | 925 | |||
3477 | 926 | return undef if (!defined($text)); | ||
3478 | 927 | |||
3479 | 928 | if (!ref($text)) { | ||
3480 | 929 | $text = _text_to_lines($text); | ||
3481 | 930 | } | ||
3482 | 931 | #$file =~ s/^.*\/// if (defined($file) and $self->{'TEST'}); | ||
3483 | 932 | my $lines_array = _complete_line_nr($text, $lines_nr, $file, | ||
3484 | 933 | $macro, $fixed_line_number); | ||
3485 | 934 | |||
3486 | 935 | $self = parser() if (!defined($self)); | ||
3487 | 936 | $self->{'input'} = [{'pending' => $lines_array}]; | ||
3488 | 937 | my $tree = $self->_parse_texi({'contents' => [], 'type' => 'root_line'}); | ||
3489 | 938 | return $tree; | ||
3490 | 939 | } | ||
3491 | 940 | |||
3492 | 941 | # return indices informations | ||
3493 | 942 | sub indices_information($) | ||
3494 | 943 | { | ||
3495 | 944 | my $self = shift; | ||
3496 | 945 | return ($self->{'index_names'}, $self->{'merged_indices'}); | ||
3497 | 946 | #return ($self->{'index_names'}, $self->{'merged_indices'}, $self->{'index_entries'}); | ||
3498 | 947 | } | ||
3499 | 948 | |||
3500 | 949 | sub floats_information($) | ||
3501 | 950 | { | ||
3502 | 951 | my $self = shift; | ||
3503 | 952 | return $self->{'floats'}; | ||
3504 | 953 | } | ||
3505 | 954 | |||
3506 | 955 | sub internal_references_information($) | ||
3507 | 956 | { | ||
3508 | 957 | my $self = shift; | ||
3509 | 958 | return $self->{'internal_references'}; | ||
3510 | 959 | } | ||
3511 | 960 | |||
3512 | 961 | sub global_commands_information($) | ||
3513 | 962 | { | ||
3514 | 963 | my $self = shift; | ||
3515 | 964 | return $self->{'extra'}; | ||
3516 | 965 | } | ||
3517 | 966 | |||
3518 | 967 | # @ dircategory_direntry | ||
3519 | 968 | # @ unassociated_menus | ||
3520 | 969 | # perl_encoding | ||
3521 | 970 | # input_encoding_name | ||
3522 | 971 | # input_file_name | ||
3523 | 972 | sub global_informations($) | ||
3524 | 973 | { | ||
3525 | 974 | my $self = shift; | ||
3526 | 975 | return $self->{'info'}; | ||
3527 | 976 | } | ||
3528 | 977 | |||
3529 | 978 | sub labels_information($) | ||
3530 | 979 | { | ||
3531 | 980 | my $self = shift; | ||
3532 | 981 | return $self->{'labels'}; | ||
3533 | 982 | } | ||
3534 | 983 | |||
3535 | 984 | # Following are the internal subroutines. The most important are | ||
3536 | 985 | # _parse_texi: the main parser loop. | ||
3537 | 986 | # _end_line: called at an end of line. Handling of @include lines is | ||
3538 | 987 | # done here. | ||
3539 | 988 | # _next_text: present the next text fragment, from pending text or line, | ||
3540 | 989 | # as described above. | ||
3541 | 990 | |||
3542 | 991 | # for debugging | ||
3543 | 992 | sub _print_current($) | ||
3544 | 993 | { | ||
3545 | 994 | my $current = shift; | ||
3546 | 995 | return Texinfo::Common::_print_current($current); | ||
3547 | 996 | } | ||
3548 | 997 | |||
3549 | 998 | # for debugging | ||
3550 | 999 | sub _print_command_args_texi($) | ||
3551 | 1000 | { | ||
3552 | 1001 | my $current = shift; | ||
3553 | 1002 | return '' if (!$current->{'cmdname'}); | ||
3554 | 1003 | my $args = ''; | ||
3555 | 1004 | my $with_brace; | ||
3556 | 1005 | if ($current->{'args'} and @{$current->{'args'}}) { | ||
3557 | 1006 | $with_brace | ||
3558 | 1007 | = ($current->{'args'}->[0]->{'type'} eq 'brace_command_arg' | ||
3559 | 1008 | or $current->{'args'}->[0]->{'type'} eq 'brace_command_context'); | ||
3560 | 1009 | $args .= '{' if ($with_brace); | ||
3561 | 1010 | foreach my $arg (@{$current->{'args'}}) { | ||
3562 | 1011 | $args .= Texinfo::Convert::Texinfo::convert($arg).', '; | ||
3563 | 1012 | } | ||
3564 | 1013 | $args =~ s/, $//; | ||
3565 | 1014 | } | ||
3566 | 1015 | chomp($args); | ||
3567 | 1016 | if ($with_brace) { | ||
3568 | 1017 | $args .= '}'; | ||
3569 | 1018 | } | ||
3570 | 1019 | return '@'.$current->{'cmdname'} .$args."\n"; | ||
3571 | 1020 | } | ||
3572 | 1021 | |||
3573 | 1022 | sub _print_current_keys($) | ||
3574 | 1023 | { | ||
3575 | 1024 | my $current = shift; | ||
3576 | 1025 | my $string = _print_current($current); | ||
3577 | 1026 | foreach my $key (keys (%$current)) { | ||
3578 | 1027 | $string .= " $key: $current->{$key}\n"; | ||
3579 | 1028 | } | ||
3580 | 1029 | if ($current->{'extra'}) { | ||
3581 | 1030 | $string .= " EXTRA\n"; | ||
3582 | 1031 | foreach my $key (keys (%{$current->{'extra'}})) { | ||
3583 | 1032 | $string .= " $key: $current->{'extra'}->{$key}\n"; | ||
3584 | 1033 | } | ||
3585 | 1034 | } | ||
3586 | 1035 | return $string; | ||
3587 | 1036 | } | ||
3588 | 1037 | |||
3589 | 1038 | # For debugging | ||
3590 | 1039 | my @kept_keys = ('contents', 'cmdname', 'type', 'text', 'args'); | ||
3591 | 1040 | my %kept_keys; | ||
3592 | 1041 | foreach my $key (@kept_keys) { | ||
3593 | 1042 | $kept_keys{$key} = 1; | ||
3594 | 1043 | } | ||
3595 | 1044 | sub _filter_print_keys { [grep {$kept_keys{$_}} ( sort keys %{$_[0]} )] }; | ||
3596 | 1045 | sub _print_tree($) | ||
3597 | 1046 | { | ||
3598 | 1047 | my $tree = shift; | ||
3599 | 1048 | local $Data::Dumper::Sortkeys = \&_filter_print_keys; | ||
3600 | 1049 | local $Data::Dumper::Purity = 1; | ||
3601 | 1050 | local $Data::Dumper::Indent = 1; | ||
3602 | 1051 | |||
3603 | 1052 | return Data::Dumper->Dump([$tree]); | ||
3604 | 1053 | } | ||
3605 | 1054 | |||
3606 | 1055 | sub _register_global_command($$$$) | ||
3607 | 1056 | { | ||
3608 | 1057 | my $self = shift; | ||
3609 | 1058 | my $command = shift; | ||
3610 | 1059 | my $current = shift; | ||
3611 | 1060 | my $line_nr = shift; | ||
3612 | 1061 | if ($command eq 'summarycontents' and !$self->{'global_commands'}->{$command}) { | ||
3613 | 1062 | $command = 'shortcontents'; | ||
3614 | 1063 | } | ||
3615 | 1064 | if ($self->{'global_commands'}->{$command} and $command ne 'author') { | ||
3616 | 1065 | push @{$self->{'extra'}->{$command}}, $current | ||
3617 | 1066 | unless (_ignore_global_commands($self)); | ||
3618 | 1067 | $current->{'line_nr'} = $line_nr if (!$current->{'line_nr'}); | ||
3619 | 1068 | return 1; | ||
3620 | 1069 | } elsif ($global_unique_commands{$command}) { | ||
3621 | 1070 | # setfilename ignored in an included file | ||
3622 | 1071 | $current->{'line_nr'} = $line_nr if (!$current->{'line_nr'}); | ||
3623 | 1072 | if ($command eq 'setfilename' | ||
3624 | 1073 | and scalar(@{$self->{'input'}}) > 1) { | ||
3625 | 1074 | } elsif (exists ($self->{'extra'}->{$current->{'cmdname'}})) { | ||
3626 | 1075 | $self->line_warn(sprintf($self->__('multiple @%s'), | ||
3627 | 1076 | $current->{'cmdname'}), $line_nr); | ||
3628 | 1077 | } else { | ||
3629 | 1078 | $self->{'extra'}->{$current->{'cmdname'}} = $current | ||
3630 | 1079 | unless (_ignore_global_commands($self)); | ||
3631 | 1080 | } | ||
3632 | 1081 | return 1; | ||
3633 | 1082 | } | ||
3634 | 1083 | return 0; | ||
3635 | 1084 | } | ||
3636 | 1085 | |||
3637 | 1086 | # parse a @macro line | ||
3638 | 1087 | sub _parse_macro_command_line($$$$$;$) | ||
3639 | 1088 | { | ||
3640 | 1089 | my $self = shift; | ||
3641 | 1090 | my $command = shift; | ||
3642 | 1091 | my $line = shift; | ||
3643 | 1092 | my $parent = shift; | ||
3644 | 1093 | my $line_nr = shift; | ||
3645 | 1094 | my $macro = { 'cmdname' => $command, 'parent' => $parent, 'contents' => [], | ||
3646 | 1095 | 'extra' => {'arg_line' => $line}, 'line_nr' => $line_nr }; | ||
3647 | 1096 | # REMACRO | ||
3648 | 1097 | if ($line =~ /^\s+([[:alnum:]][[:alnum:]-]*)\s*(.*)/) { | ||
3649 | 1098 | my $macro_name = $1; | ||
3650 | 1099 | my $args_def = $2; | ||
3651 | 1100 | my @args; | ||
3652 | 1101 | |||
3653 | 1102 | if ($args_def =~ s/^\s*{\s*(.*?)\s*}\s*//) { | ||
3654 | 1103 | @args = split(/\s*,\s*/, $1); | ||
3655 | 1104 | } | ||
3656 | 1105 | |||
3657 | 1106 | # accept an @-command after the arguments in case there is a @c or | ||
3658 | 1107 | # @comment | ||
3659 | 1108 | if ($args_def =~ /^\s*[^\@]/) { | ||
3660 | 1109 | $self->line_error(sprintf($self->__("bad syntax for \@%s argument: %s"), | ||
3661 | 1110 | $command, $args_def), | ||
3662 | 1111 | $line_nr); | ||
3663 | 1112 | $macro->{'extra'}->{'invalid_syntax'} = 1; | ||
3664 | 1113 | } | ||
3665 | 1114 | print STDERR "MACRO \@$command $macro_name\n" if ($self->{'DEBUG'}); | ||
3666 | 1115 | |||
3667 | 1116 | $macro->{'args'} = [ | ||
3668 | 1117 | { 'type' => 'macro_name', 'text' => $macro_name, | ||
3669 | 1118 | 'parent' => $macro } ]; | ||
3670 | 1119 | my $index = 0; | ||
3671 | 1120 | foreach my $formal_arg (@args) { | ||
3672 | 1121 | push @{$macro->{'args'}}, | ||
3673 | 1122 | { 'type' => 'macro_arg', 'text' => $formal_arg, | ||
3674 | 1123 | 'parent' => $macro}; | ||
3675 | 1124 | if ($formal_arg !~ /^[\w\-]+$/) { | ||
3676 | 1125 | $self->line_error(sprintf($self->__("bad or empty \@%s formal argument: %s"), | ||
3677 | 1126 | $command, $formal_arg), $line_nr); | ||
3678 | 1127 | $macro->{'extra'}->{'invalid_syntax'} = 1; | ||
3679 | 1128 | } | ||
3680 | 1129 | $macro->{'extra'}->{'args_index'}->{$formal_arg} = $index; | ||
3681 | 1130 | $index++; | ||
3682 | 1131 | } | ||
3683 | 1132 | } elsif ($line !~ /\S/) { | ||
3684 | 1133 | $self->line_error(sprintf($self-> | ||
3685 | 1134 | __("%c%s requires a name"), ord('@'), $command), $line_nr); | ||
3686 | 1135 | $macro->{'extra'}->{'invalid_syntax'} = 1; | ||
3687 | 1136 | } else { | ||
3688 | 1137 | $self->line_error(sprintf($self-> | ||
3689 | 1138 | __("bad name for \@%s"), $command), $line_nr); | ||
3690 | 1139 | $macro->{'extra'}->{'invalid_syntax'} = 1; | ||
3691 | 1140 | } | ||
3692 | 1141 | return $macro; | ||
3693 | 1142 | } | ||
3694 | 1143 | |||
3695 | 1144 | # start a paragraph if in a context where paragraphs are to be started. | ||
3696 | 1145 | sub _begin_paragraph($$;$) | ||
3697 | 1146 | { | ||
3698 | 1147 | my $self = shift; | ||
3699 | 1148 | my $current = shift; | ||
3700 | 1149 | my $line_nr = shift; | ||
3701 | 1150 | |||
3702 | 1151 | if ((!$current->{'type'} or $type_with_paragraph{$current->{'type'}}) | ||
3703 | 1152 | and !$no_paragraph_contexts{$self->{'context_stack'}->[-1]}) { | ||
3704 | 1153 | if (!defined($current->{'contents'})) { | ||
3705 | 1154 | $self->_bug_message("contents undef", $line_nr, $current); | ||
3706 | 1155 | die; | ||
3707 | 1156 | } | ||
3708 | 1157 | |||
3709 | 1158 | # find whether an @indent precedes the paragraph | ||
3710 | 1159 | my $indent; | ||
3711 | 1160 | if (scalar(@{$current->{'contents'}})) { | ||
3712 | 1161 | my $index = scalar(@{$current->{'contents'}}) -1; | ||
3713 | 1162 | while ($index >= 0 | ||
3714 | 1163 | and !($current->{'contents'}->[$index]->{'type'} | ||
3715 | 1164 | and ($current->{'contents'}->[$index]->{'type'} eq 'empty_line' | ||
3716 | 1165 | or $current->{'contents'}->[$index]->{'type'} eq 'paragraph')) | ||
3717 | 1166 | and !($current->{'contents'}->[$index]->{'cmdname'} | ||
3718 | 1167 | and $self->{'close_paragraph_commands'}->{$current->{'contents'}->[$index]->{'cmdname'}})) { | ||
3719 | 1168 | if ($current->{'contents'}->[$index]->{'cmdname'} | ||
3720 | 1169 | and ($current->{'contents'}->[$index]->{'cmdname'} eq 'indent' | ||
3721 | 1170 | or $current->{'contents'}->[$index]->{'cmdname'} eq 'noindent')) { | ||
3722 | 1171 | $indent = $current->{'contents'}->[$index]->{'cmdname'}; | ||
3723 | 1172 | last; | ||
3724 | 1173 | } | ||
3725 | 1174 | $index--; | ||
3726 | 1175 | } | ||
3727 | 1176 | } | ||
3728 | 1177 | push @{$current->{'contents'}}, | ||
3729 | 1178 | { 'type' => 'paragraph', 'parent' => $current, 'contents' => [] }; | ||
3730 | 1179 | $current->{'contents'}->[-1]->{'extra'}->{$indent} = 1 if ($indent); | ||
3731 | 1180 | $current = $current->{'contents'}->[-1]; | ||
3732 | 1181 | print STDERR "PARAGRAPH\n" if ($self->{'DEBUG'}); | ||
3733 | 1182 | return $current; | ||
3734 | 1183 | } | ||
3735 | 1184 | return 0; | ||
3736 | 1185 | } | ||
3737 | 1186 | |||
3738 | 1187 | sub _begin_preformatted($) | ||
3739 | 1188 | { | ||
3740 | 1189 | my $self = shift; | ||
3741 | 1190 | my $current = shift; | ||
3742 | 1191 | if ($preformatted_contexts{$self->{'context_stack'}->[-1]}) { | ||
3743 | 1192 | push @{$current->{'contents'}}, | ||
3744 | 1193 | { 'type' => $self->{'context_stack'}->[-1], | ||
3745 | 1194 | 'parent' => $current, 'contents' => [] }; | ||
3746 | 1195 | $current = $current->{'contents'}->[-1]; | ||
3747 | 1196 | print STDERR "PREFORMATTED $self->{'context_stack'}->[-1]\n" if ($self->{'DEBUG'}); | ||
3748 | 1197 | } | ||
3749 | 1198 | return $current; | ||
3750 | 1199 | } | ||
3751 | 1200 | |||
3752 | 1201 | # wrapper around line_warn. Set line_nr to be the line_nr of the command, | ||
3753 | 1202 | # corresponding to the opening of the command. Call line_warn with | ||
3754 | 1203 | # sprintf if needed. | ||
3755 | 1204 | sub _command_warn($$$$;@) | ||
3756 | 1205 | { | ||
3757 | 1206 | my $self = shift; | ||
3758 | 1207 | my $current = shift; | ||
3759 | 1208 | my $line_nr = shift; | ||
3760 | 1209 | my $message = shift; | ||
3761 | 1210 | |||
3762 | 1211 | if ($current->{'line_nr'}) { | ||
3763 | 1212 | $line_nr = $current->{'line_nr'}; | ||
3764 | 1213 | } | ||
3765 | 1214 | if (@_) { | ||
3766 | 1215 | $self->line_warn(sprintf($message, @_), $line_nr); | ||
3767 | 1216 | } else { | ||
3768 | 1217 | $self->line_warn($message, $line_nr); | ||
3769 | 1218 | } | ||
3770 | 1219 | } | ||
3771 | 1220 | |||
3772 | 1221 | sub _command_error($$$$;@) | ||
3773 | 1222 | { | ||
3774 | 1223 | my $self = shift; | ||
3775 | 1224 | my $current = shift; | ||
3776 | 1225 | my $line_nr = shift; | ||
3777 | 1226 | my $message = shift; | ||
3778 | 1227 | |||
3779 | 1228 | # use the beginning of the @-command for the error message | ||
3780 | 1229 | # line number if available. | ||
3781 | 1230 | # FIXME line_nr currently not registered for regular brace commands | ||
3782 | 1231 | if ($current->{'line_nr'}) { | ||
3783 | 1232 | $line_nr = $current->{'line_nr'}; | ||
3784 | 1233 | } | ||
3785 | 1234 | if (@_) { | ||
3786 | 1235 | $self->line_error(sprintf($message, @_), $line_nr); | ||
3787 | 1236 | } else { | ||
3788 | 1237 | $self->line_error($message, $line_nr); | ||
3789 | 1238 | } | ||
3790 | 1239 | } | ||
3791 | 1240 | |||
3792 | 1241 | # currently doesn't do much more than | ||
3793 | 1242 | # return $_[1]->{'parent'} | ||
3794 | 1243 | sub _close_brace_command($$$;$$) | ||
3795 | 1244 | { | ||
3796 | 1245 | my $self = shift; | ||
3797 | 1246 | my $current = shift; | ||
3798 | 1247 | my $line_nr = shift; | ||
3799 | 1248 | my $closed_command = shift; | ||
3800 | 1249 | my $interrupting_command = shift; | ||
3801 | 1250 | |||
3802 | 1251 | if ($current->{'cmdname'} ne 'verb' or $current->{'type'} eq '') { | ||
3803 | 1252 | if (defined($closed_command)) { | ||
3804 | 1253 | $self->_command_error($current, $line_nr, | ||
3805 | 1254 | $self->__("\@end %s seen before \@%s closing brace"), | ||
3806 | 1255 | $closed_command, $current->{'cmdname'}); | ||
3807 | 1256 | } elsif (defined($interrupting_command)) { | ||
3808 | 1257 | $self->_command_error($current, $line_nr, | ||
3809 | 1258 | $self->__("\@%s seen before \@%s closing brace"), | ||
3810 | 1259 | $interrupting_command, $current->{'cmdname'}); | ||
3811 | 1260 | |||
3812 | 1261 | } else { | ||
3813 | 1262 | $self->_command_error($current, $line_nr, | ||
3814 | 1263 | $self->__("%c%s missing close brace"), ord('@'), $current->{'cmdname'}); | ||
3815 | 1264 | } | ||
3816 | 1265 | } else { | ||
3817 | 1266 | $self->_command_error($current, $line_nr, | ||
3818 | 1267 | $self->__("\@%s missing closing delimiter sequence: %s}"), | ||
3819 | 1268 | $current->{'cmdname'}, $current->{'type'}); | ||
3820 | 1269 | } | ||
3821 | 1270 | $current = $current->{'parent'}; | ||
3822 | 1271 | return $current; | ||
3823 | 1272 | } | ||
3824 | 1273 | |||
3825 | 1274 | sub _in_code($$) | ||
3826 | 1275 | { | ||
3827 | 1276 | my $self = shift; | ||
3828 | 1277 | my $current = shift; | ||
3829 | 1278 | |||
3830 | 1279 | while ($current->{'parent'} and $current->{'parent'}->{'cmdname'} | ||
3831 | 1280 | and exists $brace_commands{$current->{'parent'}->{'cmdname'}} | ||
3832 | 1281 | and !exists $context_brace_commands{$current->{'parent'}->{'cmdname'}}) { | ||
3833 | 1282 | return 1 if ($code_style_commands{$current->{'parent'}->{'cmdname'}}); | ||
3834 | 1283 | $current = $current->{'parent'}->{'parent'}; | ||
3835 | 1284 | } | ||
3836 | 1285 | return 0; | ||
3837 | 1286 | } | ||
3838 | 1287 | |||
3839 | 1288 | # close brace commands, that don't set a new context (ie @caption, @footnote) | ||
3840 | 1289 | sub _close_all_style_commands($$$;$$) | ||
3841 | 1290 | { | ||
3842 | 1291 | my $self = shift; | ||
3843 | 1292 | my $current = shift; | ||
3844 | 1293 | my $line_nr = shift; | ||
3845 | 1294 | my $closed_command = shift; | ||
3846 | 1295 | my $interrupting_command = shift; | ||
3847 | 1296 | |||
3848 | 1297 | while ($current->{'parent'} and $current->{'parent'}->{'cmdname'} | ||
3849 | 1298 | and exists $brace_commands{$current->{'parent'}->{'cmdname'}} | ||
3850 | 1299 | and !exists $context_brace_commands{$current->{'parent'}->{'cmdname'}}) { | ||
3851 | 1300 | $current = _close_brace_command($self, $current->{'parent'}, $line_nr, | ||
3852 | 1301 | $closed_command, $interrupting_command); | ||
3853 | 1302 | } | ||
3854 | 1303 | return $current; | ||
3855 | 1304 | } | ||
3856 | 1305 | |||
3857 | 1306 | # close brace commands except for @caption, @footnote then the paragraph | ||
3858 | 1307 | sub _end_paragraph($$$;$$) | ||
3859 | 1308 | { | ||
3860 | 1309 | my $self = shift; | ||
3861 | 1310 | my $current = shift; | ||
3862 | 1311 | my $line_nr = shift; | ||
3863 | 1312 | my $closed_command = shift; | ||
3864 | 1313 | my $interrupting_command = shift; | ||
3865 | 1314 | |||
3866 | 1315 | $current = _close_all_style_commands($self, $current, $line_nr, | ||
3867 | 1316 | $closed_command, $interrupting_command); | ||
3868 | 1317 | if ($current->{'type'} and $current->{'type'} eq 'paragraph') { | ||
3869 | 1318 | print STDERR "CLOSE PARA\n" if ($self->{'DEBUG'}); | ||
3870 | 1319 | $current = $current->{'parent'}; | ||
3871 | 1320 | } | ||
3872 | 1321 | return $current; | ||
3873 | 1322 | } | ||
3874 | 1323 | |||
3875 | 1324 | # close brace commands except for @caption, @footnote then the preformatted | ||
3876 | 1325 | sub _end_preformatted($$$;$$) | ||
3877 | 1326 | { | ||
3878 | 1327 | my $self = shift; | ||
3879 | 1328 | my $current = shift; | ||
3880 | 1329 | my $line_nr = shift; | ||
3881 | 1330 | my $closed_command = shift; | ||
3882 | 1331 | my $interrupting_command = shift; | ||
3883 | 1332 | |||
3884 | 1333 | $current = _close_all_style_commands($self, $current, $line_nr, | ||
3885 | 1334 | $closed_command, $interrupting_command); | ||
3886 | 1335 | if ($current->{'type'} and $preformatted_contexts{$current->{'type'}}) { | ||
3887 | 1336 | print STDERR "CLOSE PREFORMATTED $current->{'type'}\n" if ($self->{'DEBUG'}); | ||
3888 | 1337 | # completly remove void preformatted contexts | ||
3889 | 1338 | if (!@{$current->{'contents'}}) { | ||
3890 | 1339 | my $removed = pop @{$current->{'parent'}->{'contents'}}; | ||
3891 | 1340 | print STDERR "popping $removed->{'type'}\n" if ($self->{'DEBUG'}); | ||
3892 | 1341 | } | ||
3893 | 1342 | $current = $current->{'parent'}; | ||
3894 | 1343 | } | ||
3895 | 1344 | return $current; | ||
3896 | 1345 | } | ||
3897 | 1346 | |||
3898 | 1347 | # check that there are no text holding environment (currently | ||
3899 | 1348 | # checking only paragraphs and preformatted) in contents | ||
3900 | 1349 | sub _check_no_text($) | ||
3901 | 1350 | { | ||
3902 | 1351 | my $current = shift; | ||
3903 | 1352 | my $after_paragraph = 0; | ||
3904 | 1353 | foreach my $content (@{$current->{'contents'}}) { | ||
3905 | 1354 | if ($content->{'type'} and $content->{'type'} eq 'paragraph') { | ||
3906 | 1355 | $after_paragraph = 1; | ||
3907 | 1356 | last; | ||
3908 | 1357 | } elsif ($content->{'type'} and $preformatted_contexts{$content->{'type'}}) { | ||
3909 | 1358 | foreach my $preformatted_content (@{$content->{'contents'}}) { | ||
3910 | 1359 | if ((defined($preformatted_content->{'text'}) | ||
3911 | 1360 | and $preformatted_content->{'text'} =~ /\S/) | ||
3912 | 1361 | or ($preformatted_content->{'cmdname'} | ||
3913 | 1362 | and ($preformatted_content->{'cmdname'} ne 'c' | ||
3914 | 1363 | and $preformatted_content->{'cmdname'} ne 'comment') | ||
3915 | 1364 | and !($preformatted_content->{'type'} | ||
3916 | 1365 | and $preformatted_content->{'type'} eq 'index_entry_command'))) { | ||
3917 | 1366 | $after_paragraph = 1; | ||
3918 | 1367 | last; | ||
3919 | 1368 | } | ||
3920 | 1369 | } | ||
3921 | 1370 | last if ($after_paragraph); | ||
3922 | 1371 | } | ||
3923 | 1372 | } | ||
3924 | 1373 | return $after_paragraph; | ||
3925 | 1374 | } | ||
3926 | 1375 | |||
3927 | 1376 | # put everything after the last @item/@itemx in an item_table type container | ||
3928 | 1377 | # and distinguish table_term and table_entry. | ||
3929 | 1378 | sub _gather_previous_item($$;$$) | ||
3930 | 1379 | { | ||
3931 | 1380 | my $self = shift; | ||
3932 | 1381 | my $current = shift; | ||
3933 | 1382 | my $next_command = shift; | ||
3934 | 1383 | my $line_nr = shift; | ||
3935 | 1384 | |||
3936 | 1385 | # nothing to do in that case. | ||
3937 | 1386 | if ($current->{'contents'}->[-1]->{'type'} | ||
3938 | 1387 | and $current->{'contents'}->[-1]->{'type'} eq 'before_item') { | ||
3939 | 1388 | if ($next_command and $next_command eq 'itemx') { | ||
3940 | 1389 | $self->line_warn(sprintf($self->__("\@itemx should not begin \@%s"), | ||
3941 | 1390 | $current->{'cmdname'}), $line_nr); | ||
3942 | 1391 | } | ||
3943 | 1392 | return; | ||
3944 | 1393 | } | ||
3945 | 1394 | #print STDERR "GATHER "._print_current($current)."\n"; | ||
3946 | 1395 | my $type; | ||
3947 | 1396 | # if before an itemx, the type is different since there should not be | ||
3948 | 1397 | # real content, so it may be treated differently | ||
3949 | 1398 | if ($next_command and $next_command eq 'itemx') { | ||
3950 | 1399 | $type = 'inter_item'; | ||
3951 | 1400 | } else { | ||
3952 | 1401 | $type = 'table_item'; | ||
3953 | 1402 | } | ||
3954 | 1403 | my $table_gathered = {'type' => $type, | ||
3955 | 1404 | 'contents' => []}; | ||
3956 | 1405 | # remove everything that is not an @item/@items or before_item to | ||
3957 | 1406 | # put it in the table_item, starting from the end. | ||
3958 | 1407 | my $contents_count = scalar(@{$current->{'contents'}}); | ||
3959 | 1408 | for (my $i = 0; $i < $contents_count; $i++) { | ||
3960 | 1409 | #print STDERR "_gather_previous_item $i on $contents_count: "._print_current($current->{'contents'}->[-1])."\n"; | ||
3961 | 1410 | if ($current->{'contents'}->[-1]->{'cmdname'} | ||
3962 | 1411 | and ($current->{'contents'}->[-1]->{'cmdname'} eq 'item' | ||
3963 | 1412 | or ($current->{'contents'}->[-1]->{'cmdname'} eq 'itemx'))) { | ||
3964 | 1413 | last; | ||
3965 | 1414 | } else { | ||
3966 | 1415 | my $item_content = pop @{$current->{'contents'}}; | ||
3967 | 1416 | $item_content->{'parent'} = $table_gathered; | ||
3968 | 1417 | unshift @{$table_gathered->{'contents'}}, $item_content; | ||
3969 | 1418 | } | ||
3970 | 1419 | } | ||
3971 | 1420 | if ($type eq 'table_item') { | ||
3972 | 1421 | my $table_entry = {'type' => 'table_entry', | ||
3973 | 1422 | 'parent' => $current, | ||
3974 | 1423 | 'contents' => []}; | ||
3975 | 1424 | my $table_term = {'type' => 'table_term', | ||
3976 | 1425 | 'parent' => $table_entry, | ||
3977 | 1426 | 'contents' => []}; | ||
3978 | 1427 | push @{$table_entry->{'contents'}}, $table_term; | ||
3979 | 1428 | my $contents_count = scalar(@{$current->{'contents'}}); | ||
3980 | 1429 | for (my $i = 0; $i < $contents_count; $i++) { | ||
3981 | 1430 | if ($current->{'contents'}->[-1]->{'type'} | ||
3982 | 1431 | and ($current->{'contents'}->[-1]->{'type'} eq 'before_item' | ||
3983 | 1432 | or $current->{'contents'}->[-1]->{'type'} eq 'table_entry')) { | ||
3984 | 1433 | last; | ||
3985 | 1434 | } else { | ||
3986 | 1435 | my $item_content = pop @{$current->{'contents'}}; | ||
3987 | 1436 | $item_content->{'parent'} = $table_term; | ||
3988 | 1437 | unshift @{$table_term->{'contents'}}, $item_content; | ||
3989 | 1438 | # debug | ||
3990 | 1439 | if (! (($item_content->{'cmdname'} | ||
3991 | 1440 | and ($item_content->{'cmdname'} eq 'itemx' | ||
3992 | 1441 | or $item_content->{'cmdname'} eq 'item')) | ||
3993 | 1442 | or ($item_content->{'type'} | ||
3994 | 1443 | and $item_content->{'type'} eq 'inter_item'))) { | ||
3995 | 1444 | $self->_bug_message("wrong element in table term", $line_nr, | ||
3996 | 1445 | $item_content); | ||
3997 | 1446 | } | ||
3998 | 1447 | } | ||
3999 | 1448 | } | ||
4000 | 1449 | push @{$current->{'contents'}}, $table_entry; | ||
4001 | 1450 | if (scalar(@{$table_gathered->{'contents'}})) { | ||
4002 | 1451 | push @{$table_entry->{'contents'}}, $table_gathered; | ||
4003 | 1452 | $table_gathered->{'parent'} = $table_entry; | ||
4004 | 1453 | } | ||
4005 | 1454 | } else { | ||
4006 | 1455 | my $after_paragraph = _check_no_text($table_gathered); | ||
4007 | 1456 | if ($after_paragraph) { | ||
4008 | 1457 | $self->line_error($self->__("\@itemx must follow \@item"), $line_nr); | ||
4009 | 1458 | } | ||
4010 | 1459 | if (scalar(@{$table_gathered->{'contents'}})) { | ||
4011 | 1460 | push @{$current->{'contents'}}, $table_gathered; | ||
4012 | 1461 | $table_gathered->{'parent'} = $current; | ||
4013 | 1462 | } | ||
4014 | 1463 | } | ||
4015 | 1464 | } | ||
4016 | 1465 | |||
4017 | 1466 | # Starting from the end, gather everything util the def_line to put in | ||
4018 | 1467 | # a def_item | ||
4019 | 1468 | sub _gather_def_item($;$) | ||
4020 | 1469 | { | ||
4021 | 1470 | my $current = shift; | ||
4022 | 1471 | my $next_command = shift; | ||
4023 | 1472 | my $type; | ||
4024 | 1473 | # means that we are between a @def*x and a @def | ||
4025 | 1474 | if ($next_command) { | ||
4026 | 1475 | $type = 'inter_def_item'; | ||
4027 | 1476 | } else { | ||
4028 | 1477 | $type = 'def_item'; | ||
4029 | 1478 | } | ||
4030 | 1479 | |||
4031 | 1480 | # This may happen for a construct like | ||
4032 | 1481 | # @deffnx a b @section | ||
4033 | 1482 | # but otherwise the end of line will lead to the command closing | ||
4034 | 1483 | return if (!$current->{'cmdname'} or $current->{'cmdname'} =~ /x$/); | ||
4035 | 1484 | #print STDERR "_gather_def_item($type) in "._print_current($current)."\n"; | ||
4036 | 1485 | my $def_item = {'type' => $type, | ||
4037 | 1486 | 'parent' => $current, | ||
4038 | 1487 | 'contents' => []}; | ||
4039 | 1488 | # remove everything that is not a def_line to put it in the def_item, | ||
4040 | 1489 | # starting from the end. | ||
4041 | 1490 | my $contents_count = scalar(@{$current->{'contents'}}); | ||
4042 | 1491 | for (my $i = 0; $i < $contents_count; $i++) { | ||
4043 | 1492 | #print STDERR "_gather_def_item $type ($i on $contents_count) "._print_current($current->{'contents'}->[-1])."\n"; | ||
4044 | 1493 | if ($current->{'contents'}->[-1]->{'type'} | ||
4045 | 1494 | and $current->{'contents'}->[-1]->{'type'} eq 'def_line') { | ||
4046 | 1495 | # and !$current->{'contents'}->[-1]->{'extra'}->{'not_after_command'}) { | ||
4047 | 1496 | last; | ||
4048 | 1497 | } else { | ||
4049 | 1498 | my $item_content = pop @{$current->{'contents'}}; | ||
4050 | 1499 | $item_content->{'parent'} = $def_item; | ||
4051 | 1500 | unshift @{$def_item->{'contents'}}, $item_content; | ||
4052 | 1501 | } | ||
4053 | 1502 | } | ||
4054 | 1503 | if (scalar(@{$def_item->{'contents'}})) { | ||
4055 | 1504 | push @{$current->{'contents'}}, $def_item; | ||
4056 | 1505 | } | ||
4057 | 1506 | } | ||
4058 | 1507 | |||
4059 | 1508 | # close formats | ||
4060 | 1509 | sub _close_command_cleanup($$$) { | ||
4061 | 1510 | my $self = shift; | ||
4062 | 1511 | my $current = shift; | ||
4063 | 1512 | |||
4064 | 1513 | return unless ($current->{'cmdname'}); | ||
4065 | 1514 | # remove the dynamic counters in multitable, they are not of use in the final | ||
4066 | 1515 | # tree. Also determine the multitable_body and multitable_head with | ||
4067 | 1516 | # @item or @headitem rows. | ||
4068 | 1517 | if ($current->{'cmdname'} eq 'multitable') { | ||
4069 | 1518 | my $in_head_or_rows; | ||
4070 | 1519 | my @contents = @{$current->{'contents'}}; | ||
4071 | 1520 | $current->{'contents'} = []; | ||
4072 | 1521 | foreach my $row (@contents) { | ||
4073 | 1522 | if ($row->{'type'} and $row->{'type'} eq 'row') { | ||
4074 | 1523 | delete $row->{'cells_count'}; | ||
4075 | 1524 | if ($row->{'contents'}->[0]->{'cmdname'} eq 'headitem') { | ||
4076 | 1525 | if (!$in_head_or_rows) { | ||
4077 | 1526 | push @{$current->{'contents'}}, {'type' => 'multitable_head', | ||
4078 | 1527 | 'parent' => $current}; | ||
4079 | 1528 | $in_head_or_rows = 1; | ||
4080 | 1529 | } | ||
4081 | 1530 | } elsif ($row->{'contents'}->[0]->{'cmdname'} eq 'item') { | ||
4082 | 1531 | if (!defined($in_head_or_rows) or $in_head_or_rows) { | ||
4083 | 1532 | push @{$current->{'contents'}}, {'type' => 'multitable_body', | ||
4084 | 1533 | 'parent' => $current}; | ||
4085 | 1534 | $in_head_or_rows = 0; | ||
4086 | 1535 | } | ||
4087 | 1536 | } | ||
4088 | 1537 | push @{$current->{'contents'}->[-1]->{'contents'}}, $row; | ||
4089 | 1538 | $row->{'parent'} = $current->{'contents'}->[-1]; | ||
4090 | 1539 | } else { | ||
4091 | 1540 | push @{$current->{'contents'}}, $row; | ||
4092 | 1541 | $in_head_or_rows = undef; | ||
4093 | 1542 | } | ||
4094 | 1543 | } | ||
4095 | 1544 | delete $current->{'rows_count'}; | ||
4096 | 1545 | } elsif ($item_container_commands{$current->{'cmdname'}}) { | ||
4097 | 1546 | delete $current->{'items_count'}; | ||
4098 | 1547 | } | ||
4099 | 1548 | |||
4100 | 1549 | # put everything after the last @def*x command in a def_item type container. | ||
4101 | 1550 | if ($def_commands{$current->{'cmdname'}}) { | ||
4102 | 1551 | # At this point the end command hasn't been added to the command contents. | ||
4103 | 1552 | # so checks cannot be done at this point. | ||
4104 | 1553 | _gather_def_item($current); | ||
4105 | 1554 | } | ||
4106 | 1555 | |||
4107 | 1556 | if ($item_line_commands{$current->{'cmdname'}}) { | ||
4108 | 1557 | # At this point the end command hasn't been added to the command contents. | ||
4109 | 1558 | # so checks cannot be done at this point. | ||
4110 | 1559 | if (@{$current->{'contents'}}) { | ||
4111 | 1560 | $self->_gather_previous_item($current); | ||
4112 | 1561 | } | ||
4113 | 1562 | } | ||
4114 | 1563 | |||
4115 | 1564 | # put end out of before_item, and replace it at the end of the parent. | ||
4116 | 1565 | # remove empty before_item. | ||
4117 | 1566 | # warn if not empty before_item, but format is empty | ||
4118 | 1567 | if ($block_item_commands{$current->{'cmdname'}}) { | ||
4119 | 1568 | if (@{$current->{'contents'}}) { | ||
4120 | 1569 | my $leading_spaces = 0; | ||
4121 | 1570 | my $before_item; | ||
4122 | 1571 | if ($current->{'contents'}->[0]->{'type'} | ||
4123 | 1572 | and $current->{'contents'}->[0]->{'type'} eq 'empty_line_after_command' | ||
4124 | 1573 | and $current->{'contents'}->[1] | ||
4125 | 1574 | and $current->{'contents'}->[1]->{'type'} | ||
4126 | 1575 | and $current->{'contents'}->[1]->{'type'} eq 'before_item') { | ||
4127 | 1576 | $leading_spaces = 1; | ||
4128 | 1577 | $before_item = $current->{'contents'}->[1]; | ||
4129 | 1578 | } elsif ($current->{'contents'}->[0]->{'type'} | ||
4130 | 1579 | and $current->{'contents'}->[0]->{'type'} eq 'before_item') { | ||
4131 | 1580 | $before_item = $current->{'contents'}->[0]; | ||
4132 | 1581 | } | ||
4133 | 1582 | if ($before_item) { | ||
4134 | 1583 | if ($current->{'extra'}->{'end_command'} | ||
4135 | 1584 | and @{$before_item->{'contents'}} | ||
4136 | 1585 | and $before_item->{'contents'}->[-1] eq $current->{'extra'}->{'end_command'}) { | ||
4137 | 1586 | my $end = pop @{$before_item->{'contents'}}; | ||
4138 | 1587 | $end->{'parent'} = $current; | ||
4139 | 1588 | push @{$current->{'contents'}}, $end; | ||
4140 | 1589 | } | ||
4141 | 1590 | # remove empty before_items | ||
4142 | 1591 | if (!@{$before_item->{'contents'}}) { | ||
4143 | 1592 | if ($leading_spaces) { | ||
4144 | 1593 | my $space = shift @{$current->{'contents'}}; | ||
4145 | 1594 | shift @{$current->{'contents'}}; | ||
4146 | 1595 | unshift @{$current->{'contents'}}, $space; | ||
4147 | 1596 | } else { | ||
4148 | 1597 | shift @{$current->{'contents'}}; | ||
4149 | 1598 | } | ||
4150 | 1599 | } else { | ||
4151 | 1600 | # warn if not empty before_item, but format is empty | ||
4152 | 1601 | my $empty_before_item = 1; | ||
4153 | 1602 | foreach my $before_item_content (@{$before_item->{'contents'}}) { | ||
4154 | 1603 | if (!$before_item_content->{'cmdname'} or | ||
4155 | 1604 | ($before_item_content->{'cmdname'} ne 'c' | ||
4156 | 1605 | and $before_item_content->{'cmdname'} ne 'comment')) { | ||
4157 | 1606 | $empty_before_item = 0; | ||
4158 | 1607 | last; | ||
4159 | 1608 | } | ||
4160 | 1609 | } | ||
4161 | 1610 | if (!$empty_before_item) { | ||
4162 | 1611 | my $empty_format = 1; | ||
4163 | 1612 | foreach my $format_content (@{$current->{'contents'}}) { | ||
4164 | 1613 | next if ($format_content eq $before_item); | ||
4165 | 1614 | if (($format_content->{'cmdname'} and | ||
4166 | 1615 | ($format_content->{'cmdname'} ne 'c' | ||
4167 | 1616 | and $format_content->{'cmdname'} ne 'comment' | ||
4168 | 1617 | and $format_content->{'cmdname'} ne 'end')) | ||
4169 | 1618 | or ($format_content->{'type'} and | ||
4170 | 1619 | ($format_content->{'type'} ne 'empty_line_after_command'))) { | ||
4171 | 1620 | $empty_format = 0; | ||
4172 | 1621 | last; | ||
4173 | 1622 | } | ||
4174 | 1623 | } | ||
4175 | 1624 | if ($empty_format) { | ||
4176 | 1625 | $self->line_warn(sprintf($self->__("\@%s has text but no \@item"), | ||
4177 | 1626 | $current->{'cmdname'}), $current->{'line_nr'}); | ||
4178 | 1627 | } | ||
4179 | 1628 | } | ||
4180 | 1629 | } | ||
4181 | 1630 | } | ||
4182 | 1631 | } | ||
4183 | 1632 | } | ||
4184 | 1633 | } | ||
4185 | 1634 | |||
4186 | 1635 | # close the current command, with error messages and give the parent. | ||
4187 | 1636 | # If the last argument is given it is the command being closed if | ||
4188 | 1637 | # hadn't there be an error, currently only block command, used for a | ||
4189 | 1638 | # better error message. | ||
4190 | 1639 | sub _close_current($$$;$$) | ||
4191 | 1640 | { | ||
4192 | 1641 | my $self = shift; | ||
4193 | 1642 | my $current = shift; | ||
4194 | 1643 | my $line_nr = shift; | ||
4195 | 1644 | my $closed_command = shift; | ||
4196 | 1645 | my $interrupting_command = shift; | ||
4197 | 1646 | |||
4198 | 1647 | if ($current->{'cmdname'}) { | ||
4199 | 1648 | print STDERR "CLOSING(_close_current) \@$current->{'cmdname'}\n" if ($self->{'DEBUG'}); | ||
4200 | 1649 | if (exists($brace_commands{$current->{'cmdname'}})) { | ||
4201 | 1650 | pop @{$self->{'context_stack'}} | ||
4202 | 1651 | if (exists $context_brace_commands{$current->{'cmdname'}}); | ||
4203 | 1652 | $current = _close_brace_command($self, $current, $line_nr, | ||
4204 | 1653 | $closed_command, $interrupting_command); | ||
4205 | 1654 | } elsif (exists($block_commands{$current->{'cmdname'}})) { | ||
4206 | 1655 | if (defined($closed_command)) { | ||
4207 | 1656 | $self->line_error(sprintf($self->__("`\@end' expected `%s', but saw `%s'"), | ||
4208 | 1657 | $current->{'cmdname'}, $closed_command), $line_nr); | ||
4209 | 1658 | } elsif ($interrupting_command) { | ||
4210 | 1659 | $self->line_error(sprintf($self->__("\@%s seen before \@end %s"), | ||
4211 | 1660 | $interrupting_command, $current->{'cmdname'}), | ||
4212 | 1661 | $line_nr); | ||
4213 | 1662 | } else { | ||
4214 | 1663 | $self->line_error(sprintf($self->__("no matching `%cend %s'"), | ||
4215 | 1664 | ord('@'), $current->{'cmdname'}), $line_nr); | ||
4216 | 1665 | if ($block_commands{$current->{'cmdname'}} eq 'conditional') { | ||
4217 | 1666 | # in this case we are within an ignored conditional | ||
4218 | 1667 | my $conditional = pop @{$current->{'parent'}->{'contents'}}; | ||
4219 | 1668 | } | ||
4220 | 1669 | } | ||
4221 | 1670 | if ($preformatted_commands{$current->{'cmdname'}} | ||
4222 | 1671 | or $menu_commands{$current->{'cmdname'}} | ||
4223 | 1672 | or $format_raw_commands{$current->{'cmdname'}}) { | ||
4224 | 1673 | my $context = pop @{$self->{'context_stack'}}; | ||
4225 | 1674 | pop @{$self->{'raw_formats_stack'}} | ||
4226 | 1675 | if ($format_raw_commands{$current->{'cmdname'}}); | ||
4227 | 1676 | } | ||
4228 | 1677 | pop @{$self->{'regions_stack'}} | ||
4229 | 1678 | if ($region_commands{$current->{'cmdname'}}); | ||
4230 | 1679 | $current = $current->{'parent'}; | ||
4231 | 1680 | } else { | ||
4232 | 1681 | # There @item and @tab commands are closed, and also line commands | ||
4233 | 1682 | # with invalid content | ||
4234 | 1683 | $current = $current->{'parent'}; | ||
4235 | 1684 | } | ||
4236 | 1685 | } elsif ($current->{'type'}) { | ||
4237 | 1686 | print STDERR "CLOSING type $current->{'type'}\n" if ($self->{'DEBUG'}); | ||
4238 | 1687 | if ($current->{'type'} eq 'bracketed') { | ||
4239 | 1688 | $self->_command_error($current, $line_nr, | ||
4240 | 1689 | $self->__("misplaced %c"), ord('{')); | ||
4241 | 1690 | } elsif ($current->{'type'} eq 'menu_comment' | ||
4242 | 1691 | or $current->{'type'} eq 'menu_entry_description') { | ||
4243 | 1692 | my $context = pop @{$self->{'context_stack'}}; | ||
4244 | 1693 | if ($context ne 'preformatted') { | ||
4245 | 1694 | $self->_bug_message("context $context instead of preformatted", | ||
4246 | 1695 | $line_nr, $current); | ||
4247 | 1696 | } | ||
4248 | 1697 | # close empty menu_comment | ||
4249 | 1698 | if (!@{$current->{'contents'}}) { | ||
4250 | 1699 | pop @{$current->{'parent'}->{'contents'}}; | ||
4251 | 1700 | } | ||
4252 | 1701 | } elsif ($current->{'type'} eq 'misc_line_arg' | ||
4253 | 1702 | or $current->{'type'} eq 'block_line_arg') { | ||
4254 | 1703 | my $context = pop @{$self->{'context_stack'}}; | ||
4255 | 1704 | if ($context ne 'line' and $context ne 'def') { | ||
4256 | 1705 | $self->_bug_message("context $context instead of line or def", | ||
4257 | 1706 | $line_nr, $current); | ||
4258 | 1707 | die; | ||
4259 | 1708 | } | ||
4260 | 1709 | } | ||
4261 | 1710 | $current = $current->{'parent'}; | ||
4262 | 1711 | } else { # Should never go here. | ||
4263 | 1712 | $current = $current->{'parent'} if ($current->{'parent'}); | ||
4264 | 1713 | $self->_bug_message("No type nor cmdname when closing", | ||
4265 | 1714 | $line_nr, $current); | ||
4266 | 1715 | } | ||
4267 | 1716 | return $current; | ||
4268 | 1717 | } | ||
4269 | 1718 | |||
4270 | 1719 | # a closed_command arg means closing until that command is found. | ||
4271 | 1720 | # no command arg means closing until the root or a root_command | ||
4272 | 1721 | # is found. | ||
4273 | 1722 | sub _close_commands($$$;$$) | ||
4274 | 1723 | { | ||
4275 | 1724 | my $self = shift; | ||
4276 | 1725 | my $current = shift; | ||
4277 | 1726 | my $line_nr = shift; | ||
4278 | 1727 | my $closed_command = shift; | ||
4279 | 1728 | my $interrupting_command = shift;; | ||
4280 | 1729 | |||
4281 | 1730 | $current = _end_paragraph($self, $current, $line_nr, $closed_command, | ||
4282 | 1731 | $interrupting_command); | ||
4283 | 1732 | $current = _end_preformatted($self, $current, $line_nr, $closed_command, | ||
4284 | 1733 | $interrupting_command); | ||
4285 | 1734 | |||
4286 | 1735 | # stop if the command is found | ||
4287 | 1736 | while (!($closed_command and $current->{'cmdname'} | ||
4288 | 1737 | and $current->{'cmdname'} eq $closed_command) | ||
4289 | 1738 | # stop if at the root | ||
4290 | 1739 | and $current->{'parent'} | ||
4291 | 1740 | # stop if in a root command | ||
4292 | 1741 | # or in a context_brace_commands and searching for a specific | ||
4293 | 1742 | # end block command (with $closed_command set). | ||
4294 | 1743 | # This second condition means that a footnote is not closed when | ||
4295 | 1744 | # looking for the end of a block command, but is closed when | ||
4296 | 1745 | # completly closing the stack. | ||
4297 | 1746 | and !($current->{'cmdname'} | ||
4298 | 1747 | and ($root_commands{$current->{'cmdname'}} | ||
4299 | 1748 | or ($closed_command and $current->{'parent'}->{'cmdname'} | ||
4300 | 1749 | and $context_brace_commands{$current->{'parent'}->{'cmdname'}})))){ | ||
4301 | 1750 | $self->_close_command_cleanup($current); | ||
4302 | 1751 | $current = $self->_close_current($current, $line_nr, $closed_command, | ||
4303 | 1752 | $interrupting_command); | ||
4304 | 1753 | } | ||
4305 | 1754 | |||
4306 | 1755 | my $closed_element; | ||
4307 | 1756 | if ($closed_command and $current->{'cmdname'} | ||
4308 | 1757 | and $current->{'cmdname'} eq $closed_command) { | ||
4309 | 1758 | if ($preformatted_commands{$current->{'cmdname'}}) { | ||
4310 | 1759 | my $context = pop @{$self->{'context_stack'}}; | ||
4311 | 1760 | if ($context ne 'preformatted') { | ||
4312 | 1761 | $self->_bug_message("context $context instead of preformatted for $closed_command", | ||
4313 | 1762 | $line_nr, $current); | ||
4314 | 1763 | } | ||
4315 | 1764 | } elsif ($format_raw_commands{$current->{'cmdname'}}) { | ||
4316 | 1765 | my $context = pop @{$self->{'context_stack'}}; | ||
4317 | 1766 | if ($context ne 'rawpreformatted') { | ||
4318 | 1767 | $self->_bug_message("context $context instead of rawpreformatted for $closed_command", | ||
4319 | 1768 | $line_nr, $current); | ||
4320 | 1769 | } | ||
4321 | 1770 | pop @{$self->{'raw_formats_stack'}}; | ||
4322 | 1771 | } elsif ($menu_commands{$current->{'cmdname'}}) { | ||
4323 | 1772 | my $context = pop @{$self->{'context_stack'}}; | ||
4324 | 1773 | # may be in menu, but context is preformatted if in a preformatted too. | ||
4325 | 1774 | if ($context ne 'menu' and $context ne 'preformatted') { | ||
4326 | 1775 | $self->_bug_message("context $context instead of preformatted or menu for $closed_command", | ||
4327 | 1776 | $line_nr, $current); | ||
4328 | 1777 | } | ||
4329 | 1778 | } | ||
4330 | 1779 | #print STDERR "close context $context for $current->{'cmdname'}\n" | ||
4331 | 1780 | # if ($self->{'DEBUG'}); | ||
4332 | 1781 | pop @{$self->{'regions_stack'}} | ||
4333 | 1782 | if ($region_commands{$current->{'cmdname'}}); | ||
4334 | 1783 | $closed_element = $current; | ||
4335 | 1784 | #$self->_close_command_cleanup($current); | ||
4336 | 1785 | $current = $current->{'parent'}; | ||
4337 | 1786 | } elsif ($closed_command) { | ||
4338 | 1787 | $self->line_error(sprintf($self->__("unmatched `%c%s'"), | ||
4339 | 1788 | ord('@'), "end $closed_command"), $line_nr); | ||
4340 | 1789 | } | ||
4341 | 1790 | return ($closed_element, $current); | ||
4342 | 1791 | } | ||
4343 | 1792 | |||
4344 | 1793 | # begin paragraph if needed. If not try to merge with the previous | ||
4345 | 1794 | # content if it is also some text. | ||
4346 | 1795 | sub _merge_text($$$) | ||
4347 | 1796 | { | ||
4348 | 1797 | my $self = shift; | ||
4349 | 1798 | my $current = shift; | ||
4350 | 1799 | my $text = shift; | ||
4351 | 1800 | |||
4352 | 1801 | my $paragraph; | ||
4353 | 1802 | |||
4354 | 1803 | my $no_merge_with_following_text = 0; | ||
4355 | 1804 | if ($text =~ /\S/) { | ||
4356 | 1805 | my $leading_spaces; | ||
4357 | 1806 | if ($text =~ /^(\s+)/) { | ||
4358 | 1807 | $leading_spaces = $1; | ||
4359 | 1808 | } | ||
4360 | 1809 | if ($current->{'contents'} and @{$current->{'contents'}} | ||
4361 | 1810 | and $current->{'contents'}->[-1]->{'type'} | ||
4362 | 1811 | and ($current->{'contents'}->[-1]->{'type'} eq 'empty_line_after_command' | ||
4363 | 1812 | or $current->{'contents'}->[-1]->{'type'} eq 'empty_spaces_before_argument' | ||
4364 | 1813 | or $current->{'contents'}->[-1]->{'type'} eq 'empty_spaces_after_close_brace')) { | ||
4365 | 1814 | $no_merge_with_following_text = 1; | ||
4366 | 1815 | } | ||
4367 | 1816 | if (_abort_empty_line($self, $current, $leading_spaces)) { | ||
4368 | 1817 | $text =~ s/^(\s+)//; | ||
4369 | 1818 | } | ||
4370 | 1819 | |||
4371 | 1820 | $paragraph = _begin_paragraph($self, $current); | ||
4372 | 1821 | $current = $paragraph if ($paragraph); | ||
4373 | 1822 | } | ||
4374 | 1823 | |||
4375 | 1824 | if (!defined($current->{'contents'})) { | ||
4376 | 1825 | $self->_bug_message("No contents in _merge_text", | ||
4377 | 1826 | undef, $current); | ||
4378 | 1827 | die; | ||
4379 | 1828 | } | ||
4380 | 1829 | |||
4381 | 1830 | if (@{$current->{'contents'}} | ||
4382 | 1831 | and exists($current->{'contents'}->[-1]->{'text'}) | ||
4383 | 1832 | and $current->{'contents'}->[-1]->{'text'} !~ /\n/ | ||
4384 | 1833 | and !$no_merge_with_following_text) { | ||
4385 | 1834 | $current->{'contents'}->[-1]->{'text'} .= $text; | ||
4386 | 1835 | print STDERR "MERGED TEXT: $text|||\n" if ($self->{'DEBUG'}); | ||
4387 | 1836 | } else { | ||
4388 | 1837 | push @{$current->{'contents'}}, { 'text' => $text, 'parent' => $current }; | ||
4389 | 1838 | print STDERR "NEW TEXT: $text|||\n" if ($self->{'DEBUG'}); | ||
4390 | 1839 | } | ||
4391 | 1840 | return $current; | ||
4392 | 1841 | } | ||
4393 | 1842 | |||
4394 | 1843 | # return the parent if in a item_container command, itemize or enumerate | ||
4395 | 1844 | sub _item_container_parent($) | ||
4396 | 1845 | { | ||
4397 | 1846 | my $current = shift; | ||
4398 | 1847 | if ((($current->{'cmdname'} and $current->{'cmdname'} eq 'item') | ||
4399 | 1848 | or ($current->{'type'} and $current->{'type'} eq 'before_item')) | ||
4400 | 1849 | and ($current->{'parent'} and $current->{'parent'}->{'cmdname'} | ||
4401 | 1850 | and $item_container_commands{$current->{'parent'}->{'cmdname'}})) { | ||
4402 | 1851 | return ($current->{'parent'}); | ||
4403 | 1852 | } | ||
4404 | 1853 | return undef; | ||
4405 | 1854 | } | ||
4406 | 1855 | |||
4407 | 1856 | # return the parent if in a item_line command, @*table | ||
4408 | 1857 | sub _item_line_parent($) | ||
4409 | 1858 | { | ||
4410 | 1859 | my $current = shift; | ||
4411 | 1860 | if ($current->{'cmdname'} and ($current->{'cmdname'} eq 'item' | ||
4412 | 1861 | or $current->{'cmdname'} eq 'itemx')) { | ||
4413 | 1862 | $current = $current->{'parent'}->{'parent'}; | ||
4414 | 1863 | } elsif ($current->{'type'} and $current->{'type'} eq 'before_item' | ||
4415 | 1864 | and $current->{'parent'}) { | ||
4416 | 1865 | $current = $current->{'parent'}; | ||
4417 | 1866 | } | ||
4418 | 1867 | return $current if ($current->{'cmdname'} | ||
4419 | 1868 | and $item_line_commands{$current->{'cmdname'}}); | ||
4420 | 1869 | return undef; | ||
4421 | 1870 | } | ||
4422 | 1871 | |||
4423 | 1872 | # return the parent if in a multitable | ||
4424 | 1873 | sub _item_multitable_parent($) | ||
4425 | 1874 | { | ||
4426 | 1875 | my $current = shift; | ||
4427 | 1876 | if (($current->{'cmdname'} and ($current->{'cmdname'} eq 'headitem' | ||
4428 | 1877 | or $current->{'cmdname'} eq 'item' or $current->{'cmdname'} eq 'tab')) | ||
4429 | 1878 | and $current->{'parent'} and $current->{'parent'}->{'parent'}) { | ||
4430 | 1879 | $current = $current->{'parent'}->{'parent'}; | ||
4431 | 1880 | } elsif ($current->{'type'} and $current->{'type'} eq 'before_item' | ||
4432 | 1881 | and $current->{'parent'}) { | ||
4433 | 1882 | $current = $current->{'parent'}; | ||
4434 | 1883 | } | ||
4435 | 1884 | return $current if ($current->{'cmdname'} | ||
4436 | 1885 | and $current->{'cmdname'} eq 'multitable'); | ||
4437 | 1886 | return undef; | ||
4438 | 1887 | } | ||
4439 | 1888 | |||
4440 | 1889 | # returns next text fragment, be it pending from a macro expansion or | ||
4441 | 1890 | # text or file | ||
4442 | 1891 | sub _next_text($$$) | ||
4443 | 1892 | { | ||
4444 | 1893 | my $self = shift; | ||
4445 | 1894 | my $line_nr = shift; | ||
4446 | 1895 | my $current = shift; | ||
4447 | 1896 | |||
4448 | 1897 | while (@{$self->{'input'}}) { | ||
4449 | 1898 | my $input = $self->{'input'}->[0]; | ||
4450 | 1899 | if (@{$input->{'pending'}}) { | ||
4451 | 1900 | my $new_text = shift @{$input->{'pending'}}; | ||
4452 | 1901 | if ($new_text->[1] and $new_text->[1]->{'end_macro'}) { | ||
4453 | 1902 | delete $new_text->[1]->{'end_macro'}; | ||
4454 | 1903 | my $top_macro = shift @{$self->{'macro_stack'}}; | ||
4455 | 1904 | print STDERR "SHIFT MACRO_STACK(@{$self->{'macro_stack'}}): $top_macro->{'args'}->[0]->{'text'}\n" | ||
4456 | 1905 | if ($self->{'DEBUG'}); | ||
4457 | 1906 | } | ||
4458 | 1907 | return ($new_text->[0], $new_text->[1]); | ||
4459 | 1908 | } elsif ($input->{'fh'}) { | ||
4460 | 1909 | my $fh = $input->{'fh'}; | ||
4461 | 1910 | my $line = <$fh>; | ||
4462 | 1911 | while (defined($line)) { | ||
4463 | 1912 | $line =~ s/\x{7F}.*\s*//; | ||
4464 | 1913 | if ($self->{'CPP_LINE_DIRECTIVES'} | ||
4465 | 1914 | # no cpp directives in ignored/macro/verbatim | ||
4466 | 1915 | and defined ($current) | ||
4467 | 1916 | and not | ||
4468 | 1917 | (($current->{'cmdname'} | ||
4469 | 1918 | and $block_commands{$current->{'cmdname'}} | ||
4470 | 1919 | and ($block_commands{$current->{'cmdname'}} eq 'raw' | ||
4471 | 1920 | or $block_commands{$current->{'cmdname'}} eq 'conditional')) | ||
4472 | 1921 | or | ||
4473 | 1922 | ($current->{'parent'} and $current->{'parent'}->{'cmdname'} | ||
4474 | 1923 | and $current->{'parent'}->{'cmdname'} eq 'verb') | ||
4475 | 1924 | ) | ||
4476 | 1925 | and $line =~ /^\s*#\s*(line)? (\d+)(( "([^"]+)")(\s+\d+)*)?\s*$/) { | ||
4477 | 1926 | $input->{'line_nr'} = $2; | ||
4478 | 1927 | if (defined($5)) { | ||
4479 | 1928 | $input->{'name'} = $5; | ||
4480 | 1929 | } | ||
4481 | 1930 | $line = <$fh>; | ||
4482 | 1931 | } else { | ||
4483 | 1932 | $input->{'line_nr'}++; | ||
4484 | 1933 | return ($line, {'line_nr' => $input->{'line_nr'}, | ||
4485 | 1934 | 'file_name' => $input->{'name'}, | ||
4486 | 1935 | 'macro' => ''}); | ||
4487 | 1936 | } | ||
4488 | 1937 | } | ||
4489 | 1938 | } | ||
4490 | 1939 | my $previous_input = shift(@{$self->{'input'}}); | ||
4491 | 1940 | # Don't close STDIN | ||
4492 | 1941 | if ($previous_input->{'fh'} and $previous_input->{'name'} ne '-') { | ||
4493 | 1942 | if (!close($previous_input->{'fh'})) { | ||
4494 | 1943 | $self->document_warn(sprintf($self->__("error on closing %s: %s"), | ||
4495 | 1944 | $previous_input->{'name'}, $!)); | ||
4496 | 1945 | |||
4497 | 1946 | } | ||
4498 | 1947 | } | ||
4499 | 1948 | } | ||
4500 | 1949 | |||
4501 | 1950 | return (undef, $line_nr); | ||
4502 | 1951 | } | ||
4503 | 1952 | |||
4504 | 1953 | # collect text and line numbers until an end of line is found. | ||
4505 | 1954 | sub _new_line($$$) | ||
4506 | 1955 | { | ||
4507 | 1956 | my $self = shift; | ||
4508 | 1957 | my $line_nr = shift; | ||
4509 | 1958 | my $current = shift; | ||
4510 | 1959 | my $new_line = ''; | ||
4511 | 1960 | |||
4512 | 1961 | while (1) { | ||
4513 | 1962 | my $new_text; | ||
4514 | 1963 | ($new_text, $line_nr) = _next_text($self, $line_nr, $current); | ||
4515 | 1964 | if (!defined($new_text)) { | ||
4516 | 1965 | $new_line = undef if ($new_line eq ''); | ||
4517 | 1966 | last; | ||
4518 | 1967 | } | ||
4519 | 1968 | |||
4520 | 1969 | $new_line .= $new_text; | ||
4521 | 1970 | |||
4522 | 1971 | my $chomped_text = $new_text; | ||
4523 | 1972 | last if chomp($chomped_text); | ||
4524 | 1973 | } | ||
4525 | 1974 | return ($new_line, $line_nr); | ||
4526 | 1975 | } | ||
4527 | 1976 | |||
4528 | 1977 | sub _expand_macro_arguments($$$$) | ||
4529 | 1978 | { | ||
4530 | 1979 | my $self = shift; | ||
4531 | 1980 | my $macro = shift; | ||
4532 | 1981 | my $line = shift; | ||
4533 | 1982 | my $line_nr = shift; | ||
4534 | 1983 | my $braces_level = 1; | ||
4535 | 1984 | my $arguments = [ '' ]; | ||
4536 | 1985 | my $arg_nr = 0; | ||
4537 | 1986 | my $args_total = scalar(@{$macro->{'args'}}) -1; | ||
4538 | 1987 | my $name = $macro->{'args'}->[0]->{'text'}; | ||
4539 | 1988 | |||
4540 | 1989 | my $line_nr_orig = $line_nr; | ||
4541 | 1990 | |||
4542 | 1991 | while (1) { | ||
4543 | 1992 | if ($line =~ s/([^\\{},]*)([\\{},])//) { | ||
4544 | 1993 | my $separator = $2; | ||
4545 | 1994 | $arguments->[-1] .= $1; | ||
4546 | 1995 | if ($separator eq '\\') { | ||
4547 | 1996 | if ($line =~ s/^(.)//) { | ||
4548 | 1997 | my $protected_char = $1; | ||
4549 | 1998 | if ($protected_char !~ /[\\{},]/) { | ||
4550 | 1999 | $arguments->[-1] .= '\\'; | ||
4551 | 2000 | } | ||
4552 | 2001 | $arguments->[-1] .= $protected_char; | ||
4553 | 2002 | |||
4554 | 2003 | print STDERR "MACRO ARG: $separator: $protected_char\n" if ($self->{'DEBUG'}); | ||
4555 | 2004 | } else { | ||
4556 | 2005 | $arguments->[-1] .= '\\'; | ||
4557 | 2006 | print STDERR "MACRO ARG: $separator\n" if ($self->{'DEBUG'}); | ||
4558 | 2007 | } | ||
4559 | 2008 | } elsif ($separator eq ',') { | ||
4560 | 2009 | if ($braces_level == 1) { | ||
4561 | 2010 | if (scalar(@$arguments) < $args_total) { | ||
4562 | 2011 | push @$arguments, ''; | ||
4563 | 2012 | $line =~ s/^\s*//; | ||
4564 | 2013 | print STDERR "MACRO NEW ARG\n" if ($self->{'DEBUG'}); | ||
4565 | 2014 | } else { | ||
4566 | 2015 | # implicit quoting when there is one argument. | ||
4567 | 2016 | if ($args_total != 1) { | ||
4568 | 2017 | $self->line_error(sprintf($self->__( | ||
4569 | 2018 | "macro `%s' called with too many args"), | ||
4570 | 2019 | $name), $line_nr); | ||
4571 | 2020 | } | ||
4572 | 2021 | $arguments->[-1] .= ','; | ||
4573 | 2022 | } | ||
4574 | 2023 | } else { | ||
4575 | 2024 | $arguments->[-1] .= ','; | ||
4576 | 2025 | } | ||
4577 | 2026 | } elsif ($separator eq '}') { | ||
4578 | 2027 | $braces_level--; | ||
4579 | 2028 | last if ($braces_level == 0); | ||
4580 | 2029 | $arguments->[-1] .= $separator; | ||
4581 | 2030 | } elsif ($separator eq '{') { | ||
4582 | 2031 | $braces_level++; | ||
4583 | 2032 | $arguments->[-1] .= $separator; | ||
4584 | 2033 | } | ||
4585 | 2034 | } else { | ||
4586 | 2035 | print STDERR "MACRO ARG end of line\n" if ($self->{'DEBUG'}); | ||
4587 | 2036 | $arguments->[-1] .= $line; | ||
4588 | 2037 | |||
4589 | 2038 | ($line, $line_nr) = _new_line($self, $line_nr, $macro); | ||
4590 | 2039 | if (!defined($line)) { | ||
4591 | 2040 | $self->line_error(sprintf($self->__("\@%s missing close brace"), | ||
4592 | 2041 | $name), $line_nr_orig); | ||
4593 | 2042 | return ($arguments, "\n", $line_nr); | ||
4594 | 2043 | } | ||
4595 | 2044 | } | ||
4596 | 2045 | } | ||
4597 | 2046 | if ($args_total == 0 and $arguments->[0] =~ /\S/) { | ||
4598 | 2047 | $self->line_error(sprintf($self->__( | ||
4599 | 2048 | "macro `%s' declared without argument called with an argument"), | ||
4600 | 2049 | $name), $line_nr); | ||
4601 | 2050 | } | ||
4602 | 2051 | print STDERR "END MACRO ARGS EXPANSION(".scalar(@$arguments)."): ". | ||
4603 | 2052 | join("|\n", @$arguments) ."|\n" if ($self->{'DEBUG'}); | ||
4604 | 2053 | return ($arguments, $line, $line_nr); | ||
4605 | 2054 | } | ||
4606 | 2055 | |||
4607 | 2056 | sub _expand_macro_body($$$$) { | ||
4608 | 2057 | my $self = shift; | ||
4609 | 2058 | my $macro = shift; | ||
4610 | 2059 | my $args = shift; | ||
4611 | 2060 | my $line_nr = shift; | ||
4612 | 2061 | |||
4613 | 2062 | my $macrobody = $macro->{'extra'}->{'macrobody'}; | ||
4614 | 2063 | my $args_total = scalar(@{$macro->{'args'}}) -1; | ||
4615 | 2064 | my $args_index = $macro->{'extra'}->{'args_index'}; | ||
4616 | 2065 | |||
4617 | 2066 | my $i; | ||
4618 | 2067 | for ($i=0; $i<=$args_total; $i++) { | ||
4619 | 2068 | $args->[$i] = "" unless (defined($args->[$i])); | ||
4620 | 2069 | } | ||
4621 | 2070 | |||
4622 | 2071 | my $result = ''; | ||
4623 | 2072 | while ($macrobody ne '') { | ||
4624 | 2073 | if ($macrobody =~ s/^([^\\]*)\\//o) { | ||
4625 | 2074 | $result .= $1; | ||
4626 | 2075 | if ($macrobody =~ s/^\\//) { | ||
4627 | 2076 | $result .= '\\'; | ||
4628 | 2077 | } elsif ($macrobody =~ s/^([^\\]*)\\//) { | ||
4629 | 2078 | my $arg = $1; | ||
4630 | 2079 | if (defined($args_index->{$arg})) { | ||
4631 | 2080 | $result .= $args->[$args_index->{$arg}]; | ||
4632 | 2081 | } else { | ||
4633 | 2082 | $self->line_error(sprintf($self->__( | ||
4634 | 2083 | "\\ in \@%s expansion followed `%s' instead of parameter name or \\"), | ||
4635 | 2084 | $macro->{'args'}->[0]->{'text'}, $arg), $line_nr); | ||
4636 | 2085 | $result .= '\\' . $arg; | ||
4637 | 2086 | } | ||
4638 | 2087 | } | ||
4639 | 2088 | next; | ||
4640 | 2089 | } | ||
4641 | 2090 | $result .= $macrobody; | ||
4642 | 2091 | last; | ||
4643 | 2092 | } | ||
4644 | 2093 | return $result; | ||
4645 | 2094 | } | ||
4646 | 2095 | |||
4647 | 2096 | # each time a new line appeared, a container is opened to hold the text | ||
4648 | 2097 | # consisting only of spaces. This container is removed here, typically | ||
4649 | 2098 | # this is called when non-space happens on a line. | ||
4650 | 2099 | sub _abort_empty_line($$;$) | ||
4651 | 2100 | { | ||
4652 | 2101 | my $self = shift; | ||
4653 | 2102 | my $current = shift; | ||
4654 | 2103 | my $additional_text = shift; | ||
4655 | 2104 | $additional_text = '' if (!defined($additional_text)); | ||
4656 | 2105 | if ($current->{'contents'} and @{$current->{'contents'}} | ||
4657 | 2106 | and $current->{'contents'}->[-1]->{'type'} | ||
4658 | 2107 | and ($current->{'contents'}->[-1]->{'type'} eq 'empty_line' | ||
4659 | 2108 | or $current->{'contents'}->[-1]->{'type'} eq 'empty_line_after_command' | ||
4660 | 2109 | or $current->{'contents'}->[-1]->{'type'} eq 'empty_spaces_before_argument' | ||
4661 | 2110 | or $current->{'contents'}->[-1]->{'type'} eq 'empty_spaces_after_close_brace')) { | ||
4662 | 2111 | print STDERR "ABORT EMPTY additional text |$additional_text|, current |$current->{'contents'}->[-1]->{'text'}|\n" if ($self->{'DEBUG'}); | ||
4663 | 2112 | $current->{'contents'}->[-1]->{'text'} .= $additional_text; | ||
4664 | 2113 | if ($current->{'contents'}->[-1]->{'text'} eq '') { | ||
4665 | 2114 | if ($current->{'extra'} | ||
4666 | 2115 | and $current->{'extra'}->{'spaces_before_argument'} | ||
4667 | 2116 | and $current->{'extra'}->{'spaces_before_argument'} | ||
4668 | 2117 | eq $current->{'contents'}->[-1]) { | ||
4669 | 2118 | delete ($current->{'extra'}->{'spaces_before_argument'}); | ||
4670 | 2119 | delete ($current->{'extra'}) if !(keys(%{$current->{'extra'}})); | ||
4671 | 2120 | } | ||
4672 | 2121 | pop @{$current->{'contents'}} | ||
4673 | 2122 | } elsif ($current->{'contents'}->[-1]->{'type'} eq 'empty_line') { | ||
4674 | 2123 | # exactly the same condition than to begin a paragraph | ||
4675 | 2124 | if ((!$current->{'type'} or $type_with_paragraph{$current->{'type'}}) | ||
4676 | 2125 | and !$no_paragraph_contexts{$self->{'context_stack'}->[-1]}) { | ||
4677 | 2126 | $current->{'contents'}->[-1]->{'type'} = 'empty_spaces_before_paragraph'; | ||
4678 | 2127 | } else { | ||
4679 | 2128 | delete $current->{'contents'}->[-1]->{'type'}; | ||
4680 | 2129 | } | ||
4681 | 2130 | } elsif ($current->{'contents'}->[-1]->{'type'} eq 'empty_line_after_command') { | ||
4682 | 2131 | $current->{'contents'}->[-1]->{'type'} = 'empty_spaces_after_command'; | ||
4683 | 2132 | } | ||
4684 | 2133 | return 1; | ||
4685 | 2134 | } | ||
4686 | 2135 | return 0; | ||
4687 | 2136 | } | ||
4688 | 2137 | |||
4689 | 2138 | # isolate last space in a command to help expansion disregard unuseful spaces. | ||
4690 | 2139 | sub _isolate_last_space($$;$) | ||
4691 | 2140 | { | ||
4692 | 2141 | my $self = shift; | ||
4693 | 2142 | my $current = shift; | ||
4694 | 2143 | my $type = shift; | ||
4695 | 2144 | $type = 'spaces_at_end' if (!defined($type)); | ||
4696 | 2145 | if ($current->{'contents'} and @{$current->{'contents'}}) { | ||
4697 | 2146 | my $index = -1; | ||
4698 | 2147 | $index = -2 | ||
4699 | 2148 | if (scalar(@{$current->{'contents'}}) > 1 | ||
4700 | 2149 | and $current->{'contents'}->[-1]->{'cmdname'} | ||
4701 | 2150 | and $self->{'misc_commands'}->{$current->{'contents'}->[-1]->{'cmdname'}}); | ||
4702 | 2151 | if (defined($current->{'contents'}->[$index]->{'text'}) | ||
4703 | 2152 | and !$current->{'contents'}->[$index]->{'type'} | ||
4704 | 2153 | and $current->{'contents'}->[$index]->{'text'} =~ /\s+$/) { | ||
4705 | 2154 | if ($current->{'contents'}->[$index]->{'text'} !~ /\S/) { | ||
4706 | 2155 | $current->{'contents'}->[$index]->{'type'} = $type; | ||
4707 | 2156 | } else { | ||
4708 | 2157 | $current->{'contents'}->[$index]->{'text'} =~ s/(\s+)$//; | ||
4709 | 2158 | my $spaces = $1; | ||
4710 | 2159 | my $new_spaces = { 'text' => $spaces, 'parent' => $current, | ||
4711 | 2160 | 'type' => $type }; | ||
4712 | 2161 | if ($index == -1) { | ||
4713 | 2162 | push @{$current->{'contents'}}, $new_spaces; | ||
4714 | 2163 | } else { | ||
4715 | 2164 | splice (@{$current->{'contents'}}, $index+1, 0, $new_spaces); | ||
4716 | 2165 | } | ||
4717 | 2166 | } | ||
4718 | 2167 | } | ||
4719 | 2168 | } | ||
4720 | 2169 | } | ||
4721 | 2170 | |||
4722 | 2171 | # used to put a node name in error messages. | ||
4723 | 2172 | sub _node_extra_to_texi($) | ||
4724 | 2173 | { | ||
4725 | 2174 | my $node = shift; | ||
4726 | 2175 | my $result = ''; | ||
4727 | 2176 | if ($node->{'manual_content'}) { | ||
4728 | 2177 | $result = '('.Texinfo::Convert::Texinfo::convert({'contents' | ||
4729 | 2178 | => $node->{'manual_content'}}) .')'; | ||
4730 | 2179 | } | ||
4731 | 2180 | if ($node->{'node_content'}) { | ||
4732 | 2181 | $result .= Texinfo::Convert::Texinfo::convert ({'contents' | ||
4733 | 2182 | => $node->{'node_content'}}); | ||
4734 | 2183 | } | ||
4735 | 2184 | return $result; | ||
4736 | 2185 | } | ||
4737 | 2186 | |||
4738 | 2187 | sub _find_end_brace($$) | ||
4739 | 2188 | { | ||
4740 | 2189 | my $text = shift; | ||
4741 | 2190 | my $braces_count = shift; | ||
4742 | 2191 | |||
4743 | 2192 | my $before = ''; | ||
4744 | 2193 | while ($braces_count > 0 and length($text)) { | ||
4745 | 2194 | if ($text =~ s/([^()]*)([()])//) { | ||
4746 | 2195 | $before .= $1.$2; | ||
4747 | 2196 | my $brace = $2; | ||
4748 | 2197 | if ($brace eq '(') { | ||
4749 | 2198 | $braces_count++; | ||
4750 | 2199 | } else { | ||
4751 | 2200 | $braces_count--; | ||
4752 | 2201 | if ($braces_count == 0) { | ||
4753 | 2202 | return ($before, $text, 0); | ||
4754 | 2203 | } | ||
4755 | 2204 | } | ||
4756 | 2205 | } else { | ||
4757 | 2206 | $before .= $text; | ||
4758 | 2207 | $text = ''; | ||
4759 | 2208 | } | ||
4760 | 2209 | } | ||
4761 | 2210 | return ($before, undef, $braces_count); | ||
4762 | 2211 | } | ||
4763 | 2212 | |||
4764 | 2213 | # This only counts opening braces, and returns 0 once all the parentheses | ||
4765 | 2214 | # are closed | ||
4766 | 2215 | sub _count_opened_tree_braces($$); | ||
4767 | 2216 | sub _count_opened_tree_braces($$) | ||
4768 | 2217 | { | ||
4769 | 2218 | my $current = shift; | ||
4770 | 2219 | my $braces_count = shift; | ||
4771 | 2220 | if (defined($current->{'text'})) { | ||
4772 | 2221 | my ($before, $after); | ||
4773 | 2222 | ($before, $after, $braces_count) = _find_end_brace($current->{'text'}, | ||
4774 | 2223 | $braces_count); | ||
4775 | 2224 | } | ||
4776 | 2225 | if ($current->{'args'}) { | ||
4777 | 2226 | foreach my $arg (@{$current->{'args'}}) { | ||
4778 | 2227 | $braces_count = _count_opened_tree_braces($arg, $braces_count); | ||
4779 | 2228 | return $braces_count if ($braces_count == 0); | ||
4780 | 2229 | } | ||
4781 | 2230 | } | ||
4782 | 2231 | if ($current->{'contents'}) { | ||
4783 | 2232 | foreach my $content (@{$current->{'contents'}}) { | ||
4784 | 2233 | $braces_count = _count_opened_tree_braces($content, $braces_count); | ||
4785 | 2234 | return $braces_count if ($braces_count == 0); | ||
4786 | 2235 | } | ||
4787 | 2236 | } | ||
4788 | 2237 | return $braces_count; | ||
4789 | 2238 | } | ||
4790 | 2239 | |||
4791 | 2240 | # retrieve a leading manual name in parentheses, if there is one. | ||
4792 | 2241 | sub _parse_node_manual($) | ||
4793 | 2242 | { | ||
4794 | 2243 | my $node = shift; | ||
4795 | 2244 | my @contents = @{$node->{'contents'}}; | ||
4796 | 2245 | _trim_spaces_comment_from_content(\@contents); | ||
4797 | 2246 | |||
4798 | 2247 | my $manual; | ||
4799 | 2248 | my $result; | ||
4800 | 2249 | #print STDERR "RRR $contents[0] and $contents[0]->{'text'} \n"; | ||
4801 | 2250 | if ($contents[0] and $contents[0]->{'text'} and $contents[0]->{'text'} =~ /^\(/) { | ||
4802 | 2251 | my $braces_count = 1; | ||
4803 | 2252 | if ($contents[0]->{'text'} !~ /^\($/) { | ||
4804 | 2253 | my $brace = shift @contents; | ||
4805 | 2254 | my $brace_text = $brace->{'text'}; | ||
4806 | 2255 | $brace_text =~ s/^\(//; | ||
4807 | 2256 | unshift @contents, { 'text' => $brace_text, 'type' => $brace->{'type'}, | ||
4808 | 2257 | 'parent' => $brace->{'parent'} } if $brace_text ne ''; | ||
4809 | 2258 | } else { | ||
4810 | 2259 | shift @contents; | ||
4811 | 2260 | } | ||
4812 | 2261 | while(@contents) { | ||
4813 | 2262 | my $content = shift @contents; | ||
4814 | 2263 | if (!defined($content->{'text'}) or $content->{'text'} !~ /\)/) { | ||
4815 | 2264 | push @$manual, $content; | ||
4816 | 2265 | $braces_count = _count_opened_tree_braces($content, $braces_count); | ||
4817 | 2266 | # This is an error, braces were closed in a command | ||
4818 | 2267 | if ($braces_count == 0) { | ||
4819 | 2268 | last; | ||
4820 | 2269 | } | ||
4821 | 2270 | } else { | ||
4822 | 2271 | my ($before, $after); | ||
4823 | 2272 | ($before, $after, $braces_count) = _find_end_brace($content->{'text'}, | ||
4824 | 2273 | $braces_count); | ||
4825 | 2274 | if ($braces_count == 0) { | ||
4826 | 2275 | $before =~ s/\)$//; | ||
4827 | 2276 | push @$manual, { 'text' => $before, 'parent' => $content->{'parent'} } | ||
4828 | 2277 | if ($before ne ''); | ||
4829 | 2278 | $after =~ s/^\s*//; | ||
4830 | 2279 | unshift @contents, { 'text' => $after, 'parent' => $content->{'parent'} } | ||
4831 | 2280 | if ($after ne ''); | ||
4832 | 2281 | last; | ||
4833 | 2282 | } else { | ||
4834 | 2283 | push @$manual, $content; | ||
4835 | 2284 | } | ||
4836 | 2285 | } | ||
4837 | 2286 | } | ||
4838 | 2287 | $result->{'manual_content'} = $manual if (defined($manual)); | ||
4839 | 2288 | } | ||
4840 | 2289 | if (@contents) { | ||
4841 | 2290 | $result->{'node_content'} = \@contents; | ||
4842 | 2291 | $result->{'normalized'} = | ||
4843 | 2292 | Texinfo::Convert::NodeNameNormalization::normalize_node({'contents' => \@contents}); | ||
4844 | 2293 | } | ||
4845 | 2294 | return $result; | ||
4846 | 2295 | } | ||
4847 | 2296 | |||
4848 | 2297 | sub _parse_float_type($) | ||
4849 | 2298 | { | ||
4850 | 2299 | my $current = shift; | ||
4851 | 2300 | if (@{$current->{'args'}}) { | ||
4852 | 2301 | my @type_contents = @{$current->{'args'}->[0]->{'contents'}}; | ||
4853 | 2302 | _trim_spaces_comment_from_content(\@type_contents); | ||
4854 | 2303 | if (@type_contents) { | ||
4855 | 2304 | my $normalized | ||
4856 | 2305 | = Texinfo::Convert::NodeNameNormalization::normalize_node( | ||
4857 | 2306 | {'contents' => \@type_contents}); | ||
4858 | 2307 | $current->{'extra'}->{'type'}->{'content'} = \@type_contents; | ||
4859 | 2308 | if ($normalized =~ /[^-]/) { | ||
4860 | 2309 | $current->{'extra'}->{'type'}->{'normalized'} = $normalized; | ||
4861 | 2310 | return 1; | ||
4862 | 2311 | } | ||
4863 | 2312 | } | ||
4864 | 2313 | } | ||
4865 | 2314 | $current->{'extra'}->{'type'}->{'normalized'} = ''; | ||
4866 | 2315 | return 0; | ||
4867 | 2316 | } | ||
4868 | 2317 | |||
4869 | 2318 | # used for definition line parsing | ||
4870 | 2319 | sub _next_bracketed_or_word($$) | ||
4871 | 2320 | { | ||
4872 | 2321 | my $self = shift; | ||
4873 | 2322 | my $contents = shift; | ||
4874 | 2323 | return undef if (!scalar(@{$contents})); | ||
4875 | 2324 | my $spaces; | ||
4876 | 2325 | $spaces = shift @{$contents} if (defined($contents->[0]->{'text'}) and | ||
4877 | 2326 | $contents->[0]->{'text'} !~ /\S/); | ||
4878 | 2327 | if (defined($spaces)) { | ||
4879 | 2328 | $spaces->{'type'} = 'spaces'; | ||
4880 | 2329 | chomp $spaces->{'text'}; | ||
4881 | 2330 | $spaces = undef if ($spaces->{'text'} eq ''); | ||
4882 | 2331 | } | ||
4883 | 2332 | return ($spaces, undef) if (!scalar(@{$contents})); | ||
4884 | 2333 | |||
4885 | 2334 | #print STDERR "BEFORE PROCESSING ".Texinfo::Convert::Texinfo::convert({'contents' => $contents}); | ||
4886 | 2335 | if ($contents->[0]->{'type'} and $contents->[0]->{'type'} eq 'bracketed') { | ||
4887 | 2336 | #print STDERR "Return bracketed\n"; | ||
4888 | 2337 | my $bracketed = shift @{$contents}; | ||
4889 | 2338 | $self->_isolate_last_space($bracketed, 'empty_space_at_end_def_bracketed'); | ||
4890 | 2339 | my $bracketed_def_content = { 'contents' => $bracketed->{'contents'}, | ||
4891 | 2340 | 'parent' => $bracketed->{'parent'}, | ||
4892 | 2341 | 'type' => 'bracketed_def_content', }; | ||
4893 | 2342 | if ($bracketed->{'extra'} and $bracketed->{'extra'}->{'spaces_before_argument'}) { | ||
4894 | 2343 | $bracketed_def_content->{'extra'}->{'spaces_before_argument'} | ||
4895 | 2344 | = $bracketed->{'extra'}->{'spaces_before_argument'}; | ||
4896 | 2345 | } | ||
4897 | 2346 | return ($spaces, $bracketed_def_content); | ||
4898 | 2347 | } elsif ($contents->[0]->{'cmdname'}) { | ||
4899 | 2348 | #print STDERR "Return command $contents->[0]->{'cmdname'}\n"; | ||
4900 | 2349 | return ($spaces, shift @{$contents}); | ||
4901 | 2350 | } else { | ||
4902 | 2351 | #print STDERR "Process $contents->[0]->{'text'}\n"; | ||
4903 | 2352 | $contents->[0]->{'text'} =~ s/^(\s*)//; | ||
4904 | 2353 | my $space_text = $1; | ||
4905 | 2354 | $spaces = {'text' => $space_text, 'type' => 'spaces'} if ($space_text); | ||
4906 | 2355 | $contents->[0]->{'text'} =~ s/^(\S+)//; | ||
4907 | 2356 | shift @{$contents} if ($contents->[0]->{'text'} eq ''); | ||
4908 | 2357 | return ($spaces, {'text' => $1}); | ||
4909 | 2358 | } | ||
4910 | 2359 | } | ||
4911 | 2360 | |||
4912 | 2361 | # definition line parsing | ||
4913 | 2362 | sub _parse_def($$$) | ||
4914 | 2363 | { | ||
4915 | 2364 | my $self = shift; | ||
4916 | 2365 | my $command = shift; | ||
4917 | 2366 | my $contents = shift; | ||
4918 | 2367 | |||
4919 | 2368 | my @contents = @$contents; | ||
4920 | 2369 | shift @contents if ($contents[0] and $contents[0]->{'type'} | ||
4921 | 2370 | and $contents[0]->{'type'} eq 'empty_spaces_after_command'); | ||
4922 | 2371 | if ($def_aliases{$command}) { | ||
4923 | 2372 | my $real_command = $def_aliases{$command}; | ||
4924 | 2373 | my $prepended = $def_map{$command}->{$real_command}; | ||
4925 | 2374 | my @prepended_content; | ||
4926 | 2375 | |||
4927 | 2376 | my $text; | ||
4928 | 2377 | my $in_bracketed; | ||
4929 | 2378 | if ($prepended =~ /^\{/) { | ||
4930 | 2379 | $text = $prepended; | ||
4931 | 2380 | $text =~ s/\{([^\}]+)\}/$1/; | ||
4932 | 2381 | $in_bracketed = 1; | ||
4933 | 2382 | } else { | ||
4934 | 2383 | $text = $prepended; | ||
4935 | 2384 | } | ||
4936 | 2385 | my $tree = $self->gdt($text); | ||
4937 | 2386 | if ($in_bracketed or @{$tree->{'contents'}} > 1) { | ||
4938 | 2387 | my $bracketed = { 'type' => 'bracketed' }; | ||
4939 | 2388 | $bracketed->{'contents'} = $tree->{'contents'}; | ||
4940 | 2389 | foreach my $content (@{$tree->{'contents'}}) { | ||
4941 | 2390 | $content->{'parent'} = $bracketed; | ||
4942 | 2391 | } | ||
4943 | 2392 | @prepended_content = ($bracketed); | ||
4944 | 2393 | } else { | ||
4945 | 2394 | @prepended_content = (@{$tree->{'contents'}}); | ||
4946 | 2395 | } | ||
4947 | 2396 | push @prepended_content, { 'text' => ' ' }; | ||
4948 | 2397 | |||
4949 | 2398 | unshift @contents, @prepended_content; | ||
4950 | 2399 | |||
4951 | 2400 | $command = $def_aliases{$command}; | ||
4952 | 2401 | } | ||
4953 | 2402 | foreach (my $i = 0; $i < scalar(@contents); $i++) { | ||
4954 | 2403 | # copy, to avoid changing the original | ||
4955 | 2404 | $contents[$i] = {'text' => $contents[$i]->{'text'}} | ||
4956 | 2405 | if (defined($contents[$i]->{'text'})); | ||
4957 | 2406 | } | ||
4958 | 2407 | my @result; | ||
4959 | 2408 | my @args = @{$def_map{$command}}; | ||
4960 | 2409 | my $arg_type; | ||
4961 | 2410 | # Even when $arg_type is not set, that is for def* that is not documented | ||
4962 | 2411 | # to take args, everything is as is arg_type was set to arg. | ||
4963 | 2412 | $arg_type = pop @args if ($args[-1] eq 'arg' or $args[-1] eq 'argtype'); | ||
4964 | 2413 | foreach my $arg (@args) { | ||
4965 | 2414 | #print STDERR "$command $arg"._print_current($contents[0]); | ||
4966 | 2415 | #foreach my $content (@contents) {print STDERR " "._print_current($content)}; | ||
4967 | 2416 | #print STDERR " contents ->".Texinfo::Convert::Texinfo::convert ({'contents' => \@contents}); | ||
4968 | 2417 | my ($spaces, $next) = $self->_next_bracketed_or_word(\@contents); | ||
4969 | 2418 | last if (!defined($next)); | ||
4970 | 2419 | #print STDERR "NEXT[$arg] ".Texinfo::Convert::Texinfo::convert($next)."\n"; | ||
4971 | 2420 | push @result, ['spaces', $spaces] if (defined($spaces)); | ||
4972 | 2421 | push @result, [$arg, $next]; | ||
4973 | 2422 | } | ||
4974 | 2423 | |||
4975 | 2424 | my @args_results; | ||
4976 | 2425 | while (@contents) { | ||
4977 | 2426 | my ($spaces, $next) = $self->_next_bracketed_or_word(\@contents); | ||
4978 | 2427 | push @args_results, ['spaces', $spaces] if (defined($spaces)); | ||
4979 | 2428 | last if (!defined($next)); | ||
4980 | 2429 | if (defined($next->{'text'})) { | ||
4981 | 2430 | while (1) { | ||
4982 | 2431 | if ($next->{'text'} =~ s/^([^\[\](),]+)//) { | ||
4983 | 2432 | push @args_results, ['arg', {'text' => $1}]; | ||
4984 | 2433 | } elsif ($next->{'text'} =~ s/^([\[\](),])//) { | ||
4985 | 2434 | push @args_results, ['delimiter', | ||
4986 | 2435 | {'text' => $1, 'type' => 'delimiter'}]; | ||
4987 | 2436 | } else { | ||
4988 | 2437 | last; | ||
4989 | 2438 | } | ||
4990 | 2439 | } | ||
4991 | 2440 | } else { | ||
4992 | 2441 | push @args_results, [ 'arg', $next ]; | ||
4993 | 2442 | } | ||
4994 | 2443 | } | ||
4995 | 2444 | if ($arg_type and $arg_type eq 'argtype') { | ||
4996 | 2445 | my $next_is_type = 1; | ||
4997 | 2446 | foreach my $arg(@args_results) { | ||
4998 | 2447 | if ($arg->[0] eq 'spaces') { | ||
4999 | 2448 | } elsif ($arg->[0] eq 'delimiter') { | ||
5000 | 2449 | $next_is_type = 1; |
The diff has been truncated for viewing.
Thanks. Uploaded.