home *** CD-ROM | disk | FTP | other *** search
/ Freelog 22 / freelog 22.iso / Prog / Djgpp / GPC2952B.ZIP / doc / gpc / demos / getoptdemo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-02-08  |  3.0 KB  |  83 lines

  1. {
  2. GPC demo program for the GetOpt functions.
  3. Comfortable command line option parsing.
  4.  
  5. Copyright (C) 1998-2001 Free Software Foundation, Inc.
  6.  
  7. Author: Frank Heckenbach <frank@pascal.gnu.de>
  8.  
  9. This program is free software; you can redistribute it and/or
  10. modify it under the terms of the GNU General Public License as
  11. published by the Free Software Foundation, version 2.
  12.  
  13. This program is distributed in the hope that it will be useful,
  14. but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16. GNU General Public License for more details.
  17.  
  18. You should have received a copy of the GNU General Public License
  19. along with this program; see the file COPYING. If not, write to
  20. the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21. Boston, MA 02111-1307, USA.
  22.  
  23. As a special exception, if you incorporate even large parts of the
  24. code of this demo program into another program with substantially
  25. different functionality, this does not cause the other program to
  26. be covered by the GNU General Public License. This exception does
  27. not however invalidate any other reasons why it might be covered
  28. by the GNU General Public License.
  29. }
  30.  
  31. program GetOptDemo;
  32.  
  33. uses GPC;
  34.  
  35. var
  36.   ch, LongOptFlag : Char;
  37.   i, LongIndex : Integer;
  38.  
  39. const
  40.   LongOptions : array [1 .. 4] of OptionType =
  41.     (('x',      NoArgument,       nil,          'x'),
  42.      ('noarg',  NoArgument,       @LongOptFlag, #2),
  43.      ('reqarg', RequiredArgument, @LongOptFlag, #3),
  44.      ('optarg', OptionalArgument, @LongOptFlag, #4));
  45.  
  46. begin
  47.   if ParamCount = 0 then
  48.     begin
  49.       Writeln (StdErr, 'GetOpt demo');
  50.       Writeln (StdErr, 'Usage: ', ParamStr (0), ' [-n] [-r foo] [-o[bar]] [--noarg] [--reqarg foo] ');
  51.       Writeln (StdErr, '       [--optarg[=bar]] [--x] [baz...]');
  52.       Halt (1)
  53.     end;
  54.   LongIndex := - 1;
  55.   repeat
  56.     ch := GetOptLong ('nr:o::', LongOptions, LongIndex, True);
  57.     case ch of
  58.       EndOfOptions  : Break;
  59.       NoOption      : Write ('no-option argument');
  60.       UnknownOption : if UnknownOptionCharacter = UnknownLongOption
  61.                         then Write ('(incorrect long option)')
  62.                         else Write ('unknown option `', UnknownOptionCharacter, '''');
  63.       LongOption    : with LongOptions [LongIndex] do
  64.                         begin
  65.                           Write ('long option `', CString2String (Name), '''');
  66.                           if Ord (LongOptFlag) <> LongIndex then
  67.                             Write (' <internal error> ')
  68.                         end;
  69.       else            Write ('option `', ch, '''')
  70.     end;
  71.     if HasOptionArgument
  72.       then Writeln (' with argument `', OptionArgument, '''')
  73.       else Writeln
  74.   until False;
  75.   if (FirstNonOption < 1) or (FirstNonOption > ParamCount + 1) then
  76.     begin
  77.       Writeln (StdErr, 'Internal error with FirstNonOption.');
  78.       Halt (2)
  79.     end;
  80.   if FirstNonOption <= ParamCount then Writeln ('Remaining arguments:');
  81.   for i := FirstNonOption to ParamCount do Writeln (ParamStr (i))
  82. end.
  83.