[25521] branches/dp2mp-move/base/src/port/port.tcl

source_changes at macosforge.org source_changes at macosforge.org
Wed May 23 21:35:06 PDT 2007


Revision: 25521
          http://trac.macosforge.org/projects/macports/changeset/25521
Author:   jmpp at macports.org
Date:     2007-05-23 21:35:05 -0700 (Wed, 23 May 2007)

Log Message:
-----------
Merging eridus' r25255: port info now opens the Portfile to show current information.

Modified Paths:
--------------
    branches/dp2mp-move/base/src/port/port.tcl

Modified: branches/dp2mp-move/base/src/port/port.tcl
===================================================================
--- branches/dp2mp-move/base/src/port/port.tcl	2007-05-24 03:40:13 UTC (rev 25520)
+++ branches/dp2mp-move/base/src/port/port.tcl	2007-05-24 04:35:05 UTC (rev 25521)
@@ -1133,150 +1133,162 @@
 
 
 proc action_info { action portlist opts } {
-	set status 0
-	require_portlist portlist
-	foreachport $portlist {	
-		# Get information about the named port
-		if {[catch {mportsearch $portname no exact} result]} {
-			global errorInfo
-			ui_debug "$errorInfo"
-			break_softcontinue "search for portname $portname failed: $result" 1 status
-		}
+    set status 0
+    require_portlist portlist
+    foreachport $portlist {
+    # If we have a url, use that, since it's most specific
+    # otherwise try to map the portname to a url
+        if {$porturl eq ""} {
+        # Verify the portname, getting portinfo to map to a porturl
+	    if {[catch {mportsearch $portname no exact} result]} {
+		ui_debug "$::errorInfo"
+		break_softcontinue "search for portname $portname failed: $result" 1 status
+	    }
+	    if {[llength $result] < 2} {
+		break_softcontinue "Port $portname not found" 1 status
+            }
+	    set found [expr [llength $result] / 2]
+            if {$found > 1} {
+                ui_warn "Found $found port $portname definitions, displaying first one."
+            }
+            array unset portinfo
+            array set portinfo [lindex $result 1]
+            set porturl $portinfo(porturl)
+            set portdir $portinfo(portdir)
+        }
+        
+	set mport [mportopen $porturl [array get options] [array get variations]]
+        array unset portinfo
+        array set portinfo [mportinfo $dport]
+        mportclose $mport
+        if {[info exists portdir]} {
+            set portinfo(portdir) $portdir
+        }
+        
+        # Map from friendly to less-friendly but real names
+        array set name_map "
+                category        categories
+                maintainer      maintainers
+                platform        platforms
+                variant         variants
+                "
+                
+        # Understand which info items are actually lists
+        # (this could be overloaded to provide a generic formatting code to
+        # allow us to, say, split off the prefix on libs)
+        array set list_map "
+                categories      1
+                depends_build   1
+                depends_lib     1
+                maintainers     1
+                platforms       1
+                variants        1
+                "
+                
+        # Set up our field separators
+        set show_label 1
+        set field_sep "\n"
+        set subfield_sep ", "
+        
+        # Tune for sort(1)
+        if {[info exists options(ports_info_line)]} {
+            array unset options ports_info_line
+            set show_label 0
+            set field_sep "\t"
+            set subfield_sep ","
+        }
 	
-		if {$result == ""} {
-			puts "No port $portname found."
-		} else {
-			set found [expr [llength $result] / 2]
-			if {$found > 1} {
-				ui_warn "Found $found port $portname definitions, displaying first one."
-			}
-			array unset portinfo
-			array set portinfo [lindex $result 1]
-			
-			
-			# Map from friendly to less-friendly but real names
-			array set name_map "
-					category		categories
-					maintainer		maintainers
-					platform		platforms
-					variant			variants
-					"
-					
-			# Understand which info items are actually lists
-			# (this could be overloaded to provide a generic formatting code to
-			# allow us to, say, split off the prefix on libs)
-			array set list_map "
-					categories		1
-					depends_build	1
-					depends_lib		1
-					maintainers		1
-					platforms		1
-					variants		1
-					"
-					
-			# Set up our field separators
-			set show_label 1
-			set field_sep "\n"
-			set subfield_sep ", "
-			
-			# Tune for sort(1)
-			if {[info exists options(ports_info_line)]} {
-				array unset options ports_info_line
-				set show_label 0
-				set field_sep "\t"
-				set subfield_sep ","
-			}
+        # Figure out whether to show field name
+	set quiet [ui_isset ports_quiet]
+        if {$quiet} {
+	    set show_label 0
+        }
+        
+        # Spin through action options, emitting information for any found
+        set fields {}
+        foreach { option } [array names options ports_info_*] {
+            set opt [string range $option 11 end]
+            
+            # Map from friendly name
+            set ropt $opt
+            if {[info exists name_map($opt)]} {
+                set ropt $name_map($opt)
+            }
+            
+            # If there's no such info, move on
+            if {![info exists portinfo($ropt)]} {
+                if {!$quiet} {
+                    puts "no info for '$opt'"
+                }
+                continue
+            }
+            
+            # Calculate field label
+            set label ""
+            if {$show_label} {
+                set label "$opt: "
+            }
+            
+            # Format the data
+            set inf $portinfo($ropt)
+            if [info exists list_map($ropt)] {
+                set field [join $inf $subfield_sep]
+            } else {
+                set field $inf
+            }
+            
+            lappend fields "$label$field"
+        }
+        
+        if {[llength $fields]} {
+            # Show specific fields
+            puts [join $fields $field_sep]
+        } else {
+        
+            # If we weren't asked to show any specific fields, then show general information
+            puts -nonewline "$portinfo(name) $portinfo(version)"
+            if {[info exists portinfo(revision)] && $portinfo(revision) > 0} { 
+                puts -nonewline ", Revision $portinfo(revision)" 
+            }
+            if {[info exists portinfo(portdir)]} {
+                puts -nonewline ", $portinfo(portdir)"
+            }
+            if {[info exists portinfo(variants)]} {
+                puts -nonewline " (Variants: [join $portinfo(variants) ", "])"
+            }
+            puts ""
+            if {[info exists portinfo(homepage)]} { 
+                puts "$portinfo(homepage)"
+            }
+    
+            if {[info exists portinfo(long_description)]} {
+                puts "\n[join $portinfo(long_description)]\n"
+            }
 
-			# Figure out whether to show field name
-			set quiet [ui_isset ports_quiet]
-			if {$quiet} {
-				set show_label 0
-			}
-			
-			# Spin through action options, emitting information for any found
-			set fields {}
-			foreach { option } [array names options ports_info_*] {
-				set opt [string range $option 11 end]
-				
-				# Map from friendly name
-				set ropt $opt
-				if {[info exists name_map($opt)]} {
-					set ropt $name_map($opt)
-				}
-				
-				# If there's no such info, move on
-				if {![info exists portinfo($ropt)]} {
-					if {!$quiet} {
-						puts "no info for '$opt'"
-					}
-					continue
-				}
-				
-				# Calculate field label
-				set label ""
-				if {$show_label} {
-					set label "$opt: "
-				}
-				
-				# Format the data
-				set inf $portinfo($ropt)
-				if [info exists list_map($ropt)] {
-					set field [join $inf $subfield_sep]
-				} else {
-					set field $inf
-				}
-				
-				lappend fields "$label$field"
-			}
-			
-			if {[llength $fields]} {
-				# Show specific fields
-				puts [join $fields $field_sep]
-			} else {
-			
-				# If we weren't asked to show any specific fields, then show general information
-				puts -nonewline "$portinfo(name) $portinfo(version)"
-				if {[info exists portinfo(revision)] && $portinfo(revision) > 0} { 
-					puts -nonewline ", Revision $portinfo(revision)" 
-				}
-				puts -nonewline ", $portinfo(portdir)" 
-				if {[info exists portinfo(variants)]} {
-					puts -nonewline " (Variants: [join $portinfo(variants) ", "])"
-				}
-				puts ""
-				if {[info exists portinfo(homepage)]} { 
-					puts "$portinfo(homepage)"
-				}
-		
-				if {[info exists portinfo(long_description)]} {
-					puts "\n[join $portinfo(long_description)]\n"
-				}
-	
-				# Emit build, library, and runtime dependencies
-				foreach {key title} {
-					depends_build "Build Dependencies"
-					depends_lib "Library Dependencies"
-					depends_run "Runtime Dependencies"
-				} {
-					if {[info exists portinfo($key)]} {
-						puts -nonewline "$title:"
-						set joiner ""
-						foreach d $portinfo($key) {
-							puts -nonewline "$joiner [lindex [split $d :] end]"
-							set joiner ","
-						}
-						set nodeps false
-						puts ""
-					}
-				}
-					
-				if {[info exists portinfo(platforms)]} { puts "Platforms: $portinfo(platforms)"}
-				if {[info exists portinfo(maintainers)]} { puts "Maintainers: $portinfo(maintainers)"}
-			}
-		}
-	}
-	
-	return $status
+            # Emit build, library, and runtime dependencies
+            foreach {key title} {
+                depends_build "Build Dependencies"
+                depends_lib "Library Dependencies"
+                depends_run "Runtime Dependencies"
+            } {
+                if {[info exists portinfo($key)]} {
+                    puts -nonewline "$title:"
+                    set joiner ""
+                    foreach d $portinfo($key) {
+                        puts -nonewline "$joiner [lindex [split $d :] end]"
+                        set joiner ","
+                    }
+                    set nodeps false
+                    puts ""
+                }
+            }
+                
+            if {[info exists portinfo(platforms)]} { puts "Platforms: $portinfo(platforms)"}
+            if {[info exists portinfo(maintainers)]} { puts "Maintainers: $portinfo(maintainers)"}
+        }
+    }
+    
+    return $status
 }
 
 

-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.macosforge.org/pipermail/macports-changes/attachments/20070523/17b62ca5/attachment.html


More information about the macports-changes mailing list