include multi-repository support into main subversion repo

git-svn-id: svn://tug.org/texlive/trunk@26004 c570f23f-e606-0410-a88d-b1316a301751

2 files changed, 812 insertions, 124 deletions

diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index a644db08522..7722c0fdf2b 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -70,20 +70,31 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages
   $tlpdb->settings;
   $tlpdb->setting($key, [$value]);
   $tlpdb->sizes_of_packages($opt_src, $opt_doc [, @packs ]);
-  $tlpdb->install_package($pkg, $dest_tlpdb, $nopostinstall, $fallbacktlpdb);
+  $tlpdb->install_package($pkg, $dest_tlpdb);
   $tlpdb->remove_package($pkg, %options);
 
-
   TeXLive::TLPDB->listdir([$dir]);
   $tlpdb->generate_listfiles([$destdir]);
 
+  $tlpdb->make_virtual;
+  $tlpdb->is_virtual;
+  $tlpdb->virtual_add_tlpdb($tlpdb, $tag);
+  $tlpdb->virtual_remove_tlpdb($tag);
+  $tlpdb->virtual_get_package($pkg, $tag);
+  $tlpdb->candidates($pkg);
+  $tlpdb->virtual_candidate($pkg);
+  $tlpdb->virtual_pinning( [@tlpkpins ] );
+
 =head1 DESCRIPTION
 
 =cut
 
-use TeXLive::TLConfig;
+use TeXLive::TLConfig qw($CategoriesRegexp $DefaultCategory $InfraLocation
+      $DatabaseName $MetaCategoriesRegexp $Archive
+      %TLPDBOptions %TLPDBSettings
+      $RelocPrefix $RelocTree);
 use TeXLive::TLUtils qw(dirname mkdirhier member win32 info log debug ddebug
-                        tlwarn basename download_file merge_into);
+                        tlwarn basename download_file merge_into tldie);
 use TeXLive::TLPOBJ;
 use TeXLive::TLWinGoo;
 
@@ -123,8 +134,7 @@ sub new {
   $_listdir = $params{'listdir'} if defined($params{'listdir'});
   bless $self, $class;
   if (defined($params{'tlpdbfile'})) {
-    my $nr_packages_read
-      = $self->from_file("$self->{'root'}/$InfraLocation/$DatabaseName");
+    my $nr_packages_read = $self->from_file($params{'tlpdbfile'}, '-from-file');
     if ($nr_packages_read == 0) {
       # that is bad, we didn't read anything, so return undef.
       return undef;
@@ -161,6 +171,10 @@ The C<add_tlpobj> adds an object of the type TLPOBJ to the TLPDB.
 
 sub add_tlpobj {
   my ($self,$tlp) = @_;
+  if ($self->is_virtual) {
+    tlwarn("cannot add tlpobj to a virtual tlpdb\n");
+    return 0;
+  }
   $self->{'tlps'}{$tlp->name} = $tlp;
 }
 
@@ -209,6 +223,10 @@ package is not present
 
 sub remove_tlpobj {
   my ($self,$pkg) = @_;
+  if ($self->is_virtual) {
+    tlwarn("cannot remove tlpobj from a virtual tlpdb\n");
+    return 0;
+  }
   if (defined($self->{'tlps'}{$pkg})) {
     delete $self->{'tlps'}{$pkg};
   } else {
@@ -228,15 +246,22 @@ It returns the actual number of packages (TLPOBJs) read from C<$filename>.
 =cut
 
 sub from_file {
-  my ($self, $path) = @_;
-  if (@_ != 2) {
+  my ($self, $path, $arg) = @_;
+  if ($self->is_virtual) {
+    tlwarn("cannot initialize from file a virtual tlpdb\n");
+    return 0;
+  }
+  if (@_ < 2) {
     die "$0: from_file needs filename for initialization";
   }
   my $root_from_path = dirname(dirname($path));
   if (defined($self->{'root'})) {
     if ($self->{'root'} ne $root_from_path) {
-      tlwarn("root=$self->{'root'}, root_from_path=$root_from_path\n");
-      tlwarn("Initialization from different location as originally given.\nHope you are sure!\n");
+      # only warn if we are not given $arg = "-from-file"
+      if (!defined($arg) || ($arg ne "-from-file")) {
+        tlwarn("root=$self->{'root'}, root_from_path=$root_from_path\n");
+        tlwarn("Initialization from different location as originally given.\nHope you are sure!\n");
+      }
     }
   } else {
     $self->root($root_from_path);
@@ -362,6 +387,10 @@ the file handle given as argument.
 
 sub writeout {
   my $self = shift;
+  if ($self->is_virtual) {
+    tlwarn("cannot write out a virtual tlpdb\n");
+    return 0;
+  }
   my $fd = (@_ ? $_[0] : STDOUT);
   foreach (sort keys %{$self->{'tlps'}}) {
     ddebug("writeout: tlpname=$_  ", $self->{'tlps'}{$_}->name, "\n");
@@ -381,6 +410,10 @@ as location. If the location is undefined, die.
 
 sub save {
   my $self = shift;
+  if ($self->is_virtual) {
+    tlwarn("cannot save a virtual tlpdb\n");
+    return 0;
+  }
   my $path = $self->location;
   mkdirhier(dirname($path));
   my $tmppath = "$path.tmp";
@@ -402,6 +435,9 @@ Returns the media code the respective installation resides on.
 
 sub media { 
   my $self = shift ; 
+  if ($self->is_virtual) {
+    return "virtual";
+  }
   return $self->{'media'};
 }
 
@@ -417,6 +453,19 @@ architectures as set in the options section
 
 sub available_architectures {
   my $self = shift;
+  my @archs;
+  if ($self->is_virtual) {
+    for my $k (keys %{$self->{'tlpdbs'}}) {
+      TeXLive::TLUtils::push_uniq \@archs, $self->{'tlpdbs'}{$k}->available_architectures;
+    }
+    return sort @archs;
+  } else {
+    return $self->_available_architectures;
+  }
+}
+
+sub _available_architectures {
+  my $self = shift;
   my @archs = $self->setting("available_architectures");
   if (! @archs) {
     # fall back to the old method checking tex\.*
@@ -444,6 +493,10 @@ adds new dependencies they are not necessarily fulfilled.
 
 sub add_tlpcontainer {
   my ($self, $package, $ziplocation, $archrefs, $dest) = @_;
+  if ($self->is_virtual) {
+    tlwarn("cannot add tlp container to a virtual tlpdb\n");
+    return 0;
+  }
   my @archs;
   if (defined($archrefs)) {
     @archs = @$archrefs;
@@ -508,6 +561,29 @@ corresponding to the I<pkgname>, or undef.
 =cut
 
 sub get_package {
+  my ($self,$pkg,$tag) = @_;
+  if ($self->is_virtual) {
+    if (defined($tag)) {
+      if (defined($self->{'packages'}{$pkg}{'tags'}{$tag})) {
+        return $self->{'packages'}{$pkg}{'tags'}{$tag}{'tlp'};
+      } else {
+        debug("TLPDB::get_package: package $pkg not found in repository $tag\n");
+        return;
+      }
+    } else {
+      $tag = $self->{'packages'}{$pkg}{'target'};
+      if (defined($tag)) {
+        return $self->{'packages'}{$pkg}{'tags'}{$tag}{'tlp'};
+      } else {
+        return;
+      }
+    }
+  } else {
+    return $self->_get_package($pkg);
+  }
+}
+
+sub _get_package {
   my ($self,$pkg) = @_;
   if (defined($self->{'tlps'}{$pkg})) {
   my $ret = $self->{'tlps'}{$pkg};
@@ -519,6 +595,35 @@ sub get_package {
 
 =pod
 
+=item C<< $tlpdb->media_of_package($pkg [, $tag]);
+
+returns the media type of the package. In the virtual case a tag can
+be given and the media of that repository is used, otherwise the
+media of the virtual candidate is given.
+
+=cut
+
+sub media_of_package {
+  my ($self, $pkg, $tag) = @_;
+  if ($self->is_virtual) {
+    if (defined($tag)) {
+      if (defined($self->{'tlpdbs'}{$tag})) {
+        return $self->{'tlpdbs'}{$tag}->media;
+      } else {
+        tlwarn ("tag $tag is not known.\n");
+        return;
+      }
+    } else {
+      my (undef,undef,undef,$maxtlpdb) = $self->virtual_candidate($pkg);
+      return $maxtlpdb->media;
+    }
+  } else {
+    return $self->media;
+  }
+}
+
+=pod
+
 =item C<< $tlpdb->list_packages >>
 
 The C<list_packages> function returns the list of all included packages.
@@ -527,6 +632,34 @@ The C<list_packages> function returns the list of all included packages.
 
 sub list_packages {
   my $self = shift;
+  my $arg = shift;
+  my $showall = 0;
+  if (defined($arg) && ($arg eq "-all")) {
+    $showall = 1;
+  }
+  if ($self->is_virtual) {
+    if ($showall) {
+      return (sort keys %{$self->{'packages'}});
+    }
+    # we have to be careful here: If a package
+    # is only present in a subsidiary repository
+    # and the package is *not* explicitely
+    # pinned to it, it will not be installable.
+    # This is what we want. But in this case
+    # we don't want it to be listed by default.
+    #
+    my @pps;
+    for my $p (keys %{$self->{'packages'}}) {
+      push @pps, $p if (defined($self->{'packages'}{$p}{'target'}));
+    }
+    return (sort @pps);
+  } else {
+    return $self->_list_packages;
+  }
+}
+
+sub _list_packages {
+  my $self = shift;
   return (sort keys %{$self->{'tlps'}});
 }
 
@@ -544,6 +677,11 @@ package onto package) are ignored.
 The next (or first) argument is the target TLPDB, then a list of
 packages.
 
+In the virtual case,
+if a package name is tagged with C<@repository-tag> then all the
+dependencies will still be expanded between all included databases.
+Only in case of .ARCH dependencies the repository-tag is sticky.
+
 We return the closure of the package list with respect to the depends
 operator. (Sorry, that was for mathematicians.)
 
@@ -567,7 +705,8 @@ sub expand_dependencies {
   my %install = ();
   my @archs = $totlpdb->available_architectures;
   for my $p (@_) {
-    $install{$p} = 1;
+    my ($pp, $aa) = split('@', $p);
+    $install{$pp} = (defined($aa) ? $aa : 0);;
   }
   my $changed = 1;
   while ($changed) {
@@ -576,7 +715,7 @@ sub expand_dependencies {
     ddebug("pre_select = @pre_select\n");
     for my $p (@pre_select) {
       next if ($p =~ m/^00texlive/);
-      my $pkg = $self->get_package($p);
+      my $pkg = $self->get_package($p, ($install{$p}?$install{$p}:undef));
       if (!defined($pkg)) {
         debug("W: $p is mentioned somewhere but not available, disabling\n");
         $install{$p} = 0;
@@ -602,16 +741,19 @@ sub expand_dependencies {
         if ($p_dep =~ m/^(.*)\.ARCH$/) {
           my $foo = "$1";
           foreach $a (@archs) {
-            $install{"$foo.$a"} = 1 if defined($self->get_package("$foo.$a"));
+            # install .ARCH packages from the same sub repository as the
+            # main packages
+            $install{"$foo.$a"} = $install{$foo}
+              if defined($self->get_package("$foo.$a"));
           }
         } elsif ($p_dep =~ m/^(.*)\.win32$/) {
           # a win32 package should *only* be installed if we are installing
           # the win32 arch
           if (grep(/^win32$/,@archs)) {
-            $install{$p_dep} = 1;
+            $install{$p_dep} = 0;
           }
         } else {
-          $install{$p_dep} = 1 unless $only_arch;
+          $install{$p_dep} = 0 unless $only_arch;
         }
       }
     }
@@ -623,7 +765,9 @@ sub expand_dependencies {
       $changed = 1;
     }
   }
-  return(keys %install);
+  # create return list
+  return map { $install{$_} eq "0"?$_:"$_\@" . $install{$_} } keys %install;
+  #return(keys %install);
 }
 
 =pod
@@ -635,6 +779,7 @@ containing a file named C<filename>.
 
 =cut
 
+# TODO adapt for searching in *all* tags ???
 sub find_file {
   my ($self,$fn) = @_;
   my @ret;
@@ -868,6 +1013,10 @@ installation.
 
 sub root {
   my $self = shift;
+  if ($self->is_virtual) {
+    tlwarn("cannot set/edit root of a virtual tlpdb\n");
+    return 0;
+  }
   if (@_) { $self->{'root'} = shift }
   return $self->{'root'};
 }
@@ -887,6 +1036,10 @@ special value C<__MASTER>.
 
 sub location {
   my $self = shift;
+  if ($self->is_virtual) {
+    tlwarn("cannot get location of a virtual tlpdb\n");
+    return 0;
+  }
   return "$self->{'root'}/$InfraLocation/$DatabaseName";
 }
 
@@ -937,8 +1090,14 @@ container level is set. See Options below.
 
 sub config_src_container {
   my $self = shift;
-  if (defined($self->{'tlps'}{'00texlive.config'})) {
-    foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) {
+  my $tlp;
+  if ($self->is_virtual) {
+    $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config');
+  } else {
+    $tlp = $self->{'tlps'}{'00texlive.config'};
+  }
+  if (defined($tlp)) {
+    foreach my $d ($tlp->depends) {
       if ($d =~ m!^container_split_src_files/(.*)$!) {
         return "$1";
       }
@@ -958,8 +1117,14 @@ container level is set. See Options below.
 
 sub config_doc_container {
   my $self = shift;
-  if (defined($self->{'tlps'}{'00texlive.config'})) {
-    foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) {
+  my $tlp;
+  if ($self->is_virtual) {
+    $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config');
+  } else {
+    $tlp = $self->{'tlps'}{'00texlive.config'};
+  }
+  if (defined($tlp)) {
+    foreach my $d ($tlp->depends) {
       if ($d =~ m!^container_split_doc_files/(.*)$!) {
         return "$1";
       }
@@ -978,8 +1143,14 @@ Returns the currently set default container format. See Options below.
 
 sub config_container_format {
   my $self = shift;
-  if (defined($self->{'tlps'}{'00texlive.config'})) {
-    foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) {
+  my $tlp;
+  if ($self->is_virtual) {
+    $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config');
+  } else {
+    $tlp = $self->{'tlps'}{'00texlive.config'};
+  }
+  if (defined($tlp)) {
+    foreach my $d ($tlp->depends) {
       if ($d =~ m!^container_format/(.*)$!) {
         return "$1";
       }
@@ -998,8 +1169,14 @@ Returns the currently set release. See Options below.
 
 sub config_release {
   my $self = shift;
-  if (defined($self->{'tlps'}{'00texlive.config'})) {
-    foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) {
+  my $tlp;
+  if ($self->is_virtual) {
+    $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config');
+  } else {
+    $tlp = $self->{'tlps'}{'00texlive.config'};
+  }
+  if (defined($tlp)) {
+    foreach my $d ($tlp->depends) {
       if ($d =~ m!^release/(.*)$!) {
         return "$1";
       }
@@ -1018,8 +1195,14 @@ Returns the currently allowed minimal release. See Options below.
 
 sub config_minrelease {
   my $self = shift;
-  if (defined($self->{'tlps'}{'00texlive.config'})) {
-    foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) {
+  my $tlp;
+  if ($self->is_virtual) {
+    $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config');
+  } else {
+    $tlp = $self->{'tlps'}{'00texlive.config'};
+  }
+  if (defined($tlp)) {
+    foreach my $d ($tlp->depends) {
       if ($d =~ m!^minrelease/(.*)$!) {
         return "$1";
       }
@@ -1039,8 +1222,14 @@ Returns the currently set revision. See Options below.
 
 sub config_revision {
   my $self = shift;
-  if (defined($self->{'tlps'}{'00texlive.config'})) {
-    foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) {
+  my $tlp;
+  if ($self->is_virtual) {
+    $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config');
+  } else {
+    $tlp = $self->{'tlps'}{'00texlive.config'};
+  }
+  if (defined($tlp)) {
+    foreach my $d ($tlp->depends) {
       if ($d =~ m!^revision/(.*)$!) {
         return "$1";
       }
@@ -1066,12 +1255,12 @@ which contains the total size of all packages under discussion.
 sub sizes_of_packages {
   my ($self, $opt_src, $opt_doc, @packs) = @_;
   @packs || ( @packs = $self->list_packages() );
-  my $media = $self->media;
   my %tlpsizes;
   my %tlpobjs;
   my $totalsize;
   foreach my $p (@packs) {
     $tlpobjs{$p} = $self->get_package($p);
+    my $media = $self->media_of_package($p);
     if (!defined($tlpobjs{$p})) {
       warn "STRANGE: $p not to be found in ", $self->root;
       next;
@@ -1110,31 +1299,46 @@ sub size_of_one_package {
 
 =pod
 
-=item C<< $tlpdb->install_package($pkg, $dest_tlpdb, $nopostinstall, $fallbacktlpdb) >>
+=item C<< $tlpdb->install_package($pkg, $dest_tlpdb [, $tag]) >>
 
 Installs the package $pkg into $dest_tlpdb.
+If C<$tag> is present and the tlpdb is virtual, tries to install $pkg
+from the repository tagged with $tag.
 
 =cut
 
 sub install_package {
-  my ($self, $pkg, $totlpdb, $nopostinstall, $fallbackmedia) = @_;
+  my ($self, $pkg, $totlpdb, $tag) = @_;
+  if ($self->is_virtual) {
+    if (defined($tag)) {
+      if (defined($self->{'packages'}{$pkg}{'tags'}{$tag})) {
+        return $self->{'tlpdbs'}{$tag}->install_package($pkg, $totlpdb);
+      } else {
+        tlwarn("package $pkg not found in repository $tag\n");
+        return;
+      }
+    } else {
+      my ($maxtag, $maxrev, $maxtlp, $maxtlpdb) = $self->virtual_candidate($pkg);
+      return $maxtlpdb->install_package($pkg, $totlpdb);
+    }
+  } else {
+    if (defined($tag)) {
+      tlwarn("not a virtual database, ignoring tag $tag on installation of $pkg\n");
+    }
+    return $self->not_virtual_install_package($pkg, $totlpdb);
+  }
+  return;
+}
+
+sub not_virtual_install_package {
+  my ($self, $pkg, $totlpdb) = @_;
   my $fromtlpdb = $self;
   my $ret;
   die("TLPDB not initialized, cannot find tlpdb!") unless (defined($fromtlpdb));
   my $tlpobj = $fromtlpdb->get_package($pkg);
   if (!defined($tlpobj)) {
-    if (defined($fallbackmedia)) {
-      if ($ret = $fallbackmedia->install_package($pkg,$totlpdb, $nopostinstall)) {
-        debug("installed $pkg from fallback\n");
-        return $ret;
-      } else {
-        tlwarn("$0: Cannot find package $pkg (in fallback, either)\n");
-        return 0;
-      }
-    } else {
-      tlwarn("$0: Cannot find package $pkg\n");
-      return 0;
-    }
+    tlwarn("$0: Cannot find package $pkg\n");
+    return 0;
   } else {
     my $container_src_split = $fromtlpdb->config_src_container;
     my $container_doc_split = $fromtlpdb->config_doc_container;
@@ -1182,7 +1386,7 @@ sub install_package {
         next;
       }
     } elsif (&media eq 'NET') {
-      $container = "$root/$Archive/$pkg.$DefaultContainerExtension";
+      $container = "$root/$Archive/$pkg.$TeXLive::TLConfig::DefaultContainerExtension";
     }
     $self->_install_package ($container, $reloc, \@installfiles, $totlpdb) 
       || return(0);
@@ -1256,23 +1460,21 @@ sub install_package {
     $totlpdb->save;
     # compute the return value
     TeXLive::TLUtils::announce_execute_actions("enable", $tlpobj);
-    if (!$nopostinstall) {
-      # do the postinstallation actions
-      #
-      # Run the post installation code in the postaction tlpsrc entries
-      # in case we are on w32 and the admin did install for himself only
-      # we switch off admin mode
-      if (win32() && admin() && !$totlpdb->option("w32_multi_user")) {
-        non_admin();
-      }
-      # for now desktop_integration maps to both installation
-      # of desktop shortcuts and menu items, but we can split them later
-      &TeXLive::TLUtils::do_postaction("install", $tlpobj,
-        $totlpdb->option("file_assocs"),
-        $totlpdb->option("desktop_integration"),
-        $totlpdb->option("desktop_integration"),
-        $totlpdb->option("post_code"));
+    # do the postinstallation actions
+    #
+    # Run the post installation code in the postaction tlpsrc entries
+    # in case we are on w32 and the admin did install for himself only
+    # we switch off admin mode
+    if (win32() && admin() && !$totlpdb->option("w32_multi_user")) {
+      non_admin();
     }
+    # for now desktop_integration maps to both installation
+    # of desktop shortcuts and menu items, but we can split them later
+    &TeXLive::TLUtils::do_postaction("install", $tlpobj,
+      $totlpdb->option("file_assocs"),
+      $totlpdb->option("desktop_integration"),
+      $totlpdb->option("desktop_integration"),
+      $totlpdb->option("post_code"));
   }
   return 1;
 }
@@ -1525,7 +1727,7 @@ sub remove_package {
     # the postaction code part cannot be evaluated now since the
     # files are already removed.
     # Again, desktop integration maps to desktop and menu links
-    if (!$nopostinstall) {
+    if (!$opts{'nopostinstall'}) {
       &TeXLive::TLUtils::do_postaction("remove", $tlp,
         $localtlpdb->option("file_assocs"),
         $localtlpdb->option("desktop_integration"),
@@ -1557,7 +1759,12 @@ sub _set_setting_value {
 sub _set_value_pkg {
   my ($self,$pkgname,$pre,$key,$value) = @_;
   my $k = "$pre$key";
-  my $pkg = $self->{'tlps'}{$pkgname};
+  my $pkg;
+  if ($self->is_virtual) {
+    $pkg = $self->{'tlpdbs'}{'main'}->get_package($pkgname);
+  } else {
+    $pkg = $self->{'tlps'}{$pkgname};
+  }
   my @newdeps;
   if (!defined($pkg)) {
     $pkg = new TeXLive::TLPOBJ;
@@ -1595,8 +1802,14 @@ sub _setting_value {
 sub _value_pkg {
   my ($self,$pkg,$pre,$key) = @_;
   my $k = "$pre$key";
-  if (defined($self->{'tlps'}{$pkg})) {
-    foreach my $d ($self->{'tlps'}{$pkg}->depends) {
+  my $tlp;
+  if ($self->is_virtual) {
+    $tlp = $self->{'tlpdbs'}{'main'}->get_package($pkg);
+  } else {
+    $tlp = $self->{'tlps'}{$pkg};
+  }
+  if (defined($tlp)) {
+    foreach my $d ($tlp->depends) {
       if ($d =~ m!^$k:(.*)$!) {
         return "$1";
       }
@@ -1709,7 +1922,12 @@ sub _keyshash {
   my ($self, $pre, $hr) = @_;
   my @allowed = keys %$hr;
   my %ret;
-  my $pkg = $self->{'tlps'}{'00texlive.installation'};
+  my $pkg;
+  if ($self->is_virtual) {
+    $pkg = $self->{'tlpdbs'}{'main'}->get_package('00texlive.installation');
+  } else {
+    $pkg = $self->{'tlps'}{'00texlive.installation'};
+  }
   if (defined($pkg)) {
     foreach my $d ($pkg->depends) {
       if ($d =~ m!^$pre([^:]*):(.*)!) {
@@ -1858,6 +2076,362 @@ sub language_lua_lines {
 
 =back
 
+=head1 VIRTUAL DATABASES
+
+The purpose of virtual databases is to collect several data sources
+and present them in one way. The normal functions will always return
+the best candidate for the set of functions.
+
+More docs to be written
+
+=cut
+
+#
+# packages are saved:
+# $self->{'packages'}{$pkgname}{'tags'}{$tag}{'revision'} = $rev
+# $self->{'packages'}{$pkgname}{'tags'}{$tag}{'tlp'} = $tlp
+# $self->{'packages'}{$pkgname}{'target'} = $target_tag
+#
+
+sub is_virtual {
+  my $self = shift;
+  if (defined($self->{'virtual'}) && $self->{'virtual'}) {
+    return 1;
+  }
+  return 0;
+}
+
+sub make_virtual {
+  my $self = shift;
+  if (!$self->is_virtual) {
+    if ($self->list_packages) {
+      tlerror("Cannot convert a initialized tlpdb to virtual for now!\n");
+      return 0;
+    }
+    $self->{'virtual'} = 1;
+  }
+  return 1;
+}
+
+sub virtual_add_tlpdb {
+  my ($self, $tlpdb, $tag) = @_;
+  if (!$self->is_virtual) {
+    tlerror("Cannot add tlpdb to a non-virtual tlpdb!\n");
+    return 0;
+  }
+  $self->{'tlpdbs'}{$tag} = $tlpdb;
+  for my $p ($tlpdb->list_packages) {
+    my $tlp = $tlpdb->get_package($p);
+    $self->{'packages'}{$p}{'tags'}{$tag}{'revision'} = $tlp->revision;
+    $self->{'packages'}{$p}{'tags'}{$tag}{'tlp'} = $tlp;
+  }
+  $self->check_evaluate_pinning();
+  return 1;
+}
+
+sub virtual_remove_tlpdb {
+  my ($self, $tag) = @_;
+  if (!$self->is_virtual) {
+    tlerror("Cannot remove tlpdb from a non-virtual tlpdb!\n");
+    return 0;
+  }
+  if (!defined($self->{'tlpdbs'}{$tag})) {
+    tlwarn("TLPDB virtual_remove_tlpdb: unknown tag $tag\n");
+    return 0;
+  }
+  for my $p ($self->{'tlpdbs'}{$tag}->list_packages) {
+    delete $self->{'packages'}{$p}{'tags'}{$tag};
+  }
+  delete $self->{'tlpdbs'}{$tag};
+  $self->check_evaluate_pinning();
+  return 1;
+}
+
+sub virtual_get_package {
+  my ($self, $pkg, $tag) = @_;
+  if (defined($self->{'packages'}{$pkg}{'tags'}{$tag})) {
+    return $self->{'packages'}{$pkg}{'tags'}{$tag}{'tlp'};
+  } else {
+    tlwarn("pkg $pkg not found in tag $tag\n");
+    return;
+  }
+}
+
+=item C<< $tlpdb->candidates ( $pkg ) >>
+
+Returns the list of candidates for the given package in the
+format
+
+  tag/revision
+
+If the returned list is empty, then the database was not virtual and
+no install candidate was found.
+
+If the returned list contains undef as first element, the database
+is virtual, and no install candidate was found.
+
+The remaining elements in the list are all repositories that provide
+that package.
+
+Note that there might not be an install candidate, but still the
+package is provided by a sub-repository. This can happen if a package
+is present only in the sub-repository and there is no explicit pin
+for that package in the pinning file.
+
+=cut
+
+sub is_repository {
+  my $self = shift;
+  my $tag = shift;
+  if (!$self->is_virtual) {
+    return ( ($tag eq $self->{'root'}) ? 1 : 0 );
+  }
+  return ( defined($self->{'tlpdbs'}{$tag}) ? 1 : 0 );
+}
+
+
+# returns a list of tag/rev
+sub candidates {
+  my $self = shift;
+  my $pkg = shift;
+  my @ret = ();
+  if ($self->is_virtual) {
+    if (defined($self->{'packages'}{$pkg})) {
+      my $t = $self->{'packages'}{$pkg}{'target'};
+      if (defined($t)) {
+        push @ret, "$t/" . $self->{'packages'}{$pkg}{'tags'}{$t}{'revision'};
+      } else {
+        $t = "";
+        # no target found, but maybe available somewhere else,
+        # we return undef as first one
+        push @ret, undef;
+      }
+      # make sure that we always check for main as repo
+      my @repos = keys %{$self->{'packages'}{$pkg}};
+      for my $r (sort keys %{$self->{'packages'}{$pkg}{'tags'}}) {
+        push @ret, "$r/" . $self->{'packages'}{$pkg}{'tags'}{$r}{'revision'}
+          if ($t ne $r);
+      }
+    }
+  } else {
+    my $tlp = $self->get_package($pkg);
+    if (defined($tlp)) {
+      push @ret, "main/" . $tlp->revision;
+    }
+  }
+  return @ret;
+}
+
+=item C<< $tlpdb->candidate ( ) >>
+
+Returns either a list of four undef, if no install candidate is found,
+or the following information on the install candidate as list: the tag
+name of the repository, the revision number of the package in the
+candidate repository, the tlpobj of the package in the candidate
+repository, and the candidate repository's TLPDB itself.
+
+=cut
+
+#
+sub virtual_candidate {
+  my ($self, $pkg) = @_;
+  my $t = $self->{'packages'}{$pkg}{'target'};
+  if (defined($t)) {
+    return ($t, $self->{'packages'}{$pkg}{'tags'}{$t}{'revision'},
+      $self->{'packages'}{$pkg}{'tags'}{$t}{'tlp'}, $self->{'tlpdbs'}{$t});
+  }
+  return(undef,undef,undef,undef);
+}
+
+=item C<< $tlpdb->virtual_pinning ( [@pinning_data] ) >>
+
+Without any argument returns the pinning data, or undef. Be reminded that an
+empty pinning data will behave differently to no pinning data.
+
+With an argument it must be a list of pins, where each pin
+must be one hash ref with the following keys:
+C<repo> the tag of the repository,
+C<glob> the glob for matching a package
+C<re> the regexp which corresponds to the glob
+C<line> the line where the glob was found (for warning purpose).
+
+=cut
+
+sub virtual_pinning {
+  my $self = shift;
+  my (@pins) = @_;
+  if (!$self->is_virtual) {
+    tlerror("Not-virtual databases cannot have pinning data.\n");
+    return 0;
+  }
+  if (!@pins) {
+    if (!defined($self->{'pindata'})) {
+      my @foo = ();
+      $self->{'pindata'} = \@foo;
+    }
+    return (@{$self->{'pindata'}});
+  } else {
+    $self->{'pindata'} = \@pins;
+    $self->check_evaluate_pinning();
+    return ($self->{'pindata'});
+  }
+}
+
+#
+# current format:
+# <repo>:<pkg_glob>[,<pkg_glob>,...][:<options>]
+# only supported options for now is
+#   revision
+# meaning that, if for the selected package there is no other
+# "non-revision" pinning, then all repo/package versions are compared
+# using normal revision comparison, and the biggest revision number wins.
+# That allows you to have the same package in several repos:
+#   repo1:foo:revision
+#   repo2:foo:revision
+#   repo1:*
+#   repo2:*
+# means that:
+# for package "foo" the revision numbers of "foo" in the repos "repo1",
+# "repo2", and "main" are numerically compared and biggest number wins.
+# for all other packages of "repo1" and "repo2", other other repositories
+# are not considered.
+#
+# NOT IMPLEMENTED YET!!!
+#
+# $pin{'repo'} = $repo;
+# $pin{'glob'} = $glob;
+# $pin{'re'} = $re;
+# $pin{'line'} = $line; # for debug/warning purpose
+sub make_pin_data_from_line {
+  my $self = shift;
+  my $l = shift;
+  my ($a, $b, $c) = split(/:/, $l);
+  my @ret;
+  my %m;
+  $m{'repo'} = $a;
+  $m{'line'} = $l;
+  if (defined($c)) {
+    $m{'options'} = $c;
+  }
+  # split the package globs
+  for (split(/,/, $b)) {
+    my %mm = %m;
+    $mm{'glob'} = $_;
+    $mm{'re'} = glob_to_regex($_);
+    push @ret, \%mm;
+  }
+  return @ret;
+}
+
+sub check_evaluate_pinning {
+  my $self = shift;
+  my @pins = (defined($self->{'pindata'}) ? @{$self->{'pindata'}} : ());
+  #
+  # run through the pin lines and make sure that all the conditions
+  # and requirements are obeyed
+  my %pkgs = %{$self->{'packages'}};
+  # main:*
+  my ($mainpin) = $self->make_pin_data_from_line("main:*");
+  # the default main:* is always considered to be matched
+  $mainpin->{'hit'} = 1;
+  push @pins, $mainpin;
+  for my $pkg (keys %pkgs) {
+    PINS: for my $pp (@pins) {
+      my $pre = $pp->{'re'};
+      if (($pkg =~ m/$pre/) &&
+          (defined($self->{'packages'}{$pkg}{'tags'}{$pp->{'repo'}}))) {
+        $self->{'packages'}{$pkg}{'target'} = $pp->{'repo'};
+        # register that this pin was hit
+        $pp->{'hit'} = 1;
+        last PINS;
+      }
+    }
+  }
+  # check that all pinning lines where hit
+  for my $p (@pins) {
+    next if defined($p->{'hit'});
+    tlwarn("pinning warning: the entry in line\n  ", $p->{'line'},
+           "\nconcerning the package pattern ", $p->{'glob'},
+           "\nis not matched by any package!\n");
+  }
+}
+
+
+# implementation copied from Text/Glob.pm (copyright Richard Clamp).
+# changes made:
+# remove $strict_leading_dot and $strict_wildcard_slash if calls
+# and execute the code unconditionally, as we do not change the
+# default settings of 1 of these two variables.
+sub glob_to_regex {
+    my $glob = shift;
+    my $regex = glob_to_regex_string($glob);
+    return qr/^$regex$/;
+}
+
+sub glob_to_regex_string
+{
+    my $glob = shift;
+    my ($regex, $in_curlies, $escaping);
+    local $_;
+    my $first_byte = 1;
+    for ($glob =~ m/(.)/gs) {
+        if ($first_byte) {
+            $regex .= '(?=[^\.])' unless $_ eq '.';
+            $first_byte = 0;
+        }
+        if ($_ eq '/') {
+            $first_byte = 1;
+        }
+        if ($_ eq '.' || $_ eq '(' || $_ eq ')' || $_ eq '|' ||
+            $_ eq '+' || $_ eq '^' || $_ eq '$' || $_ eq '@' || $_ eq '%' ) {
+            $regex .= "\\$_";
+        }
+        elsif ($_ eq '*') {
+            $regex .= $escaping ? "\\*" : "[^/]*";
+        }
+        elsif ($_ eq '?') {
+            $regex .= $escaping ? "\\?" : "[^/]";
+        }
+        elsif ($_ eq '{') {
+            $regex .= $escaping ? "\\{" : "(";
+            ++$in_curlies unless $escaping;
+        }
+        elsif ($_ eq '}' && $in_curlies) {
+            $regex .= $escaping ? "}" : ")";
+            --$in_curlies unless $escaping;
+        }
+        elsif ($_ eq ',' && $in_curlies) {
+            $regex .= $escaping ? "," : "|";
+        }
+        elsif ($_ eq "\\") {
+            if ($escaping) {
+                $regex .= "\\\\";
+                $escaping = 0;
+            }
+            else {
+                $escaping = 1;
+            }
+            next;
+        }
+        else {
+            $regex .= $_;
+            $escaping = 0;
+        }
+        $escaping = 0;
+    }
+    print "# $glob $regex\n" if debug;
+
+    return $regex;
+}
+
+sub match_glob {
+    print "# ", join(', ', map { "'$_'" } @_), "\n" if debug;
+    my $glob = shift;
+    my $regex = glob_to_regex $glob;
+    local $_;
+    grep { $_ =~ $regex } @_;
+}
+
 =pod
 
 =head1 OPTIONS
@@ -1919,4 +2493,4 @@ GNU General Public License Version 2 or later.
 ### tab-width: 2
 ### indent-tabs-mode: nil
 ### End:
-# vim:set tabstop=2 expandtab: #
+# vim:set tabstop=2 expandtab autoindent: #
diff --git a/Master/tlpkg/dev/dev.multi-source-support-v2.patch b/Master/tlpkg/dev/dev.multi-source-support-v2.patch
index 18c03dcd4ec..c32c0ff64bf 100644
--- a/Master/tlpkg/dev/dev.multi-source-support-v2.patch
+++ b/Master/tlpkg/dev/dev.multi-source-support-v2.patch
@@ -1,8 +1,8 @@
 ---
  texmf/scripts/texlive/tlmgr.pl    |  916 ++++++++++++++++++++++++++++++++------
- texmf/scripts/texlive/tlmgrgui.pl |  292 ++++++++++--
+ texmf/scripts/texlive/tlmgrgui.pl |  394 ++++++++++++++--
  tlpkg/TeXLive/TLPDB.pm            |  706 ++++++++++++++++++++++++++---
- 3 files changed, 1665 insertions(+), 249 deletions(-)
+ 3 files changed, 1767 insertions(+), 249 deletions(-)
 
 Index: tlpkg/TeXLive/TLPDB.pm
 ===================================================================
@@ -2241,8 +2241,8 @@ Index: texmf/scripts/texlive/tlmgr.pl
 Index: texmf/scripts/texlive/tlmgrgui.pl
 ===================================================================
 --- texmf/scripts/texlive/tlmgrgui.pl.orig	2011-06-16 21:30:37.000000000 +0900
-+++ texmf/scripts/texlive/tlmgrgui.pl	2012-03-28 14:30:06.000129905 +0900
-@@ -1,7 +1,7 @@
++++ texmf/scripts/texlive/tlmgrgui.pl	2012-03-29 02:38:57.124639975 +0900
+@@ -1,13 +1,17 @@
  #!/usr/bin/env perl
  # $Id: tlmgrgui.pl 23011 2011-06-16 12:30:37Z preining $
  #
@@ -2251,7 +2251,17 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
  # This file is licensed under the GNU General Public License version 2
  # or any later version.
  #
-@@ -60,8 +60,15 @@
+ # GUI for tlmgr
+ # version 2, completely rewritten GUI
+ #
++#
++# TODO FOR MULTI SUPPORT
++#   - colorize the General config tab, if something is changed, show it in RED
++#     that can actually applied to single repo tlmgrgui, too
+ # TODO: Fix return codes of execute_action sub items and execute_action
+ #       so that we can give a decent warning window
+ # TODO: implement path adjustment also for Windows
+@@ -60,8 +64,17 @@
  our @update_function_list;
  
  my $tlpdb_location;
@@ -2264,10 +2274,12 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
 +my %repos;
 +my @tags;
 +
++my $location_button; # uggg, change from far away ...
++
  #
  # shortcuts for padding, expand/fill, and pack sides, anchors
  my @p_ii = qw/-padx 2m -pady 2m/;
-@@ -97,6 +104,7 @@
+@@ -97,6 +110,7 @@
  my $darktext;
  my $match_entry;
  my $loaded_text;
@@ -2275,7 +2287,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
  
  #
  # communication between filters and the rest
-@@ -169,6 +177,8 @@
+@@ -169,6 +183,8 @@
    #  cmd line > tlpdb
    # save the two possible location for the menu
    $tlpdb_location = $localtlpdb->option("location");
@@ -2284,7 +2296,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
    if (defined($opts{"location"})) {
      $cmdline_location = $opts{"location"};
    }
-@@ -261,14 +271,13 @@
+@@ -261,14 +277,13 @@
          -selectmode => "none");
  
    my $button_frame = $mw->Frame;
@@ -2303,7 +2315,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
    $loaded_text->pack(-anchor => 'e', -padx => 0, -pady => 0, 
      -ipadx => 0, -ipady => 0, -side => 'right');
      
-@@ -484,8 +493,14 @@
+@@ -484,8 +499,14 @@
    #
    # FILE MENU
    #
@@ -2319,7 +2331,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
      -command => sub { setup_location($tlpdb_location); });
    if (defined($cmdline_location)) {
      $menu_file->add('command', -label => __("Load cmd line repository:") . " $cmdline_location",
-@@ -663,7 +678,7 @@
+@@ -663,7 +684,7 @@
        -sticky => "nw");
    }
    $tf->Label(-text => __("Remote Revision:"))->grid(
@@ -2328,7 +2340,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
      -sticky => "nw");
    if (defined($Packages{$p}{'remotecatalogueversion'})) {
      $tf->Label(-text => __("Remote Catalogue Version:"))->grid(
-@@ -838,7 +853,7 @@
+@@ -838,7 +859,7 @@
          $t .= " ($Packages{$p}{'localcatalogueversion'})";
        }
        $g->itemCreate($p, 2, -itemtype => 'text', -style => $st, -text => $t);
@@ -2337,7 +2349,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
        if ($Packages{$p}{'remotecatalogueversion'}) {
          $t .= " ($Packages{$p}{'remotecatalogueversion'})";
        }
-@@ -905,9 +920,13 @@
+@@ -905,9 +926,13 @@
        return 0;
      }
      # check first for the default search type, the descriptions
@@ -2351,7 +2363,14 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
        }
      }
      if (!$found) {
-@@ -1052,6 +1071,13 @@
+@@ -1046,12 +1071,20 @@
+   }
+   %changeddefaults = ();
+   for my $k (keys %defaults) {
++    $changeddefaults{$k}{'changed'} = 0;
+     $changeddefaults{$k}{'value'}   = $defaults{$k};
+     if ($TeXLive::TLConfig::TLPDBOptions{$k}->[0] eq "b") {
+       $changeddefaults{$k}{'display'} = ($defaults{$k} ? __("Yes") : __("No"));
      } else {
        if ($k eq "file_assocs") {
          $changeddefaults{$k}{'display'} = $fileassocdesc[$defaults{$k}];
@@ -2365,7 +2384,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
        } else {
          $changeddefaults{$k}{'display'} = $defaults{$k};
        }
-@@ -1075,11 +1101,23 @@
+@@ -1075,11 +1108,23 @@
  
    push @config_set_l, 
      $back_config_set->Label(-text => __("Default package repository"), -anchor => "w");
@@ -2375,12 +2394,12 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
 -    $back_config_set->Button(-text => __("Change"), 
 -      -command => sub { menu_default_location($sw); });
 +  if ($#tlpdb_tags > 0) {
-+    my @vals = map { "$_:$tlpdb_repos{$_}" } sort @tlpdb_tags;
-+    my $b = $back_config_set->Button(-relief => 'flat',
++    my @vals = map { "$_:$tlpdb_repos{$_}" } sort sort_main_first @tlpdb_tags;
++    $location_button = $back_config_set->Button(-relief => 'flat',
 +      -textvariable => \$changeddefaults{"location"}{'display'});
-+    $b->configure(
-+      -command => sub { transient_show_multiple_repos($b, @vals); });
-+    push @config_set_m, $b;
++    $location_button->configure(
++      -command => sub { transient_show_multiple_repos($location_button, @vals); });
++    push @config_set_m, $location_button;
 +    push @config_set_r,
 +      $back_config_set->Button(-text => __("Change"), 
 +        -command => sub { menu_multi_location($sw); });
@@ -2394,7 +2413,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
  
  
    if ($mode_expert) {
-@@ -1383,48 +1421,145 @@
+@@ -1383,48 +1428,240 @@
    }
  }
  
@@ -2497,49 +2516,92 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
 +  }
 +}
 +
++sub sort_main_first {
++  if ($a eq 'main') {
++    if ($b eq 'main') {
++      return 0;
++    } else {
++      return -1;
++    }
++  } else {
++    if ($b eq 'main') {
++      return 1;
++    } else {
++      return ($a cmp $b);
++    }
++  }
++}
 +
 +sub menu_multi_location {
 +  my $mw = shift;
 +  my $val;
-+  my $sw = $mw->Toplevel(-title => __("Edit default package repositories"));
++  our $sw = $mw->Toplevel(-title => __("Edit default package repositories"));
 +  $sw->transient($mw);
 +  $sw->grab();
 +  $sw->Label(-text => __("Specify set of repositories to be used"))->pack(-padx => "2m", -pady => "2m");
 +
-+  my $f1 = $sw->Frame;
-+  my @entry_tag; my $tagw = 10;
-+  my @entry_loc; my $locw = 30;
++  our $f1 = $sw->Frame;
++  my @entry_tag; our $tagw = 10;
++  my @entry_loc; our $locw = 30;
 +  my @entry_del;
 +  my @entry_chg;
 +
-+  my %edit_repos = %tlpdb_repos;
-+  my @edit_tags = @tlpdb_tags;
-+  push @entry_tag, $f1->Entry(-text => 'main', -state => 'readonly', -width => $tagw);
-+  push @entry_loc, $f1->Entry(-text => $tlpdb_repos{'main'}, -width => $locw);
-+  push @entry_del, $f1->Button(-text => __("Delete"), -state => 'disabled');
-+  push @entry_chg, $f1->Button(-text => __("Change"),
-+    -command => sub {
-+      my $ret = ask_one_repository($sw, __("Change main package repository"),
-+        __("New main package repository"));
-+      $edit_repos{'main'} = $ret if (defined($ret));
-+    });
-+  for my $t (sort @edit_tags) {
-+    next if ($t eq "main");
-+    push @entry_tag, $f1->Entry(-textvariable => \$t, -width => $tagw);
-+    push @entry_loc, $f1->Entry(-textvariable => \$edit_repos{$t}, -width => $locw);
-+    push @entry_del, $f1->Button(-text => __("Delete"));
-+    push @entry_chg, $f1->Button(-text => __("Change"),
++  my $addrepo_button;
++
++
++  sub add_buttons {
++    my ($ref) = @_;
++    my $t = $ref->{'tag'};
++    $ref->{'tag_w'} = $f1->Entry(-textvariable => \$ref->{'tag'}, -state => ($t eq "main" ? 'readonly' : 'normal'), -width => $tagw);
++    $ref->{'val_w'} = $f1->Entry(-textvariable => \$ref->{'val'}, -width => $locw);
++    $ref->{'del_w'} = $f1->Button(-text => __("Delete"),
++      -state => ($t eq "main" ? 'disabled' : 'normal'),
++      -command => sub {
++        $ref->{'status'} = 0;
++        $ref->{'tag_w'}->configure(-state => 'disabled');
++        $ref->{'val_w'}->configure(-state => 'disabled');
++        $ref->{'del_w'}->configure(-state => 'disabled');
++        $ref->{'chg_w'}->configure(-state => 'disabled');
++      });
++    $ref->{'chg_w'} = $f1->Button(-text => __("Change"),
 +      -command => sub {
-+        my $ret = ask_one_repository($sw, __("Change subsidiary package repository"),
-+          __("New subsidiary package repository"));
-+        $edit_repos{$t} = $ret if (defined($ret));
++        my $ret = ask_one_repository($sw, __("Change " . ($t eq "main" ? "main" : "subsidiary") . " package repository"),
++          __(($t eq "main" ? "Change main" : "New subsidiary") . " package repository"));
++        $ref->{'val'} = $ret if (defined($ret));
 +      });
 +  }
-+  # add some "Add ..." line? TODO
-+  for my $i (0..$#entry_tag) {
-+    $entry_tag[$i]->grid( $entry_loc[$i], $entry_del[$i], $entry_chg[$i],
++
++  my %changed_repos = repository_to_array($changeddefaults{'location'}{'value'});
++
++  my @edit_repos;
++  push @edit_repos, { 'tag' => 'main', 'val' => $changed_repos{'main'}, 'status' => 1};
++  for my $k (sort keys %changed_repos) {
++    next if ($k eq "main");
++    push @edit_repos, { 'tag'=> $k, 'val' => $changed_repos{$k}, 'status' => 1 };
++  }
++  for my $ref (@edit_repos) {
++    add_buttons($ref);
++  }
++  for my $ref (@edit_repos) {
++    my %foo = %$ref;
++    $foo{'tag_w'}->grid($foo{'val_w'}, $foo{'del_w'}, $foo{'chg_w'},
 +       -padx => "1m", -pady => "1m", -sticky => "nwe");
 +  }
++  $addrepo_button = $f1->Button(-text => __("Add repository") . "...",
++    -command => sub { 
++      my $ret = ask_one_repository($sw, __("Add package repository"),
++        __("Add package repository"));
++      if (defined($ret)) {
++        $addrepo_button->gridForget;
++        my %foo = ( 'tag' => $ret, 'val' => $ret, 'status' => 1 );
++        add_buttons(\%foo);
++        $foo{'tag_w'}->grid($foo{'val_w'}, $foo{'del_w'}, $foo{'chg_w'},
++          -padx => "1m", -pady => "1m", -sticky => "nwe");
++        push @edit_repos, \%foo;
++      }
++      $addrepo_button->grid(-columnspan => 2, -column => 2);
++    });
++  $addrepo_button->grid(-columnspan => 2, -column => 2);
 +
 +  $f1->pack;
 +
@@ -2549,17 +2611,69 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
        sub { 
 -        $changeddefaults{'location'}{'value'} = 
 -          $changeddefaults{'location'}{'display'} = $entry->get;
-+        print "TODO TODO TODO ___ EDITING OF MULTIPLE NOT SUPPORTED!!!\nWE ALSO HAVE TO MAKE SURE THAT THERE IS ONE MAIN AND NOT MORE ETC ETC\n";
++        # we have to check if something has changed ... and for consistency!!!
++        my %new_repos;
++        for my $ref (@edit_repos) {
++          my %foo = %$ref;
++          if ($foo{'status'}) {
++            if (defined($new_repos{$foo{'tag'}})) {
++              $sw->Dialog(-title => __("Warning"),
++                -text => __("Multiple defined tags (first column) are not possible, please fix it."), -buttons => [ __("Ok") ])->Show;
++              return;
++            }
++            $new_repos{$foo{'tag'}} = $foo{'val'};
++          }
++        }
++        my $differs = 0;
++        for my $k (keys %changed_repos) {
++          if (!defined($new_repos{$k})) {
++            $differs = 1;
++            last;
++          }
++          if ($changed_repos{$k} ne $new_repos{$k}) {
++            $differs = 1;
++            last;
++          }
++        }
++        if (!$differs) {
++          # do the same the other way round
++          for my $k (keys %new_repos) {
++            if (!defined($changed_repos{$k})) {
++              $differs = 1;
++              last;
++            }
++            if ($changed_repos{$k} ne $new_repos{$k}) {
++              $differs = 1;
++              last;
++            }
++          }
++        }
++        if ($differs) {
++          # print "current repos:\n";
++          # for my $ref (@edit_repos) {
++          #   print "tag = $ref->{'tag'}\n";
++          #   print "val = $ref->{'val'}\n";
++          #   print "act = $ref->{'status'}\n";
++          # }
++          $changeddefaults{'location'}{'value'} = array_to_repository(%new_repos);
++          $changeddefaults{'location'}{'display'} = __("multiple repositories");
++          my @vals = map { "$_:$new_repos{$_}" } 
++            sort sort_main_first keys %new_repos;
++          $location_button->configure(
++            -command => sub { transient_show_multiple_repos($location_button, @vals); });
++        } else {
++          # print "Nothing happend!\n";
++        }
          $sw->destroy;
        })->pack(-side => 'left',-padx => "2m", -pady => "2m");
    my $cancelbutton = $f->Button(-text => __("Cancel"), 
            -command => sub { $sw->destroy })->pack(-side => 'right',-padx => "2m", -pady => "2m");
 +  my $resetbutton = $f->Button(-text => __("Revert"), 
-+          -command => sub { print "TODO REVERT SETTINGS\n"; })->pack(-side => 'right',-padx => "2m", -pady => "2m");
++          -command => sub { $sw->destroy; menu_multi_location($mw); })->pack(-side => 'right',-padx => "2m", -pady => "2m");
    $f->pack(-expand => 'x');
    $sw->bind('<Return>', [ $okbutton, 'Invoke' ]);
    $sw->bind('<Escape>', [ $cancelbutton, 'Invoke' ]);
-@@ -1554,19 +1689,27 @@
+@@ -1554,19 +1791,27 @@
  sub setup_location {
    my $loc = shift;
    $location = $loc; 
@@ -2592,7 +2706,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
      $mw->Unbusy;
      if (!defined($remotetlpdb)) {
        # something went badly wrong, maybe the newroot is wrong?
-@@ -1725,7 +1868,7 @@
+@@ -1725,7 +1970,7 @@
  # sub populate_Packages
  #
  sub populate_Packages {
@@ -2601,7 +2715,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
    my $p = $tlp->name;
    $Packages{$p}{'displayname'}   = $p;
    if ($mode eq "local") {
-@@ -1736,6 +1879,10 @@
+@@ -1736,6 +1981,10 @@
      $Packages{$p}{'tlp'}           = $tlp;
    } else {
      $Packages{$p}{'remoterevision'} = $tlp->revision;
@@ -2612,7 +2726,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
      $Packages{$p}{'selected'}      = 0
        unless defined $Packages{$p}{'selected'};
      if (!defined($Packages{$p}{'tlp'})) {
-@@ -1865,6 +2012,7 @@
+@@ -1865,6 +2114,7 @@
        next;
      }
      delete $Packages{$p}{'remoterevision'};
@@ -2620,7 +2734,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
      delete $Packages{$p}{'remotecatalogueversion'};
    }
    if (defined($remotetlpdb)) {
-@@ -1875,8 +2023,15 @@
+@@ -1875,8 +2125,15 @@
          push @do_later_media, $p;
          next;
        }
@@ -2638,7 +2752,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
      }
    }
    my @avail_arch = $localtlpdb->available_architectures;
-@@ -1886,9 +2041,16 @@
+@@ -1886,9 +2143,16 @@
        tlerror("very strange, above it matched and now not anymore?!?! $p\n");
        next;
      }
@@ -2657,7 +2771,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
      } else {
        # two cases:
        # - $mp.$ma where $ma is in available_archs
-@@ -1926,7 +2088,7 @@
+@@ -1926,7 +2190,7 @@
        } else {
          # only show that one if it is locally installed
          if (defined($Packages{$p})) {
@@ -2666,7 +2780,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
          }
        }
      }
-@@ -2216,7 +2378,47 @@
+@@ -2216,7 +2480,47 @@
  sub update_loaded_location_string {
    my $arg = shift;
    $arg || ($arg = $location);
@@ -2675,7 +2789,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
 +  my @tags = sort keys %repos;
 +  my @vals;
 +  if ($#tags > 0) {
-+    @vals = sort map { "$_:$repos{$_}" } @tags;
++    @vals = map { "$_:$repos{$_}" } sort sort_main_first @tags;
 +  } else {
 +    @vals = ( $arg );
 +  }