1275970Scy[= AutoGen5 template foo=(base-name) -*- Mode: scheme -*-=] 2275970Scy[= 3275970Scy 4275970Scy(emit (dne "# ")) 5275970Scy 6275970Scy(if (not (and (exist? "prog-name") (exist? "prog-title") (exist? "version"))) 7275970Scy (error "prog-name and prog-title are required")) 8275970Scy(define prog-name (get "prog-name")) 9275970Scy 10275970Scy(if (> (string-length prog-name) 16) 11275970Scy (error (sprintf "prog-name limited to 16 characters: %s" 12275970Scy prog-name)) ) 13275970Scy(if (not (exist? "long-opts")) 14275970Scy (error "long-opts is required")) 15275970Scy 16275970Scy;; perl list containing string to initialize the option hash 17275970Scy(define perl_opts "") 18275970Scy;; perl list containing option definitions for Getopt::Long 19275970Scy(define perl_defs " ") 20275970Scy;; usage string 21275970Scy(define perl_usage "") 22275970Scy 23275970Scy(define optname-from "A-Z_^") 24275970Scy(define optname-to "a-z--") 25275970Scy(define counter 0) 26275970Scy 27275970Scy(define q (lambda (s) (string-append "'" s "'"))) 28275970Scy(define qp (lambda (s) (string-append "q{" s "}"))) 29275970Scy 30275970Scy=][= 31275970Scy 32275970ScyFOR flag =][= 33275970Scy 34275970Scy(define optarg "") ;; the option argument for Getopt::Long 35275970Scy(define opttarget "''") ;; the value of a hash key that represents option 36275970Scy(define optargname "") 37275970Scy(define optisarray #f) 38275970Scy(define optname (string-tr! (get "name") optname-from optname-to)) 39275970Scy 40275970Scy=][= # 41275970Scy;; since autoopts doesn't support float we take the combination arg-name = 42275970Scy;; float and arg-type = string as float 43275970Scy=][= 44275970Scy IF arg-type =][= 45275970Scy CASE arg-type =][= 46275970Scy 47275970Scy =* num =][= (set! optarg "=i") =][= 48275970Scy 49275970Scy =* str =][= 50275970Scy (if (and (exist? "arg-name") (== (get "arg-name") "float")) 51275970Scy (set! optarg "=f") 52275970Scy (set! optarg "=s") 53275970Scy ) =][= 54275970Scy 55275970Scy * =][= 56275970Scy (error (string-append "unknown arg type '" 57275970Scy (get "arg-type") "' for " (get "name"))) =][= 58275970Scy ESAC arg-type =][= 59275970Scy ENDIF =][= 60275970Scy 61275970Scy(if (exist? "stack-arg") 62275970Scy ;; set optarget to array reference if can take more than one value 63275970Scy ;; FIXME: if "max" exists, then just presume it is greater than 1 64275970Scy ;; 65275970Scy (if (and (exist? "max") (== (get "max") "NOLIMIT")) 66275970Scy (begin 67275970Scy (set! opttarget (string-append 68275970Scy "[" 69275970Scy (if (exist? "arg-default") (q (get "arg-default")) "") 70275970Scy "]" 71275970Scy ) 72275970Scy ) 73275970Scy (set! optisarray #t) 74275970Scy ) 75275970Scy (error "If stack-arg then max has to be NOLIMIT") 76275970Scy ) 77275970Scy ;; just scalar otherwise 78275970Scy (if (exist? "arg-default") (set! opttarget (q (get "arg-default")))) 79275970Scy) 80275970Scy 81275970Scy(set! perl_opts (string-append perl_opts 82275970Scy "'" (get "name") "' => " opttarget ",\n ")) 83275970Scy 84275970Scy(define def_add (string-append "'" optname (if (exist? "value") 85275970Scy (string-append "|" (get "value")) "") optarg "',")) 86275970Scy 87275970Scy(define add_len (+ (string-length def_add) counter)) 88275970Scy(if (> add_len 80) 89275970Scy (begin 90275970Scy (set! perl_defs (string-append perl_defs "\n " def_add)) 91275970Scy (set! counter 8) 92275970Scy ) 93275970Scy (begin 94275970Scy (set! perl_defs (string-append perl_defs " " def_add)) 95275970Scy (set! counter (+ counter add_len)) 96275970Scy ) 97275970Scy) 98275970Scy 99275970Scy(if (exist? "arg-type") 100275970Scy (if (and (exist? "arg-name") (== (get "arg-name") "float")) 101275970Scy (set! optargname "=float") 102275970Scy (set! optargname (string-append "=" (substring (get "arg-type") 0 3))) 103275970Scy ) 104275970Scy (set! optargname " ") 105275970Scy) 106275970Scy 107275970Scy(if (not (exist? "deprecated")) 108275970Scy (set! perl_usage (string-append perl_usage 109275970Scy (sprintf "\n %-28s %s" (string-append 110275970Scy (if (exist? "value") (string-append "-" (get "value") ",") " ") 111275970Scy " --" 112275970Scy (get "name") 113275970Scy optargname) 114275970Scy (get "descrip")) 115275970Scy) ) ) 116275970Scy(if optisarray 117275970Scy (set! perl_usage (string-append perl_usage 118275970Scy "\n - may appear multiple times")) 119275970Scy) 120275970Scy 121275970Scy=][= 122275970Scy 123275970ScyENDFOR each "flag" =] 124275970Scy 125275970Scyuse Getopt::Long qw(GetOptionsFromArray); 126275970ScyGetopt::Long::Configure(qw(no_auto_abbrev no_ignore_case_always)); 127275970Scy 128275970Scymy $usage; 129275970Scy 130275970Scysub usage { 131275970Scy my ($ret) = @_; 132275970Scy print STDERR $usage; 133275970Scy exit $ret; 134275970Scy} 135275970Scy 136275970Scysub paged_usage { 137275970Scy my ($ret) = @_; 138275970Scy my $pager = $ENV{PAGER} || '(less || more)'; 139275970Scy 140275970Scy open STDOUT, "| $pager" or die "Can't fork a pager: $!"; 141275970Scy print $usage; 142275970Scy 143275970Scy exit $ret; 144275970Scy} 145275970Scy 146275970Scysub processOptions { 147275970Scy my $args = shift; 148275970Scy 149275970Scy my $opts = { 150275970Scy [= (. perl_opts) =]'help' => '', 'more-help' => '' 151275970Scy }; 152275970Scy my $argument = '[= argument =]'; 153275970Scy my $ret = GetOptionsFromArray($args, $opts, ( 154275970Scy[= (. perl_defs) =] 155275970Scy 'help|?', 'more-help')); 156275970Scy 157275970Scy $usage = <<'USAGE'; 158275970Scy[= prog-name =] - [= prog-title =] - Ver. [= version =] 159275970ScyUSAGE: [= prog-name =] [ -<flag> [<val>] | --<name>[{=| }<val>] ]... [= argument =] 160275970Scy[= (. perl_usage) =] 161275970Scy -?, --help Display usage information and exit 162275970Scy --more-help Pass the extended usage information through a pager 163275970Scy 164275970ScyOptions are specified by doubled hyphens and their name or by a single 165275970Scyhyphen and the flag character. 166275970ScyUSAGE 167275970Scy 168275970Scy usage(0) if $opts->{'help'}; 169275970Scy paged_usage(0) if $opts->{'more-help'};[= 170275970Scy 171275970ScyCASE argument =][= 172275970Scy!E =][= 173275970Scy==* "[" =][= 174275970Scy* =] 175275970Scy 176275970Scy if ($argument && $argument =~ /^[^\[]/ && !@$args) { 177275970Scy print STDERR "Not enough arguments supplied (See --help/-?)\n"; 178275970Scy exit 1; 179275970Scy }[= 180275970Scy 181275970ScyESAC 182275970Scy 183275970Scy=] 184275970Scy $_[0] = $opts; 185275970Scy return $ret; 186275970Scy} 187275970Scy 188275970ScyEND { close STDOUT }; 189