Options.Mod 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742
  1. MODULE Options; (** AUTHOR "staubesv"; PURPOSE "Command line options parsing"; *)
  2. (*
  3. * Simple framework that parses command line options.
  4. *
  5. * Usage:
  6. *
  7. * 1. Create Option object instance
  8. *
  9. * NEW(options);
  10. *
  11. * 2. Add options of type Flag, String or Integer
  12. *
  13. * options.Add("h", "help", Flag); (* -h / --help option flags *)
  14. * options.Add("s", "string", String); (* -s=Hello / --string="Hello World" *)
  15. * options.Add("i", "integer", Integer); (* -i=76H / --integer=999 *)
  16. *
  17. * 3. Parse options at the current position of the context argument stream (this will skip whitespace and options on the stream)
  18. *
  19. * IF options.Parse(context.arg, context.out) THEN (* some useful work *) END;
  20. *
  21. * Note: Parse will output an error message on the context error stream if option parsing fails
  22. *
  23. * 4. Access options
  24. *
  25. * IF options.GetFlag("help") THEN (* flag -h or --help is set *) END;
  26. * IF options.GetString("string", string_variable) THEN
  27. * (* If -s or --string was set, read the string argument into the string-variable *)
  28. * END;
  29. *
  30. *
  31. * Options = [ "-" Option [ {WhiteSpace "-" Option} ] ]
  32. * Option = "-" NameOption | CharOption
  33. * NameOption = Name [Assignment]
  34. * CharOption = Char [Assignment] | Flags
  35. * Flags = = Char {Char}
  36. * Assignment = "=" (EnquotedString | Name | Char)
  37. * Name = Char Char {Char}
  38. * EnquotedString = " anyChars except quote " | ' anyChars except apostroph '
  39. * Char = (32 < ORD(CHAR) < 127) & (ch # Assignment) & (ch # OptionDelimiter)
  40. *)
  41. IMPORT
  42. KernelLog, Streams, Strings, Commands;
  43. CONST
  44. (** Option Types *)
  45. Flag* = 0;
  46. String* = 1;
  47. Integer* = 2;
  48. Unknown = -1;
  49. MaxOptions = 64;
  50. OptionDelimiter = "-";
  51. Assignment = "=";
  52. Invalid = -1;
  53. TYPE
  54. Name* = ARRAY 32 OF CHAR;
  55. Parameter* = ARRAY 256 OF CHAR;
  56. Option = RECORD
  57. isSet : BOOLEAN;
  58. timestamp : LONGINT;
  59. ch : CHAR; (* single character name *)
  60. name : Name; (* multi character name *)
  61. type : LONGINT; (* Flag, String or Integer *)
  62. value : LONGINT; (* Integer value if type = Integer *)
  63. string : Parameter; (* String value if type = String *)
  64. END;
  65. TYPE
  66. Options* = OBJECT
  67. VAR
  68. options : ARRAY MaxOptions OF Option;
  69. nofOptions : LONGINT;
  70. arg : Streams.Reader;
  71. error : Streams.Writer;
  72. setError : BOOLEAN;
  73. timestamp : LONGINT;
  74. PROCEDURE &Init*;
  75. BEGIN
  76. timestamp := 0;
  77. Reset;
  78. END Init;
  79. (** Add option declaration.
  80. - Duplicate names are not allowed!
  81. - Numbers are not allowed as option character or as first character of an option name *)
  82. PROCEDURE Add*(ch : CHAR; CONST name : Name; type : LONGINT);
  83. VAR index : LONGINT; char : Name;
  84. BEGIN {EXCLUSIVE}
  85. IF (("0" <= ch) & (ch <= "9")) OR (("0" <= name[0]) & (name[0] <= "9")) THEN
  86. KernelLog.String("Command implementation error: Numbers are not allowed as first character of an option name. Ignore option ");
  87. KernelLog.Ln;
  88. RETURN;
  89. END;
  90. char[0] := ch; char[1] := 0X;
  91. index := FindOption(char);
  92. IF (index = Invalid) THEN index := FindOption(name); END;
  93. IF (index = Invalid) THEN
  94. IF (nofOptions < MaxOptions-1) THEN
  95. options[nofOptions].isSet := FALSE;
  96. options[nofOptions].ch := ch;
  97. options[nofOptions].name := name;
  98. options[nofOptions].type := type;
  99. INC(nofOptions);
  100. ELSE
  101. KernelLog.String("Command implementation error: Maximum number of option declarations exceeded. Ignore option ");
  102. KernelLog.Ln;
  103. END;
  104. ELSE
  105. KernelLog.String("Command implementation error: Duplicate option declaration. Ignore option .");
  106. KernelLog.Ln;
  107. END;
  108. END Add;
  109. (** Check whether an option of type Flag is set *)
  110. PROCEDURE GetFlag*(CONST name : Name) : BOOLEAN;
  111. VAR index : LONGINT;
  112. BEGIN {EXCLUSIVE}
  113. index := FindOption(name);
  114. IF (index # Invalid) THEN
  115. IF (options[index].type = Flag) THEN
  116. RETURN options[index].isSet;
  117. ELSE
  118. WrongUsage(options[index]);
  119. END;
  120. END;
  121. RETURN FALSE;
  122. END GetFlag;
  123. PROCEDURE SetFlag*(ch : CHAR; CONST name : Name) : BOOLEAN;
  124. BEGIN {EXCLUSIVE}
  125. RETURN SetFlagIntern(ch, name, FALSE);
  126. END SetFlag;
  127. (** Check whether an option of type Integer is set and retrieve its value if so *)
  128. PROCEDURE GetInteger*( CONST name : Name; VAR integer : LONGINT) : BOOLEAN;
  129. VAR index : LONGINT;
  130. BEGIN {EXCLUSIVE}
  131. index := FindOption(name);
  132. IF (index # Invalid) THEN
  133. IF (options[index].type = Integer) THEN
  134. IF (options[index].isSet) THEN
  135. integer := options[index].value;
  136. RETURN TRUE;
  137. END;
  138. ELSE
  139. WrongUsage(options[index]);
  140. END;
  141. END;
  142. RETURN FALSE;
  143. END GetInteger;
  144. PROCEDURE SetInteger*(ch : CHAR; CONST name : Name; CONST string : ARRAY OF CHAR) : BOOLEAN;
  145. VAR index : LONGINT; optionName : Name;
  146. BEGIN {EXCLUSIVE}
  147. IF (ch = 0X) THEN optionName := name; ELSE optionName[0] := ch; optionName[1] := 0X; END;
  148. index := FindOption(optionName);
  149. IF (index # Invalid) & (options[index].type = Integer) THEN
  150. options[index].timestamp := timestamp;
  151. options[index].isSet := TRUE;
  152. RETURN TRUE;
  153. ELSE
  154. RETURN FALSE;
  155. END;
  156. END SetInteger;
  157. (** Check whether an option of type String is set and retrieve its value if so *)
  158. PROCEDURE GetString*(CONST name : Name; VAR string : ARRAY OF CHAR) : BOOLEAN;
  159. VAR index : LONGINT;
  160. BEGIN {EXCLUSIVE}
  161. index := FindOption(name);
  162. IF (index # Invalid) THEN
  163. IF (options[index].type = String) THEN
  164. IF (options[index].isSet) THEN
  165. COPY(options[index].string, string);
  166. RETURN TRUE;
  167. END;
  168. ELSE
  169. WrongUsage(options[index]);
  170. END;
  171. END;
  172. RETURN FALSE;
  173. END GetString;
  174. PROCEDURE SetString*(ch : CHAR; CONST name : Name; CONST string : ARRAY OF CHAR) : BOOLEAN;
  175. BEGIN {EXCLUSIVE}
  176. RETURN SetStringIntern(ch, name, string, FALSE);
  177. END SetString;
  178. (** Unset all options *)
  179. PROCEDURE Clear*;
  180. VAR i : LONGINT;
  181. BEGIN {EXCLUSIVE}
  182. FOR i := 0 TO nofOptions-1 DO
  183. options[i].isSet := FALSE;
  184. END;
  185. END Clear;
  186. (** Remove all declared options *)
  187. PROCEDURE Reset*;
  188. VAR i : LONGINT;
  189. BEGIN {EXCLUSIVE}
  190. nofOptions := 0; timestamp := 0;
  191. FOR i := 0 TO MaxOptions-1 DO
  192. options[i].isSet := FALSE;
  193. options[i].timestamp := 0;
  194. options[i].ch := 0X;
  195. options[i].name := "";
  196. options[i].type := Unknown;
  197. options[i].value := 0;
  198. options[i].string := "";
  199. END;
  200. setError := FALSE;
  201. END Reset;
  202. (** Parse options from the argument stream starting at the current position (skip whitespace).
  203. The actual options will be set as side effect when parsing.
  204. *)
  205. PROCEDURE Parse*(arg : Streams.Reader; error : Streams.Writer) : BOOLEAN;
  206. VAR succeeded : BOOLEAN;
  207. BEGIN {EXCLUSIVE}
  208. ASSERT(arg # NIL);
  209. SELF.arg := arg; SELF.error := error;
  210. INC(timestamp);
  211. arg.SkipWhitespace;
  212. setError := FALSE;
  213. succeeded := ParseOptions() & ~setError;
  214. IF ~succeeded & (error # NIL) THEN error.Update; END;
  215. RETURN succeeded;
  216. END Parse;
  217. PROCEDURE ParseString*(CONST string : ARRAY OF CHAR; error : Streams.Writer) : BOOLEAN;
  218. VAR reader : Streams.StringReader;
  219. BEGIN
  220. NEW(reader, LEN(string)); reader.SetRaw(string, 0, LEN(string));
  221. RETURN Parse(reader, error);
  222. END ParseString;
  223. (* Options = [ "-" Option [ WhiteSpace { "-" Option} ] ] *)
  224. PROCEDURE ParseOptions() : BOOLEAN;
  225. VAR ch : CHAR; oldPos : LONGINT;
  226. BEGIN
  227. oldPos := arg.Pos();
  228. ch := arg.Peek();
  229. WHILE (ch = OptionDelimiter) DO
  230. arg.Char(ch); (* consume OptionDelimiter *)
  231. ch := arg.Peek();
  232. IF ("0" <= ch) & (ch <= "9") THEN
  233. IF arg.CanSetPos() THEN
  234. arg.SetPos(oldPos);
  235. ELSE
  236. KernelLog.String("Options.ParseOptions: Warning: Streams integrity destroyed..."); KernelLog.Ln;
  237. END;
  238. RETURN TRUE;
  239. END;
  240. IF ~ParseOption() THEN
  241. RETURN FALSE;
  242. END;
  243. oldPos := arg.Pos();
  244. arg.SkipWhitespace;
  245. ch := arg.Peek();
  246. END;
  247. RETURN TRUE;
  248. END ParseOptions;
  249. (* Option = "-" NameOption | CharOption *)
  250. PROCEDURE ParseOption() : BOOLEAN;
  251. VAR ch : CHAR;
  252. BEGIN
  253. ch := arg.Peek();
  254. IF (ch = OptionDelimiter) THEN
  255. arg.Char(ch); (* consume OptionDelimiter *)
  256. RETURN ParseNameOption();
  257. ELSIF IsValidChar(ch) THEN
  258. RETURN ParseCharOption();
  259. ELSE
  260. IF (error # NIL) THEN
  261. ShowPos(arg.Pos());
  262. error.String('Expected "'); error.Char(OptionDelimiter);
  263. error.String('" or valid option char'); error.Ln;
  264. END;
  265. RETURN FALSE;
  266. END;
  267. END ParseOption;
  268. (* NameOption = Name [Assignment] *)
  269. PROCEDURE ParseNameOption() : BOOLEAN;
  270. VAR ch : CHAR; name : Name; parameter : Parameter; ignoreHere : BOOLEAN;
  271. BEGIN
  272. IF ParseName(name, 0X) THEN
  273. ch := arg.Peek();
  274. IF (ch = Assignment) THEN
  275. IF ParseAssignment(parameter) THEN
  276. ignoreHere := SetStringIntern(0X, name, parameter, TRUE);
  277. RETURN TRUE;
  278. END;
  279. ELSIF (ch > " ") THEN
  280. IF (error # NIL) THEN
  281. ShowPos(arg.Pos());
  282. error.String("Expected white space"); error.Ln;
  283. END;
  284. ELSE
  285. ignoreHere := SetFlagIntern(0X, name, TRUE);
  286. RETURN TRUE;
  287. END;
  288. END;
  289. RETURN FALSE;
  290. END ParseNameOption;
  291. (* Name = Char Char {Char} *)
  292. PROCEDURE ParseName(VAR name : ARRAY OF CHAR; firstChar : CHAR) : BOOLEAN;
  293. VAR ch : CHAR; i : LONGINT; pos : LONGINT;
  294. BEGIN
  295. pos := arg.Pos();
  296. IF (firstChar # 0X) OR ParseChar(name[0]) THEN
  297. IF ParseChar(name[1]) THEN
  298. i := 2;
  299. ch := arg.Peek();
  300. WHILE (i < LEN(name)-1) & IsValidChar(ch) DO
  301. arg.Char(name[i]); INC(i);
  302. ch := arg.Peek();
  303. END;
  304. name[i] := 0X;
  305. IF (i >= LEN(name)-1) & IsValidChar(ch) THEN
  306. IF (error # NIL) THEN ShowPos(pos); error.String(": Name is too long"); error.Ln; END;
  307. ELSE
  308. RETURN TRUE;
  309. END;
  310. END;
  311. END;
  312. RETURN FALSE;
  313. END ParseName;
  314. (* CharOption = Char [Assignment] | Flags *)
  315. PROCEDURE ParseCharOption() : BOOLEAN;
  316. VAR ch, optionChar : CHAR; parameter : Parameter; ignoreHere : BOOLEAN; count : LONGINT;
  317. BEGIN
  318. IF ParseChar(optionChar) THEN
  319. ch := arg.Peek();
  320. IF (ch = Assignment) THEN (* Char [Assignment] *)
  321. IF ParseAssignment(parameter) THEN
  322. ignoreHere := SetStringIntern(optionChar, "", parameter, TRUE);
  323. RETURN TRUE;
  324. ELSE
  325. RETURN FALSE;
  326. END;
  327. END;
  328. ignoreHere := SetFlagIntern(optionChar, "", TRUE);
  329. count := 1;
  330. ch := arg.Peek();
  331. WHILE IsValidChar(ch) & (count <= MaxOptions) DO (* Flags *)
  332. arg.Char(optionChar);
  333. ignoreHere := SetFlagIntern(optionChar, "", TRUE);
  334. INC(count);
  335. ch := arg.Peek();
  336. END;
  337. IF (ch = Assignment) THEN
  338. IF (error # NIL) THEN ShowPos(arg.Pos()); error.String(": Assignment to set of flags not allowed"); error.Ln; END;
  339. ELSIF (ch <= " ") THEN
  340. RETURN TRUE;
  341. ELSIF (count > MaxOptions) THEN
  342. (* SetFlagIntern will report this error *)
  343. ELSE
  344. IF (error # NIL) THEN ShowPos(arg.Pos()); error.String(": Expected option character"); error.Ln; END;
  345. END;
  346. END;
  347. RETURN FALSE;
  348. END ParseCharOption;
  349. (* Assignment = "=" (EnquotedString | Name | Char) *)
  350. PROCEDURE ParseAssignment(VAR parameter : Parameter) : BOOLEAN;
  351. VAR ch : CHAR; delimiter : CHAR; i : LONGINT;
  352. BEGIN
  353. arg.Char(ch);
  354. ASSERT(ch = Assignment);
  355. ch := arg.Peek();
  356. IF (ch = '"') OR (ch = "'") THEN
  357. arg.Char(delimiter);
  358. ch := arg.Peek();
  359. i := 0;
  360. WHILE (i < LEN(parameter)-1) & (ch # delimiter) DO
  361. arg.Char(parameter[i]); INC(i);
  362. ch := arg.Peek();
  363. END;
  364. IF (ch = delimiter) THEN
  365. arg.Char(ch); (* consume delimiter *)
  366. RETURN TRUE;
  367. ELSIF (error #NIL) THEN
  368. ShowPos(arg.Pos());
  369. error.String("Parameter is too long"); error.Ln;
  370. error.Update;
  371. END;
  372. ELSIF IsValidChar(ch) THEN
  373. arg.Char(parameter[0]);
  374. ch := arg.Peek();
  375. IF IsValidChar(ch) THEN (* Name *)
  376. RETURN ParseName(parameter, ch);
  377. ELSE (* Char *)
  378. parameter[1] := 0X;
  379. RETURN TRUE;
  380. END;
  381. ELSIF (error # NIL) THEN
  382. ShowPos(arg.Pos());
  383. error.String("Expected assignment value"); error.Ln;
  384. error.Update;
  385. END;
  386. RETURN FALSE;
  387. END ParseAssignment;
  388. PROCEDURE ParseChar(VAR ch : CHAR) : BOOLEAN;
  389. BEGIN
  390. ch := arg.Peek();
  391. IF IsValidChar(ch) THEN
  392. arg.Char(ch);
  393. RETURN TRUE;
  394. ELSE
  395. IF (error # NIL) THEN
  396. ShowPos(arg.Pos());
  397. error.String("Expected option character"); error.Ln;
  398. error.Update;
  399. END;
  400. RETURN FALSE;
  401. END;
  402. END ParseChar;
  403. PROCEDURE SetFlagIntern(ch : CHAR; CONST name : Name; checkTimestamp : BOOLEAN) : BOOLEAN;
  404. VAR index : LONGINT; optionName : Name;
  405. BEGIN
  406. IF (ch = 0X) THEN optionName := name; ELSE optionName[0] := ch; optionName[1] := 0X; END;
  407. index := FindOption(optionName);
  408. IF (index # Invalid) THEN
  409. IF ~checkTimestamp OR (options[index].timestamp < timestamp) THEN
  410. IF (options[index].type = Flag) THEN
  411. options[index].timestamp := timestamp;
  412. options[index].isSet := TRUE;
  413. RETURN TRUE;
  414. ELSIF (error # NIL) THEN
  415. error.String("Option "); ShowOption(ch, name);
  416. error.String(" requires a parameter"); error.Ln;
  417. END;
  418. ELSIF (error # NIL) THEN
  419. error.String("Option "); ShowOption(ch, name);
  420. error.String(" set multiple times"); error.Ln;
  421. END;
  422. ELSIF (error # NIL) THEN
  423. error.String("Unknown option "); ShowOption(ch, name); error.Ln;
  424. END;
  425. setError := TRUE;
  426. RETURN FALSE;
  427. END SetFlagIntern;
  428. PROCEDURE SetStringIntern(ch : CHAR; CONST name : Name; CONST string : ARRAY OF CHAR; checkTimestamp : BOOLEAN) : BOOLEAN;
  429. VAR index : LONGINT; optionName : Name;
  430. BEGIN
  431. IF (ch = 0X) THEN optionName := name; ELSE optionName[0] := ch; optionName[1] := 0X; END;
  432. index := FindOption(optionName);
  433. IF (index # Invalid) THEN
  434. IF ~checkTimestamp OR (options[index].timestamp < timestamp) THEN
  435. IF (options[index].type = String) THEN
  436. options[index].timestamp := timestamp;
  437. options[index].isSet := TRUE;
  438. COPY(string, options[index].string);
  439. RETURN TRUE;
  440. ELSIF (options[index].type = Integer) THEN
  441. options[index].timestamp := timestamp;
  442. IF StringToInteger(string, options[index].value, TRUE) THEN
  443. options[index].isSet := TRUE;
  444. RETURN TRUE;
  445. ELSIF (error # NIL) THEN
  446. error.String("Option "); ShowOption(ch, name);
  447. error.String(" expects decimal number as parameter"); error.Ln;
  448. END;
  449. ELSIF (error # NIL) THEN
  450. error.String("Option "); ShowOption(ch, name);
  451. error.String(" does not have a parameter"); error.Ln;
  452. END;
  453. ELSIF (error # NIL) THEN
  454. error.String("Option "); ShowOption(ch, name);
  455. error.String(" set multiple times"); error.Ln;
  456. END;
  457. ELSIF (error # NIL) THEN
  458. error.String("Unknown option "); ShowOption(ch, name); error.Ln;
  459. END;
  460. setError := TRUE;
  461. RETURN FALSE;
  462. END SetStringIntern;
  463. (* Returns the index of option with character 'ch' or name 'name' or Invalid, if option not found *)
  464. PROCEDURE FindOption(CONST name : Name) : LONGINT;
  465. VAR ch : CHAR; i : LONGINT;
  466. BEGIN
  467. IF (name[1] = 0X) THEN ch := name[0]; ELSE ch := 0X; END;
  468. FOR i := 0 TO nofOptions-1 DO
  469. IF ((options[i].ch # 0X) & (options[i].ch = ch)) OR ((options[i].name # "") & (options[i].name = name)) THEN
  470. RETURN i;
  471. END;
  472. END;
  473. RETURN Invalid;
  474. END FindOption;
  475. PROCEDURE WrongUsage(option : Option);
  476. BEGIN
  477. IF (error # NIL) THEN
  478. error.String("Warning: Option declaration does not match option usage.");
  479. error.Ln; error.Update;
  480. END;
  481. END WrongUsage;
  482. PROCEDURE ShowPos(pos : LONGINT);
  483. BEGIN
  484. IF (error # NIL) THEN
  485. error.String("Pos "); error.Int(pos, 2); error.String(": ");
  486. END;
  487. END ShowPos;
  488. PROCEDURE ShowOption(ch : CHAR; CONST name : Name);
  489. BEGIN
  490. IF (ch # 0X) THEN
  491. error.Char("-"); error.Char(ch);
  492. ELSE
  493. error.String("--"); error.String(name);
  494. END;
  495. END ShowOption;
  496. (** Debug: List all known options and their current values *)
  497. PROCEDURE Show*(out : Streams.Writer);
  498. VAR i : LONGINT;
  499. BEGIN {EXCLUSIVE}
  500. IF (nofOptions > 0) THEN
  501. FOR i := 0 TO (nofOptions-1) DO
  502. out.Int(i+1, 2); out.String(": ");
  503. IF (options[i].ch # 0X) THEN
  504. out.Char(options[i].ch);
  505. IF (options[i].name # "") THEN out.String(", "); END;
  506. END;
  507. IF (options[i].name # "") THEN
  508. out.String(options[i].name);
  509. END;
  510. out.String(", Set: ");
  511. IF options[i].isSet THEN out.String("Yes"); ELSE out.String("No"); END;
  512. out.String(", Type: ");
  513. CASE options[i].type OF
  514. |Flag:
  515. out.String("Flag");
  516. |String:
  517. out.String("String");
  518. IF (options[i].isSet) THEN out.String(" ("); out.String(options[i].string); out.String(")"); END;
  519. |Integer:
  520. out.String("Integer");
  521. IF (options[i].isSet) THEN out.String(" ("); out.Int(options[i].value, 0); out.String(")"); END;
  522. ELSE
  523. out.String("Unknown");
  524. END;
  525. out.Ln;
  526. END;
  527. ELSE
  528. out.String("No options set"); out.Ln;
  529. END;
  530. out.Update;
  531. END Show;
  532. END Options;
  533. Default = POINTER TO RECORD
  534. name: Name;
  535. defaults: Strings.String;
  536. next: Default;
  537. END;
  538. Defaults* = OBJECT
  539. VAR
  540. head, tail: Default;
  541. PROCEDURE &InitDefaults*;
  542. BEGIN
  543. head := NIL; tail := NIL;
  544. END InitDefaults;
  545. PROCEDURE Add*(CONST name, defaults: ARRAY OF CHAR);
  546. VAR default: Default;
  547. BEGIN
  548. default := head;
  549. WHILE (default # NIL) & (default.name # name) DO
  550. default := default.next;
  551. END;
  552. IF default = NIL THEN
  553. NEW(default);
  554. COPY(name, default.name); default.defaults := Strings.NewString(defaults);
  555. IF tail = NIL THEN head := default
  556. ELSE tail.next := default;
  557. END;
  558. tail := default;
  559. ELSE
  560. default.defaults := Strings.ConcatToNew(default.defaults^, " ");
  561. default.defaults := Strings.ConcatToNew(default.defaults^, defaults);
  562. END;
  563. END Add;
  564. PROCEDURE Get*(CONST name: ARRAY OF CHAR): Streams.Reader;
  565. VAR s: Streams.StringReader; default: Default;
  566. BEGIN
  567. s := NIL;
  568. default := head;
  569. WHILE (default # NIL) & (default.name # name) DO
  570. default := default.next;
  571. END;
  572. IF default # NIL THEN
  573. NEW(s, LEN(default.defaults));
  574. s.Set(default.defaults^);
  575. END;
  576. RETURN s;
  577. END Get;
  578. PROCEDURE Show*(out: Streams.Writer);
  579. VAR default: Default;
  580. BEGIN
  581. default := head;
  582. WHILE (default # NIL) DO
  583. out.String(default.name); out.String(" : "); out.String(default.defaults^); out.Ln;
  584. default := default.next;
  585. END;
  586. END Show;
  587. END Defaults;
  588. (** merge base options into options -- replacing only options that had not been set previously *)
  589. PROCEDURE Merge*(VAR this: Options; base: Options);
  590. VAR i,index: LONGINT;
  591. BEGIN
  592. IF (base # NIL) THEN
  593. IF this = NIL THEN
  594. this := base
  595. ELSE
  596. FOR i := 0 TO base.nofOptions-1 DO
  597. IF (base.options[i].isSet) THEN
  598. index := this.FindOption(base.options[i].name);
  599. IF ~this.options[i].isSet THEN
  600. this.options[index] := base.options[i]
  601. END
  602. END;
  603. END;
  604. END
  605. END;
  606. END Merge;
  607. PROCEDURE IsValidChar(ch : CHAR) : BOOLEAN;
  608. BEGIN
  609. RETURN (" " < ch) & (ch < CHR(128)) & (ch # OptionDelimiter) & (ch # Assignment);
  610. END IsValidChar;
  611. PROCEDURE StringToInteger*(CONST string : ARRAY OF CHAR; VAR x: LONGINT; hex: BOOLEAN) : BOOLEAN;
  612. VAR pos, vd, vh, sign, d: LONGINT; ch: CHAR; ok: BOOLEAN;
  613. BEGIN
  614. IF (LEN(string) <= 0) THEN RETURN FALSE; END;
  615. pos := 0;
  616. IF (string[pos] = "-") THEN sign := -1; INC(pos);
  617. ELSIF (string[pos] = "+") THEN sign := 1; INC(pos);
  618. ELSE sign := 1;
  619. END;
  620. vd := 0; vh := 0; ok := FALSE; d := 0;
  621. LOOP
  622. IF (pos >= LEN(string)) THEN EXIT; END;
  623. ch := string[pos];
  624. IF (ch >= "0") & (ch <= "9") THEN
  625. d := ORD( ch ) - ORD( "0" );
  626. ELSIF hex & (CAP( ch ) >= "A") & (CAP( ch ) <= "F") THEN
  627. d := ORD( CAP( ch ) ) - ORD( "A" ) + 10;
  628. ELSE
  629. EXIT;
  630. END;
  631. vd := 10 * vd + d; vh := 16 * vh + d; (* ignore overflow *)
  632. INC(pos); ok := TRUE
  633. END;
  634. IF hex & (CAP( ch ) = "H") THEN (* optional "H" present *)
  635. vd := vh; (* use the hex value *)
  636. INC(pos);
  637. END;
  638. x := sign * vd;
  639. RETURN ok & ((pos >= LEN(string)) OR (string[pos] <= " "));
  640. END StringToInteger;
  641. PROCEDURE Test*(context : Commands.Context);
  642. VAR options : Options; string : ARRAY 32 OF CHAR;
  643. BEGIN
  644. NEW(options);
  645. options.Add("f", "flag", Flag);
  646. options.Add("s", "string", String);
  647. options.Add("i", "integer", Integer);
  648. IF options.Parse(context.arg, context.error) THEN
  649. context.out.Ln;
  650. options.Show(context.out);
  651. context.arg.SkipWhitespace;
  652. context.arg.String(string);
  653. IF options.GetFlag("dw") THEN END;
  654. context.out.String("Parsed argument: "); context.out.String(string);
  655. context.out.Ln; context.out.Update;
  656. IF options.Parse(context.arg, context.error) THEN
  657. options.Show(context.out);
  658. context.out.Ln;
  659. END;
  660. context.out.String("Parsing a string..");
  661. context.out.Ln; context.out.Update;
  662. options.Clear;
  663. IF options.ParseString("--flag -s=Hello -i=99 ", context.error) THEN
  664. options.Show(context.out);
  665. END;
  666. END;
  667. END Test;
  668. END Options.
  669. Options.Test --string="Hello World" -i=3432 --flag "This is the first argument" --string="Override string option" ~
  670. Options.Test -i="99" --flag ~
  671. Options.Test -afds -b --fdas ~
  672. Options.Test -f -s=fds ~
  673. SystemTools.Free Options ~