opts.tm (4011B)
1 #!/usr/bin/env sh 2 # \ 3 echo "You have reached libsuitcase Tcl component opts.tm. Please note that this"; \ 4 echo "Tcl module is not intended to be directly invoked."; \ 5 echo ""; \ 6 echo "This Tcl module requires Tcl 8.6 or above."; \ 7 echo "To use opts.tm in your script, you can read it in through tail -n +11, or"; \ 8 echo "you can add it to your script's project directory as a separate file."; \ 9 echo "Thank you for using /pkg/umbrellix.net/prog/suitcase"; \ 10 exit 64 11 12 proc opts {{consume {h v H: M: help version headers: markdown:}} argl} { 13 # will always output a list n=2. 14 # [lindex [opts ...] 0] = a list of lists: option, argument(s) 15 # [lindex [opts ...] 1] = a list of arguments not consumed 16 # loptpile contains the long options followed by the number of arguments they consume 17 # a : not immediately preceded by a backslash means that consumed++ 18 # two backslashes collapse to one. 19 # soptpile contains the options which are one letter (one may write -HM header markdown) 20 set loptpile [list] 21 set soptpile [list] 22 foreach {option} $consume { 23 set optname "" 24 set colons 0 25 set prevl "" 26 foreach {l} [split $option {}] { 27 if {$l == ":" && $prevl != "\\"} {incr colons} 28 if {($l != "\\" || $prevl == "\\") && $colons < 1} { 29 append optname $l 30 } 31 if {$prevl != "\\"} {set prevl $l} {set prevl ""} 32 } 33 if {[string length $optname] > 1} {lappend loptpile $optname $colons} {lappend soptpile $optname $colons} 34 } 35 set consumingargs [list] 36 set consumedargs [list] 37 set unconsumedargs [list] 38 set n 0 39 set dashdash 0 40 while {$n < [llength $argl]} { 41 set arg [lindex $argl $n] 42 set colons 0 43 if {$dashdash} { 44 lappend unconsumedargs $arg 45 } { 46 if {[string index $arg 0] == "-"} { 47 if {[string index $arg 1] == "-"} { 48 if {[string length $arg] == 2} {set dashdash 1} { 49 # long opt; consume argument immediately after, even if it starts with a dash 50 # if not a real opt, don't care 51 if {[set colons [dict get $loptpile [string range $arg 2 end]]] != ""} { 52 set consumedarg [list [string range $arg 2 end]] 53 if {$colons != 0} { 54 if {[llength [lrange $argl [expr {$n+1}] [expr {$n+$colons}]]] == $colons} { 55 lappend consumedarg [lrange $argl [expr {$n+1}] [expr {$n+$colons}]] 56 incr n $colons 57 } { 58 return -code error "Reached end of arguments list while consuming arguments for option $arg ([lrange $argl [expr {$n+1}] [expr {$n+$colons}]])" 59 } 60 } 61 lappend consumedargs $consumedarg 62 } { 63 lappend unconsumedargs $arg 64 } 65 } 66 } { 67 if {[string length $arg] == 1} {lappend unconsumedargs $arg} { 68 # short option 69 foreach {letter} [split [string range $arg 1 end] {}] { 70 if {[catch {dict get $soptpile $letter} colons] == 0} { 71 #set colons [dict get $soptpile $letter] 72 set consumedarg [list $letter] 73 if {$colons != 0} { 74 if {[llength [lrange $argl [expr {$n+1}] [expr {$n+$colons}]]] == $colons} { 75 foreach {ar} [lrange $argl [expr {$n+1}] [expr {$n+$colons}]] {lappend consumedarg $ar} 76 incr n $colons 77 } { 78 return -code error "Reached end of arguments list while consuming arguments for option $arg ([lrange $argl [expr {$n+1}] [expr {$n+$colons}]])" 79 } 80 } 81 lappend consumedargs $consumedarg 82 } { 83 # unrecognized dash option - warn user and treat as a separate non-option arg 84 puts stderr [format "warning: option -%s not recognized by this program. Treating as a SEPARATE non-option argument - if this wasn't intended, put the argument containing this option after a \'--\'!" $letter] 85 lappend unconsumedargs [join [list - $letter] {}] 86 } 87 # if there's even zero colons 88 } 89 # foreach letter 90 } 91 # if only dash, else short option 92 } 93 # if two dashes 94 } else { 95 lappend unconsumedargs $arg 96 } 97 # if one dash 98 } 99 # if dashdash 100 incr n 101 } 102 # while 103 return [list $consumedargs $unconsumedargs] 104 } 105