Adhoc named parameters

np.tcl

@@ -74,15 +74,16 @@ namespace eval ::np {
 				break
 			}
 
-			# if "var" doesn't start with a dash, flip to positional
-			if {[string index $arg 0] ne "-"} {
-				#puts "possible var '$arg' doesn't start with a dash, flip to positional"
+			# if "var" doesn't start with a dash or equal sign, flip to positional
+			set start_character [string index $arg 0]
+			if {$start_character ne "-" && $start_character ne "="} {
+				#puts "possible var '$arg' doesn't start with a dash or equal sign, flip to positional"
 				break
 			}
 
 			# if "var" isn't known to us as a named parameter, flip to positional
 			set var [string range $arg 1 end]
-			if {[lsearch $named $var] < 0} {
+			if {[lsearch $named $var] < 0 && $start_character ne "="} {
 				#puts "'var' '$arg' not recognized, flip to positional"
 				break
 			}
@@ -97,12 +98,22 @@ namespace eval ::np {
 			# we're good, set the named parameter into the variable sets
 			#puts [list set vsets($var) [lindex $realArgs 1]]
 
+			# but don't allow a valid named parameter to be set as a keyword parameter
+			if {$start_character eq "=" && [lsearch $named $var] >= 0} {
+				error [dict get $argd errmsg] "" [list TCL WRONGARGS]
+			}
+
 			# but don't allow the same variable to be set twice
-			if {[info exists vsets($var)]} {
+			if {[info exists vsets($var)] || [info exists kwsets($var)]} {
 				error [dict get $argd errmsg] "" [list TCL WRONGARGS]
 			}
 
-			set vsets($var) [lindex $realArgs 1]
+			# write to kwsets, if a keword argument was detected
+			if {$start_character eq "="} {
+				set kwsets($var) [lindex $realArgs 1]
+			} else {
+				set vsets($var) [lindex $realArgs 1]
+			}
 			set realArgs [lrange $realArgs 2 end]
 		}
 
@@ -155,6 +166,16 @@ namespace eval ::np {
 			upvar $var myvar
 			set myvar $value
 		}
+
+		# create an empty dict in the caller's frame
+		upvar kwargs kw_args
+		set kw_args [dict create]
+		# now iterate through the var-value pairs and set the dict kwargs
+		# in the caller's frame
+		foreach "var value" [array get kwsets] {
+			#puts "set kw_args $var $value"
+			dict set kw_args $var $value
+		}
 		return
 	}
 
@@ -184,4 +205,4 @@ namespace eval ::np {
 	}
 }
 
-package provide np 1.0.0
+package provide np 1.1.1

tests/np1.test

@@ -340,4 +340,33 @@ test np-7.1 "call named parameters with expando" -setup {
 } -result "a defb c {}"
 
 
+
+test np-8.0 "regular and adhoc named parameter in a variable" -setup {
+	np::proc t {a --} {
+		return [list $a $kwargs]
+	}
+} -body {
+	set n "-a"
+	set m "=b"
+	t $n a $m b
+} -result "a {b b}"
+
+test np-8.1 "call regular and adhoc named parameters with expando" -setup {
+	np::proc t {a {b defb} -- c args} {
+		return [list $a $b $c $kwargs $args]
+	}
+} -body {
+	set l {=d d -a a -- c}
+	t {*}$l
+} -result "a defb c {d d} {}"
+
+test np-8.2 "call regular and double adhoc named parameters with expando" -setup {
+	np::proc t {a {b defb} -- c args} {
+		return [list $a $b $c $kwargs $args]
+	}
+} -body {
+	set l {=d d -a a =e e -- c}
+	t {*}$l
+} -result "a defb c {d d e e} {}"
+
 cleanupTests