<pre style='margin:0'>
Joshua Root (jmroot) pushed a commit to branch master
in repository macports-base.
</pre>
<p><a href="https://github.com/macports/macports-base/commit/0129a0c750b68e7ad6366c3e910868f4cb491a7a">https://github.com/macports/macports-base/commit/0129a0c750b68e7ad6366c3e910868f4cb491a7a</a></p>
<pre style="white-space: pre; background: #F8F8F8"><span style='display:block; white-space:pre;color:#808000;'>commit 0129a0c750b68e7ad6366c3e910868f4cb491a7a
</span>Author: Joshua Root <jmr@macports.org>
AuthorDate: Wed Jan 31 08:05:12 2024 +1100
<span style='display:block; white-space:pre;color:#404040;'> Split port.tcl portlist procs into their own package
</span><span style='display:block; white-space:pre;color:#404040;'>
</span><span style='display:block; white-space:pre;color:#404040;'> These can be of use to other API clients.
</span>---
Makefile.in | 2 +-
configure | 3 +-
configure.ac | 1 +
src/Makefile.in | 1 +
src/port/port.tcl | 316 +-----------------------------------------
src/portlist1.0/Makefile.in | 28 ++++
src/portlist1.0/portlist.tcl | 318 +++++++++++++++++++++++++++++++++++++++++++
7 files changed, 352 insertions(+), 317 deletions(-)
<span style='display:block; white-space:pre;color:#808080;'>diff --git a/Makefile.in b/Makefile.in
</span><span style='display:block; white-space:pre;color:#808080;'>index 07a44ee9c..3db2734fe 100644
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>--- a/Makefile.in
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>+++ b/Makefile.in
</span><span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -16,7 +16,7 @@ include Mk/macports.autoconf.mk
</span>
all:: Mk/macports.autoconf.mk
<span style='display:block; white-space:pre;background:#ffe0e0;'>-Mk/macports.autoconf.mk: Mk/macports.autoconf.mk.in src/config.h.in Makefile.in doc/Makefile.in src/Makefile.in src/cregistry/Makefile.in src/darwintracelib1.0/Makefile.in src/machista1.0/Makefile.in src/macports1.0/Makefile.in src/mpcommon1.0/Makefile.in src/package1.0/Makefile.in src/pextlib1.0/Makefile.in src/port/Makefile.in src/port1.0/Makefile.in src/programs/Makefile.in src/programs/daemondo/Makefile.in src/registry2.0/Makefile.in tests/Makefile.in vendor/Makefile.in config.status
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+Mk/macports.autoconf.mk: Mk/macports.autoconf.mk.in src/config.h.in Makefile.in doc/Makefile.in src/Makefile.in src/cregistry/Makefile.in src/darwintracelib1.0/Makefile.in src/machista1.0/Makefile.in src/macports1.0/Makefile.in src/mpcommon1.0/Makefile.in src/package1.0/Makefile.in src/pextlib1.0/Makefile.in src/portlist1.0/Makefile.in src/port/Makefile.in src/port1.0/Makefile.in src/programs/Makefile.in src/programs/daemondo/Makefile.in src/registry2.0/Makefile.in tests/Makefile.in vend [...]
</span> ./config.status
${MAKE} clean
<span style='display:block; white-space:pre;color:#808080;'>diff --git a/configure b/configure
</span><span style='display:block; white-space:pre;color:#808080;'>index 84b55e18d..73462725e 100755
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>--- a/configure
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>+++ b/configure
</span><span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -9446,7 +9446,7 @@ printf "%s\n" "yes" >&6; }
</span>
# Output
<span style='display:block; white-space:pre;background:#ffe0e0;'>-ac_config_files="$ac_config_files Doxyfile Makefile Mk/macports.autoconf.mk doc/Makefile doc/base.mtree doc/macosx.mtree doc/macports.conf doc/prefix.mtree doc/pubkeys.conf portmgr/dmg/postflight setupenv.bash src/Makefile src/cregistry/Makefile src/compat/Makefile src/darwintracelib1.0/Makefile src/darwintracelib1.0/tests/Makefile src/machista1.0/Makefile src/macports1.0/Makefile src/macports1.0/macports_autoconf.tcl src/macports1.0/macports_test_autoconf.tcl src/mpcommon1.0/Makefile sr [...]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ac_config_files="$ac_config_files Doxyfile Makefile Mk/macports.autoconf.mk doc/Makefile doc/base.mtree doc/macosx.mtree doc/macports.conf doc/prefix.mtree doc/pubkeys.conf portmgr/dmg/postflight setupenv.bash src/Makefile src/cregistry/Makefile src/compat/Makefile src/darwintracelib1.0/Makefile src/darwintracelib1.0/tests/Makefile src/machista1.0/Makefile src/macports1.0/Makefile src/macports1.0/macports_autoconf.tcl src/macports1.0/macports_test_autoconf.tcl src/mpcommon1.0/Makefile sr [...]
</span>
ac_config_files="$ac_config_files vendor/tclsh"
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -10173,6 +10173,7 @@ do
</span> "src/package1.0/Makefile") CONFIG_FILES="$CONFIG_FILES src/package1.0/Makefile" ;;
"src/package1.0/package_test_autoconf.tcl") CONFIG_FILES="$CONFIG_FILES src/package1.0/package_test_autoconf.tcl" ;;
"src/pextlib1.0/Makefile") CONFIG_FILES="$CONFIG_FILES src/pextlib1.0/Makefile" ;;
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ "src/portlist1.0/Makefile") CONFIG_FILES="$CONFIG_FILES src/portlist1.0/Makefile" ;;
</span> "src/port/Makefile") CONFIG_FILES="$CONFIG_FILES src/port/Makefile" ;;
"src/port1.0/Makefile") CONFIG_FILES="$CONFIG_FILES src/port1.0/Makefile" ;;
"src/port1.0/port_autoconf.tcl") CONFIG_FILES="$CONFIG_FILES src/port1.0/port_autoconf.tcl" ;;
<span style='display:block; white-space:pre;color:#808080;'>diff --git a/configure.ac b/configure.ac
</span><span style='display:block; white-space:pre;color:#808080;'>index 02144a8ea..1f78e9194 100644
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>--- a/configure.ac
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>+++ b/configure.ac
</span><span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -432,6 +432,7 @@ AC_CONFIG_FILES([
</span> src/package1.0/Makefile
src/package1.0/package_test_autoconf.tcl
src/pextlib1.0/Makefile
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ src/portlist1.0/Makefile
</span> src/port/Makefile
src/port1.0/Makefile
src/port1.0/port_autoconf.tcl
<span style='display:block; white-space:pre;color:#808080;'>diff --git a/src/Makefile.in b/src/Makefile.in
</span><span style='display:block; white-space:pre;color:#808080;'>index a3085ab15..5542783e3 100644
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>--- a/src/Makefile.in
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>+++ b/src/Makefile.in
</span><span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -7,6 +7,7 @@ TCLPKG= cregistry \
</span> port1.0 \
package1.0 \
pextlib1.0 \
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ portlist1.0 \
</span> machista1.0 \
mpcommon1.0
SUBDIR= compat ${TCLPKG} port programs
<span style='display:block; white-space:pre;color:#808080;'>diff --git a/src/port/port.tcl b/src/port/port.tcl
</span><span style='display:block; white-space:pre;color:#808080;'>index 591cd2af4..1f3f44098 100755
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>--- a/src/port/port.tcl
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>+++ b/src/port/port.tcl
</span><span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -45,6 +45,7 @@ if {![catch {package require term::ansi::send}]} {
</span> package require Tclx
package require macports
package require Pextlib 1.0
<span style='display:block; white-space:pre;background:#e0ffe0;'>+package require portlist
</span>
# Standard procedures
proc print_usage {{verbose 1}} {
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -121,52 +122,6 @@ proc print_tickets_url {args} {
</span> }
}
<span style='display:block; white-space:pre;background:#ffe0e0;'>-# Form a composite version as is sometimes used for registry functions
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-# This function sorts the variants and presents them in a canonical representation
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-proc composite_version {version variations {emptyVersionOkay 0}} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # Form a composite version out of the version and variations
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # Select the variations into positive and negative
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set pos [list]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set neg [list]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- foreach { key val } $variations {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {$val eq "+"} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- lappend pos $key
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- } elseif {$val eq "-"} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- lappend neg $key
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # If there is no version, we have nothing to do
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set composite_version ""
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {$version ne "" || $emptyVersionOkay} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set pos_str ""
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set neg_str ""
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[llength $pos]} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set pos_str "+[join [lsort -ascii $pos] "+"]"
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[llength $neg]} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set neg_str "-[join [lsort -ascii $neg] "-"]"
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set composite_version "$version$pos_str$neg_str"
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- return $composite_version
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-}
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-set port_split_variants_re {([-+])([[:alpha:]_]+[\w\.]*)}
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-proc split_variants {variants} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set result [list]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set l [regexp -all -inline -- $::port_split_variants_re $variants]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- foreach { match sign variant } $l {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- lappend result $variant $sign
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- return $result
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-}
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span> ##
# Maps friendly field names to their real name
# Names which do not need mapping are not changed.
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -214,70 +169,6 @@ proc registry_installed {portname {portversion ""}} {
</span> }
}
<span style='display:block; white-space:pre;background:#ffe0e0;'>-proc entry_for_portlist {portentry} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- global global_options
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # Each portlist entry currently has the following elements in it:
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # url if any
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # name
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # version (version_revision)
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # variants array (variant=>+-)
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # requested_variants array (variant=>+-)
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # options array (key=>value)
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # fullname (name/version_revision+-variants)
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # Note: name always normalised to lower case in fullname
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array set port $portentry
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {![info exists port(url)]} { set port(url) "" }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {![info exists port(name)]} { set port(name) "" }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {![info exists port(version)]} { set port(version) "" }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {![info exists port(variants)]} { set port(variants) "" }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {![info exists port(requested_variants)]} { set port(requested_variants) "" }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {![info exists port(options)]} { set port(options) [array get global_options] }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # If neither portname nor url is specified, then default to the current port
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if { $port(url) eq "" && $port(name) eq "" } {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set url file://.
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set portname [url_to_portname $url]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set port(url) $url
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set port(name) $portname
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {$portname eq ""} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- ui_error "A default port name could not be supplied."
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # Form the fully discriminated portname: portname/version_revison+-variants
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set port(fullname) [string tolower $port(name)]/[composite_version $port(version) $port(variants)]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- return [array get port]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-}
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-proc add_to_portlist {listname portentry} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- upvar $listname portlist
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # Form portlist entry and add to portlist
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- lappend portlist [entry_for_portlist $portentry]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-}
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-proc add_ports_to_portlist {listname ports {overridelist ""}} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- upvar $listname portlist
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array set overrides $overridelist
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # Add each entry to the named portlist, overriding any values
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # specified as overrides
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- foreach portentry $ports {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array set port $portentry
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[info exists overrides(version)]} { set port(version) $overrides(version) }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[info exists overrides(variants)]} { set port(variants) $overrides(variants) }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[info exists overrides(requested_variants)]} { set port(requested_variants) $overrides(requested_variants) }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[info exists overrides(options)]} { set port(options) $overrides(options) }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- add_to_portlist portlist [array get port]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-}
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span>
proc url_to_portname { url {quiet 0} } {
# Save directory and restore the directory, since mportopen changes it
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -330,89 +221,6 @@ proc require_portlist { nameportlist {is_upgrade "no"} } {
</span> return 0
}
<span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-# Execute the enclosed block once for every element in the portlist
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-# When the block is entered, the following variables will have been set:
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-# portspec, porturl, portname, portversion, options, variations, requested_variations, portmetadata
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-proc foreachport {portlist block} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set savedir [pwd]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- foreach portspec $portlist {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # Set the variables for the block
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- uplevel 1 "array unset portspec; array set portspec { $portspec }"
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- uplevel 1 {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set porturl $portspec(url)
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set portname $portspec(name)
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set portversion $portspec(version)
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array unset variations
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array set variations $portspec(variants)
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array unset requested_variations
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array set requested_variations $portspec(requested_variants)
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array unset options
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array set options $portspec(options)
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array unset portmetadata
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[info exists portspec(metadata)]} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array set portmetadata $portspec(metadata)
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # Invoke block
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- uplevel 1 $block
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # Restore cwd after each port, since mportopen changes it, and otherwise relative
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # urls would break on subsequent passes
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[file exists $savedir]} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- cd $savedir
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- } else {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- cd ~
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-}
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-proc portlist_compare { a b } {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array set a_ $a
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array set b_ $b
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set namecmp [string equal -nocase $a_(name) $b_(name)]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {$namecmp != 1} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {$a_(name) eq [lindex [lsort -dictionary [list $a_(name) $b_(name)]] 0]} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- return -1
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- return 1
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set avr_ [split $a_(version) "_"]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set bvr_ [split $b_(version) "_"]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set versioncmp [vercmp [lindex $avr_ 0] [lindex $bvr_ 0]]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {$versioncmp != 0} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- return $versioncmp
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set ar_ [lindex $avr_ 1]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set br_ [lindex $bvr_ 1]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {$ar_ < $br_} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- return -1
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- } elseif {$ar_ > $br_} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- return 1
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- } else {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- return 0
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-}
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-# Sort two ports in NVR (name@version_revision) order
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-proc portlist_sort { list } {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- return [lsort -command portlist_compare $list]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-}
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-proc portlist_compareint { a b } {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array set a_ [list "name" [lindex $a 0] "version" "[lindex $a 1]_[lindex $a 2]"]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array set b_ [list "name" [lindex $b 0] "version" "[lindex $b 1]_[lindex $b 2]"]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- return [portlist_compare [array get a_] [array get b_]]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-}
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-# Same as portlist_sort, but with numeric indexes {name version revision}
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-proc portlist_sortint { list } {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- return [lsort -command portlist_compareint $list]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-}
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span> # sort portlist so dependents come before their dependencies
proc portlist_sortdependents { portlist } {
foreach p $portlist {
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -452,11 +260,6 @@ proc portlist_sortdependents_helper {p up_entries up_dependents up_seen up_retli
</span> }
}
<span style='display:block; white-space:pre;background:#ffe0e0;'>-proc regex_pat_sanitize { s } {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set sanitized [regsub -all {[\\(){}+$.^]} $s {\\&}]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- return $sanitized
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-}
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span> ##
# Makes sure we get the current terminal size
proc term_init_size {} {
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -1485,123 +1288,6 @@ proc add_multiple_ports { resname ports {remainder ""} } {
</span> add_ports_to_portlist reslist $ports [array get overrides]
}
<span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-proc unique_entries { entries } {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # Form the list of all the unique elements in the list a,
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # considering only the port fullname, and taking the first
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # found element first
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set result [list]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array unset unique
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- foreach item $entries {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array set port $item
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[info exists unique($port(fullname))]} continue
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set unique($port(fullname)) 1
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- lappend result $item
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- return $result
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-}
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-proc opUnion { a b } {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # Return the unique elements in the combined two lists
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- return [unique_entries [concat $a $b]]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-}
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-proc opIntersection { a b } {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set result [list]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # Rules we follow in performing the intersection of two port lists:
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- #
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # a/, a/ ==> a/
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # a/, b/ ==>
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # a/, a/1.0 ==> a/1.0
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # a/1.0, a/ ==> a/1.0
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # a/1.0, a/2.0 ==>
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- #
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # If there's an exact match, we take it.
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # If there's a match between simple and discriminated, we take the later.
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # First create a list of the fully discriminated names in b
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array unset bfull
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set i 0
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- foreach bitem [unique_entries $b] {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array set port $bitem
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set bfull($port(fullname)) $i
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- incr i
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # Walk through each item in a, matching against b
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- foreach aitem [unique_entries $a] {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array set port $aitem
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # Quote the fullname and portname to avoid special characters messing up the regexp
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set safefullname [regex_pat_sanitize $port(fullname)]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set simpleform [string equal -nocase "$port(name)/" $port(fullname)]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {$simpleform} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set pat "^${safefullname}"
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- } else {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set safename [regex_pat_sanitize [string tolower $port(name)]]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set pat "^${safefullname}$|^${safename}/$"
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set matches [array names bfull -regexp $pat]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- foreach match $matches {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {$simpleform} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set i $bfull($match)
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- lappend result [lindex $b $i]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- } else {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- lappend result $aitem
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- return $result
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-}
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-proc opComplement { a b } {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set result [list]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # Return all elements of a not matching elements in b
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # First create a list of the fully discriminated names in b
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array unset bfull
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set i 0
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- foreach bitem $b {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array set port $bitem
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set bfull($port(fullname)) $i
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- incr i
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # Walk through each item in a, taking all those items that don't match b
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- foreach aitem $a {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array set port $aitem
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # Quote the fullname and portname to avoid special characters messing up the regexp
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set safefullname [regex_pat_sanitize $port(fullname)]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set simpleform [string equal -nocase "$port(name)/" $port(fullname)]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {$simpleform} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set pat "^${safefullname}"
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- } else {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set safename [regex_pat_sanitize [string tolower $port(name)]]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set pat "^${safefullname}$|^${safename}/$"
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set matches [array names bfull -regexp $pat]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # We copy this element to result only if it didn't match against b
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {![llength $matches]} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- lappend result $aitem
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- return $result
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-}
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span> proc parseFullPortSpec { urlname namename vername varname optname } {
upvar $urlname porturl
upvar $namename portname
<span style='display:block; white-space:pre;color:#808080;'>diff --git a/src/portlist1.0/Makefile.in b/src/portlist1.0/Makefile.in
</span>new file mode 100644
<span style='display:block; white-space:pre;color:#808080;'>index 000000000..2505b6983
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>--- /dev/null
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>+++ b/src/portlist1.0/Makefile.in
</span><span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -0,0 +1,28 @@
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+srcdir = @srcdir@
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+VPATH = @srcdir@
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+include ../../Mk/macports.autoconf.mk
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+SRCS = portlist.tcl
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+INSTALLDIR= ${TCL_PACKAGE_PATH}/portlist1.0
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+all:: pkgIndex.tcl
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+pkgIndex.tcl: $(SRCS)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ $(SILENT) ../pkg_mkindex.sh .
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+clean::
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ rm -f pkgIndex.tcl
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+distclean:: clean
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ rm -f Makefile
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+install:: all
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ $(INSTALL) -d -o "${DSTUSR}" -g "${DSTGRP}" -m "${DSTMODE}" "${DESTDIR}${INSTALLDIR}"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ $(SILENT) set -x; for file in ${SRCS}; do \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ $(INSTALL) -o "${DSTUSR}" -g "${DSTGRP}" -m 444 "$(srcdir)/$$file" "${DESTDIR}${INSTALLDIR}/$$file"; \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ done
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ $(INSTALL) -o "${DSTUSR}" -g "${DSTGRP}" -m 444 pkgIndex.tcl "${DESTDIR}${INSTALLDIR}"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+test:: ;
</span><span style='display:block; white-space:pre;color:#808080;'>diff --git a/src/portlist1.0/portlist.tcl b/src/portlist1.0/portlist.tcl
</span>new file mode 100644
<span style='display:block; white-space:pre;color:#808080;'>index 000000000..c5bed852d
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>--- /dev/null
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>+++ b/src/portlist1.0/portlist.tcl
</span><span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -0,0 +1,318 @@
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# Commands for handling and combining lists of port information ("portentries")
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+package provide portlist 1.0
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+namespace eval portlist {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ variable split_variants_re {([-+])([[:alpha:]_]+[\w\.]*)}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc regex_pat_sanitize {s} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set sanitized [regsub -all {[\\(){}+$.^]} $s {\\&}]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return $sanitized
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# Form a composite version as is sometimes used for registry functions
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# This function sorts the variants and presents them in a canonical representation
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc composite_version {version variations {emptyVersionOkay 0}} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # Form a composite version out of the version and variations
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # Select the variations into positive and negative
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set pos [list]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set neg [list]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ foreach { key val } $variations {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {$val eq "+"} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ lappend pos $key
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ } elseif {$val eq "-"} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ lappend neg $key
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # If there is no version, we have nothing to do
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set composite_version ""
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {$version ne "" || $emptyVersionOkay} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set pos_str ""
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set neg_str ""
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[llength $pos]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set pos_str "+[join [lsort -ascii $pos] "+"]"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[llength $neg]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set neg_str "-[join [lsort -ascii $neg] "-"]"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set composite_version "$version$pos_str$neg_str"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return $composite_version
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc split_variants {variants} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set result [list]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set l [regexp -all -inline -- $portlist::split_variants_re $variants]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ foreach { match sign variant } $l {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ lappend result $variant $sign
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return $result
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc entry_for_portlist {portentry} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ global global_options
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # Each portlist entry currently has the following elements in it:
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # url if any
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # name
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # version (version_revision)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # variants array (variant=>+-)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # requested_variants array (variant=>+-)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # options array (key=>value)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # fullname (name/version_revision+-variants)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # Note: name always normalised to lower case in fullname
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array set port $portentry
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {![info exists port(url)]} { set port(url) "" }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {![info exists port(name)]} { set port(name) "" }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {![info exists port(version)]} { set port(version) "" }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {![info exists port(variants)]} { set port(variants) "" }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {![info exists port(requested_variants)]} { set port(requested_variants) "" }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {![info exists port(options)]} { set port(options) [array get global_options] }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # If neither portname nor url is specified, then default to the current port
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if { $port(url) eq "" && $port(name) eq "" } {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set url file://.
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set portname [url_to_portname $url]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set port(url) $url
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set port(name) $portname
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {$portname eq ""} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ ui_error "A default port name could not be supplied."
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # Form the fully discriminated portname: portname/version_revison+-variants
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set port(fullname) [string tolower $port(name)]/[composite_version $port(version) $port(variants)]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return [array get port]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc add_to_portlist {listname portentry} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ upvar $listname portlist
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # Form portlist entry and add to portlist
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ lappend portlist [entry_for_portlist $portentry]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc add_ports_to_portlist {listname ports {overridelist ""}} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ upvar $listname portlist
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array set overrides $overridelist
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # Add each entry to the named portlist, overriding any values
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # specified as overrides
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ foreach portentry $ports {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array set port $portentry
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[info exists overrides(version)]} { set port(version) $overrides(version) }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[info exists overrides(variants)]} { set port(variants) $overrides(variants) }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[info exists overrides(requested_variants)]} { set port(requested_variants) $overrides(requested_variants) }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[info exists overrides(options)]} { set port(options) $overrides(options) }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ add_to_portlist portlist [array get port]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# Execute the enclosed block once for every element in the portlist
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# When the block is entered, the following variables will have been set:
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# portspec, porturl, portname, portversion, options, variations, requested_variations, portmetadata
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc foreachport {portlist block} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set savedir [pwd]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ foreach portspec $portlist {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # Set the variables for the block
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ uplevel 1 "array unset portspec; array set portspec { $portspec }"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ uplevel 1 {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set porturl $portspec(url)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set portname $portspec(name)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set portversion $portspec(version)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array unset variations
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array set variations $portspec(variants)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array unset requested_variations
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array set requested_variations $portspec(requested_variants)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array unset options
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array set options $portspec(options)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array unset portmetadata
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[info exists portspec(metadata)]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array set portmetadata $portspec(metadata)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # Invoke block
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ uplevel 1 $block
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # Restore cwd after each port, since mportopen changes it, and otherwise relative
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # urls would break on subsequent passes
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[file exists $savedir]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ cd $savedir
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ } else {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ cd ~
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc portlist_compare { a b } {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array set a_ $a
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array set b_ $b
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set namecmp [string equal -nocase $a_(name) $b_(name)]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {$namecmp != 1} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {$a_(name) eq [lindex [lsort -dictionary [list $a_(name) $b_(name)]] 0]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return -1
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return 1
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set avr_ [split $a_(version) "_"]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set bvr_ [split $b_(version) "_"]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set versioncmp [vercmp [lindex $avr_ 0] [lindex $bvr_ 0]]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {$versioncmp != 0} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return $versioncmp
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set ar_ [lindex $avr_ 1]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set br_ [lindex $bvr_ 1]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {$ar_ < $br_} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return -1
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ } elseif {$ar_ > $br_} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return 1
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ } else {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return 0
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# Sort two ports in NVR (name@version_revision) order
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc portlist_sort { list } {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return [lsort -command portlist_compare $list]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc portlist_compareint { a b } {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array set a_ [list "name" [lindex $a 0] "version" "[lindex $a 1]_[lindex $a 2]"]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array set b_ [list "name" [lindex $b 0] "version" "[lindex $b 1]_[lindex $b 2]"]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return [portlist_compare [array get a_] [array get b_]]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# Same as portlist_sort, but with numeric indexes {name version revision}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc portlist_sortint { list } {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return [lsort -command portlist_compareint $list]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc unique_entries { entries } {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # Form the list of all the unique elements in the list a,
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # considering only the port fullname, and taking the first
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # found element first
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set result [list]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array unset unique
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ foreach item $entries {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array set port $item
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[info exists unique($port(fullname))]} continue
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set unique($port(fullname)) 1
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ lappend result $item
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return $result
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc opUnion { a b } {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # Return the unique elements in the combined two lists
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return [unique_entries [concat $a $b]]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc opIntersection { a b } {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set result [list]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # Rules we follow in performing the intersection of two port lists:
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ #
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # a/, a/ ==> a/
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # a/, b/ ==>
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # a/, a/1.0 ==> a/1.0
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # a/1.0, a/ ==> a/1.0
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # a/1.0, a/2.0 ==>
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ #
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # If there's an exact match, we take it.
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # If there's a match between simple and discriminated, we take the later.
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # First create a list of the fully discriminated names in b
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array unset bfull
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set i 0
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ foreach bitem [unique_entries $b] {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array set port $bitem
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set bfull($port(fullname)) $i
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ incr i
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # Walk through each item in a, matching against b
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ foreach aitem [unique_entries $a] {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array set port $aitem
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # Quote the fullname and portname to avoid special characters messing up the regexp
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set safefullname [regex_pat_sanitize $port(fullname)]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set simpleform [string equal -nocase "$port(name)/" $port(fullname)]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {$simpleform} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set pat "^${safefullname}"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ } else {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set safename [regex_pat_sanitize [string tolower $port(name)]]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set pat "^${safefullname}$|^${safename}/$"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set matches [array names bfull -regexp $pat]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ foreach match $matches {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {$simpleform} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set i $bfull($match)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ lappend result [lindex $b $i]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ } else {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ lappend result $aitem
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return $result
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc opComplement { a b } {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set result [list]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # Return all elements of a not matching elements in b
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # First create a list of the fully discriminated names in b
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array unset bfull
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set i 0
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ foreach bitem $b {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array set port $bitem
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set bfull($port(fullname)) $i
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ incr i
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # Walk through each item in a, taking all those items that don't match b
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ foreach aitem $a {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array set port $aitem
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # Quote the fullname and portname to avoid special characters messing up the regexp
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set safefullname [regex_pat_sanitize $port(fullname)]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set simpleform [string equal -nocase "$port(name)/" $port(fullname)]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {$simpleform} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set pat "^${safefullname}"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ } else {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set safename [regex_pat_sanitize [string tolower $port(name)]]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set pat "^${safefullname}$|^${safename}/$"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set matches [array names bfull -regexp $pat]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # We copy this element to result only if it didn't match against b
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {![llength $matches]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ lappend result $aitem
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return $result
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span></pre><pre style='margin:0'>
</pre>