home *** CD-ROM | disk | FTP | other *** search
/ CyberMycha 2006 April / SGP.iso / dema / Keepsake-Demo-en-li-v1.0.exe / res / bin / prime / cmdinterp.tcl next >
Text File  |  2005-10-29  |  4KB  |  122 lines
  1. class cmdinterp {
  2.     proc cmdinterp { this cmdline optline } {
  3.         set ($this,opts) ""
  4.         set ($this,args) ""
  5.         set cmdlength [llength $cmdline]
  6.         
  7.         set optbool ""
  8.         foreach o $optline {
  9.             if { [llength $o] == 1 } {
  10.                 set optname $o
  11.                 set optvalue 0
  12.                 append optbool "$optname "
  13.             } else {
  14.                 set optname [lindex $o 0]
  15.                 set optvalue [lindex $o 1]
  16.                 for {set i 0} {$i < [llength $optvalue]} {incr i} {
  17.                     set optarray($optname.$i) [lindex $optvalue $i]
  18.                 }
  19.             }
  20.             set optarray($optname) $optvalue
  21.             set optarray($optname?) "0"
  22.         }
  23.  
  24.         set argi 0 
  25.         set maxi 0 
  26.         set opti 0
  27.         set optname ""
  28.         for { set i 0 } { $i < $cmdlength } { incr i } {
  29.             set match ""
  30.     
  31.             set cmd [lindex $cmdline $i]
  32.             regexp -- {^-(.*)} $cmd -> match
  33.  
  34.             if { $match != "" } {
  35.                 if { [expr $argi-$opti] <= 0 } {
  36.                     set argi 0
  37.                     set opti 0
  38.                     set maxi 0
  39.                 }
  40.             }
  41.                 
  42.             if { $argi > 0 } {
  43.                 incr argi -1
  44.  
  45.                 append optarray($optname) "$cmd "
  46.                 set optarray($optname.[expr $maxi-$argi-1]) $cmd
  47.                 continue
  48.             }
  49.                 
  50.             if { $match != "" } {
  51.                 if { $optname != "" } {
  52.                     set optarray($optname) [string trim $optarray($optname)]
  53.                 }
  54.                 
  55.                 set optname $match
  56.  
  57.                 if { [array names optarray $optname] == "" } {
  58.                     set optarray($optname) "*"
  59.                 }
  60.                 
  61.                 if { [string match "*$match *" $optbool] } {
  62.                     set optarray($optname) 1
  63.                     set optarray($optname?) 1
  64.                 } else {
  65.                     set argi [llength $optarray($optname)]
  66.                     if {$optarray($optname) == "*"} {
  67.                         set argi 999999999
  68.                         set opti 999999999
  69.                     }
  70.                     set optarray($optname) ""
  71.                     set optarray($optname?) "1"
  72.                     if { !$argi } { set argi 1 }
  73.                     set maxi $argi
  74.                 }
  75.                 continue
  76.             }
  77.             
  78.             append ($this,args) "$cmd "
  79.         }
  80.  
  81.         if { [expr $argi-$opti] > 0 } {
  82.             error "option -$optname miss [expr $argi] arguments."
  83.             return
  84.         }
  85.  
  86.         if { $optname != "" } {
  87.             set optarray($optname) [string trim $optarray($optname)]
  88.         }
  89.         
  90.         set ($this,opts) [array get optarray]
  91.         set ($this,args) [string trim $($this,args)]
  92.     }
  93.  
  94.     proc ~cmdinterp { this  } {}
  95.  
  96.     proc getopts { this } {
  97.         return $($this,opts)
  98.     }
  99.  
  100.     proc getargs { this } {
  101.         return $($this,args)
  102.     }
  103. }
  104.  
  105.  
  106. namespace eval cmdline {
  107.     proc getopt {argvVar optstring} {
  108.         set i [new cmdinterp $argvVar $optstring]
  109.         set r [cmdinterp::getopts $i]
  110.         delete $i
  111.         return $r
  112.     }
  113.  
  114.     proc getarg {argvVar optstring} {
  115.         set i [new cmdinterp $argvVar $optstring]
  116.         set r [cmdinterp::getargs $i]
  117.         delete $i
  118.         return $r
  119.     }
  120. }
  121.  
  122.