==== //depot/users/amit/lib/public/tcllib/cmdline/cmdline.tcl#7 (text) - //depot/users/amit/lib/public/tcllib/cmdline/cmdline.tcl#1 (text) ==== content
@@ -14,9 +14,8 @@
 # RCS: @(#) $Id: cmdline.tcl,v 1.28 2011/02/23 17:41:52 andreas_kupries Exp $
 
 package require Tcl 8.2
+package require fileutil 1.14.4
+package provide cmdline 1.3.3
 
-package provide cmdline 1.3.3
 namespace eval ::cmdline {
     namespace export getArgv0 getopt getKnownOpt getfiles getoptions \
 	    getKnownOptions usage
@@ -453,7 +452,6 @@
     variable dummy
     regexp      -- {must be (.+)$} $charclasses dummy charclasses
     regsub -all -- {, (or )?}      $charclasses {|}   charclasses
-    set charclasses "$charclasses|file|dir"
     unset dummy
 }
 
@@ -590,7 +588,7 @@
                         set retvar $opt
                         set argsList [lrange $argsList 1 end]
 
-                    } elseif {[regexp -- "\\.(arg|$charclasses|{.*})\$" $opt dummy charclass]
+                    } elseif {[regexp -- "\\.(arg|$charclasses)\$" $opt dummy charclass]
                             || [regexp -- {\.\(([^)]+)\)} $opt dummy charclass]} {
 				if {[string equal arg $charclass]} {
                             set type arg
@@ -601,7 +599,7 @@
                         }
 
                         set argsList [lrange $argsList 1 end]
-                        set opt [lindex [split $opt . ] 0 ]
+                        set opt [file rootname $opt]
 
                         while {1} {
                             if {[llength $argsList] == 0
@@ -639,29 +637,6 @@
                                     set retval -2
                                 }
                                 set quantifier ""
-                            } elseif { (($type == "oneof")
-                                    && ([regexp {\{.*\}} $charclass dummy ] ==1 ))} {
-                                        if { [ eval regexp $charclass [lindex $argsList 0] dummy ] == 1 } {
-                                            set retval 1
-                                            set retvar $opt
-                                            lappend optarg [lindex $argsList 0]
-                                        } else {
-                                                set retval -4
-                                                set retvar $opt
-                                                set optarg "Option requires value matching $charclass pattern"
-                                        }
-                                set argsList [lrange $argsList 1 end]
-                            } elseif { (($type == "class")
-                                    && ([string equal "dir" $charclass ] || [string equal file $charclass ]))} {
-                                        if { [ ::fileutil::test [lindex $argsList 0] [list exists $charclass] optarg ] } {
-                                                    set retval 1
-                                                    set retvar $opt
-                                                    lappend optarg [lindex $argsList 0]
-                                        } else {
-                                                    set retval -4
-                                                    set retvar $opt
-                                        }
-                                set argsList [lrange $argsList 1 end]
                             } elseif {($type == "arg")
                                     || (($type == "oneof")
                                     && [string first "|[lindex $argsList 0]|" "|$charclass|"] != -1)
@@ -777,11 +752,6 @@
         if {[regsub -- {\.secret$} $name {} name] == 1} {
             # Remove this extension before passing to typedGetopt.
         }
-        if {[regsub -- {\.must$} $name {} name] == 1} {
-            # Remove this extension before passing to typedGetopt.
-            regsub -- {\..*$} $name {} temp
-            set must($temp) 1
-        }
         if {[regsub -- {\.multi$} $name {} name] == 1} {
             # Remove this extension before passing to typedGetopt.
 
@@ -801,8 +771,7 @@
     }
     set argc [llength $argv]
     while {[set err [typedGetopt argv $opts opt arg]]} {
-        switch $err {
-        1 {
+        if {$err == 1} {
             if {[info exists result($opt)]
                     && [info exists multi($opt)]} {
                 # Toggle boolean options or append new arguments
@@ -810,29 +779,17 @@
                 if {$arg == ""} {
                     unset result($opt)
                 } else {
-                    set result($opt) [concat  $result($opt) $arg]
+                    set result($opt) "$result($opt) $arg"
                 }
             } else {
-                set result($opt) [list $arg]
+                set result($opt) "$arg"
             }
-        } 
-        -1 {
-            error [typedUsage $optlist "ERROR:: \"-$opt\" Invalid option $arg \n $usage"]
-        }
-        -3 {
-            error [typedUsage $optlist "ERROR:: Argument to a valid option \"-$opt\" does not match type $arg \n $usage"]
-        } 
-        -4 {
-            error [typedUsage $optlist "ERROR:: Argument to a valid option \"-$opt\" $arg \n $usage"]
-        } 
-        -2 { 
-            if { ![info exists defaults($opt)] } {
-                error [typedUsage $optlist "ERROR:: Missing argument to a valid option \"-$opt\" $arg \n $usage"]
+        } elseif {($err == -1) || ($err == -3)} {
+            error [typedUsage $optlist $usage]
+        } elseif {$err == -2 && ![info exists defaults($opt)]} {
+            error [typedUsage $optlist $usage]
             }
         }
-    }
-    }
-
     if {[info exists result(?)] || [info exists result(help)]} {
         error [typedUsage $optlist $usage]
     }
@@ -841,11 +798,6 @@
             set result($opt) $dflt
         }
     }	
-    foreach opt [array names must ] {
-    	if { ! [ info exists result($opt) ] } {
-		error [typedUsage $optlist "$opt is must parameter"]
-	}
-    }
     return [array get result]
 }
 
@@ -863,7 +815,8 @@
 
 proc ::cmdline::typedUsage {optlist {usage {options:}}} {
     variable charclasses
-    set str "[getArgv0]: $usage\n"
+
+    set str "[getArgv0] $usage\n"
     foreach opt [concat $optlist \
             {{help "Print this message"} {? "Print this message"}}] {
         set name [lindex $opt 0]
@@ -871,17 +824,14 @@
             # Hidden option
 
         } else {
-            if {[regsub -- {\.must$} $name {} name] == 1} {
-                # Display something about must options
-            }
             if {[regsub -- {\.multi$} $name {} name] == 1} {
                 # Display something about multiple options
             }
 
-            if {[regexp -- "\\.(arg|$charclasses|{.*})\$" $name dummy charclass]
+            if {[regexp -- "\\.(arg|$charclasses)\$" $name dummy charclass]
                     || [regexp -- {\.\(([^)]+)\)} $opt dummy charclass]} {
                    regsub -- "\\..+\$" $name {} name
-                set comment [lindex $opt end]
+                set comment [lindex $opt 2]
                 set default "<[lindex $opt 1]>"
                 if {$default == "<>"} {
                     set default ""
@@ -889,7 +839,7 @@
                 append str [format " %-20s %s %s\n" "-$name $charclass" \
                         $comment $default]
             } else {
-                set comment [lindex $opt end]
+                set comment [lindex $opt 1]
 		append str [format " %-20s %s\n" "-$name" $comment]
             }
         }
@@ -914,19 +864,19 @@
 proc ::cmdline::prefixSearch {list pattern} {
     # Check for an exact match
 
-    if {[set pos [::lsearch -nocase -exact $list $pattern]] > -1} {
+    if {[set pos [::lsearch -exact $list $pattern]] > -1} {
         return $pos
     }
 
     # Check for a unique short version
 
     set slist [lsort $list]
-    if {[set pos [::lsearch -nocase -glob $slist $pattern*]] > -1} {
+    if {[set pos [::lsearch -glob $slist $pattern*]] > -1} {
         # What if there is nothing for the check variable?
 
         set check [lindex $slist [expr {$pos + 1}]]
         if {[string first $pattern $check] != 0} {
-            return [::lsearch -nocase -exact $list [lindex $slist $pos]]
+            return [::lsearch -exact $list [lindex $slist $pos]]
         }
     }
     return -1
