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

[raimue at macports.org]

Revision: 100059
          https://trac.macports.org/changeset/100059
Author:   raimue at macports.org
Date:     2012-11-25 10:14:05 -0800 (Sun, 25 Nov 2012)
Log Message:
-----------
port/port.tcl:
Add pseudo-ports subport:, subports: to get ports having a matching subport and
subportof: to get the parent port of a subport

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

Modified: trunk/base/src/port/port.tcl
===================================================================
--- trunk/base/src/port/port.tcl	2012-11-25 18:08:20 UTC (rev 100058)
+++ trunk/base/src/port/port.tcl	2012-11-25 18:14:05 UTC (rev 100059)
@@ -297,7 +297,8 @@
     switch -- $field {
         variant -
         platform -
-        maintainer {
+        maintainer -
+        subport {
             set field "${field}s"
         }
         category {
@@ -1140,7 +1141,43 @@
     return [portlist_sort $results]
 }
 
+proc get_subports {portname} {
+    global global_variations
 
+    # look up portname
+    if {[catch {mportlookup $portname} result]} {
+        ui_debug "$::errorInfo"
+        return -code error "lookup of portname $portname failed: $result"
+    }
+    if {[llength $result] < 2} {
+        return -code error "Port $portname not found"
+    }
+    array unset portinfo
+    array set portinfo [lindex $result 1]
+    set porturl $portinfo(porturl)
+
+    # open portfile
+    if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
+        ui_debug "$::errorInfo"
+        return -code error "Unable to open port: $result"
+    }
+    array unset portinfo
+    array set portinfo [mportinfo $mport]
+    mportclose $mport
+
+    # gather its subports
+    set results {}
+
+    if {[info exists portinfo(subports)]} {
+        foreach subport $portinfo(subports) {
+            add_to_portlist results [list name $subport]
+        }
+    }
+
+    return [portlist_sort $results]
+}
+
+
 ##########################################
 # Port expressions
 ##########################################
@@ -1325,6 +1362,8 @@
         ^depends_fetch:     -
         ^replaced_by:       -
         ^revision:          -
+        ^subport:           -
+        ^subports:          -
         ^license:           { # Handle special port selectors
             advance
 
@@ -1379,6 +1418,17 @@
             set el 1
         }
 
+        ^subportof:         {
+            advance
+
+            # Break up the token, because older Tcl switch doesn't support -matchvar
+            regexp {^(\w+):(.*)} $token matchvar selector portname
+
+            add_multiple_ports reslist [get_subports $portname]
+
+            set el 1
+        }
+
         [][?*]              { # Handle portname glob patterns
             advance; add_multiple_ports reslist [get_matching_ports $token no glob]
             set el 1
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20121125/f289b300/attachment.html>