gcc/m2/gm2-libs/GetOpt.mod

   1 (* GetOpt.mod allows users to manage long options to getopt.
   2
   3 Copyright (C) 2017-2023 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   8 GNU Modula-2 is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Modula-2 is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 Under Section 7 of GPL version 3, you are granted additional
  19 permissions described in the GCC Runtime Library Exception, version
  20 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 IMPLEMENTATION MODULE GetOpt ;  (*!m2pim+gm2*)
  28
  29 FROM DynamicStrings IMPORT string, InitStringCharStar ;
  30 FROM Storage IMPORT ALLOCATE, REALLOCATE, DEALLOCATE ;
  31 FROM MemUtils IMPORT MemCopy ;
  32
  33 IMPORT cgetopt ;
  34
  35
  36 TYPE
  37    Crecord = RECORD    (* see man 3 getopt.  *)
  38                 name   : ADDRESS ;
  39                 has_arg: INTEGER ;
  40                 flag   : PtrToInteger ;
  41                 val    : INTEGER ;
  42              END ;
  43
  44    ptrToCrecord = POINTER TO Crecord ;
  45
  46    LongOptions = POINTER TO RECORD
  47                                cptr: ptrToCrecord ;
  48                                len : CARDINAL ;
  49                                size: CARDINAL ;
  50                             END ;
  51
  52
  53 (*
  54    GetOpt - call C getopt and fill in the parameters:
  55             optarg, optind, opterr and optop.
  56 *)
  57
  58 PROCEDURE GetOpt (argc: INTEGER; argv: ADDRESS; optstring: String;
  59                   VAR optarg: String;
  60                   VAR optind, opterr, optopt: INTEGER) : CHAR ;
  61 VAR
  62    r: CHAR ;
  63 BEGIN
  64    r := cgetopt.getopt (argc, argv, string (optstring)) ;
  65    optarg := InitStringCharStar (cgetopt.optarg) ;
  66    opterr := cgetopt.opterr ;
  67    optopt := cgetopt.optopt ;
  68    RETURN r
  69 END GetOpt ;
  70
  71
  72 (*
  73    InitLongOptions - creates and returns a LongOptions empty array.
  74 *)
  75
  76 PROCEDURE InitLongOptions () : LongOptions ;
  77 VAR
  78    lo: LongOptions ;
  79 BEGIN
  80    NEW (lo) ;
  81    WITH lo^ DO
  82       cptr := NIL ;
  83       len := 0 ;
  84       size := 0
  85    END ;
  86    RETURN lo
  87 END InitLongOptions ;
  88
  89
  90 (*
  91    AddLongOption - appends long option {name, has_arg, flag, val} to the
  92                    array of options and new long options array is returned.
  93                    The old array, lo, should no longer be used.
  94
  95    (from man 3 getopt)
  96        The meanings of the different fields are:
  97
  98        name   is the name of the long option.
  99
 100        has_arg
 101               is: no_argument (or 0) if the option does not take an  argument;  required_argument
 102               (or  1)  if  the  option  requires  an argument; or optional_argument (or 2) if the
 103               option takes an optional argument.
 104
 105        flag   specifies how results are returned for a  long  option.   If  flag  is  NULL,  then
 106               getopt_long()  returns  val.   (For example, the calling program may set val to the
 107               equivalent short option character.)  Otherwise, getopt_long() returns 0,  and  flag
 108               points to a variable which is set to val if the option is found, but left unchanged
 109               if the option is not found.
 110
 111        val    is the value to return, or to load into the variable pointed to by flag.
 112
 113        The last element of the array has to be filled with zeros.
 114 *)
 115
 116 PROCEDURE AddLongOption (lo: LongOptions;
 117                          name: String; has_arg: INTEGER;
 118                          flag: PtrToInteger; val: INTEGER) : LongOptions ;
 119 VAR
 120    old,
 121    entry: ptrToCrecord ;
 122 BEGIN
 123    IF lo^.cptr = NIL
 124    THEN
 125       NEW (lo^.cptr) ;
 126       lo^.len := 1 ;
 127       lo^.size := SIZE (Crecord) ;
 128       entry := lo^.cptr
 129    ELSE
 130       old := lo^.cptr ;
 131       INC (lo^.len) ;
 132       lo^.size := lo^.len * SIZE (Crecord) ;
 133       REALLOCATE (lo^.cptr, lo^.size) ;
 134       IF lo^.cptr = NIL
 135       THEN
 136          entry := NIL
 137       ELSIF old = lo^.cptr
 138       THEN
 139          entry := lo^.cptr ;
 140          INC (entry, SIZE (Crecord) * lo^.len-1)
 141       ELSE
 142          MemCopy (old, lo^.len-1, lo^.cptr) ;
 143          entry := lo^.cptr ;
 144          INC (entry, SIZE (Crecord) * lo^.len-1)
 145       END
 146    END ;
 147    fillIn (entry, name, has_arg, flag, val) ;
 148    RETURN lo
 149 END AddLongOption ;
 150
 151
 152 (*
 153    fillIn - fills in
 154 *)
 155
 156 PROCEDURE fillIn (entry: ptrToCrecord;
 157                   name: String; has_arg: INTEGER; flag: PtrToInteger; val: INTEGER) ;
 158 BEGIN
 159    IF entry # NIL
 160    THEN
 161       entry^.name := name ;
 162       entry^.has_arg := has_arg ;
 163       entry^.flag := flag ;
 164       entry^.val := val
 165    END
 166 END fillIn ;
 167
 168
 169 (*
 170    KillLongOptions - returns NIL and also frees up memory associated with, lo.
 171 *)
 172
 173 PROCEDURE KillLongOptions (lo: LongOptions) : LongOptions ;
 174 BEGIN
 175    DEALLOCATE (lo^.cptr, lo^.size) ;
 176    DISPOSE (lo) ;
 177    RETURN NIL
 178 END KillLongOptions ;
 179
 180
 181 (*
 182    GetOptLong - works like GetOpt but will accept long options (using two dashes).
 183                 If the program only accepts long options then optstring should be
 184                 an empty string, not NIL.
 185 *)
 186
 187 PROCEDURE GetOptLong (argc: INTEGER; argv: ADDRESS; optstring: String;
 188                       longopts: LongOptions; VAR longindex: INTEGER) : INTEGER ;
 189 VAR
 190    r: INTEGER ;
 191 BEGIN
 192    r := cgetopt.getopt_long (argc, argv, string (optstring), longopts^.cptr, longindex) ;
 193    RETURN r
 194 END GetOptLong ;
 195
 196
 197 (*
 198    GetOptLongOnly - works like GetOptLong except that a single dash can be used
 199                     for a long option.
 200 *)
 201
 202 PROCEDURE GetOptLongOnly (argc: INTEGER; argv: ADDRESS; optstring: String;
 203                           longopts: LongOptions; VAR longindex: INTEGER) : INTEGER ;
 204 VAR
 205    r: INTEGER ;
 206 BEGIN
 207    r := cgetopt.getopt_long_only (argc, argv, string (optstring),
 208                                  longopts^.cptr, longindex) ;
 209    RETURN r
 210 END GetOptLongOnly ;
 211
 212
 213 END GetOpt.