------------------------------------------------------------------------------- -- -- -- Ada Interface to the X Window System and Motif(tm)/Lesstif -- -- Copyright (c) 1996-2001 Hans-Frieder Vogt -- -- -- -- This program is free software; you can redistribute it and/or modify -- -- it under the terms of the GNU General Public License as published by -- -- the Free Software Foundation; either version 2 of the License, or -- -- (at your option) any later version. -- -- -- -- This program is distributed in the hope that it will be useful, -- -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- See the GNU General Public License for more details. -- -- -- -- You should have received a copy of the GNU General Public License -- -- along with this program; if not, write to the -- -- Free Software Foundation, Inc., -- -- 59 Temple Place - Suite 330, -- -- Boston, MA 02111-1307, USA. -- -- -- -- -- -- X Window System is copyrighted by the X Consortium -- -- Motif(tm) is copyrighted by the Open Software Foundation, Inc. -- -- -- -- -- ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- -- -- HISTORY: -- June 20, 1998 begin of history -- July 2001 extended to handle continuation lines and included "s -- (patch by Vadim Godunko) => Version 1.2 -- 5 Aug 2001 HFVogt: cleaned up code, bug-fixed grouping with "(" and ")" -- comments are now also output -- support #include, but treat "" and <> equally -- check and correct identifier name -- => Version 1.3 -- ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- -- -- take a resource file and write a file includeable (with-able) into Ada-source -- -- WARNING: the name of the newly-created package has to be changed -- ------------------------------------------------------------------------------- with Text_IO, Ada.Command_Line, String_List; use Text_IO, Ada.Command_Line, String_List; with Ada.Characters.Handling, Ada.Characters.Latin_1; procedure MakeFallb is Version : constant String := "1.3"; Input_File : File_Type; procedure Print_Info is begin Set_Output (Standard_Error); New_Line; Put_Line ( "MakeFallback V" & Version & " -- (c)1996-2001 Hans-Frieder Vogt"); Put_Line ( " (c)2001 Vadim Godunko"); Put_Line ( "rewrites resource file so that they can be included in an Ada program"); New_Line; Set_Output (Standard_Output); end Print_Info; procedure Print_Usage is begin Set_Output (Standard_Error); New_Line; Put_Line ( " Usage:"); Put_Line ( " makefallb Resource-File > Resource-In-Ada-File"); New_Line; Set_Output (Standard_Output); end Print_Usage; -- a valid Ada Identifier begins with a letter, followed by letters, digits -- or underscores -- we simply replace any invalid character by '_' -- if, however, the first character is not valid, we prepend an 'F' to the -- name -- function Validify_Identifier (Str : in String) return String is Tmp_Str : String (1 .. Str'Length+1); Tmp_Idx : Natural := 0; use Ada.Characters.Handling; begin if not Is_Letter (Str (Str'First)) then Tmp_Idx := Tmp_Idx + 1; Tmp_Str (Tmp_Idx) := 'F'; end if; for I in Str'Range loop Tmp_Idx := Tmp_Idx + 1; if Is_Alphanumeric (Str (I)) or else Str (I) = '_' then Tmp_Str (Tmp_Idx) := Str (I); else Tmp_Str (Tmp_Idx) := '_'; end if; end loop; return Tmp_Str (1 .. Tmp_Idx); end Validify_Identifier; function Find_Name (Arg : in String) return String is Last_Point_Pos : Natural := Arg'Last+1; Last_Slash_Pos : Natural := Arg'First-1; begin for I in reverse Arg'Range loop if Arg (I) = '.' and then Last_Point_Pos = Arg'Last+1 then Last_Point_Pos := I; elsif Arg (I) = '/' then Last_Slash_Pos := I; exit; end if; end loop; return Validify_Identifier (Arg (Last_Slash_Pos+1 .. Last_Point_Pos-1)) & "_Fallback"; end Find_Name; function Get_Include_Name (Str : in String) return String is First_Idx : Natural := Str'Last+1; Last_Idx : Natural := Str'First-1; begin for I in Str'Range loop -- at the moment we treat '"' and '<' equally! -- if Str (I) = '"' or else Str (I) = '<' then First_Idx := I+1; exit; end if; end loop; for I in reverse First_Idx .. Str'Last loop if Str (I) = '"' or else Str (I) = '>' then Last_Idx := I-1; exit; end if; end loop; return Str (First_Idx .. Last_Idx); end Get_Include_Name; function Remove_Tabulators (Str : in String) return String is Return_Str : String (Str'Range) := Str; begin for I in Return_Str'Range loop if Return_Str (I) = Ada.Characters.Latin_1.HT then Return_Str (I) := ' '; end if; end loop; return Return_Str; end Remove_Tabulators; function Double_Quotes (Str : in String) return String is Return_Str : String (1 .. Str'Length * 2); Index : Integer := Return_Str'First; begin for I in Str'Range loop Return_Str (Index) := Str (I); Index := Index + 1; if Str (I) = '"' then Return_Str (Index) := '"'; Index := Index + 1; end if; end loop; return Return_Str (Return_Str'First .. Index - 1); end Double_Quotes; procedure Process_File (File_Name : in String) is Input_File : File_Type; Buf_Len : constant Natural := 1024; Buffer : String (1 .. Buf_Len); Buf_Last : Natural; Continue_Line : Boolean := False; Last_Was_Comment : Boolean := False; begin Open (Input_File, In_File, File_Name); -- now the data lines -- while not End_Of_File (Input_File) loop Get_Line (Input_File, Buffer, Buf_Last); if Buf_Last > 0 then if (Buf_Last > 8 and then Buffer (1 .. 8) = "#include") then Put ("-- " & Buffer (1 .. Buf_Last)); Process_File (Get_Include_Name (Buffer (10 .. Buf_Last))); New_Line; Put_Line ("-- end of " & Buffer (1 .. Buf_Last)); Last_Was_Comment := True; elsif (Continue_Line or else Buffer(1) /= '!') then Put_Line (" &"); if Buffer (Buf_Last) = '\' then if not Continue_Line then Put_Line ("("); Continue_Line := True; end if; Put ("""" & Double_Quotes (Remove_Tabulators (Buffer (1 .. Buf_Last-1))) & """"); else Put ("""" & Double_Quotes (Remove_Tabulators (Buffer (1 .. Buf_Last))) & """"); end if; if Continue_Line and Buffer (Buf_Last) /= '\' then New_Line; Put (")"); Continue_Line := False; end if; Last_Was_Comment := False; else -- preserve comments -- if not Last_Was_Comment then -- only vor better visibility -- New_Line; end if; Put_Line ("-- " & Remove_Tabulators (Buffer (2 .. Buf_Last))); Last_Was_Comment := True; end if; elsif Continue_Line then Put (")"); Continue_Line := False; Last_Was_Comment := False; end if; end loop; Close (Input_File); exception when Name_Error => Put_Line (Standard_Error, "MakeFallb ERROR: File """ & File_Name & """ not found!"); end Process_File; begin Print_Info; if Argument_Count < 1 then Put_Line (Standard_Error, "MakeFallback: ERROR: not enough parameters"); Print_Usage; Set_Exit_Status (Failure); return; end if; -- first output the header -- Put_Line ("with String_List;"); Put_Line ("use String_List;"); Put_Line ("package Fallback is"); New_Line; Put_Line (" " & Find_Name (Argument (1)) & " : String_List.Element_Access_List :="); Put (" String_List.Null_Element_Access_List"); Process_File (Argument (1)); Put_Line (";"); -- output the trailer -- New_Line; Put_Line ("end Fallback;"); Set_Exit_Status (Success); end MakeFallb;