[37247] trunk/base/src/port/port.tcl

raimue at macports.org raimue at macports.org
Sat May 31 19:53:04 PDT 2008


Revision: 37247
          http://trac.macosforge.org/projects/macports/changeset/37247
Author:   raimue at macports.org
Date:     2008-05-31 19:53:03 -0700 (Sat, 31 May 2008)

Log Message:
-----------
port/port.tcl:
Enable multiple arguments for --options

Modified Paths:
--------------
    trunk/base/src/port/port.tcl

Modified: trunk/base/src/port/port.tcl
===================================================================
--- trunk/base/src/port/port.tcl	2008-05-31 23:39:10 UTC (rev 37246)
+++ trunk/base/src/port/port.tcl	2008-06-01 02:53:03 UTC (rev 37247)
@@ -2504,18 +2504,52 @@
 
 # cmd_args_array specifies which arguments the commands accept
 # Commands not listed here do not accept any arguments
+# Syntax if {option argn}
+# Where option is the name of the option and argn specifies how many arguments
+# this argument takes
 global cmd_args_array
 array set cmd_args_array {
-    info        {category categories depends_build depends_lib depends_run
-                 description epoch homepage long_description maintainer
-                 maintainers name platform platforms portdir revision
-                 variant variants version}
-    selfupdate  {nosync pretend}
-    uninstall   {follow-dependents}
-    variants    {index}
-    clean       {all archive dist work}
+    info        {{category 0} {categories 0} {depends_build 0} {depends_lib 0} {depends_run 0}
+                {description 0} {epoch 0} {homepage 0} {long_description 0} {maintainer 0}
+                {maintainers 0} {name 0} {platform 0} {platforms 0} {portdir 0} {revision 0}
+                {variant 0} {variants 0} {version 0}}
+    selfupdate  {{nosync 0} {pretend 0}}
+    uninstall   {{follow-dependents 0}}
+    variants    {{index 0}}
+    clean       {{all 0} {archive 0} {dist 0} {work 0}}
 }
 
+##
+# Checks whether the given option is valid
+#
+# œparam action for which action
+# @param option the option to check
+# @param upoptargc reference to upvar for storing the number of arguments for
+#                  this option
+proc cmd_option_exists { action option {upoptargc ""}} {
+    global cmd_args_array
+    upvar 1 $upoptargc optargc
+
+    # This could be so easy with lsearch -index,
+    # but that's only available as of Tcl 8.5
+
+    if {![info exists cmd_args_array($action)]} {
+        return 0
+    }
+
+    foreach item $cmd_args_array($action) {
+        set name [lindex $item 0]
+        set argc [lindex $item 1]
+
+        if {$name == $option} {
+            set optargc $argc
+            return 1
+        }
+    }
+
+    return 0
+}
+
 # Parse global options
 #
 # Note that this is called several times:
@@ -2542,10 +2576,24 @@
                 }
                 default {
                     set key [string range $arg 2 end]
-                    if {![info exists cmd_args_array($action)] || [lsearch -exact $cmd_args_array($action) $key] == -1} {
+                    set kargc 0
+                    if {![cmd_option_exists $action $key kargc]} {
                         return -code error "${action} does not accept --${key}"
                     }
-                    set global_options(ports_${action}_${key}) yes
+                    if {$kargc == 0} {
+                        set global_options(ports_${action}_${key}) yes
+                    } else {
+                        set args {}
+                        while {[moreargs] && $kargc > 0} {
+                            advance
+                            lappend args [lookahead]
+                            set kargc [expr $kargc - 1]
+                        }
+                        if {$kargc > 0} {
+                            return -code error "--${key} expects [expr $kargc + [llength $args]] parameters!"
+                        }
+                        set global_options(ports_${action}_${key}) $args
+                    }
                 }
             }
         } else {

-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.macosforge.org/pipermail/macports-changes/attachments/20080531/9ee8b7f0/attachment-0001.htm 


More information about the macports-changes mailing list