[44051] users/perry/base-select/src

[perry at macports.org]

Revision: 44051
          http://trac.macports.org/changeset/44051
Author:   perry at macports.org
Date:     2008-12-19 21:09:46 -0800 (Fri, 19 Dec 2008)
Log Message:
-----------
base-select/src - Added action_select and mportselect.
Note that mportselect is only a stub right now :).

Modified Paths:
--------------
    users/perry/base-select/src/macports1.0/macports.tcl
    users/perry/base-select/src/port/port.tcl

Modified: users/perry/base-select/src/macports1.0/macports.tcl
===================================================================
--- users/perry/base-select/src/macports1.0/macports.tcl	2008-12-20 04:37:23 UTC (rev 44050)
+++ users/perry/base-select/src/macports1.0/macports.tcl	2008-12-20 05:09:46 UTC (rev 44051)
@@ -2268,3 +2268,11 @@
     # close the port handle
     mportclose $workername
 }
+
+# mportselect
+proc mportselect {action group {version ""}} {
+    ui_debug "mportselect \[$action] \[$group] \[$version]"
+    ui_warn "This is a stub."
+
+    return 1
+}

Modified: users/perry/base-select/src/port/port.tcl
===================================================================
--- users/perry/base-select/src/port/port.tcl	2008-12-20 04:37:23 UTC (rev 44050)
+++ users/perry/base-select/src/port/port.tcl	2008-12-20 05:09:46 UTC (rev 44051)
@@ -1669,6 +1669,75 @@
 }
 
 
+proc action_select { action portlist opts } {
+    ui_debug "action_select \[$portlist] \[$opts]..."
+
+    set commands [array names [array set {} $opts]]
+    # Error out if no group is specified.
+    if {[llength $portlist] < 1} {
+        ui_error "port select \[--list|--set|--show] \[<group> \[<version]]"
+        return 1
+    }
+    set group [lindex $portlist 0]
+
+    # If no command (--set, --show, --list) is specified, default to the
+    # show command.
+    if {[llength $commands] < 1} {
+        set command show
+        ui_debug [concat "No command was specified. Defaulting to the " \
+                         "'show' command..."]
+    # Only allow one command to be specified at a time.
+    } elseif {[llength $commands] > 1} {
+        ui_error [concat "Multiple commands were specified. Only one " \
+                         "command may be specified at a time."]
+        return 1
+    } else {
+        set command [string map {ports_select_ ""} [lindex $commands 0]]
+        ui_debug "The '$command' command was specified."
+    }
+
+    switch -- $command {
+        list {
+            if {[llength $portlist] > 1} {
+                ui_warn [concat "The 'list' command does not expect any " \
+                                "arguments. Extra arguments will be ignored."]
+            }
+
+            ui_debug "Executing mportselect(list, $group)..."
+            return [mportselect $command $group]
+        }
+        set {
+            if {[llength $portlist] < 2} {
+                ui_error [concat "The 'set' command expects two " \
+                                 "arguments: <group>, <version>"]
+                return 1
+            } elseif {[llength $portlist] > 2} {
+                ui_warn [concat "The 'set' command only expects two " \
+                                "arguments. Extra arguments will be " \
+                                "ignored."]
+            }
+            set version [lindex $portlist 1]
+
+            ui_debug "Executing mportselect($command, $group, $version)..."
+            return [mportselect $command $group $version]
+        }
+        show {
+            if {[llength $portlist] > 1} {
+                ui_warn [concat "The 'show' command does not expect any " \
+                                "arguments. Extra arguments will be ignored."]
+            }
+
+            ui_debug "Executing mportselect($command, $group)..."
+            return [mportselect $command $group]
+        }
+        default {
+            ui_error "An unknown command '$command' was specified."
+            return 1
+        }
+    }
+}
+
+
 proc action_selfupdate { action portlist opts } {
     global global_options
     if { [catch {macports::selfupdate [array get global_options]} result ] } {
@@ -2625,6 +2694,8 @@
     activate    [list action_activate       [action_args_const ports]] \
     deactivate  [list action_deactivate     [action_args_const ports]] \
     \
+    select      [list action_select         [action_args_const strings]] \
+    \
     sync        [list action_sync           [action_args_const none]] \
     selfupdate  [list action_selfupdate     [action_args_const none]] \
     \
@@ -2741,6 +2812,7 @@
     clean       {all archive dist work}
     mirror      {new}
     lint        {nitpick}
+    select      {list set show}
 }
 
 ##
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20081219/c7eebdf3/attachment-0001.html>