comp.lang.ada
 help / color / mirror / Atom feed
* fyi: getopt package in Ada.
@ 1999-03-01  0:00 nabbasi
  1999-03-01  0:00 ` robert_dewar
  0 siblings, 1 reply; 12+ messages in thread
From: nabbasi @ 1999-03-01  0:00 UTC (permalink / raw)


-- for GNAT users, save this file, and do gnatchop on it. This will create
-- 3 files. getopt.ads, getopt.adb, test_getopt.adb


------------------------------------------------------------------------------
--                                                                          --
--                               G E T O P T                                --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--$Header: getopt.ads,v 1.1.1.1 1999/03/01 12:23:04 nabbasi Exp $           --
--                                                                          --
--                  Copyright (C) 1998 Nasser Abbasi                        --
--                                                                          --
-- This is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion. GETOPT is distributed in the hope that it will be useful, but WITH --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details. Free Software Foundation,  59 Temple Place - Suite    --
-- 330,  Boston, MA 02111-1307, USA.                                        --
--                                                                          --
--                                                                          --
------------------------------------------------------------------------------

-- change history:
--
-- name         changes
-- ----------   --------------------------------------------------------------
-- NMA021899    created
--

-- description:
--
-- This package is an Ada implementation of getopt() as specified by the
-- document "The Single UNIX Specification, Version 2", Copyright 1997 The
-- Open Group
--
-- Compiler used: GNAT 3.11p
-- Platform:      Linux 2.0.36 ( Red hat 5.2)
--

with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

package Getopt is

   function Getopt(Optstring : String)  return Integer;


   Optind : Positive;
   Optarg : Unbounded_String ;
   Optopt : Character := ' ';
   Opterr : Integer := 1;

end Getopt;

------------------------------------------------------------------------------
--                                                                          --
--                               G E T O P T                                --
--                                                                          --
--                                 BODY                                     --
--                                                                          --
--$Header: getopt.adb,v 1.2 1999/03/01 12:54:03 nabbasi Exp $               --
--                                                                          --
--                                                                          --
--                                                                          --
--                  Copyright (C) 1998 Nasser Abbasi                        --
--                       nabbasi@pacbell.net                                --
--                                                                          --
-- This is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion. GETOPT is distributed in the hope that it will be useful, but WITH --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details. Free Software Foundation,  59 Temple Place - Suite    --
-- 330,  Boston, MA 02111-1307, USA.                                        --
--                                                                          --
--                                                                          --
------------------------------------------------------------------------------

-- change history:
--
-- name         changes
-- ----------   --------------------------------------------------------------
-- NMA021899    created
--

-- description:
--
-- This package is an Ada implementation of getopt() as specified by the
-- document "The Single UNIX Specification, Version 2", Copyright 1997 The
-- Open Group
--
-- This describes the items involveed using example
--
--
--         curopt
--           |
--           V
-- "-f foo -dbc -k"
--  ^
--  |
-- optind
--
-- optind is position (index) that tells which command line argument is being
-- processed now.
-- curopt tells which optchar is being processed within one command line
-- argument. This is needed only if more that one optchar are stuck
-- togother in one argument with no space, as in -df where both d and f
-- are valid optchar and d takes no optarg.
--
--
-- Compiler used: GNAT 3.11p
-- Platform:      Linux 2.0.36 ( Red hat 5.2)
--

with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Text_Io; use Ada.Text_Io;

package body Getopt is

   Curopt  : Natural := 2;

   procedure No_Optarg_Case is
   begin
                  if( Curopt < Argument(Optind)'Length) then
                     Curopt := Curopt +1;
                  else
                     Curopt := 2;
                     Optind := Optind+1;
                  end if;
   end No_Optarg_Case;

   function Getopt(Optstring : String)  return Integer is
   begin

      if ( Argument_Count = 0  or else optind > Argument_Count
           or  else ( Argument( optind )(1) /= '-')  ) then
         return -1;
      end if;

      if( Argument( optind )'Length = 1 ) then
         return -1;
      end if;

      -- according to The Single UNIX  Specification, Version 2, if "--"
      -- is found, return -1 after  ++optind.
      if( Argument( Optind )(2) = '-' ) then
         Optind := Optind + 1;
         return -1;
      end if;

      -- if we get here, the command argument has "-X"
      for I in Optstring'Range loop
         if( Optstring(I) = Argument( optind )( Curopt ) ) then
            if( I < Optstring'Length ) then
               if (Optstring(I+1) = ':') then

                  -- see if optarg stuck to optchar
                  if( Argument(Optind)'Length -  Curopt > 0 ) then
                     Optarg  := To_Unbounded_String(
                      Argument( optind )(Curopt+1..Argument( optind )'Length));
                     Curopt := Curopt + 1;
                     optind  := Optind + 1;
                     return character'pos(Optstring(I));
                  end if;

                  -- see if optarg on separate argument
                  if( Optind < Argument_Count ) then
                     Curopt := 2;
                     optind  := optind + 1;
                     optarg  := To_Unbounded_String (Argument(optind ));
                     optind  := optind + 1;
                     return character'Pos(Optstring(I));
                  else
                     Optind := Optind+1;
                     Optopt := Optstring(I);

                     if( Opterr=1  and Optstring(1) /= ':' ) then
                        Put_Line(Standard_Error,
                                 "Argument expected for the -"&
                                 Optstring(I..I) & " option");
                     end if;

                     if( Optstring(1) = ':' ) then
                        return Character'Pos(':');
                     else
                        return  Character'Pos('?');
                     end if;
                  end if;
               else  -- current optchar matches and has no arg option
                  No_Optarg_Case;
                  return character'pos(Optstring(I));
               end if;
            else -- last char in optstring, can't have argument
               No_Optarg_Case;
               return character'pos(Optstring(I));
            end if;
         end if;
      End loop;

      Optopt := Argument(Optind)( Curopt );
      No_Optarg_Case;

      -- we get here if current command argument not found in optstring
      return character'pos('?');

   end Getopt;

begin
   Optarg := To_Unbounded_String("");
   Optind := 1;
end Getopt;

-- Test example showing how to use GETOPT Ada package
-- Nasser Abbasi

with Ada.Text_Io; use Ada.Text_Io;
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

with Getopt;

procedure Test_Getopt is
   Test_String : String := "c:di:n:p:u:V";
   Optchar : character;
   Value   : Integer;
begin
    Getopt.Opterr := 1;


   loop
      Value := Getopt.Getopt( Test_String );
      exit when Value = -1;

      optchar :=  Character'Val( Value );
      case optchar is
         when 'c' =>
            Put_Line("commant is "& To_String(Getopt.Optarg));
         when 'd' =>
             Put_Line("debug on");
         when 'i' =>
            Put_line("got -i, its argument is:" & To_String(Getopt.Optarg) );
         when 'n' =>
            Put_line("got -n, its argument is:" & To_String(Getopt.Optarg));
         when 'p' =>
            Put_line("got -p, its argument is:" & To_String(Getopt.Optarg));
         when 'u' =>
            Put_line("got -u, its argument is:" & To_String(Getopt.Optarg));
         when 'V' =>
            Put_line("got -V");

         when '?' =>
            Put_Line("got ?, optopt is " & Getopt.Optopt);

         when ':' =>
            Put_Line("get :, optopt is "& Getopt.optopt);

         when others => null;
      end case;
   end loop;


   -- now lets print the remaining arguments if any
   declare
     Index : positive;
   begin
      Index := Getopt.Optind;
      for I in Index..Argument_Count loop
         Put_Line( Argument(I) );
      end loop;
   end;

end Test_Getopt;




^ permalink raw reply	[flat|nested] 12+ messages in thread
end of thread, other threads:[~1999-03-03  0:00 UTC | newest]

Thread overview: 12+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
1999-03-01  0:00 fyi: getopt package in Ada nabbasi
1999-03-01  0:00 ` robert_dewar
1999-03-01  0:00   ` nabbasi
1999-03-02  0:00     ` Pascal Obry
1999-03-02  0:00       ` still Looking for GNAT modified GPL header nabbasi
1999-03-02  0:00         ` dennison
1999-03-02  0:00         ` Samuel Tardieu
1999-03-02  0:00           ` nabbasi
1999-03-02  0:00         ` dewar
1999-03-03  0:00         ` Pascal Obry
1999-03-02  0:00     ` fyi: getopt package in Ada robert_dewar
1999-03-02  0:00     ` nabbasi

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox