1/* Copyright 2010-2021 Free Software Foundation, Inc. 2 3 This program is free software: you can redistribute it and/or modify 4 it under the terms of the GNU General Public License as published by 5 the Free Software Foundation, either version 3 of the License, or 6 (at your option) any later version. 7 8 This program is distributed in the hope that it will be useful, 9 but WITHOUT ANY WARRANTY; without even the implied warranty of 10 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 GNU General Public License for more details. 12 13 You should have received a copy of the GNU General Public License 14 along with this program. If not, see <http://www.gnu.org/licenses/>. */ 15 16#include <config.h> 17 18/* Avoid namespace conflicts. */ 19#define context perl_context 20 21#define PERL_NO_GET_CONTEXT 22#include "EXTERN.h" 23#include "perl.h" 24#include "XSUB.h" 25 26#undef context 27 28#include <libintl.h> 29 30#include <stdlib.h> 31#include <stdio.h> 32#include <dirent.h> 33#include <string.h> 34 35#include "parser.h" 36#include "input.h" 37#include "labels.h" 38#include "indices.h" 39#include "api.h" 40 41ELEMENT *Root; 42 43#ifdef ENABLE_NLS 44 45#define LOCALEDIR DATADIR "/locale" 46 47/* Use the uninstalled locales dir. 48 NB the texinfo.mo files are not actually created here, only the 49 texinfo_document.mo files, which aren't used by parsetexi. 50 Hence, error messages will be translated only when the program is 51 installed. */ 52static void 53find_locales_dir (char *builddir) 54{ 55 DIR *dir; 56 char *s; 57 58 dTHX; 59 60 /* Can't use asprintf here, because it might come from Gnulib, and 61 will then use malloc that is different from Perl's malloc, whereas 62 free below is redirected to Perl's implementation. This could 63 cause crashes if the two malloc/free implementations were different. */ 64 s = malloc (strlen (builddir) + strlen ("/LocaleData") + 1); 65 sprintf (s, "%s/LocaleData", builddir); 66 dir = opendir (s); 67 if (!dir) 68 { 69 free (s); 70 fprintf (stderr, "Locales dir for document strings not found: %s\n", 71 strerror (errno)); 72 } 73 else 74 { 75 bindtextdomain (PACKAGE, s); 76 free (s); 77 closedir (dir); 78 } 79} 80 81int 82init (int texinfo_uninstalled, char *builddir) 83{ 84 setlocale (LC_ALL, ""); 85 86 /* Use installed or uninstalled translation files for gettext. */ 87 if (texinfo_uninstalled) 88 find_locales_dir (builddir); 89 else 90 bindtextdomain (PACKAGE, LOCALEDIR); 91 92 textdomain (PACKAGE); 93 94 return 1; 95} 96 97#else 98 99int 100init (int texinfo_uninstalled, char *builddir) 101{ 102 return 1; 103} 104 105#endif 106 107static void 108reset_floats () 109{ 110 floats_number = 0; 111} 112 113void 114reset_parser_except_conf (void) 115{ 116 /* do before destroying tree because index entries usually refer to in-tree 117 elements. */ 118 wipe_indices (); 119 if (Root) 120 { 121 destroy_element_and_children (Root); 122 Root = 0; 123 } 124 wipe_user_commands (); 125 wipe_macros (); 126 init_index_commands (); 127 wipe_errors (); 128 reset_context_stack (); 129 reset_region_stack (); 130 reset_floats (); 131 wipe_global_info (); 132 set_input_encoding ("utf-8"); 133 reset_internal_xrefs (); 134 reset_labels (); 135 input_reset_input_stack (); 136 free_small_strings (); 137 138 current_node = current_section = current_part = 0; 139} 140 141void 142reset_parser (void) 143{ 144 debug ("!!!!!!!!!!!!!!!! RESETTING THE PARSER !!!!!!!!!!!!!!!!!!!!!"); 145 146 reset_parser_except_conf (); 147 wipe_values (); 148 clear_expanded_formats (); 149 reset_conf (); 150} 151 152/* Set ROOT to root of tree obtained by parsing FILENAME. */ 153int 154parse_file (char *filename) 155{ 156 debug_output = 0; 157 Root = parse_texi_file (filename); 158 if (Root) 159 return 0; 160 return 1; 161} 162 163/* Set ROOT to root of tree obtained by parsing the Texinfo code in STRING. 164 STRING should be a UTF-8 buffer. Used for parse_texi_line. */ 165void 166parse_string (char *string) 167{ 168 reset_parser_except_conf (); 169 input_push_text (strdup (string), 0); 170 Root = parse_texi (new_element (ET_root_line)); 171} 172 173/* Used for parse_texi_text. STRING should be a UTF-8 buffer. */ 174void 175parse_text (char *string) 176{ 177 reset_parser_except_conf (); 178 input_push_text_with_line_nos (strdup (string), 1); 179 Root = parse_texi (new_element (ET_text_root)); 180} 181 182 183static void element_to_perl_hash (ELEMENT *e); 184 185/* Return reference to Perl array built from e. If any of 186 the elements in E don't have 'hv' set, set it to an empty 187 hash table, or create it if there is no parent element, indicating the 188 element is not in the tree. */ 189static SV * 190build_perl_array (ELEMENT_LIST *e) 191{ 192 SV *sv; 193 AV *av; 194 int i; 195 196 dTHX; 197 198 av = newAV (); 199 sv = newRV_inc ((SV *) av); 200 for (i = 0; i < e->number; i++) 201 { 202 if (!e->list[i]) /* For arrays only, allow elements to be undef. */ 203 av_push (av, newSV (0)); 204 if (!e->list[i]->hv) 205 { 206 if (e->list[i]->parent) 207 e->list[i]->hv = newHV (); 208 else 209 { 210 /* Out-of-tree element */ 211 /* WARNING: This is possibly recursive. */ 212 element_to_perl_hash (e->list[i]); 213 } 214 } 215 av_push (av, newRV_inc ((SV *) e->list[i]->hv)); 216 } 217 return sv; 218} 219 220/* Return reference to hash corresponding to VALUE. */ 221static SV * 222build_node_spec (NODE_SPEC_EXTRA *value) 223{ 224 HV *hv; 225 226 dTHX; 227 228 if (!value->manual_content && !value->node_content) 229 return newSV(0); /* Perl 'undef' */ 230 231 hv = newHV (); 232 233 if (value->manual_content) 234 { 235 hv_store (hv, "manual_content", strlen ("manual_content"), 236 build_perl_array (&value->manual_content->contents), 0); 237 } 238 239 if (value->node_content) 240 { 241 hv_store (hv, "node_content", strlen ("node_content"), 242 build_perl_array (&value->node_content->contents), 0); 243 } 244 245 return newRV_inc ((SV *)hv); 246} 247 248/* Set E->hv and 'hv' on E's descendants. e->parent->hv is assumed 249 to already exist. */ 250static void 251element_to_perl_hash (ELEMENT *e) 252{ 253 SV *sv; 254 255 dTHX; 256 257 /* e->hv may already exist if there was an extra value elsewhere 258 referring to e. */ 259 if (!e->hv) 260 { 261 e->hv = newHV (); 262 } 263 264 if (e->parent) 265 { 266 if (!e->parent->hv) 267 e->parent->hv = newHV (); 268 sv = newRV_inc ((SV *) e->parent->hv); 269 hv_store (e->hv, "parent", strlen ("parent"), sv, 0); 270 } 271 272 if (e->type) 273 { 274 sv = newSVpv (element_type_names[e->type], 0); 275 hv_store (e->hv, "type", strlen ("type"), sv, 0); 276 } 277 278 if (e->cmd) 279 { 280 sv = newSVpv (command_name(e->cmd), 0); 281 hv_store (e->hv, "cmdname", strlen ("cmdname"), sv, 0); 282 283 /* TODO: Same optimizations as for 'type'. */ 284 } 285 286 /* A lot of special cases for when an empty contents array should be 287 created. Largely by trial and error to match the Perl code. Some of 288 them don't make sense, like @arrow{}, @image, or for accent commands. */ 289 if (e->contents.number > 0 290 || e->type == ET_text_root 291 || e->type == ET_root_line 292 || e->type == ET_bracketed 293 || e->type == ET_bracketed_def_content 294 || e->type == ET_line_arg 295 || e->cmd == CM_image 296 || e->cmd == CM_item && e->parent && e->parent->type == ET_row 297 || e->cmd == CM_headitem && e->parent && e->parent->type == ET_row 298 || e->cmd == CM_tab && e->parent && e->parent->type == ET_row 299 || e->cmd == CM_anchor 300 || e->cmd == CM_macro 301 || e->cmd == CM_multitable 302 || e->type == ET_menu_entry_name 303 || e->type == ET_menu_entry_description 304 || e->type == ET_brace_command_arg 305 || e->type == ET_brace_command_context 306 || e->type == ET_block_line_arg 307 || e->type == ET_before_item 308 || e->type == ET_inter_item 309 || e->cmd == CM_TeX 310 || e->type == ET_elided 311 || e->type == ET_elided_block 312 || e->type == ET_preformatted 313 || e->type == ET_paragraph 314 || (command_flags(e) & CF_root) 315 || (command_data(e->cmd).flags & CF_brace 316 && (command_data(e->cmd).data >= 0 317 || command_data(e->cmd).data == BRACE_style 318 || command_data(e->cmd).data == BRACE_context 319 || command_data(e->cmd).data == BRACE_other 320 || command_data(e->cmd).data == BRACE_accent 321 )) 322 || e->cmd == CM_node) 323 { 324 AV *av; 325 int i; 326 327 av = newAV (); 328 sv = newRV_inc ((SV *) av); 329 hv_store (e->hv, "contents", strlen ("contents"), sv, 0); 330 for (i = 0; i < e->contents.number; i++) 331 { 332 element_to_perl_hash (e->contents.list[i]); 333 sv = newRV_inc ((SV *) e->contents.list[i]->hv); 334 av_push (av, sv); 335 } 336 } 337 338 if (e->args.number > 0) 339 { 340 AV *av; 341 int i; 342 343 av = newAV (); 344 sv = newRV_inc ((SV *) av); 345 hv_store (e->hv, "args", strlen ("args"), sv, 0); 346 for (i = 0; i < e->args.number; i++) 347 { 348 element_to_perl_hash (e->args.list[i]); 349 sv = newRV_inc ((SV *) e->args.list[i]->hv); 350 av_push (av, sv); 351 } 352 } 353 354 if (e->text.space > 0) 355 { 356 sv = newSVpv (e->text.text, e->text.end); 357 if (e->cmd != CM_value) 358 hv_store (e->hv, "text", strlen ("text"), sv, 0); 359 else 360 hv_store (e->hv, "type", strlen ("type"), sv, 0); 361 362 SvUTF8_on (sv); 363 /* The strings here have to be in UTF-8 to start with. 364 This leads to an unnecessary round trip with "@documentencoding 365 ISO-8859-1" for Info and plain text output, when we first convert the 366 characters in the input file to UTF-8, and convert them back again for 367 the output. 368 369 The alternative is to leave the UTF-8 flag off, and hope that Perl 370 interprets 8-bit encodings like ISO-8859-1 correctly. See 371 "How does Perl store UTF-8 strings?" in "man perlguts". */ 372 } 373 374 if (e->extra_number > 0) 375 { 376 HV *extra; 377 int i; 378 int all_deleted = 1; 379 extra = newHV (); 380 381 for (i = 0; i < e->extra_number; i++) 382 { 383#define STORE(sv) hv_store (extra, key, strlen (key), sv, 0) 384 char *key = e->extra[i].key; 385 ELEMENT *f = e->extra[i].value; 386 387 if (e->extra[i].type == extra_deleted) 388 continue; 389 all_deleted = 0; 390 391 switch (e->extra[i].type) 392 { 393 case extra_element: 394 /* For references to other parts of the tree, create the hash so 395 we can point to it. */ 396 if (!f->hv) 397 f->hv = newHV (); 398 STORE(newRV_inc ((SV *)f->hv)); 399 break; 400 case extra_element_oot: 401 if (!f->hv) 402 element_to_perl_hash (f); 403 STORE(newRV_inc ((SV *)f->hv)); 404 break; 405 case extra_contents: 406 case extra_contents_oot: 407 { 408 if (f) 409 STORE(build_perl_array (&f->contents)); 410 break; 411 } 412 case extra_contents_array: 413 { 414 /* Like extra_contents, but this time output an array 415 of arrays (instead of an array). */ 416 int j; 417 AV *av; 418 av = newAV (); 419 STORE(newRV_inc ((SV *)av)); 420 for (j = 0; j < f->contents.number; j++) 421 { 422 SV *array; 423 ELEMENT *g; 424 425 g = f->contents.list[j]; 426 if (g) 427 array = build_perl_array (&g->contents); 428 else 429 array = newSV (0); /* undef */ 430 av_push (av, array); 431 } 432 break; 433 } 434 case extra_string: 435 { /* A simple string. */ 436 char *value = (char *) f; 437 STORE(newSVpv (value, 0)); 438 break; 439 } 440 case extra_integer: 441 { /* A simple integer. The intptr_t cast here prevents 442 a warning on MinGW ("cast from pointer to integer of 443 different size"). */ 444 IV value = (IV) (intptr_t) f; 445 STORE(newSViv (value)); 446 break; 447 } 448 case extra_misc_args: 449 { 450 int j; 451 AV *av; 452 av = newAV (); 453 STORE(newRV_inc ((SV *)av)); 454 /* An array of strings. */ 455 for (j = 0; j < f->contents.number; j++) 456 { 457 if (f->contents.list[j]->text.end > 0) 458 { 459 av_push (av, 460 newSVpv (f->contents.list[j]->text.text, 461 f->contents.list[j]->text.end)); 462 } 463 else 464 { 465 /* Empty strings permitted. */ 466 av_push (av, 467 newSVpv ("", 0)); 468 } 469 } 470 break; 471 } 472 case extra_node_spec: 473 /* A complex structure - see "parse_node_manual" function 474 in end_line.c */ 475 if (f) 476 STORE(build_node_spec ((NODE_SPEC_EXTRA *) f)); 477 break; 478 case extra_node_spec_array: 479 { 480 AV *av; 481 NODE_SPEC_EXTRA **array; 482 av = newAV (); 483 STORE(newRV_inc ((SV *)av)); 484 array = (NODE_SPEC_EXTRA **) f; 485 while (*array) 486 { 487 av_push (av, build_node_spec (*array)); 488 array++; 489 } 490 break; 491 } 492 case extra_index_entry: 493 /* A "index_entry" extra key on a command defining an index 494 entry. Unlike the other keys, the value is not in the 495 main parse tree, but in the indices_information. It would 496 be much nicer if we could get rid of the need for this key. 497 We set this afterwards in build_index_data. */ 498 break; 499 case extra_def_info: 500 { 501 DEF_INFO *d = (DEF_INFO *) f; 502 HV *def_parsed_hash; 503 504 /* Create a "def_parsed_hash" extra value. */ 505 def_parsed_hash = newHV (); 506 STORE(newRV_inc ((SV *)def_parsed_hash)); 507 508#define SAVE_DEF(X) { if (!d->X->hv) \ 509 element_to_perl_hash (d->X); \ 510 hv_store (def_parsed_hash, #X, strlen (#X), \ 511 newRV_inc ((SV *)d->X->hv), 0) ; } 512 513 if (d->category) 514 SAVE_DEF(category) 515 if (d->class) 516 SAVE_DEF(class) 517 if (d->type) 518 SAVE_DEF(type) 519 if (d->name) 520 SAVE_DEF(name) 521 break; 522 } 523 case extra_float_type: 524 { 525 EXTRA_FLOAT_TYPE *eft = (EXTRA_FLOAT_TYPE *) f; 526 HV *type = newHV (); 527 if (eft->content) 528 hv_store (type, "content", strlen ("content"), 529 build_perl_array (&eft->content->contents), 0); 530 if (eft->normalized) 531 hv_store (type, "normalized", strlen ("normalized"), 532 newSVpv (eft->normalized, 0), 0); 533 STORE(newRV_inc ((SV *)type)); 534 break; 535 } 536 default: 537 fatal ("unknown extra type"); 538 break; 539 } 540 } 541#undef STORE 542 543 if (!all_deleted) 544 hv_store (e->hv, "extra", strlen ("extra"), 545 newRV_inc((SV *)extra), 0); 546 } 547 548 if (e->line_nr.line_nr 549 && !(command_flags(e) & CF_INFOENCLOSE)) 550 { 551#define STORE(key, sv) hv_store (hv, key, strlen (key), sv, 0) 552 LINE_NR *line_nr = &e->line_nr; 553 HV *hv = newHV (); 554 hv_store (e->hv, "line_nr", strlen ("line_nr"), 555 newRV_inc((SV *)hv), 0); 556 557 if (line_nr->file_name) 558 { 559 STORE("file_name", newSVpv (line_nr->file_name, 0)); 560 } 561 else 562 STORE("file_name", newSVpv ("", 0)); 563 564 if (line_nr->line_nr) 565 { 566 STORE("line_nr", newSViv (line_nr->line_nr)); 567 } 568 569 if (line_nr->macro) 570 { 571 STORE("macro", newSVpv (line_nr->macro, 0)); 572 } 573 else 574 STORE("macro", newSVpv ("", 0)); 575#undef STORE 576 } 577} 578 579HV * 580build_texinfo_tree (void) 581{ 582 element_to_perl_hash (Root); 583 return Root->hv; 584} 585 586/* Return array of target elements. build_texinfo_tree must 587 be called first. */ 588AV * 589build_label_list (void) 590{ 591 AV *target_array; 592 SV *sv; 593 int i; 594 595 dTHX; 596 597 target_array = newAV (); 598 599 for (i = 0; i < labels_number; i++) 600 { 601 sv = newRV_inc (labels_list[i].target->hv); 602 av_push (target_array, sv); 603 } 604 605 return target_array; 606} 607 608AV * 609build_internal_xref_list (void) 610{ 611 AV *list_av; 612 SV *sv; 613 int i; 614 615 dTHX; 616 617 list_av = newAV (); 618 619 for (i = 0; i < internal_xref_number; i++) 620 { 621 sv = newRV_inc (internal_xref_list[i]->hv); 622 av_push (list_av, sv); 623 } 624 625 return list_av; 626} 627 628/* Return hash for list of @float's that appeared in the file. */ 629HV * 630build_float_list (void) 631{ 632 HV *float_hash; 633 SV **type_array; 634 SV *sv; 635 AV *av; 636 int i; 637 638 dTHX; 639 640 float_hash = newHV (); 641 642 for (i = 0; i < floats_number; i++) 643 { 644 type_array = hv_fetch (float_hash, 645 floats_list[i].type, 646 strlen (floats_list[i].type), 647 0); 648 if (!type_array) 649 { 650 av = newAV (); 651 hv_store (float_hash, 652 floats_list[i].type, 653 strlen (floats_list[i].type), 654 newRV_inc ((SV *)av), 655 0); 656 } 657 else 658 { 659 av = (AV *)SvRV (*type_array); 660 } 661 sv = newRV_inc ((SV *)floats_list[i].element->hv); 662 av_push (av, sv); 663 } 664 665 return float_hash; 666} 667 668/* Ensure that I->hv is a hash value for a single entry in 669 $self->{'index_names'}, containing information about a single index. */ 670static void 671build_single_index_data (INDEX *i) 672{ 673#define STORE(key, value) hv_store (hv, key, strlen (key), value, 0) 674 675 HV *hv; 676 AV *entries; 677 int j; 678 int entry_number; 679 680 dTHX; 681 682 if (!i->hv) 683 { 684 hv = newHV (); 685 i->hv = (void *) hv; 686 } 687 else 688 { 689 hv = (HV *) i->hv; 690 } 691 692 STORE("name", newSVpv (i->name, 0)); 693 STORE("in_code", i->in_code ? newSViv(1) : newSViv(0)); 694 695 if (i->merged_in) 696 { 697 /* This index is merged in another one. */ 698 INDEX *ultimate = ultimate_index (i); 699 700 if (!ultimate->hv) 701 { 702 ultimate->hv = (void *) newHV (); 703 ultimate->contained_hv = (void *) newHV (); 704 hv_store (ultimate->hv, 705 "contained_indices", 706 strlen ("contained_indices"), 707 newRV_inc ((SV *)(HV *) ultimate->contained_hv), 708 0); 709 } 710 711 hv_store (ultimate->contained_hv, i->name, strlen (i->name), 712 newSViv (1), 0); 713 714 STORE("merged_in", newSVpv (ultimate->name, 0)); 715 716 if (i->contained_hv) 717 { 718 /* This is unlikely to happen, as if this index is merged into 719 another one, any indices merged into this index would have been 720 recorded under that one, and not this one. */ 721 hv_delete (i->hv, 722 "contained_indices", strlen ("contained_indices"), 723 G_DISCARD); 724 i->contained_hv = 0; 725 } 726 } 727 else 728 { 729 if (!i->contained_hv) 730 { 731 i->contained_hv = newHV (); 732 STORE("contained_indices", newRV_inc ((SV *)(HV *) i->contained_hv)); 733 } 734 /* Record that this index "contains itself". */ 735 hv_store (i->contained_hv, i->name, strlen (i->name), newSViv(1), 0); 736 } 737 738 if (i->index_number > 0) 739 { 740 entries = newAV (); 741 STORE("index_entries", newRV_inc ((SV *) entries)); 742 } 743#undef STORE 744 745 entry_number = 1; 746 if (i->index_number > 0) 747 for (j = 0; j < i->index_number; j++) 748 { 749#define STORE2(key, value) hv_store (entry, key, strlen (key), value, 0) 750 HV *entry; 751 INDEX_ENTRY *e; 752 753 e = &i->index_entries[j]; 754 entry = newHV (); 755 756 STORE2("index_name", newSVpv (i->name, 0)); 757 STORE2("index_at_command", 758 newSVpv (command_name(e->index_at_command), 0)); 759 STORE2("index_type_command", 760 newSVpv (command_name(e->index_type_command), 0)); 761 STORE2("command", 762 newRV_inc ((SV *)e->command->hv)); 763 STORE2("number", newSViv (entry_number)); 764 if (e->region) 765 { 766 STORE2("region", newRV_inc ((SV *)e->region->hv)); 767 } 768 if (e->content) 769 { 770 SV **contents_array; 771 if (!e->content->hv) 772 { 773 if (e->content->parent) 774 fatal ("index element should not be in-tree"); 775 element_to_perl_hash (e->content); 776 } 777 contents_array = hv_fetch (e->content->hv, 778 "contents", strlen ("contents"), 0); 779 780 if (!contents_array) 781 { 782 element_to_perl_hash (e->content); 783 contents_array = hv_fetch (e->content->hv, 784 "contents", strlen ("contents"), 0); 785 } 786 787 if (contents_array) 788 { 789 /* Copy the reference to the array. */ 790 STORE2("content", newRV_inc ((SV *)(AV *)SvRV(*contents_array))); 791 792 STORE2("content_normalized", 793 newRV_inc ((SV *)(AV *)SvRV(*contents_array))); 794 } 795 else 796 { 797 STORE2("content", newRV_inc ((SV *)newAV ())); 798 STORE2("content_normalized", newRV_inc ((SV *)newAV ())); 799 } 800 } 801 else 802 ; /* will be set in Texinfo::Common::complete_indices */ 803 804 if (e->node) 805 STORE2("node", newRV_inc ((SV *)e->node->hv)); 806 if (e->sortas) 807 STORE2("sortas", newSVpv (e->sortas, 0)); 808 809 /* Skip these as these entries do not refer to the place in the document 810 where the index commands occurred. */ 811 if (!lookup_extra (e->command, "seeentry") 812 && !lookup_extra (e->command, "seealso")) 813 { 814 av_push (entries, newRV_inc ((SV *)entry)); 815 entry_number++; 816 } 817 818 /* We set this now because the index data structures don't 819 exist at the time that the main tree is built. */ 820 { 821 SV **extra_hash; 822 extra_hash = hv_fetch (e->command->hv, "extra", strlen ("extra"), 0); 823 if (!extra_hash) 824 { 825 /* There's no guarantee that the "extra" value was set on 826 the element. */ 827 extra_hash = hv_store (e->command->hv, "extra", strlen ("extra"), 828 newRV_inc ((SV *)newHV ()), 0); 829 } 830 831 hv_store ((HV *)SvRV(*extra_hash), "index_entry", strlen ("index_entry"), 832 newRV_inc ((SV *)entry), 0); 833 } 834#undef STORE2 835 } 836} 837 838/* Return object to be used as $self->{'index_names'} in the perl code. 839 build_texinfo_tree must be called before this so all the 'hv' fields 840 are set on the elements in the tree. */ 841HV * 842build_index_data (void) 843{ 844 HV *hv; 845 INDEX **i, *idx; 846 847 dTHX; 848 849 hv = newHV (); 850 851 for (i = index_names; (idx = *i); i++) 852 { 853 HV *hv2; 854 build_single_index_data (idx); 855 hv2 = idx->hv; 856 hv_store (hv, idx->name, strlen (idx->name), newRV_inc ((SV *)hv2), 0); 857 } 858 859 return hv; 860} 861 862 863/* Return object to be used as $self->{'info'} in the Perl code, retrievable 864 with the 'global_informations' function. */ 865HV * 866build_global_info (void) 867{ 868 HV *hv; 869 int i; 870 ELEMENT *e; 871 872 dTHX; 873 874 hv = newHV (); 875 if (global_info.input_encoding_name) 876 hv_store (hv, "input_encoding_name", strlen ("input_encoding_name"), 877 newSVpv (global_info.input_encoding_name, 0), 0); 878 if (global_info.input_perl_encoding) 879 hv_store (hv, "input_perl_encoding", strlen ("input_perl_encoding"), 880 newSVpv (global_info.input_perl_encoding, 0), 0); 881 882 if (global_info.dircategory_direntry.contents.number > 0) 883 { 884 AV *av = newAV (); 885 hv_store (hv, "dircategory_direntry", strlen ("dircategory_direntry"), 886 newRV_inc ((SV *) av), 0); 887 for (i = 0; i < global_info.dircategory_direntry.contents.number; i++) 888 { 889 e = contents_child_by_index (&global_info.dircategory_direntry, i); 890 if (e->hv) 891 av_push (av, newRV_inc ((SV *) e->hv)); 892 } 893 } 894 895 if (global_info.novalidate) 896 { 897 hv_store (hv, "novalidate", strlen ("novalidate"), 898 newSVpv ("1", 0), 0); 899 } 900 901 char *txi_flags[] = { "txiindexatsignignore", "txiindexbackslashignore", 902 "txiindexhyphenignore", "txiindexlessthanignore", 0}; 903 char **p; 904 905 for (p = txi_flags; (*p); p++) 906 { 907 if (fetch_value (*p)) 908 hv_store (hv, *p, strlen (*p), newSVpv ("1", 0), 0); 909 } 910 911 return hv; 912} 913 914/* Return object to be used as $self->{'extra'} in the Perl code, which 915 are mostly references to tree elements. */ 916HV * 917build_global_info2 (void) 918{ 919 HV *hv; 920 AV *av; 921 int i; 922 ELEMENT *e; 923 924 dTHX; 925 926 hv = newHV (); 927 928 /* These should be unique elements. */ 929 930#define BUILD_GLOBAL_UNIQ(cmd) \ 931 if (global_info.cmd && global_info.cmd->hv) \ 932 { \ 933 hv_store (hv, #cmd, strlen (#cmd), \ 934 newRV_inc ((SV *) global_info.cmd->hv), 0); \ 935 } 936 937 BUILD_GLOBAL_UNIQ(setfilename); 938 BUILD_GLOBAL_UNIQ(settitle); 939 BUILD_GLOBAL_UNIQ(copying); 940 BUILD_GLOBAL_UNIQ(titlepage); 941 BUILD_GLOBAL_UNIQ(top); 942 BUILD_GLOBAL_UNIQ(documentdescription); 943 BUILD_GLOBAL_UNIQ(pagesizes); 944 BUILD_GLOBAL_UNIQ(fonttextsize); 945 BUILD_GLOBAL_UNIQ(footnotestyle); 946 BUILD_GLOBAL_UNIQ(setchapternewpage); 947 BUILD_GLOBAL_UNIQ(everyheading); 948 BUILD_GLOBAL_UNIQ(everyfooting); 949 BUILD_GLOBAL_UNIQ(evenheading); 950 BUILD_GLOBAL_UNIQ(evenfooting); 951 BUILD_GLOBAL_UNIQ(oddheading); 952 BUILD_GLOBAL_UNIQ(oddfooting); 953 BUILD_GLOBAL_UNIQ(everyheadingmarks); 954 BUILD_GLOBAL_UNIQ(everyfootingmarks); 955 BUILD_GLOBAL_UNIQ(evenheadingmarks); 956 BUILD_GLOBAL_UNIQ(oddheadingmarks); 957 BUILD_GLOBAL_UNIQ(evenfootingmarks); 958 BUILD_GLOBAL_UNIQ(oddfootingmarks); 959 BUILD_GLOBAL_UNIQ(shorttitlepage); 960 BUILD_GLOBAL_UNIQ(title); 961#undef BUILD_GLOBAL_UNIQ 962 963 /* NOTE: Same list in handle_commands.c:register_global_command. */ 964 965 /* The following are arrays of elements. */ 966 967 968 if (global_info.footnotes.contents.number > 0) 969 { 970 av = newAV (); 971 hv_store (hv, "footnote", strlen ("footnote"), 972 newRV_inc ((SV *) av), 0); 973 for (i = 0; i < global_info.footnotes.contents.number; i++) 974 { 975 e = contents_child_by_index (&global_info.footnotes, i); 976 if (e->hv) 977 av_push (av, newRV_inc ((SV *) e->hv)); 978 } 979 } 980 981#define BUILD_GLOBAL_ARRAY(cmd) \ 982 if (global_info.cmd.contents.number > 0) \ 983 { \ 984 av = newAV (); \ 985 hv_store (hv, #cmd, strlen (#cmd), \ 986 newRV_inc ((SV *) av), 0); \ 987 for (i = 0; i < global_info.cmd.contents.number; i++) \ 988 { \ 989 e = contents_child_by_index (&global_info.cmd, i); \ 990 if (e->hv) \ 991 av_push (av, newRV_inc ((SV *) e->hv)); \ 992 } \ 993 } 994 995 BUILD_GLOBAL_ARRAY(hyphenation); 996 BUILD_GLOBAL_ARRAY(insertcopying); 997 BUILD_GLOBAL_ARRAY(printindex); 998 BUILD_GLOBAL_ARRAY(subtitle); 999 BUILD_GLOBAL_ARRAY(titlefont); 1000 BUILD_GLOBAL_ARRAY(listoffloats); 1001 BUILD_GLOBAL_ARRAY(detailmenu); 1002 BUILD_GLOBAL_ARRAY(part); 1003 1004 /* from Common.pm %document_settable_at_commands */ 1005 BUILD_GLOBAL_ARRAY(allowcodebreaks); 1006 BUILD_GLOBAL_ARRAY(clickstyle); 1007 BUILD_GLOBAL_ARRAY(codequotebacktick); 1008 BUILD_GLOBAL_ARRAY(codequoteundirected); 1009 BUILD_GLOBAL_ARRAY(contents); 1010 BUILD_GLOBAL_ARRAY(deftypefnnewline); 1011 BUILD_GLOBAL_ARRAY(documentencoding); 1012 BUILD_GLOBAL_ARRAY(documentlanguage); 1013 BUILD_GLOBAL_ARRAY(exampleindent); 1014 BUILD_GLOBAL_ARRAY(firstparagraphindent); 1015 BUILD_GLOBAL_ARRAY(frenchspacing); 1016 BUILD_GLOBAL_ARRAY(headings); 1017 BUILD_GLOBAL_ARRAY(kbdinputstyle); 1018 BUILD_GLOBAL_ARRAY(paragraphindent); 1019 BUILD_GLOBAL_ARRAY(shortcontents); 1020 BUILD_GLOBAL_ARRAY(urefbreakstyle); 1021 BUILD_GLOBAL_ARRAY(xrefautomaticsectiontitle); 1022 return hv; 1023} 1024 1025/* for debugging */ 1026void 1027set_debug (int value) 1028{ 1029 debug_output = value; 1030} 1031 1032