1------------------------------------------------------------------------------ 2-- -- 3-- GNAT SYSTEM UTILITIES -- 4-- -- 5-- X G N A T U G N -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2003-2013, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING3. If not, go to -- 19-- http://www.gnu.org/licenses for a complete copy of the license. -- 20-- -- 21------------------------------------------------------------------------------ 22 23-- This utility is used to process the source of gnat_ugn.texi to make a 24-- version suitable for running through standard Texinfo processor. It is 25-- invoked as follows: 26 27-- xgnatugn <target> <in-file> <word-list> [ <out-file> [ <warnings> ] ] 28 29-- 1. <target> is the target type of the manual, which is one of: 30 31-- unw Unix and Windows platforms 32-- vms OpenVMS 33 34-- 2. <in-file> is the file name of the Texinfo file to be 35-- preprocessed. 36 37-- 3. <word-list> is the name of the word list file. This file is used for 38-- rewriting the VMS edition. Each line contains a word mapping: The source 39-- word in the first column, the target word in the second column. The 40-- columns are separated by a '^' character. When preprocessing for VMS, the 41-- first word is replaced with the second. (Words consist of letters, 42-- digits, and the four characters "?-_~". A sequence of multiple words can 43-- be replaced if they are listed in the first column, separated by a single 44-- space character. If multiple words are to be replaced, there must be a 45-- replacement for each prefix.) 46 47-- 4. <out-file> (optional) is the name of the output file. It defaults to 48-- gnat_ugn_unw.texi or gnat_ugn_vms.texi, depending on the target. 49 50-- 5. <warnings> (optional, and allowed only if <out-file> is explicit) 51-- can be any string. If present, it indicates that warning messages are 52-- to be output to Standard_Error. If absent, no warning messages are 53-- generated. 54 55-- The following steps are performed: 56 57-- In VMS mode 58 59-- Any occurrences of ^alpha^beta^ are replaced by beta. The sequence 60-- must fit on a single line, and there can only be one occurrence on a 61-- line. 62 63-- Any occurrences of a word in the Ug_Words list are replaced by the 64-- appropriate vms equivalents. Note that replacements do not occur 65-- within ^alpha^beta^ sequences. 66 67-- Any occurrence of [filename].extension, where extension one of the 68-- following: 69 70-- "o", "ads", "adb", "ali", "ada", "atb", "ats", "adc", "c" 71 72-- replaced by the appropriate VMS names (all upper case with .o 73-- replaced .OBJ). Note that replacements do not occur within 74-- ^alpha^beta^ sequences. 75 76-- In UNW mode 77 78-- Any occurrences of ^alpha^beta^ are replaced by alpha. The sequence 79-- must fit on a single line. 80 81-- In both modes 82 83-- The sequence ^^^ is replaced by a single ^. This escape sequence 84-- must be used if the literal character ^ is to appear in the 85-- output. A line containing this escape sequence may not also contain 86-- a ^alpha^beta^ sequence. 87 88with Ada.Command_Line; use Ada.Command_Line; 89with Ada.Strings; use Ada.Strings; 90with Ada.Strings.Fixed; use Ada.Strings.Fixed; 91with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; 92with Ada.Strings.Maps; use Ada.Strings.Maps; 93with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; 94with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO; 95with Ada.Text_IO; use Ada.Text_IO; 96 97with GNAT.Spitbol; use GNAT.Spitbol; 98with GNAT.Spitbol.Table_VString; use GNAT.Spitbol.Table_VString; 99 100procedure Xgnatugn is 101 102 procedure Usage; 103 -- Print usage information. Invoked if an invalid command line is 104 -- encountered. 105 106 subtype Sfile is Ada.Streams.Stream_IO.File_Type; 107 108 Output_File : Sfile; 109 -- The preprocessed output is written to this file 110 111 type Input_File is record 112 Name : VString; 113 Data : Ada.Text_IO.File_Type; 114 Line : Natural := 0; 115 end record; 116 -- Records information on an input file. Name and Line are used 117 -- in error messages, Line is updated automatically by Get_Line. 118 119 function Get_Line (Input : access Input_File) return String; 120 -- Returns a line from Input and performs the necessary 121 -- line-oriented checks (length, character set, trailing spaces). 122 123 procedure Put_Line (F : Sfile; S : String); 124 -- Local version of Put_Line ensures Unix style line endings 125 126 First_Time : Boolean := True; 127 Number_Of_Warnings : Natural := 0; 128 Number_Of_Errors : Natural := 0; 129 Warnings_Enabled : Boolean; 130 131 procedure Error 132 (Input : Input_File; 133 At_Character : Natural; 134 Message : String); 135 procedure Error 136 (Input : Input_File; 137 Message : String); 138 -- Prints a message reporting an error on line Input.Line. If 139 -- At_Character is not 0, indicate the exact character at which 140 -- the error occurs. 141 142 procedure Warning 143 (Input : Input_File; 144 At_Character : Natural; 145 Message : String); 146 147 Dictionary_File : aliased Input_File; 148 procedure Read_Dictionary_File; 149 -- Dictionary_File is opened using the name given on the command 150 -- line. It contains the replacements for the Ug_Words list. 151 -- Read_Dictionary_File reads Dictionary_File and fills the 152 -- Ug_Words table. 153 154 Source_File : aliased Input_File; 155 procedure Process_Source_File; 156 -- Source_File is opened using the name given on the command line. 157 -- It contains the Texinfo source code. Process_Source_File 158 -- performs the necessary replacements. 159 160 type Flag_Type is (UNW, VMS, FSFEDITION, PROEDITION, GPLEDITION); 161 -- The flags permitted in @ifset or @ifclear commands: 162 -- 163 -- Targets for preprocessing 164 -- UNW (Unix and Windows) or VMS 165 -- 166 -- Editions of the manual 167 -- FSFEDITION, PROEDITION, or GPLEDITION 168 -- 169 -- Conditional commands for target are processed by xgnatugn 170 -- 171 -- Conditional commands for edition are passed through unchanged 172 173 subtype Target_Type is Flag_Type range UNW .. VMS; 174 175 Target : Target_Type; 176 -- The Target variable is initialized using the command line 177 178 Valid_Characters : constant Character_Set := To_Set (Span => (' ', '~')); 179 -- This array controls which characters are permitted in the input 180 -- file (after line breaks have been removed). Valid characters 181 -- are all printable ASCII characters and the space character. 182 183 Word_Characters : constant Character_Set := 184 (To_Set (Ranges => 185 (('0', '9'), ('a', 'z'), ('A', 'Z'))) 186 or To_Set ("?-_~")); 187 -- The characters which are permitted in words. Other (valid) 188 -- characters are assumed to be delimiters between words. Note that 189 -- this set has to include all characters of the source words of the 190 -- Ug_Words dictionary. 191 192 Reject_Trailing_Spaces : constant Boolean := True; 193 -- Controls whether Xgnatug rejects superfluous space characters 194 -- at the end of lines. 195 196 Maximum_Line_Length : constant Positive := 79; 197 Fatal_Line_Length_Limit : constant Positive := 5000; 198 Fatal_Line_Length : exception; 199 -- If Maximum_Line_Length is exceeded in an input file, an error 200 -- message is printed. If Fatal_Line_Length is exceeded, 201 -- execution terminates with a Fatal_Line_Length exception. 202 203 VMS_Escape_Character : constant Character := '^'; 204 -- The character used to mark VMS alternatives (^alpha^beta^) 205 206 Extensions : GNAT.Spitbol.Table_VString.Table (20); 207 procedure Initialize_Extensions; 208 -- This table records extensions and their replacement for 209 -- rewriting filenames in the VMS version of the manual. 210 211 function Is_Extension (Extension : String) return Boolean; 212 function Get_Replacement_Extension (Extension : String) return String; 213 -- These functions query the replacement table. Is_Extension 214 -- checks if the given string is a known extension. 215 -- Get_Replacement returns the replacement extension. 216 217 Ug_Words : GNAT.Spitbol.Table_VString.Table (200); 218 function Is_Known_Word (Word : String) return Boolean; 219 function Get_Replacement_Word (Word : String) return String; 220 -- The Ug_Words table lists replacement words for the VMS version 221 -- of the manual. Is_Known_Word and Get_Replacement_Word query 222 -- this table. The table is filled using Read_Dictionary_File. 223 224 function Rewrite_Source_Line (Line : String) return String; 225 -- This subprogram takes a line and rewrites it according to Target. 226 -- It relies on information in Source_File to generate error messages. 227 228 ----------- 229 -- Usage -- 230 ----------- 231 232 procedure Usage is 233 begin 234 Put_Line (Standard_Error, 235 "usage: xgnatugn TARGET SOURCE DICTIONARY [OUTFILE [WARNINGS]]"); 236 New_Line; 237 Put_Line (Standard_Error, "TARGET is one of:"); 238 239 for T in Target_Type'Range loop 240 Put_Line (Standard_Error, " " & Target_Type'Image (T)); 241 end loop; 242 243 New_Line; 244 Put_Line (Standard_Error, "SOURCE is the source file to process."); 245 New_Line; 246 Put_Line (Standard_Error, "DICTIONARY is the name of a file " 247 & "that contains word replacements"); 248 Put_Line (Standard_Error, "for the VMS version."); 249 New_Line; 250 Put_Line (Standard_Error, 251 "OUT-FILE, if present, is the output file to be created;"); 252 Put_Line (Standard_Error, 253 "If OUT-FILE is absent, the output file is either " & 254 "gnat_ugn_unw.texi, "); 255 Put_Line (Standard_Error, 256 "or gnat_ugn_vms.texi, depending on TARGET."); 257 New_Line; 258 Put_Line (Standard_Error, 259 "WARNINGS, if present, is any string;"); 260 Put_Line (Standard_Error, 261 "it will result in warning messages (e.g., line too long))"); 262 Put_Line (Standard_Error, 263 "being output to Standard_Error."); 264 end Usage; 265 266 -------------- 267 -- Get_Line -- 268 -------------- 269 270 function Get_Line (Input : access Input_File) return String is 271 Line_Buffer : String (1 .. Fatal_Line_Length_Limit); 272 Last : Natural; 273 274 begin 275 Input.Line := Input.Line + 1; 276 Get_Line (Input.Data, Line_Buffer, Last); 277 278 if Last = Line_Buffer'Last then 279 Error (Input.all, "line exceeds fatal line length limit"); 280 raise Fatal_Line_Length; 281 end if; 282 283 declare 284 Line : String renames Line_Buffer (Line_Buffer'First .. Last); 285 286 begin 287 for J in Line'Range loop 288 if not Is_In (Line (J), Valid_Characters) then 289 Error (Input.all, J, "invalid character"); 290 exit; 291 end if; 292 end loop; 293 294 if Line'Length > Maximum_Line_Length then 295 Warning (Input.all, Maximum_Line_Length + 1, "line too long"); 296 end if; 297 298 if Reject_Trailing_Spaces 299 and then Line'Length > 0 300 and then Line (Line'Last) = ' ' 301 then 302 Error (Input.all, Line'Last, "trailing space character"); 303 end if; 304 305 return Trim (Line, Right); 306 end; 307 end Get_Line; 308 309 -------------- 310 -- Put_Line -- 311 -------------- 312 313 procedure Put_Line (F : Sfile; S : String) is 314 begin 315 String'Write (Stream (F), S); 316 Character'Write (Stream (F), ASCII.LF); 317 end Put_Line; 318 319 ----------- 320 -- Error -- 321 ----------- 322 323 procedure Error 324 (Input : Input_File; 325 Message : String) 326 is 327 begin 328 Error (Input, 0, Message); 329 end Error; 330 331 procedure Error 332 (Input : Input_File; 333 At_Character : Natural; 334 Message : String) 335 is 336 Line_Image : constant String := Integer'Image (Input.Line); 337 At_Character_Image : constant String := Integer'Image (At_Character); 338 -- These variables are required because we have to drop the leading 339 -- space character. 340 341 begin 342 Number_Of_Errors := Number_Of_Errors + 1; 343 344 if At_Character > 0 then 345 Put_Line (Standard_Error, 346 S (Input.Name) & ':' 347 & Line_Image (Line_Image'First + 1 .. Line_Image'Last) & ':' 348 & At_Character_Image (At_Character_Image'First + 1 349 .. At_Character_Image'Last) 350 & ": " 351 & Message); 352 else 353 Put_Line (Standard_Error, 354 S (Input.Name) & ':' 355 & Line_Image (Line_Image'First + 1 .. Line_Image'Last) 356 & ": " 357 & Message); 358 end if; 359 end Error; 360 361 ------------- 362 -- Warning -- 363 ------------- 364 365 procedure Warning 366 (Input : Input_File; 367 At_Character : Natural; 368 Message : String) 369 is 370 Line_Image : constant String := Integer'Image (Input.Line); 371 At_Character_Image : constant String := Integer'Image (At_Character); 372 -- These variables are required because we have to drop the leading 373 -- space character. 374 375 begin 376 if not Warnings_Enabled then 377 return; 378 end if; 379 380 Number_Of_Warnings := Number_Of_Warnings + 1; 381 382 if At_Character > 0 then 383 Put_Line (Standard_Error, 384 S (Input.Name) & ':' 385 & Line_Image (Line_Image'First + 1 .. Line_Image'Last) & ':' 386 & At_Character_Image (At_Character_Image'First + 1 387 .. At_Character_Image'Last) 388 & ": warning: " 389 & Message); 390 else 391 Put_Line (Standard_Error, 392 S (Input.Name) & ':' 393 & Line_Image (Line_Image'First + 1 .. Line_Image'Last) 394 & ": warning: " 395 & Message); 396 end if; 397 end Warning; 398 399 -------------------------- 400 -- Read_Dictionary_File -- 401 -------------------------- 402 403 procedure Read_Dictionary_File is 404 begin 405 while not End_Of_File (Dictionary_File.Data) loop 406 declare 407 Line : constant String := 408 Get_Line (Dictionary_File'Access); 409 Split : constant Natural := 410 Index (Line, (1 => VMS_Escape_Character)); 411 412 begin 413 if Line'Length = 0 then 414 Error (Dictionary_File, "empty line in dictionary file"); 415 416 elsif Line (Line'First) = ' ' then 417 Error (Dictionary_File, 1, "line starts with space character"); 418 419 elsif Split = 0 then 420 Error (Dictionary_File, "line does not contain " 421 & VMS_Escape_Character & " character"); 422 else 423 declare 424 Source : constant String := 425 Trim (Line (1 .. Split - 1), Both); 426 Target : constant String := 427 Trim (Line (Split + 1 .. Line'Last), Both); 428 429 Two_Spaces : constant Natural := Index (Source, " "); 430 431 Non_Word_Character : constant Natural := 432 Index (Source, 433 Word_Characters or 434 To_Set (" ."), 435 Outside); 436 437 begin 438 if Two_Spaces /= 0 then 439 Error (Dictionary_File, Two_Spaces, 440 "multiple space characters in source word"); 441 end if; 442 443 if Non_Word_Character /= 0 then 444 Error (Dictionary_File, Non_Word_Character, 445 "illegal character in source word"); 446 end if; 447 448 if Source'Length = 0 then 449 Error (Dictionary_File, "source is empty"); 450 451 elsif Target'Length = 0 then 452 Error (Dictionary_File, "target is empty"); 453 454 else 455 Set (Ug_Words, Source, V (Target)); 456 457 -- Ensure that if Source is a sequence of words 458 -- "WORD1 WORD2 ...", we already have a mapping for 459 -- "WORD1". 460 461 for J in Source'Range loop 462 if Source (J) = ' ' then 463 declare 464 Prefix : String renames 465 Source (Source'First .. J - 1); 466 begin 467 if not Is_Known_Word (Prefix) then 468 Error (Dictionary_File, 469 "prefix '" & Prefix 470 & "' not known at this point"); 471 end if; 472 end; 473 end if; 474 end loop; 475 end if; 476 end; 477 end if; 478 end; 479 end loop; 480 end Read_Dictionary_File; 481 482 ------------------------- 483 -- Rewrite_Source_Line -- 484 ------------------------- 485 486 function Rewrite_Source_Line (Line : String) return String is 487 488 -- We use a simple lexer to split the line into tokens: 489 490 -- Word consisting entirely of Word_Characters 491 -- VMS_Alternative ^alpha^beta^ replacement (but not ^^^) 492 -- Space a space character 493 -- Other everything else (sequence of non-word characters) 494 -- VMS_Error incomplete VMS alternative 495 -- End_Of_Line no more characters on this line 496 497 -- A sequence of three VMS_Escape_Characters is automatically 498 -- collapsed to an Other token. 499 500 type Token_Span is record 501 First, Last : Positive; 502 end record; 503 -- The character range covered by a token in Line 504 505 type Token_Kind is (End_Of_Line, Word, Other, 506 VMS_Alternative, VMS_Error); 507 type Token_Record (Kind : Token_Kind := End_Of_Line) is record 508 First : Positive; 509 case Kind is 510 when Word | Other => 511 Span : Token_Span; 512 when VMS_Alternative => 513 Non_VMS, VMS : Token_Span; 514 when VMS_Error | End_Of_Line => 515 null; 516 end case; 517 end record; 518 519 Input_Position : Positive := Line'First; 520 Token : Token_Record; 521 -- The position of the next character to be processed by Next_Token 522 523 procedure Next_Token; 524 -- Returns the next token in Line, starting at Input_Position 525 526 Rewritten_Line : VString; 527 -- Collects the line as it is rewritten 528 529 procedure Rewrite_Word; 530 -- The current token is assumed to be a Word. When processing the VMS 531 -- version of the manual, additional tokens are gathered to check if 532 -- we have a file name or a sequence of known words. 533 534 procedure Maybe_Rewrite_Extension; 535 -- The current token is assumed to be Other. When processing the VMS 536 -- version of the manual and the token represents a single dot ".", 537 -- the following word is rewritten according to the rules for 538 -- extensions. 539 540 VMS_Token_Seen : Boolean := False; 541 -- This is set to true if a VMS_Alternative has been encountered, or a 542 -- ^^^ token. 543 544 ---------------- 545 -- Next_Token -- 546 ---------------- 547 548 procedure Next_Token is 549 Remaining_Line : String renames Line (Input_Position .. Line'Last); 550 Last_Character : Natural; 551 552 begin 553 if Remaining_Line'Length = 0 then 554 Token := (End_Of_Line, Remaining_Line'First); 555 return; 556 end if; 557 558 -- ^alpha^beta^, the VMS_Alternative case 559 560 if Remaining_Line (Remaining_Line'First) = VMS_Escape_Character then 561 declare 562 VMS_Second_Character, VMS_Third_Character : Natural; 563 564 begin 565 if VMS_Token_Seen then 566 Error (Source_File, Remaining_Line'First, 567 "multiple " & VMS_Escape_Character 568 & " characters on a single line"); 569 else 570 VMS_Token_Seen := True; 571 end if; 572 573 -- Find the second and third escape character. If one of 574 -- them is not present, generate an error token. 575 576 VMS_Second_Character := 577 Index (Remaining_Line (Remaining_Line'First + 1 578 .. Remaining_Line'Last), 579 (1 => VMS_Escape_Character)); 580 581 if VMS_Second_Character = 0 then 582 Input_Position := Remaining_Line'Last + 1; 583 Token := (VMS_Error, Remaining_Line'First); 584 return; 585 end if; 586 587 VMS_Third_Character := 588 Index (Remaining_Line (VMS_Second_Character + 1 589 .. Remaining_Line'Last), 590 (1 => VMS_Escape_Character)); 591 592 if VMS_Third_Character = 0 then 593 Input_Position := Remaining_Line'Last + 1; 594 Token := (VMS_Error, Remaining_Line'First); 595 return; 596 end if; 597 598 -- Consume all the characters we are about to include in 599 -- the token. 600 601 Input_Position := VMS_Third_Character + 1; 602 603 -- Check if we are in a ^^^ situation, and return an Other 604 -- token in this case. 605 606 if Remaining_Line'First + 1 = VMS_Second_Character 607 and then Remaining_Line'First + 2 = VMS_Third_Character 608 then 609 Token := (Other, Remaining_Line'First, 610 (Remaining_Line'First, Remaining_Line'First)); 611 return; 612 end if; 613 614 Token := (VMS_Alternative, Remaining_Line'First, 615 (Remaining_Line'First + 1, VMS_Second_Character - 1), 616 (VMS_Second_Character + 1, VMS_Third_Character - 1)); 617 return; 618 end; 619 end if; 620 621 -- The Word case. Search for characters not in Word_Characters. 622 -- We have found a word if the first non-word character is not 623 -- the first character in Remaining_Line, i.e. if Remaining_Line 624 -- starts with a word character. 625 626 Last_Character := Index (Remaining_Line, Word_Characters, Outside); 627 if Last_Character /= Remaining_Line'First then 628 629 -- If we haven't found a character which is not in 630 -- Word_Characters, all remaining characters are part of the 631 -- current Word token. 632 633 if Last_Character = 0 then 634 Last_Character := Remaining_Line'Last + 1; 635 end if; 636 637 Input_Position := Last_Character; 638 Token := (Word, Remaining_Line'First, 639 (Remaining_Line'First, Last_Character - 1)); 640 return; 641 end if; 642 643 -- Remaining characters are in the Other category. To speed 644 -- up processing, we collect them together if there are several 645 -- of them. 646 647 Input_Position := Last_Character + 1; 648 Token := (Other, 649 Remaining_Line'First, 650 (Remaining_Line'First, Last_Character)); 651 end Next_Token; 652 653 ------------------ 654 -- Rewrite_Word -- 655 ------------------ 656 657 procedure Rewrite_Word is 658 First_Word : String 659 renames Line (Token.Span.First .. Token.Span.Last); 660 661 begin 662 -- We do not perform any error checking below, so we can just skip 663 -- all processing for the non-VMS version. 664 665 if Target /= VMS then 666 Append (Rewritten_Line, First_Word); 667 Next_Token; 668 return; 669 end if; 670 671 if Is_Known_Word (First_Word) then 672 673 -- If we have a word from the dictionary, we look for the 674 -- longest possible sequence we can rewrite. 675 676 declare 677 Seq : Token_Span := Token.Span; 678 Lost_Space : Boolean := False; 679 680 begin 681 Next_Token; 682 loop 683 if Token.Kind = Other 684 and then Line (Token.Span.First .. Token.Span.Last) = " " 685 then 686 Next_Token; 687 688 if Token.Kind /= Word 689 or else not Is_Known_Word (Line (Seq.First 690 .. Token.Span.Last)) 691 then 692 -- When we reach this point, the following conditions 693 -- are true: 694 695 -- Seq is a known word 696 697 -- The previous token was a space character 698 699 -- Seq extended to the current token is not a 700 -- known word. 701 702 Lost_Space := True; 703 exit; 704 705 else 706 -- Extend Seq to cover the current (known) word 707 708 Seq.Last := Token.Span.Last; 709 Next_Token; 710 end if; 711 712 else 713 -- When we reach this point, the following conditions 714 -- are true: 715 716 -- Seq is a known word 717 718 -- The previous token was a word 719 720 -- The current token is not a space character. 721 722 exit; 723 end if; 724 end loop; 725 726 -- Rewrite Seq, and add the lost space if necessary 727 728 Append (Rewritten_Line, 729 Get_Replacement_Word (Line (Seq.First .. Seq.Last))); 730 if Lost_Space then 731 Append (Rewritten_Line, ' '); 732 end if; 733 734 -- The unknown token will be processed during the 735 -- next iteration of the main loop. 736 return; 737 end; 738 end if; 739 740 Next_Token; 741 742 if Token.Kind = Other 743 and then Line (Token.Span.First .. Token.Span.Last) = "." 744 then 745 -- Deal with extensions 746 747 Next_Token; 748 if Token.Kind = Word 749 and then 750 Is_Extension (Line (Token.Span.First .. Token.Span.Last)) 751 then 752 -- We have discovered a file extension. Convert the file 753 -- name to upper case. 754 755 Append (Rewritten_Line, 756 Translate (First_Word, Upper_Case_Map) & '.'); 757 Append (Rewritten_Line, 758 Get_Replacement_Extension 759 (Line (Token.Span.First .. Token.Span.Last))); 760 Next_Token; 761 else 762 -- We already have: Word ".", followed by an unknown token 763 764 Append (Rewritten_Line, First_Word & '.'); 765 766 -- The unknown token will be processed during the next 767 -- iteration of the main loop. 768 end if; 769 770 else 771 -- We have an unknown Word, followed by an unknown token. 772 -- The unknown token will be processed by the outer loop. 773 774 Append (Rewritten_Line, First_Word); 775 end if; 776 end Rewrite_Word; 777 778 ----------------------------- 779 -- Maybe_Rewrite_Extension -- 780 ----------------------------- 781 782 procedure Maybe_Rewrite_Extension is 783 begin 784 -- Again, we need no special processing in the non-VMS case 785 786 if Target = VMS 787 and then Line (Token.Span.First .. Token.Span.Last) = "." 788 then 789 -- This extension is not preceded by a word, otherwise 790 -- Rewrite_Word would have handled it. 791 792 Next_Token; 793 794 if Token.Kind = Word 795 and then Is_Extension (Line (Token.Span.First 796 .. Token.Span.Last)) 797 then 798 Append (Rewritten_Line, '.' & Get_Replacement_Extension 799 (Line (Token.Span.First .. Token.Span.Last))); 800 Next_Token; 801 else 802 Append (Rewritten_Line, '.'); 803 end if; 804 805 else 806 Append (Rewritten_Line, Line (Token.Span.First 807 .. Token.Span.Last)); 808 Next_Token; 809 end if; 810 end Maybe_Rewrite_Extension; 811 812 -- Start of processing for Process_Source_Line 813 814 begin 815 -- The following parser recognizes the following special token 816 -- sequences: 817 818 -- Word "." Word rewrite as file name if second word is extension 819 -- Word " " Word rewrite as a single word using Ug_Words table 820 821 Next_Token; 822 loop 823 case Token.Kind is 824 when End_Of_Line => 825 exit; 826 827 when Word => 828 Rewrite_Word; 829 830 when Other => 831 Maybe_Rewrite_Extension; 832 833 when VMS_Alternative => 834 if Target = VMS then 835 Append (Rewritten_Line, Line (Token.VMS.First 836 .. Token.VMS.Last)); 837 else 838 Append (Rewritten_Line, Line (Token.Non_VMS.First 839 .. Token.Non_VMS.Last)); 840 end if; 841 842 Next_Token; 843 844 when VMS_Error => 845 Error (Source_File, Token.First, "invalid VMS alternative"); 846 Next_Token; 847 end case; 848 end loop; 849 850 return S (Rewritten_Line); 851 end Rewrite_Source_Line; 852 853 ------------------------- 854 -- Process_Source_File -- 855 ------------------------- 856 857 procedure Process_Source_File is 858 begin 859 while not End_Of_File (Source_File.Data) loop 860 declare 861 Line : constant String := Get_Line (Source_File'Access); 862 863 Rewritten : constant String := Rewrite_Source_Line (Line); 864 -- We unconditionally rewrite the line so that we can check the 865 -- syntax of all lines, and not only those which are actually 866 -- included in the output. 867 868 begin 869 if First_Time 870 and then Line'Length > 3 and then Line (1 .. 3) = "@if" 871 then 872 Put_Line (Output_File, "@set " & Argument (1)); 873 First_Time := False; 874 end if; 875 876 Put_Line (Output_File, Rewritten); 877 end; 878 end loop; 879 end Process_Source_File; 880 881 --------------------------- 882 -- Initialize_Extensions -- 883 --------------------------- 884 885 procedure Initialize_Extensions is 886 887 procedure Add (Extension : String); 888 -- Adds an extension which is replaced with itself (in upper case) 889 890 procedure Add (Extension, Replacement : String); 891 -- Adds an extension with a custom replacement 892 893 --------- 894 -- Add -- 895 --------- 896 897 procedure Add (Extension : String) is 898 begin 899 Add (Extension, Translate (Extension, Upper_Case_Map)); 900 end Add; 901 902 procedure Add (Extension, Replacement : String) is 903 begin 904 Set (Extensions, Extension, V (Replacement)); 905 end Add; 906 907 -- Start of processing for Initialize_Extensions 908 909 begin 910 -- To avoid performance degradation, increase the constant in the 911 -- definition of Extensions above if you add more extensions here. 912 913 Add ("o", "OBJ"); 914 Add ("ads"); 915 Add ("adb"); 916 Add ("ali"); 917 Add ("ada"); 918 Add ("atb"); 919 Add ("ats"); 920 Add ("adc"); 921 Add ("c"); 922 end Initialize_Extensions; 923 924 ------------------ 925 -- Is_Extension -- 926 ------------------ 927 928 function Is_Extension (Extension : String) return Boolean is 929 begin 930 return Present (Extensions, Extension); 931 end Is_Extension; 932 933 ------------------------------- 934 -- Get_Replacement_Extension -- 935 ------------------------------- 936 937 function Get_Replacement_Extension (Extension : String) return String is 938 begin 939 return S (Get (Extensions, Extension)); 940 end Get_Replacement_Extension; 941 942 ------------------- 943 -- Is_Known_Word -- 944 ------------------- 945 946 function Is_Known_Word (Word : String) return Boolean is 947 begin 948 return Present (Ug_Words, Word); 949 end Is_Known_Word; 950 951 -------------------------- 952 -- Get_Replacement_Word -- 953 -------------------------- 954 955 function Get_Replacement_Word (Word : String) return String is 956 begin 957 return S (Get (Ug_Words, Word)); 958 end Get_Replacement_Word; 959 960-- Start of processing for Xgnatugn 961 962 Valid_Command_Line : Boolean; 963 Output_File_Name : VString; 964 965begin 966 Initialize_Extensions; 967 Valid_Command_Line := Argument_Count in 3 .. 5; 968 969 -- First argument: Target 970 971 if Valid_Command_Line then 972 begin 973 Target := Flag_Type'Value (Argument (1)); 974 975 if not Target'Valid then 976 Valid_Command_Line := False; 977 end if; 978 979 exception 980 when Constraint_Error => 981 Valid_Command_Line := False; 982 end; 983 end if; 984 985 -- Second argument: Source_File 986 987 if Valid_Command_Line then 988 begin 989 Source_File.Name := V (Argument (2)); 990 Open (Source_File.Data, In_File, Argument (2)); 991 992 exception 993 when Ada.Text_IO.Name_Error => 994 Valid_Command_Line := False; 995 end; 996 end if; 997 998 -- Third argument: Dictionary_File 999 1000 if Valid_Command_Line then 1001 begin 1002 Dictionary_File.Name := V (Argument (3)); 1003 Open (Dictionary_File.Data, In_File, Argument (3)); 1004 1005 exception 1006 when Ada.Text_IO.Name_Error => 1007 Valid_Command_Line := False; 1008 end; 1009 end if; 1010 1011 -- Fourth argument: Output_File 1012 1013 if Valid_Command_Line then 1014 if Argument_Count in 4 .. 5 then 1015 Output_File_Name := V (Argument (4)); 1016 else 1017 case Target is 1018 when UNW => 1019 Output_File_Name := V ("gnat_ugn_unw.texi"); 1020 when VMS => 1021 Output_File_Name := V ("gnat_ugn_vms.texi"); 1022 end case; 1023 end if; 1024 1025 Warnings_Enabled := Argument_Count = 5; 1026 1027 begin 1028 Create (Output_File, Out_File, S (Output_File_Name)); 1029 1030 exception 1031 when Ada.Text_IO.Name_Error | Ada.Text_IO.Use_Error => 1032 Valid_Command_Line := False; 1033 end; 1034 end if; 1035 1036 if not Valid_Command_Line then 1037 Usage; 1038 Set_Exit_Status (Failure); 1039 1040 else 1041 Read_Dictionary_File; 1042 Close (Dictionary_File.Data); 1043 1044 -- Main processing starts here 1045 1046 Process_Source_File; 1047 Close (Output_File); 1048 Close (Source_File.Data); 1049 1050 New_Line (Standard_Error); 1051 1052 if Number_Of_Warnings = 0 then 1053 Put_Line (Standard_Error, " NO Warnings"); 1054 1055 else 1056 Put (Standard_Error, Integer'Image (Number_Of_Warnings)); 1057 Put (Standard_Error, " Warning"); 1058 1059 if Number_Of_Warnings > 1 then 1060 Put (Standard_Error, "s"); 1061 end if; 1062 1063 New_Line (Standard_Error); 1064 end if; 1065 1066 if Number_Of_Errors = 0 then 1067 Put_Line (Standard_Error, " NO Errors"); 1068 1069 else 1070 Put (Standard_Error, Integer'Image (Number_Of_Errors)); 1071 Put (Standard_Error, " Error"); 1072 1073 if Number_Of_Errors > 1 then 1074 Put (Standard_Error, "s"); 1075 end if; 1076 1077 New_Line (Standard_Error); 1078 end if; 1079 1080 if Number_Of_Errors /= 0 then 1081 Set_Exit_Status (Failure); 1082 else 1083 Set_Exit_Status (Success); 1084 end if; 1085 end if; 1086end Xgnatugn; 1087