updated fift + bugfixes

crypto/fift/lib/GetOpt.fif

@@ -33,12 +33,16 @@ recursive list-delete-range {
 } : list-find-opt
 // ( -- s i or 0 )  finds first option in cmdline args
 { $* @ list-find-opt } : first-opt
-// ( s t -- ? )  checks whether short/long option s matches description t
-{ third $= } : short-option-matches
 ' second : get-opt-flags
 ' first : get-opt-exec
+// ( s t -- ? )  checks whether short/long option s matches description t
+{ third $= } : short-option-matches
 { dup get-opt-flags 4 and 0= 3 + [] $=
 } : long-option-matches
+// ( t -- s -1 or 0 )  extracts help message from description
+{ dup get-opt-flags 4 and 0= 4 + over count over >
+  { [] true } { 2drop false } cond
+} : get-opt-help
 // ( s l -- t -1 or 0 )  finds short/long option s in list l
 { swap 1 { swap short-option-matches } does assoc-gen
 } : lookup-short-option
@@ -47,37 +51,57 @@ recursive list-delete-range {
 // ( s -- s' null or s' s'' )  Splits long option --opt=arg at '='
 { dup "=" $pos 1+ ?dup { tuck $| swap rot 1- $| drop swap } { null } cond
 } : split-longopt
+variable options-list
 // ( l -- i or 0 ) 
 // parses command line arguments according to option description list l
 // and returns index i of first incorrect option
-{ { first-opt dup 0= { true } {
-    swap dup "--" $pfx? {  // l i s
+{ options-list !
+  { first-opt dup 0= { true } {
+    swap dup "--" $pfx? {  // i s
       dup $len 2 = { drop dup 1 $*del.. 0 true } {
-      split-longopt swap 3 pick
-      lookup-long-option not { drop true } { // l i s' t f
-      dup get-opt-exec swap get-opt-flags 3 and // l i s' e f'
-      2 pick null? { dup 1 = } { dup 0= negate } cond  // l i s' e f' f''
+      split-longopt swap options-list @
+      lookup-long-option not { drop true } { // i s' t f
+      dup get-opt-exec swap get-opt-flags 3 and // i s' e f'
+      2 pick null? { dup 1 = } { dup 0= negate } cond  // i s' e f' f''
       dup 1 = { 2drop 2drop true } {
       { drop nip over 1+ $() swap execute 2 $*del.. false } {
       ' nip ifnot execute 1 $*del.. false
-    } cond } cond } cond } cond } { // l i s
+    } cond } cond } cond } cond } { // i s
       1 $| nip {
         dup $len 0= { drop 1 $*del.. false true } {
-        1 $| swap 3 pick  // l i s' s l
-        lookup-short-option not { drop true true } { // l i s' t
-        dup get-opt-exec swap get-opt-flags 3 and  // l i s' e f'
+        1 $| swap options-list @  // i s' s l
+        lookup-short-option not { drop true true } { // i s' t
+        dup get-opt-exec swap get-opt-flags 3 and  // i s' e f'
         ?dup 0= { execute false } {
         2 pick $len { drop execute "" false } {
-        2 = { nip null swap execute "" false } {  // l i e
+        2 = { nip null swap execute "" false } {  // i e
         nip over 1+ $() swap execute 2 $*del.. false true
       } cond } cond } cond } cond } cond } until
     } cond
-  } cond } until nip
+  } cond } until
 } : getopt
+// ( t -- )  Displays help message for one option
+{ dup get-opt-flags dup 4 and 2 pick third swap {
+    ."-" type ."/" over 3 [] type } {
+    dup $len { dup "--" $pfx? { ."-" } ifnot type } {
+    drop ."usage: " $0 type
+  } cond } cond
+  dup 3 and ?dup {
+    2 = { ."[=<optarg>]" } { ."=<optarg>" } cond
+  } if
+  8 and { 9 emit } ifnot
+  get-opt-help { type } { ."No help available" } cond cr
+} : show-opt-help
+// ( -- )  Displays options help message according to options-list
+{ options-list @ { dup null? not } {
+    uncons swap show-opt-help
+  } while drop
+} : show-options-help
 // ( l -- )  Parses options and throws an error on failure
-{ getopt ?dup { $() "cannot parse command line options near `" swap $+ +"`" abort } if
+{ getopt ?dup {
+  $() "cannot parse command line options near `" swap $+ +"`"
+  show-options-help abort } if
 } : run-getopt
-
 anon constant opt-list-marker
 ' opt-list-marker : begin-options
 { opt-list-marker list-until-marker } : end-options
@@ -90,3 +114,7 @@ anon constant opt-list-marker
 { 2 rot triple } dup : short-option-?arg : long-option-?arg
 { 5 2swap 4 tuple } : short-long-option-arg
 { 6 2swap 4 tuple } : short-long-option-?arg
+// ( o s -- s' )  Adds help message to option
+' , : option-help
+// ( s -- o )  Creates a generic help message
+{ 'nop 8 "" 3 roll 4 tuple } : generic-help