------------------------------------------------------------------------------- -- -- -- Ada Interface to the X Window System and Motif(tm)/Lesstif -- -- Copyright (c) 1996-2000 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: -- 28.09.96 H.-F. Vogt (vogt@ilaws6.luftfahrt.uni-stuttgart.de) -- in the Ada source, lines depending on sthg are declared as follows -- -- -- UseSymbol -- code used if Symbol defined -- -- NotSymbol -- code used if Symbol is not defined -- -- EndSymbol -- -- 12.06.98 H.-F. Vogt added ability to define multiple symbols for certain -- code lines, e.g. (looks a bit complicated :) -- -- UseSymbol1 Symbol2 -- code used if Symbol1 OR Symbol2 is defined -- -- NotSymbol1 Symbol2 -- code used if none of Symbol1 and Symbol2 is defined -- -- End Symbol1 Symbol2 -- ------------------------------------------------------------------------------- -- ---------------------------------------------------------------------------- -- -- preprocess Ada source -- -- comment out/ uncomment lines depending on symbols being defined or not -- -- -- ---------------------------------------------------------------------------- with Ada.Command_Line, Ada.Strings.Unbounded, Ada.Characters.Handling; with Text_Io; with String_List; procedure Preprocess is use Ada.Strings.Unbounded, String_List; File_To_Process : Unbounded_String; Processed_File : Text_Io.File_Type; -- String to store one line Line : String (1 .. 1024); Line_Last : Natural; Need_Help : exception; Comment_Out : Boolean := False; Num_Symbols : Natural := 0; Max_Symbols : constant := 100; type Boolean_Array_Type is array (Natural range <>) of Boolean; subtype Mask_Type is Boolean_Array_Type (1 .. Max_Symbols); type Mask_Stack_Type is array (Natural range <>) of Mask_Type; And_Mask_Stack : Mask_Stack_Type (1 .. 10); Not_Mask_Stack : Mask_Stack_Type (1 .. 10); A_Mask_Stack : Mask_Stack_Type (0 .. 10); N_Mask_Stack : Mask_Stack_Type (0 .. 10); Mask_Stack_L : Natural := 0; -- we store all known symbols -- type Known_Symbols_Type is array (Natural range <>) of Unbounded_String; Known_Symbols : Known_Symbols_Type (1 .. Max_Symbols); function Index (Sym : in String) return Natural is begin for I in 1 .. Num_Symbols loop if To_String (Known_Symbols(I)) = Sym then return I; end if; end loop; return 0; end Index; procedure Process_Command_Line is begin for I in 1 .. Ada.Command_Line.Argument_Count loop declare Arg : constant String := Ada.Command_Line.Argument (I); Idx : Natural; begin if Arg'Length > 2 and then Arg (Arg'First .. Arg'First+1) = "-D" then -- define Symbol Text_Io.Put_Line (Text_Io.Standard_Error, "...define symbol """ & Arg (Arg'First+2 .. Arg'Last) & """"); Idx := Index (Arg (Arg'First+2 .. Arg'Last)); if Idx = 0 then Known_Symbols (Num_Symbols+1) := To_Unbounded_String (Arg (Arg'First+2 .. Arg'Last)); Num_Symbols := Num_Symbols + 1; A_Mask_Stack (Mask_Stack_L) (Num_Symbols) := True; N_Mask_Stack (Mask_Stack_L) (Num_Symbols) := False; end if; else -- interpret as file name if File_To_Process = Null_Unbounded_String then File_To_Process := To_Unbounded_String (Arg); else Text_Io.Put_Line (Text_Io.Standard_Error, "ERROR: couldn't interpret argument """ & Arg & """"); raise Need_Help; end if; end if; end; end loop; -- we add a symbol which is used internally only -- Known_Symbols (Num_Symbols+1) := To_Unbounded_String ("Internal"); Num_Symbols := Num_Symbols + 1; A_Mask_Stack (Mask_Stack_L) (Num_Symbols) := True; N_Mask_Stack (Mask_Stack_L) (Num_Symbols) := False; end Process_Command_Line; procedure Get_Symbol (Str : in String; Last : out Natural; Ret_Str : out String; Ret_Last : out Natural) is Ret_String : String (1 .. Str'Length); Last_In_Ret : Natural := 0; First : Natural := Str'Last + 1; Last_In_Str : Natural := Str'First-1; begin -- first look for the first non-blank character for I in Str'Range loop if not (Str (I) = ' ' or else Ada.Characters.Handling.Is_Control (Str (I))) then First := I; exit; end if; end loop; for I in First .. Str'Last loop exit when Str (I) = ' ' or else Ada.Characters.Handling.Is_Control (Str (I)); Last_In_Ret := Last_In_Ret + 1; Ret_String (Last_In_Ret) := Str (I); Last_In_Str := I; end loop; Ret_Str (1 .. Last_In_Ret) := Ret_String (1 .. Last_In_Ret); Ret_Last := Last_In_Ret; Last := Last_In_Str; end Get_Symbol; procedure Actualize_Comment_Out is begin if Mask_Stack_L > 0 then for I in 1 .. Num_Symbols loop A_Mask_Stack (Mask_Stack_L) (I) := A_Mask_Stack(Mask_Stack_L-1) (I) and And_Mask_Stack (Mask_Stack_L) (I); N_Mask_Stack (Mask_Stack_L) (I) := A_Mask_Stack(Mask_Stack_L-1) (I) and Not_Mask_Stack (Mask_Stack_L) (I); end loop; end if; -- Use Debug --! Text_Io.Put (Text_Io.Standard_Error, "active Mask:"); --! for I in 1 .. Num_Symbols loop --! if A_Mask_Stack (Mask_Stack_L)(I) then --! Text_Io.Put (Text_Io.Standard_Error, " """ & --! To_String (Known_Symbols (I)) & """"); --! end if; --! end loop; --! Text_Io.Put_Line (Text_Io.Standard_Error, "!"); --! Text_Io.Put (Text_Io.Standard_Error, "negative Mask:"); --! for I in 1 .. Num_Symbols loop --! if N_Mask_Stack (Mask_Stack_L)(I) then --! Text_Io.Put (Text_Io.Standard_Error, " """ & --! To_String (Known_Symbols (I)) & """"); --! end if; --! end loop; --! Text_Io.Put_Line (Text_Io.Standard_Error, "!"); -- End Debug Comment_Out := True; -- first check if there is something valid -- for I in 1 .. Num_Symbols loop if A_Mask_Stack (Mask_Stack_L)(I) then Comment_Out := False; exit; end if; end loop; -- then check if there is something invalid -- if not Comment_Out then for I in 1 .. Num_Symbols loop if N_Mask_Stack (Mask_Stack_L)(I) then Comment_Out := True; return; end if; end loop; end if; end Actualize_Comment_Out; procedure Help is begin Text_Io.Put_Line (Text_Io.Standard_Error, "Preprocess -- comment out/uncomment lines in Ada-Source depending on"); Text_Io.Put_Line (Text_Io.Standard_Error, " Symbols being defined or not"); Text_Io.Put_Line (Text_Io.Standard_Error, "(c)1996,1998 H.-F. Vogt"); Text_Io.New_Line (Text_Io.Standard_Error); Text_Io.Put_Line (Text_Io.Standard_Error, "Usage:"); Text_Io.Put_Line (Text_Io.Standard_Error, " preprocess {-DSymbol} Filename > Where-To-Put-The-Result"); Text_Io.New_Line (Text_Io.Standard_Error); Text_Io.Flush (Text_Io.Standard_Error); end Help; begin Process_Command_Line; if File_To_Process = Null_Unbounded_String then Text_Io.Put_Line (Text_Io.Standard_Error, "ERROR: No input file!"); raise Need_Help; end if; Text_Io.Put (Text_Io.Standard_Error, "process " & To_String (File_To_Process) & " ... "); Text_Io.Open (File => Processed_File, Mode => Text_Io.In_File, Name => To_String (File_To_Process)); while not Text_Io.End_Of_File (Processed_File) loop Text_Io.Get_Line (File => Processed_File, Item => Line, Last => Line_Last); if Line_Last > 6 and then Line (1 .. 6) = "-- Use" then declare Find_Next : Natural := 6; Buffer : String (1 .. Line_Last-6); Buffer_L : Natural; Idx : Natural; New_Mask : Boolean_Array_Type (1 .. Num_Symbols) := (others => False); begin loop Get_Symbol (Line (Find_Next+1 .. Line_Last), Find_Next, Buffer, Buffer_L); exit when Buffer_L = 0; Idx := Index (Buffer (1 .. Buffer_L)); if Idx /= 0 then New_Mask (Idx) := True; end if; end loop; for I in 1 .. Num_Symbols loop And_Mask_Stack (Mask_Stack_L+1) (I) := New_Mask (I); Not_Mask_Stack (Mask_Stack_L+1) (I) := False; end loop; Mask_Stack_L := Mask_Stack_L + 1; end; Actualize_Comment_Out; Text_Io.Put_Line (Line (1 .. Line_Last)); elsif Line_Last > 6 and then Line (1 .. 6) = "-- Not" then declare Find_Next : Natural := 6; Buffer : String (1 .. Line_Last-6); Buffer_L : Natural; Idx : Natural; New_Stack_Level : Boolean := True; New_Mask : Boolean_Array_Type (1 .. Num_Symbols) := (others => False); begin loop Get_Symbol (Line (Find_Next+1 .. Line_Last), Find_Next, Buffer, Buffer_L); exit when Buffer_L = 0; Idx := Index (Buffer (1 .. Buffer_L)); if Idx /= 0 then New_Mask (Idx) := True; end if; end loop; if Mask_Stack_L > 0 then New_Stack_Level := False; for I in 1 .. Num_Symbols loop if And_Mask_Stack(Mask_Stack_L) (I) /= New_Mask (I) then New_Stack_Level := True; exit; end if; end loop; end if; if New_Stack_Level then Mask_Stack_L := Mask_Stack_L + 1; end if; for I in 1 .. Num_Symbols loop And_Mask_Stack (Mask_Stack_L) (I) := True; Not_Mask_Stack (Mask_Stack_L) (I) := New_Mask (I); end loop; end; Actualize_Comment_Out; Text_Io.Put_Line (Line (1 .. Line_Last)); elsif Line_Last > 6 and then Line (1 .. 6) = "-- End" then if Mask_Stack_L > 0 then Mask_Stack_L := Mask_Stack_L - 1; else Text_Io.Put_Line (Text_Io.Standard_Error, "ERROR: Too many Pops!"); end if; Actualize_Comment_Out; Text_Io.Put_Line (Line (1 .. Line_Last)); else if Comment_Out then if Line_Last >= 4 and then Line (1 .. 4) = "--! " then Text_Io.Put_Line (Line (1 .. Line_Last)); else Text_Io.Put_Line ("--! " & Line (1 .. Line_Last)); end if; else if Line_Last >= 4 and then Line (1 .. 4) = "--! " then Text_Io.Put_Line (Line (5 .. Line_Last)); else Text_Io.Put_Line (Line (1 .. Line_Last)); end if; end if; end if; end loop; if Mask_Stack_L > 0 then Text_Io.Put_Line (Text_Io.Standard_Error, "ERROR: Not enough Pops!"); end if; Text_Io.Close (Processed_File); Text_Io.Put_Line (Text_Io.Standard_Error, "OK"); exception when Need_Help => Help; end Preprocess;