From 2cac79fdf3335a4ca4bfd936a9a8b33deab1bd5c Mon Sep 17 00:00:00 2001 From: Sergey Matveev Date: Tue, 8 Jul 2025 10:27:13 +0300 Subject: [PATCH] Anchors support --- FORMAT | 17 +++++- swg | 183 ++++++++++++++++++++++++++++++++++++++++----------------- 2 files changed, 144 insertions(+), 56 deletions(-) diff --git a/FORMAT b/FORMAT index 28954aa..d381fe1 100644 --- 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 
 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
@@ -8,15 +9,27 @@ role only (currently) during HTML generation.
 
 * => URL[ optional text]
   Creates {optional text|URL} link in HTML.
+
 * img URL[ optional text][ => URL-A]
   Creates  in HTML.
   If "=> URL" is specified, then .
+
 * |...
   Just inserts raw ... line to HTML output as-is.
+
 * #...
   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.
+
+* 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 b1ff10e..fdb9aff 100755
--- a/swg
+++ b/swg
@@ -7,7 +7,7 @@ use warnings;
 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)};
@@ -94,7 +94,7 @@ use File::Basename;
         $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;
@@ -128,16 +128,56 @@ my %Backs;
 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}/) {
-            $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;
         }
+        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;
@@ -152,14 +192,10 @@ for my $pth (keys %Mtimes) {
                     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;
     }
@@ -176,7 +212,7 @@ for my $pth (keys %Mtimes) {
             my %h;
             $Backs{$_} = \%h;
         }
-        $Backs{$_}{$pth} = 1;
+        $Backs{$_}{$pth} = $found{$_};
     }
 }
 
@@ -250,7 +286,7 @@ sub genHTML {
         }
         $base = dirname $base;
         if ($base eq q{/}) {
-            $base = ".";
+            $base = q{.};
         }
         foreach (@links) {
             $rel = File::Spec->abs2rel($_, $base);
@@ -327,6 +363,14 @@ END_HTML
             } elsif ($cmd eq q{do-backs}) {
                 $doBacks = 1;
                 return;
+            } elsif ($cmd =~ /^A\s+\[[^[]+\]$/) {
+                return;
+            } elsif ($cmd =~ /^A\s+\[[^[]+\]\s+(.+)$/) {
+                print {$out} "";
+                return;
+            } elsif ($cmd =~ /^A\s+(.+)$/) {
+                print {$out} "";
+                return;
             } elsif ($cmd =~ /^#/) {
                 return;
             } elsif ($cmd =~ /^[|]/) {
@@ -346,7 +390,10 @@ END_HTML
             $_ = htmlescape $_;
             if (/\[.+\]/) {
                 while (my ($i, $l) = each @links) {
-                    s/\[\Q$l\E\]/[$l]<\/a>/g;
+                    s/\[\Q$l\E\]#(\S+)/[$l]#$1<\/a>/g;
+                    if (not defined $1) {
+                        s/\[\Q$l\E\]/[$l]<\/a>/g;
+                    }
                 }
             }
         }
@@ -363,19 +410,30 @@ END_HTML
         while (<$fh>) { procline $_ }
         close $fh or croak "$!";
     }
-    @links = sort keys %{$Backs{noindex $page}};
-    my $backsWereGenerated = ($doBacks && $#links != -1) ? 1 : 0;
-    if ($backsWereGenerated) {
-        makerels;
-        procline "|
${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 "|
${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} "
\n"; @@ -389,11 +447,33 @@ sub nodename { 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; } +my $InfoIndexCmd = "[index]\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; @@ -420,7 +500,7 @@ sub genInfo { if (/${CR}$/) { chop; /^\s*(.*)$/; - if (($1 =~ /^#/) or ($1 =~ /^do-backs/)) { + if ($1 =~ /^[#A]|do-backs/) { next; } } @@ -428,14 +508,7 @@ sub genInfo { 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; } @@ -461,7 +534,7 @@ END_LATEX chop; /^\s*(.*)$/; my $cmd = $1; - if (($cmd =~ /^#/) or ($cmd =~ /^do-backs/)) { + if ($cmd =~ /^[#A]|do-backs/) { next; } if ($cmd =~ /^=> (\S+)\s?(.*)$/) { @@ -504,6 +577,13 @@ END_LATEX return; } +sub printMenuEntry { + my ($node) = @_; + $node = nodename $node; + print "* $node: $node.\n"; + return; +} + sub genInfoIndex { my $page = shift; my $pth; @@ -512,22 +592,17 @@ sub genInfoIndex { 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; } @@ -642,7 +717,7 @@ if ($ARGV[0] eq q{files}) { genInfo $page; } print "${sep}File: self, Node: index, Up: Top\n\n"; - print "[index]\n* Menu:\n"; + print $InfoIndexCmd; 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 { - genLaTeXSection "/", genIndex2Buf q{/}; + genLaTeXSection q{/}, genIndex2Buf q{/}; delete $CatFiles{q{/}}; } foreach my $cat (keys %CatFiles) { -- 2.50.0