crumbs.pl 1.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051
  1. # Copyright (C) 2004, 2005 Alex Schroeder <alex@emacswiki.org>
  2. #
  3. # This program is free software; you can redistribute it and/or modify
  4. # it under the terms of the GNU General Public License as published by
  5. # the Free Software Foundation; either version 3 of the License, or
  6. # (at your option) any later version.
  7. #
  8. # This program is distributed in the hope that it will be useful,
  9. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. # GNU General Public License for more details.
  12. #
  13. # You should have received a copy of the GNU General Public License
  14. # along with this program. If not, see <http://www.gnu.org/licenses/>.
  15. use strict;
  16. use v5.10;
  17. AddModuleDescription('crumbs.pl', 'List Parent Pages Extension');
  18. our ($q, %RuleOrder, @MyRules, $LinkPattern, $FreeLinks, $FreeLinkPattern, $WikiLinks);
  19. push(@MyRules, \&CrumbsRule);
  20. $RuleOrder{\&CrumbsRule} = -10; # run before default rules!
  21. sub CrumbsRule {
  22. if (not (pos) # first!
  23. and (($WikiLinks && /\G($LinkPattern\n)/cg)
  24. or ($FreeLinks && /\G(\[\[$FreeLinkPattern\]\]\n)/cg))) {
  25. my $oldpos = pos; # will be trashed below
  26. my $cluster = FreeToNormal($2);
  27. my %seen = ($cluster => 1);
  28. my @links = ($cluster);
  29. AllPagesList(); # set IndexHash
  30. while ($cluster) {
  31. my $text = GetPageContent($cluster); # opening n files is slow!
  32. if (($WikiLinks && $text =~ /^$LinkPattern\n/)
  33. or ($FreeLinks && $text =~ /^\[\[$FreeLinkPattern\]\]\n/)) {
  34. $cluster = FreeToNormal($1);
  35. }
  36. last if not $cluster or $seen{$cluster};
  37. $seen{$cluster} = 1;
  38. push(@links, $cluster);
  39. }
  40. my $result = $q->span({-class=>'crumbs'}, map { GetPageLink($_) } reverse(@links));
  41. pos = $oldpos; # set after $_ is set!
  42. return $result; # clean rule, will be cached!
  43. }
  44. return;
  45. }