Gitiles
Code Review Sign In
gerrit.omnirom.org / android_external_libncurses / refs/heads/android-16 / . / Ada95 / samples / ncurses2-getopt.adb
blob: 7c902f9308ba7839921bb93d653dbfe67aee0e5e [file] [log] [blame]
Amit Daniel Kachhape6a01f52011-07-20 11:45:59 +0530[diff] [blame]1------------------------------------------------------------------------------
2-- --
3-- GNAT ncurses Binding Samples --
4-- --
5-- ncurses --
6-- --
7-- B O D Y --
8-- --
9------------------------------------------------------------------------------
micky3879b9f5e72025-07-08 18:04:53 -0400[diff] [blame]10-- Copyright 2020 Thomas E. Dickey --
11-- Copyright 2000-2008,2011 Free Software Foundation, Inc. --
Amit Daniel Kachhape6a01f52011-07-20 11:45:59 +0530[diff] [blame]12-- --
13-- Permission is hereby granted, free of charge, to any person obtaining a --
14-- copy of this software and associated documentation files (the --
15-- "Software"), to deal in the Software without restriction, including --
16-- without limitation the rights to use, copy, modify, merge, publish, --
17-- distribute, distribute with modifications, sublicense, and/or sell --
18-- copies of the Software, and to permit persons to whom the Software is --
19-- furnished to do so, subject to the following conditions: --
20-- --
21-- The above copyright notice and this permission notice shall be included --
22-- in all copies or substantial portions of the Software. --
23-- --
24-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
25-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
26-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
27-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
28-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
29-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
30-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
31-- --
32-- Except as contained in this notice, the name(s) of the above copyright --
33-- holders shall not be used in advertising or otherwise to promote the --
34-- sale, use or other dealings in this Software without prior written --
35-- authorization. --
36------------------------------------------------------------------------------
37-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
38-- Version Control
micky3879b9f5e72025-07-08 18:04:53 -0400[diff] [blame]39-- $Revision: 1.9 $
40-- $Date: 2020/02/02 23:34:34 $
Amit Daniel Kachhape6a01f52011-07-20 11:45:59 +0530[diff] [blame]41-- Binding Version 01.00
42------------------------------------------------------------------------------
43-- A simplified version of the GNU getopt function
44-- copyright Free Software Foundtion
45
46with Ada.Strings.Fixed;
47with Ada.Strings.Bounded;
48with Ada.Text_IO; use Ada.Text_IO;
49
50package body ncurses2.getopt is
51
52 nextchar : Natural := 0;
53
54 -- Ncurses doesn't use the non option elements so we are spared
55 -- the job of computing those.
56
57 -- also the user is not allowed to modify argv or argc
58 -- Doing so is Erroneous execution.
59
Steve Kondikae271bc2015-11-15 02:50:53 +0100[diff] [blame]60 -- long options are not handled.
Amit Daniel Kachhape6a01f52011-07-20 11:45:59 +0530[diff] [blame]61
62 procedure Qgetopt (retval : out Integer;
63 argc : Integer;
64 argv : stringfunc;
65 -- argv will be the Argument function.
66 optstring : String;
67 optind : in out Integer;
68 -- ignored for ncurses, must be initialized to 1 by
69 -- the caller
70 Optarg : out stringa
Steve Kondikae271bc2015-11-15 02:50:53 +0100[diff] [blame]71 -- a garbage collector would be useful here.
Amit Daniel Kachhape6a01f52011-07-20 11:45:59 +0530[diff] [blame]72 ) is
73
74 package BS is new Ada.Strings.Bounded.Generic_Bounded_Length (200);
75 use BS;
76 optargx : Bounded_String;
77 begin
78
79 if argc < optind then
80 retval := -1;
81 return;
82 end if;
83
84 optargx := To_Bounded_String ("");
85
86 if nextchar = 0 then
87
88 if argv (optind) = "--" then
89 -- the rest are non-options, we ignore them
90 retval := -1;
91 return;
92 end if;
93
94 if argv (optind)(1) /= '-' or argv (optind)'Length = 1 then
95 optind := optind + 1;
96 Optarg := new String'(argv (optind));
97 retval := 1;
98 return;
99 end if;
100
101 nextchar := 2; -- skip the one hyphen.
102 end if;
103
104 -- Look at and handle the next short option-character.
105 declare
106 c : Character := argv (optind) (nextchar);
107 temp : constant Natural :=
108 Ada.Strings.Fixed.Index (optstring, String'(1 => c));
109 begin
110 if temp = 0 or c = ':' then
111 Put_Line (Standard_Error,
112 argv (optind) & ": invalid option -- " & c);
113 c := '?';
114 return;
115 end if;
116
117 if optstring (temp + 1) = ':' then
118 if optstring (temp + 2) = ':' then
119 -- This is an option that accepts an argument optionally.
120 if nextchar /= argv (optind)'Length then
121 optargx := To_Bounded_String
122 (argv (optind) (nextchar .. argv (optind)'Length));
123 else
124 Optarg := null;
125 end if;
126 else
127 -- This is an option that requires an argument.
128 if nextchar /= argv (optind)'Length then
129 optargx := To_Bounded_String
130 (argv (optind) (nextchar .. argv (optind)'Length));
131 optind := optind + 1;
132 elsif optind = argc then
133 Put_Line (Standard_Error,
134 argv (optind) &
135 ": option requires an argument -- " & c);
136 if optstring (optstring'First) = ':' then
137 c := ':';
138 else
139 c := '?';
140 end if;
141 else
142 -- increment it again when taking next ARGV-elt as argument.
143 optind := optind + 1;
144 optargx := To_Bounded_String (argv (optind));
145 optind := optind + 1;
146 end if;
147 end if;
148 nextchar := 0;
149 else -- no argument for the option
150 if nextchar = argv (optind)'Length then
151 optind := optind + 1;
152 nextchar := 0;
153 else
154 nextchar := nextchar + 1;
155 end if;
156 end if;
157
158 retval := Character'Pos (c);
159 Optarg := new String'(To_String (optargx));
160 return;
161 end;
162 end Qgetopt;
163
164end ncurses2.getopt;