Anchors support

diff --git a/FORMAT b/FORMAT
index 28954aa3292c2572fb3983882f310a8d9703913e..d381fe1c1b155ab6675a5b479a07cd141d5badfa 100644 (file)
--- a/FORMAT
+++ b/FORMAT
@@ -1,6 +1,7 @@
 Page format is trivial: it is arbitrary formatted plaintext.
 It will be rendered in HTML through the <pre> tag.
 The only specific inline formatting construction is [LINKS].
 Page format is trivial: it is arbitrary formatted plaintext.
 It will be rendered in HTML through the <pre> tag.
 The only specific inline formatting construction is [LINKS].

+It may be followed by "#name" to create an anchored link.

 
 But there are also special "command" lines, ending with "\r\n"
 instead of ordinary "\n". Here are possible commands, playing
 
 But there are also special "command" lines, ending with "\r\n"
 instead of ordinary "\n". Here are possible commands, playing


@@ -8,15 +9,27 @@ role only (currently) during HTML generation.
 
 * => URL[ optional text]
   Creates <a href="URL">{optional text|URL}</a> link in HTML.
 
 * => URL[ optional text]
   Creates <a href="URL">{optional text|URL}</a> link in HTML.

+

 * img URL[ optional text][ => URL-A]
   Creates <img src="URL" [alt="optional text"] /> in HTML.
   If "=> URL" is specified, then <a href="URL-A"><img ... /></a>.
 * img URL[ optional text][ => URL-A]
   Creates <img src="URL" [alt="optional text"] /> in HTML.
   If "=> URL" is specified, then <a href="URL-A"><img ... /></a>.

+

 * |...
   Just inserts raw ... line to HTML output as-is.
 * |...
   Just inserts raw ... line to HTML output as-is.

+

 * #...
   Does nothing, commented line.
 * #...
   Does nothing, commented line.

-* do-backs
-  Forcefully creates a table with all backlinks to the page.
+

 * <<[indent][page]
   Include contents of the specified page. indent is optional.
   Brackets around [page] are for making a link to page.
 * <<[indent][page]
   Include contents of the specified page. indent is optional.
   Brackets around [page] are for making a link to page.

+
+* do-backs
+  Forcefully creates a table with all backlinks to the page.
+
+* A name
+  Creates an invisible anchor with the specified name.
+
+* A [page] name
+  Also creates an anchor, but also links resulting page+anchor to the
+  specified page. It may be useful for creating index-pages.

diff --git a/swg b/swg
index b1ff10e256e99d4381f7adffa602b7bb72f24d79..fdb9affb1ff745ba3e0e0d65572b8206ab32da24 100755 (executable)
--- a/swg
+++ b/swg
@@ -7,7 +7,7 @@ use warnings;
 use utf8;
 use Carp q{croak};
 
 use utf8;
 use Carp q{croak};
 

-use version; our $VERSION = qv(1.0.0);
+use version; our $VERSION = qv(1.1.0);

 
 use Encode qw(encode decode);
 binmode STDOUT, q{:encoding(UTF-8)};
 
 use Encode qw(encode decode);
 binmode STDOUT, q{:encoding(UTF-8)};


@@ -94,7 +94,7 @@ use File::Basename;
         $cat = dirname $pth;
         $cat = ($cat eq q{.}) ? q{/} : "$cat/";
         if (-d $fn) {
         $cat = dirname $pth;
         $cat = ($cat eq q{.}) ? q{/} : "$cat/";
         if (-d $fn) {

-            if (not defined $CatFiles{$pth}) {
+            if (not exists $CatFiles{$pth}) {

                 my @files;
                 my @dirs;
                 $CatFiles{$pth} = \@files;
                 my @files;
                 my @dirs;
                 $CatFiles{$pth} = \@files;


@@ -128,16 +128,56 @@ my %Backs;
 for my $pth (keys %Mtimes) {
     my %found;
     my $lines = 0;
 for my $pth (keys %Mtimes) {
     my %found;
     my $lines = 0;

+    my $vlines = 0; # visible lines
+    my sub assureInFound {
+        my ($w) = @_;
+        if (not exists $found{$w}) {
+            my %h;
+            $found{$w} = \%h;
+        }
+        return;
+    }
+    my sub isMissing {
+        my ($w) = @_;
+        if (not exists $Mtimes{$w}) {
+            if (exists $ENV{SWG_PRINT_MISSING}) {
+                print "missing $w\n";
+            }
+            return 1;
+        }
+        return 0;
+    }

     my sub procline;
     sub procline {
         my ($line) = @_;
         if ($line =~ /^.*<<.*\[(.*)\]${CR}/) {
     my sub procline;
     sub procline {
         my ($line) = @_;
         if ($line =~ /^.*<<.*\[(.*)\]${CR}/) {

-            $found{$1} = 1;
+            assureInFound $1;
+            $found{$1}{q{}} = 0;

             open my $fh, q{<:encoding(UTF-8)}, $1 or croak "$!";
             while (<$fh>) { $lines++; procline $_ }
             close $fh or croak "$!";
             return;
         }
             open my $fh, q{<:encoding(UTF-8)}, $1 or croak "$!";
             while (<$fh>) { $lines++; procline $_ }
             close $fh or croak "$!";
             return;
         }

+        if ($line !~ /^\s*[#A]|do-backs.*${CR}$/) {
+            $vlines++;
+        }
+        if ($line =~ /^\s*#.*${CR}$/) {
+            return;
+        }
+        if ($line =~ /^\s*A\s+\[([^[]+)\]${CR}$/) {
+            my $w = $1;
+            return if isMissing $w;
+            assureInFound $w;
+            $found{$w}{q{}} = $vlines;
+            return;
+        }
+        if ($line =~ /^\s*A\s+\[([^[]+)\]\s+(.+)${CR}$/) {
+            my $w = $1;
+            return if isMissing $w;
+            assureInFound $w;
+            $found{$w}{$2} = $vlines;
+            return;
+        }

         foreach my $w (split /\s+/, $line) {
             if ($w =~ /\[([^]]+)\]/) {
                 $w = $1;
         foreach my $w (split /\s+/, $line) {
             if ($w =~ /\[([^]]+)\]/) {
                 $w = $1;


@@ -152,14 +192,10 @@ for my $pth (keys %Mtimes) {
                     next;
                 }
             } else {
                     next;
                 }
             } else {

-                if (not exists $Mtimes{$w}) {
-                    if (exists $ENV{SWG_PRINT_MISSING}) {
-                        print "missing $w\n";
-                    }
-                    next;
-                }
+                next if isMissing $w;

             }
             }

-            $found{$w} = 1;
+            assureInFound $w;
+            $found{$w}{q{}} = 0;

         }
         return;
     }
         }
         return;
     }


@@ -176,7 +212,7 @@ for my $pth (keys %Mtimes) {
             my %h;
             $Backs{$_} = \%h;
         }
             my %h;
             $Backs{$_} = \%h;
         }

-        $Backs{$_}{$pth} = 1;
+        $Backs{$_}{$pth} = $found{$_};

     }
 }
 
     }
 }
 


@@ -250,7 +286,7 @@ sub genHTML {
         }
         $base = dirname $base;
         if ($base eq q{/}) {
         }
         $base = dirname $base;
         if ($base eq q{/}) {

-            $base = ".";
+            $base = q{.};

         }
         foreach (@links) {
             $rel = File::Spec->abs2rel($_, $base);
         }
         foreach (@links) {
             $rel = File::Spec->abs2rel($_, $base);


@@ -327,6 +363,14 @@ END_HTML
             } elsif ($cmd eq q{do-backs}) {
                 $doBacks = 1;
                 return;
             } elsif ($cmd eq q{do-backs}) {
                 $doBacks = 1;
                 return;

+            } elsif ($cmd =~ /^A\s+\[[^[]+\]$/) {
+                return;
+            } elsif ($cmd =~ /^A\s+\[[^[]+\]\s+(.+)$/) {
+                print {$out} "<a id=\"$1\"></a>";
+                return;
+            } elsif ($cmd =~ /^A\s+(.+)$/) {
+                print {$out} "<a id=\"$1\"></a>";
+                return;

             } elsif ($cmd =~ /^#/) {
                 return;
             } elsif ($cmd =~ /^[|]/) {
             } elsif ($cmd =~ /^#/) {
                 return;
             } elsif ($cmd =~ /^[|]/) {


@@ -346,7 +390,10 @@ END_HTML
             $_ = htmlescape $_;
             if (/\[.+\]/) {
                 while (my ($i, $l) = each @links) {
             $_ = htmlescape $_;
             if (/\[.+\]/) {
                 while (my ($i, $l) = each @links) {

-                    s/\[\Q$l\E\]/<a href="$rels[$i].html">[$l]<\/a>/g;
+                    s/\[\Q$l\E\]#(\S+)/<a href="$rels[$i].html#$1">[$l]#$1<\/a>/g;
+                    if (not defined $1) {
+                        s/\[\Q$l\E\]/<a href="$rels[$i].html">[$l]<\/a>/g;
+                    }

                 }
             }
         }
                 }
             }
         }


@@ -363,19 +410,30 @@ END_HTML
         while (<$fh>) { procline $_ }
         close $fh or croak "$!";
     }
         while (<$fh>) { procline $_ }
         close $fh or croak "$!";
     }

-    @links = sort keys %{$Backs{noindex $page}};
-    my $backsWereGenerated = ($doBacks && $#links != -1) ? 1 : 0;
-    if ($backsWereGenerated) {
-        makerels;
-        procline "|<a id=\"backs\"><hr/>${CR}\n";
-        print {$out} "        Backlinks:\n";
-        my $ctr = 0;
-        my $pth;
-        foreach my $l (@links) {
-            $pth = noindex $l;
-            procline sprintf "%3d % -39s %19s %8d\n",
-                $ctr, "[$pth]", ($Mtimes{$l} or q{}), ($Lines{$l} or 0);
-            $ctr++;
+    my $backsWereGenerated = 0;
+    {
+        @links = ();
+        my %backs;
+        if (exists $Backs{noindex $page}) {
+            %backs = %{$Backs{noindex $page}};
+            @links = sort keys %backs;
+        }
+        if ($doBacks && $#links != -1) {
+            my $backsWereGenerated = 1;
+            makerels;
+            procline "|<a id=\"backs\"><hr/>${CR}\n";
+            print {$out} "        Backlinks:\n";
+            my $ctr = 0;
+            my $pth;
+            foreach my $l (@links) {
+                $pth = noindex $l;
+                foreach my $a (sort keys %{$backs{$l}}) {
+                    procline sprintf "%3d % -39s %19s %8d\n",
+                        $ctr, ($a eq q{}) ? "[$pth]" : "[$pth]#$a",
+                        ($Mtimes{$l} or q{}), ($Lines{$l} or 0);
+                    $ctr++;
+                }
+            }

         }
     }
     print {$out} "</pre>\n";
         }
     }
     print {$out} "</pre>\n";


@@ -389,11 +447,33 @@ sub nodename {
     return $n;
 }
 
     return $n;
 }
 

-sub printMenuEntry {
-    print q{* } . (nodename $_) . q{: } . (nodename $_) . ".\n";
+sub printIndexMenuEntry {
+    my ($node, $anchor, $line) = @_;
+    $node = nodename $node;
+    print "* $node#$anchor: $node. (line $line)\n";

     return;
 }
 
     return;
 }
 

+my $InfoIndexCmd = "\0\b[index\0\b]\n* Menu:\n";
+
+sub printInfoBacks {
+    my $page = $_[0];
+    if (not defined $Backs{noindex $page}) {
+        return;
+    }
+    my %backs = %{$Backs{noindex $page}};
+    if (scalar keys %backs > 0) {
+        print "${InfoIndexCmd}Backlinks:\n";
+        foreach my $l (sort keys %backs) {
+            my %as = %{$backs{$l}};
+            foreach my $a (sort keys %as) {
+                printIndexMenuEntry $l, $a, $as{$a} + 2;
+            }
+        }
+        print "\n";
+    }
+}
+

 sub genInfo {
     my $page = shift;
     my %links;
 sub genInfo {
     my $page = shift;
     my %links;


@@ -420,7 +500,7 @@ sub genInfo {
         if (/${CR}$/) {
             chop;
             /^\s*(.*)$/;
         if (/${CR}$/) {
             chop;
             /^\s*(.*)$/;

-            if (($1 =~ /^#/) or ($1 =~ /^do-backs/)) {
+            if ($1 =~ /^[#A]|do-backs/) {

                 next;
             }
         }
                 next;
             }
         }


@@ -428,14 +508,7 @@ sub genInfo {
         print "$_\n";
     }
     close $fh or croak "$!";
         print "$_\n";
     }
     close $fh or croak "$!";

-    my @backs = sort keys %{$Backs{noindex $page}};
-    if ($#backs != -1) {
-        print "\n* Menu:\nBacklinks:\n";
-        foreach (@backs) {
-            printMenuEntry $_;
-        }
-        print "\n";
-    }
+    printInfoBacks $page;

     return;
 }
 
     return;
 }
 


@@ -461,7 +534,7 @@ END_LATEX
             chop;
             /^\s*(.*)$/;
             my $cmd = $1;
             chop;
             /^\s*(.*)$/;
             my $cmd = $1;

-            if (($cmd =~ /^#/) or ($cmd =~ /^do-backs/)) {
+            if ($cmd =~ /^[#A]|do-backs/) {

                 next;
             }
             if ($cmd =~ /^=> (\S+)\s?(.*)$/) {
                 next;
             }
             if ($cmd =~ /^=> (\S+)\s?(.*)$/) {


@@ -504,6 +577,13 @@ END_LATEX
     return;
 }
 
     return;
 }
 

+sub printMenuEntry {
+    my ($node) = @_;
+    $node = nodename $node;
+    print "* $node: $node.\n";
+    return;
+}
+

 sub genInfoIndex {
     my $page = shift;
     my $pth;
 sub genInfoIndex {
     my $page = shift;
     my $pth;


@@ -512,22 +592,17 @@ sub genInfoIndex {
         printMenuEntry $_;
     }
     print "\n";
         printMenuEntry $_;
     }
     print "\n";

-    my @links = sort @{$CatDirs{$page}};
-    if ($#links != -1) {
-        print "\n* Menu:\nSubcategories:\n";
-        foreach (@links) {
-            printMenuEntry $_;
-        }
-        print "\n";
-    }
-    @links = sort keys %{$Backs{noindex $page}};
-    if ($#links != -1) {
-        print "\n* Menu:\nBacklinks:\n";
-        foreach (@links) {
-            printMenuEntry $_;
+    {
+        my @links = sort @{$CatDirs{$page}};
+        if ($#links != -1) {
+            print "\n* Menu:\nSubcategories:\n";
+            foreach (@links) {
+                printMenuEntry $_;
+            }
+            print "\n";

         }
         }

-        print "\n";

     }
     }

+    printInfoBacks $page;

     return;
 }
 
     return;
 }
 


@@ -642,7 +717,7 @@ if ($ARGV[0] eq q{files}) {
         genInfo $page;
     }
     print "${sep}File: self, Node: index, Up: Top\n\n";
         genInfo $page;
     }
     print "${sep}File: self, Node: index, Up: Top\n\n";

-    print "\0\b[index\0\b]\n* Menu:\n";
+    print $InfoIndexCmd;

     foreach my $cat (keys %CatFiles) {
         print q{* } . (nodename $cat) . q{: } .
             (nodename $cat) . ". (line 0)\n";
     foreach my $cat (keys %CatFiles) {
         print q{* } . (nodename $cat) . q{: } .
             (nodename $cat) . ". (line 0)\n";


@@ -677,7 +752,7 @@ END_LATEX
         delete $Mtimes{q{index}};
         delete $CatFiles{q{/}};
     } else {
         delete $Mtimes{q{index}};
         delete $CatFiles{q{/}};
     } else {

-        genLaTeXSection "/", genIndex2Buf q{/};
+        genLaTeXSection q{/}, genIndex2Buf q{/};

         delete $CatFiles{q{/}};
     }
     foreach my $cat (keys %CatFiles) {
         delete $CatFiles{q{/}};
     }
     foreach my $cat (keys %CatFiles) {