1 files changed, 47 insertions, 4 deletions
diff --git a/Master/tlpkg/TeXLive/TLTREE.pm b/Master/tlpkg/TeXLive/TLTREE.pm
index fe3689302b0..fa734190d27 100644
--- a/Master/tlpkg/TeXLive/TLTREE.pm
+++ b/Master/tlpkg/TeXLive/TLTREE.pm
@@ -1,6 +1,6 @@
 # $Id$
 # TeXLive::TLTREE.pm - work with the tree of all files
-# Copyright 2007-2014 Norbert Preining
+# Copyright 2007-2016 Norbert Preining
 # This file is licensed under the GNU General Public License version 2
 # or any later version.
 
@@ -315,15 +315,58 @@ sub _get_files_matching_regexp_pattern {
   return(@returnfiles);
 }
 
+#
+# go through all dir names in the TLTREE such that 
+# which are named like the last entry of @patwords,
+# and which have initial path component of the 
+# rest of @patwords
+#
+# This is not optimal, because many subsetted 
+# dirs are found, example package graphics contains
+# the following exception line to make sure that 
+# these files are not included.
+# docpattern +!d texmf-dist/doc/latex/graphicxbox/examples/graphics
+#
+# We don't need *arbitrary* depth, because what can happen is
+# that the autopattern
+#   docpattern Package t texmf-dist doc %NAME%
+# can match at one of the following
+#   texmf-dist/doc/%NAME
+#   texmf-dist/doc/<SOMETHING>/%NAME
+# but not deeper.
+# Same for the others.
+#
+# Lets say that we try that <SOMETHING> contains at *most* 
+# one (1) / (forward slash/path separator)
+#
+# only for fonts we need a special treatment with 3
+#
 sub _get_files_matching_dir_pattern {
   my ($self,$type,@patwords) = @_;
   my $tl = pop @patwords;
+  my $maxintermediate = 1;
+  if (($#patwords >= 1 && $patwords[1] eq 'fonts')
+      || 
+      ($#patwords >= 2 && $patwords[2] eq 'context')) {
+    $maxintermediate = 2;
+  }
   my @returnfiles;
   if (defined($self->{'_dirnames'}{$tl})) {
     foreach my $tld (@{$self->{'_dirnames'}{$tl}}) {
-      if (index($tld,join("/",@patwords)."/") == 0) {
-        my @files = $self->files_under_path($tld);
-        TeXLive::TLUtils::push_uniq(\@returnfiles, @files);
+      my $startstr = join("/",@patwords)."/";
+      if (index($tld, $startstr) == 0) {
+        my $middlepart = $tld;
+        $middlepart =~ s/\Q$startstr\E//;
+        $middlepart =~ s!/$tl/!!;
+        # put match into list context returns
+        # all matches, which is than coerced to
+        # an integer which gives the number!
+        my $number = () = $middlepart =~ m!/!g;
+        #printf STDERR "DEBUG: maxint=$maxintermediate, number=$number, patwords=@patwords\n";
+        if ($number <= $maxintermediate) {
+          my @files = $self->files_under_path($tld);
+          TeXLive::TLUtils::push_uniq(\@returnfiles, @files);
+        }
       }
     }
   }