gcc/ada/a-colire.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --             A D A . C O M M A N D _ L I N E . R E M O V E                --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1999-2009, 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.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 package body Ada.Command_Line.Remove is
  33
  34    -----------------------
  35    -- Local Subprograms --
  36    -----------------------
  37
  38    procedure Initialize;
  39    --  Initialize the Remove_Count and Remove_Args variables
  40
  41    ----------------
  42    -- Initialize --
  43    ----------------
  44
  45    procedure Initialize is
  46    begin
  47       if Remove_Args = null then
  48          Remove_Count := Argument_Count;
  49          Remove_Args := new Arg_Nums (1 .. Argument_Count);
  50
  51          for J in Remove_Args'Range loop
  52             Remove_Args (J) := J;
  53          end loop;
  54       end if;
  55    end Initialize;
  56
  57    ---------------------
  58    -- Remove_Argument --
  59    ---------------------
  60
  61    procedure Remove_Argument (Number : Positive) is
  62    begin
  63       Initialize;
  64
  65       if Number > Remove_Count then
  66          raise Constraint_Error;
  67       end if;
  68
  69       Remove_Count := Remove_Count - 1;
  70
  71       for J in Number .. Remove_Count loop
  72          Remove_Args (J) := Remove_Args (J + 1);
  73       end loop;
  74    end Remove_Argument;
  75
  76    procedure Remove_Argument (Argument : String) is
  77    begin
  78       for J in reverse 1 .. Argument_Count loop
  79          if Argument = Ada.Command_Line.Argument (J) then
  80             Remove_Argument (J);
  81          end if;
  82       end loop;
  83    end Remove_Argument;
  84
  85    ----------------------
  86    -- Remove_Arguments --
  87    ----------------------
  88
  89    procedure Remove_Arguments (From : Positive; To : Natural) is
  90    begin
  91       Initialize;
  92
  93       if From > Remove_Count
  94         or else To > Remove_Count
  95       then
  96          raise Constraint_Error;
  97       end if;
  98
  99       if To >= From then
 100          Remove_Count := Remove_Count - (To - From + 1);
 101
 102          for J in From .. Remove_Count loop
 103             Remove_Args (J) := Remove_Args (J + (To - From + 1));
 104          end loop;
 105       end if;
 106    end Remove_Arguments;
 107
 108    procedure Remove_Arguments (Argument_Prefix : String) is
 109    begin
 110       for J in reverse 1 .. Argument_Count loop
 111          declare
 112             Arg : constant String := Argument (J);
 113
 114          begin
 115             if Arg'Length >= Argument_Prefix'Length
 116               and then Arg (1 .. Argument_Prefix'Length) = Argument_Prefix
 117             then
 118                Remove_Argument (J);
 119             end if;
 120          end;
 121       end loop;
 122    end Remove_Arguments;
 123
 124 end Ada.Command_Line.Remove;