| 1 | ---------------------------------------------------------------- {{{1 --------- |
|---|---|
| 2 | --: Copyright © 1998 Nasser Abbasi -- |
| 3 | --: Copyright © 2003 Martin Krischik -- |
| 4 | ------------------------------------------------------------------------------- |
| 5 | --: This is free software; you can redistribute it and/or modify it under -- |
| 6 | --: terms of the GNU General Public License as published by the Free Soft- -- |
| 7 | --: ware Foundation; either version 2, or (at your option) any later ver- -- |
| 8 | --: sion. GETOPT is distributed in the hope that it will be useful, but WITH -- |
| 9 | --: OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| 10 | --: or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- |
| 11 | --: for more details. Free Software Foundation, 59 Temple Place - Suite -- |
| 12 | --: 330, Boston, MA 02111-1307, USA. -- |
| 13 | --: -- |
| 14 | --: As a special exception, if other files instantiate generics from this -- |
| 15 | --: unit, or you link this unit with other files to produce an executable, -- |
| 16 | --: this unit does not by itself cause the resulting executable to be -- |
| 17 | --: covered by the GNU General Public License. This exception does not -- |
| 18 | --: however invalidate any other reasons why the executable file might be -- |
| 19 | --: covered by the GNU Public License. -- |
| 20 | ------------------------------------------------------------------------------- |
| 21 | --: change history: -- |
| 22 | --: -- |
| 23 | --: name changes -- |
| 24 | --: ---------- -------------------------------------------------------------- |
| 25 | --: NMA021899 created -- |
| 26 | --: NMA030299 Made it modified GPL. chanegd header. -- |
| 27 | --: -- |
| 28 | --: description: -- |
| 29 | --: -- |
| 30 | --: This package is an Ada implementation of getopt() as specified by the -- |
| 31 | --: document "The Single UNIX Specification, Version 2", Copyright 1997 The -- |
| 32 | --: Open Group -- |
| 33 | --: -- |
| 34 | --: Compiler used: GNAT 3.11p -- |
| 35 | --: Platform: Linux 2.0.36 ( Red hat 5.2) -- |
| 36 | --------------------------------------------------------------- }}}1 ---------- |
| 37 | |
| 38 | pragma License (Modified_Gpl); |
| 39 | pragma Ada_2022; |
| 40 | |
| 41 | with Ada.Strings.Wide_Wide_Unbounded; |
| 42 | |
| 43 | --- |
| 44 | -- @summary |
| 45 | -- Ada Class Library |
| 46 | -- Analyse command line |
| 47 | -- |
| 48 | -- @description |
| 49 | -- A modern object oriented version of GetOpt made for Ada - that's without the C style ugliness. |
| 50 | -- |
| 51 | -- Also, unlike for example GNAT.Command_Line this package is re-entrant. All internal states are kept inside the |
| 52 | -- class instance so two tasks can parse the command line in parallel. |
| 53 | -- |
| 54 | -- Last not least this command line parser has wide character support for short options, long options and file names. |
| 55 | -- |
| 56 | package AdaCL.Command_Line.GetOpt is |
| 57 | |
| 58 | --- |
| 59 | -- internale data |
| 60 | type Object is tagged private; |
| 61 | |
| 62 | -- Return values. The C version had only two states: -1 error, > 0 option character. |
| 63 | -- |
| 64 | --: @value EndOfOptions no more options |
| 65 | --: @value NoOption no option |
| 66 | --: @value GNU_Style GNU style option |
| 67 | --: @value WithArgument option with argument |
| 68 | --: @value WithoutArgument option without argument |
| 69 | --: @value Error parser encountered error |
| 70 | type FoundFlag is |
| 71 | (EndOfOptions, |
| 72 | NoOption, |
| 73 | GNU_Style, |
| 74 | WithArgument, |
| 75 | WithoutArgument, |
| 76 | Error); |
| 77 | |
| 78 | --- |
| 79 | -- GNU Option to request Help |
| 80 | -- |
| 81 | Help_GNU : constant Wide_Wide_String; |
| 82 | |
| 83 | --- |
| 84 | -- Short Option to request Help |
| 85 | -- |
| 86 | Help_Short : constant Wide_Wide_Character; |
| 87 | |
| 88 | --- |
| 89 | -- Flags an Error, unknown options are errors |
| 90 | -- |
| 91 | Option_Error : constant Wide_Wide_Character; |
| 92 | |
| 93 | --- |
| 94 | -- Options with Arguments. |
| 95 | -- |
| 96 | Option_Argument : constant Wide_Wide_Character; |
| 97 | |
| 98 | --- |
| 99 | -- Character with which all options start |
| 100 | -- |
| 101 | Option_Marker : constant Wide_Wide_Character; |
| 102 | |
| 103 | --- |
| 104 | -- Option could not be parsed |
| 105 | -- |
| 106 | Option_Parse_Error : exception; |
| 107 | |
| 108 | --- |
| 109 | -- Option was not given |
| 110 | -- |
| 111 | Option_Missing_Error : exception; |
| 112 | |
| 113 | --- |
| 114 | -- Wrong combination of Options was not given |
| 115 | -- |
| 116 | Option_Wrong_Error : exception; |
| 117 | |
| 118 | --- |
| 119 | -- get next Option. |
| 120 | -- |
| 121 | --: @param This Object itself. |
| 122 | --: @param Found Result of the Next command |
| 123 | procedure Next (This : in out Object; Found : out FoundFlag); |
| 124 | |
| 125 | --- |
| 126 | -- Start Parsing the command line. |
| 127 | -- |
| 128 | --: @param This the Object itself |
| 129 | procedure Parse (This : in out Object); |
| 130 | |
| 131 | --- |
| 132 | -- A Classic Style Option without Argument was found on the command line |
| 133 | -- |
| 134 | --: @param This the Object itself |
| 135 | procedure Analyze_WithoutArgument (This : in out Object); |
| 136 | |
| 137 | --- |
| 138 | -- A Classic Style Option with Argument was found on the command line |
| 139 | -- |
| 140 | --: @param This the Object itself |
| 141 | procedure Analyze_WithArgument (This : in out Object); |
| 142 | |
| 143 | --- |
| 144 | -- A GNU Style was found on the command line |
| 145 | -- |
| 146 | --: @param This the Object itself |
| 147 | procedure Analyze_GNU (This : in out Object); |
| 148 | |
| 149 | --- |
| 150 | -- A File was found on the command line |
| 151 | -- |
| 152 | --: @param This the Object itself |
| 153 | procedure Analyze_File (This : in out Object); |
| 154 | |
| 155 | --- |
| 156 | -- Print a help line |
| 157 | -- |
| 158 | --: @param Evironment_Variable Name of alternative environment variable. |
| 159 | procedure Put_Help_Line (Evironment_Variable : String); |
| 160 | |
| 161 | --- |
| 162 | -- Print a help line |
| 163 | -- |
| 164 | --: @param Long Long GNU style option |
| 165 | --: @param Description description of option |
| 166 | procedure Put_Help_Line (Long : Wide_Wide_String; Description : Wide_Wide_String) with |
| 167 | Pre => (Long'Length < 20); |
| 168 | |
| 169 | --- |
| 170 | -- Print a help line |
| 171 | -- |
| 172 | --: @param Short Short option |
| 173 | --: @param Long Long GNU style option |
| 174 | --: @param Description description of option |
| 175 | procedure Put_Help_Line |
| 176 | (Short : Wide_Wide_Character; |
| 177 | Long : Wide_Wide_String; |
| 178 | Description : Wide_Wide_String) with |
| 179 | Pre => (Long'Length < 20); |
| 180 | |
| 181 | --- |
| 182 | -- Print a help line |
| 183 | -- |
| 184 | --: @param Long Long GNU style option |
| 185 | --: @param Option parameter for option |
| 186 | --: @param Description description of option |
| 187 | procedure Put_Help_Line |
| 188 | (Long : Wide_Wide_String; |
| 189 | Option : Wide_Wide_String; |
| 190 | Description : Wide_Wide_String) with |
| 191 | Pre => (Option'Length + 1 < 10) and then (Long'Length + Option'Length + 1 < 20); |
| 192 | |
| 193 | --- |
| 194 | -- Print a help line |
| 195 | -- |
| 196 | --: @param Short Short option |
| 197 | --: @param Long Long GNU style option |
| 198 | --: @param Option parameter for option |
| 199 | --: @param Description description of option |
| 200 | procedure Put_Help_Line |
| 201 | (Short : Wide_Wide_Character; |
| 202 | Long : Wide_Wide_String; |
| 203 | Option : Wide_Wide_String; |
| 204 | Description : Wide_Wide_String) with |
| 205 | Pre => (Option'Length + 1 < 10) and then (Long'Length + Option'Length + 1 < 20); |
| 206 | |
| 207 | --- |
| 208 | -- A Call for Help was found on the command line |
| 209 | -- |
| 210 | --: @param This the Object itself |
| 211 | procedure WriteHelp (This : in out Object); |
| 212 | |
| 213 | --- |
| 214 | -- Nr of Last Option processed |
| 215 | -- |
| 216 | --: @param This Object itself. |
| 217 | function Get_Optind (This : in Object) return Positive with |
| 218 | Inline; |
| 219 | |
| 220 | --- |
| 221 | -- Last Argument Option Found. |
| 222 | -- |
| 223 | --: @param This Object itself. |
| 224 | function Get_Argument (This : in Object) return Wide_Wide_String with |
| 225 | Inline; |
| 226 | |
| 227 | --- |
| 228 | -- Last Single Character Option Found. |
| 229 | -- |
| 230 | --: @param This Object itself. |
| 231 | --: @return Option found. |
| 232 | function Get_Option (This : in Object) return Wide_Wide_Character with |
| 233 | Inline; |
| 234 | |
| 235 | --- |
| 236 | -- Last GNU-Option Found. |
| 237 | -- |
| 238 | --: @param This Object itself. |
| 239 | --: @return GNU option found. |
| 240 | function Get_GNUOption (This : in Object) return Wide_Wide_String with |
| 241 | Inline; |
| 242 | |
| 243 | --- |
| 244 | -- Get Format string. The usual mix of options and ':' |
| 245 | -- |
| 246 | --: @param This Object itself. |
| 247 | --: @return currently used pattern. |
| 248 | function Get_Pattern (This : in Object) return Wide_Wide_String with |
| 249 | Inline; |
| 250 | |
| 251 | --- |
| 252 | -- Set Format string. The usual mix of options and ':' |
| 253 | -- |
| 254 | --: @param This Object itself. |
| 255 | --: @param Pattern Pattern to parse. |
| 256 | procedure Set_Pattern (This : in out Object; Pattern : in Wide_Wide_String) with |
| 257 | Inline; |
| 258 | |
| 259 | --- |
| 260 | -- Set error handling on or off |
| 261 | -- |
| 262 | --: @param This Object itself. |
| 263 | --: @param ExceptionOnError when true raise exception on error else return option ':' or '?' |
| 264 | procedure Set_ExceptionOnError (This : in out Object; ExceptionOnError : in Boolean := True) with |
| 265 | Inline; |
| 266 | |
| 267 | --- |
| 268 | -- Get GNU Option extraction flag. GNU-Options start with "--" and have the Format --option=argument. |
| 269 | -- |
| 270 | --: @param This Object itself. |
| 271 | --: @return True if GNU options are parsed. |
| 272 | function Get_ExtractGNU (This : in Object) return Boolean with |
| 273 | Inline; |
| 274 | |
| 275 | --- |
| 276 | -- Set GNU Option extraction flag. GNU-Options start with "--" and have the Format --option=argument. |
| 277 | -- |
| 278 | --: @param This Object itself. |
| 279 | --: @param ExtractGNU When true, gnu options are extracted. |
| 280 | procedure Set_ExtractGNU (This : in out Object; ExtractGNU : in Boolean := True) with |
| 281 | Inline; |
| 282 | |
| 283 | private |
| 284 | package Unbounded renames Ada.Strings.Wide_Wide_Unbounded; |
| 285 | |
| 286 | Help_GNU : constant Wide_Wide_String := "help"; |
| 287 | Help_Short : constant Wide_Wide_Character := '?'; |
| 288 | Option_Error : constant Wide_Wide_Character := '?'; |
| 289 | Option_Argument : constant Wide_Wide_Character := ':'; |
| 290 | Option_Marker : constant Wide_Wide_Character := '-'; |
| 291 | |
| 292 | --- |
| 293 | -- An opject oriented version of getopt made for Ada - thats without the C style uglines. If you are looking for a |
| 294 | -- 100% compatible Version of getopt see: |
| 295 | -- |
| 296 | -- Also, unlike for exapmle GNAT.Command_Line this package is reentrant. All internal states are kept inside the |
| 297 | -- class instanz so two tasks can parse the command line in parallel. |
| 298 | -- |
| 299 | -- last not least we support GNU style command line options. |
| 300 | -- |
| 301 | --: @field ExceptionOnError Error handling on or off |
| 302 | --: @field Pattern Set Format string. The usual mix of options and ':' |
| 303 | --: @field Argument Last Argument Option Found. |
| 304 | --: @field GNUOption Last GNU-Option Found. |
| 305 | --: @field Option Last Single Character Option Found. |
| 306 | --: @field ExtractGNU GNU Option extraction flag. GNU-Options start with |
| 307 | type Object is tagged record |
| 308 | Curopt : Natural := 2; |
| 309 | Optind : Positive := 1; |
| 310 | ExceptionOnError : Boolean := True; |
| 311 | Pattern : Unbounded.Unbounded_Wide_Wide_String := Unbounded.Null_Unbounded_Wide_Wide_String; |
| 312 | Argument : Unbounded.Unbounded_Wide_Wide_String := Unbounded.Null_Unbounded_Wide_Wide_String; |
| 313 | GNUOption : Unbounded.Unbounded_Wide_Wide_String := Unbounded.Null_Unbounded_Wide_Wide_String; |
| 314 | Option : Wide_Wide_Character := Option_Error; |
| 315 | ExtractGNU : Boolean := False; |
| 316 | end record; |
| 317 | |
| 318 | end AdaCL.Command_Line.GetOpt; |
| 319 | |
| 320 | ---------------------------------------------------------------- {{{ ---------- |
| 321 | --: vim: set textwidth=0 nowrap tabstop=8 shiftwidth=3 softtabstop=3 expandtab : |
| 322 | --: vim: set filetype=ada fileencoding=utf-8 fileformat=unix foldmethod=expr : |
| 323 | --: vim: set spell spelllang=en_gb |