Add UWC script to help maintaining What's Cooking messages

diff --git a/UWC b/UWC
new file mode 100755 (executable)
index 0000000..1659715
--- /dev/null
+++ b/UWC
@@ -0,0 +1,219 @@
+#!/usr/bin/perl -w
+#
+# Update an older edition of What's Cooking with the latest data.
+#
+# Usage: UWC [ old [ new ] ]
+#
+# Giving no parameter is the same as giving a single "-" to the command.
+#
+# The command reads the old edition of (annotated) "What's Cooking"
+# message from "old", and "new".  If "old" is "-", it is read from
+# the standard input.  If "new" is not specified, WC script is run
+# and its output is used.
+#
+# An annotated "What's Cooking" message can have group header (a line
+# that has the group name enclosed in "[" and "]"), and annotatation
+# paragraphs after each topic's commit list, in addition to the bare
+# "WC" output.
+#
+# The group headers, topics in each group and their order in the group,
+# and annotation to topics are preserved from the "old" message.  The
+# list of commits in each topic is replaced with the one taken from the
+# "new" message.  Any topic in "new" that did not exist in "old" appear
+# in "New Topics" group.  Also, topics that do not appear in the "new"
+# message are marked with <<deleted>>, topics whose commit list are
+# different from "old" are marked with <<updated from...>>>.
+#
+# Typically the maintainer would place the What's Cooking message
+# previously sent in a buffer in Emacs, and filter the buffer contents
+# with this script, to prepare an up-to-date message.
+
+sub parse_whats_cooking {
+       my ($fh) = @_;
+       my $head = undef;
+       my $group = undef;
+       my %wc = ("group list" => [], "topic hash" => {});
+       my $topic;
+       my $skipping_comment = 0;
+
+       while (<$fh>) {
+               if (/^-{40,}$/) {
+                       # Group separator
+                       next;
+               }
+
+               if (!defined $head) {
+                       if (/^Here are the topics that have been cooking\./) {
+                               $head = $_;
+                       }
+                       next;
+               }
+
+               if (/^<<.*>>$/) {
+                       next;
+               }
+
+               if ($skipping_comment) {
+                       if (/^>>$/) {
+                               $skipping_comment = 0;
+                       }
+                       next;
+               }
+
+               if (!$skipping_comment && /^<</) {
+                       $skipping_comment = 1;
+                       next;
+               }
+
+               if (/^\[(.*)\]$/) {
+                       $group = $1;
+                       push @{$wc{"group list"}}, $group;
+                       $wc{" $group"} = [];
+                       $topic = undef;
+                       next;
+               }
+
+               if (!defined $group) {
+                       if (/^\* (\S+) (\(.*\) \d+ commits?)$/) {
+                               # raw output
+                               $group = "Misc";
+                               push @{$wc{"group list"}}, $group;
+                               $wc{" $group"} = [];
+                       } else {
+                               $head .= $_;
+                               next;
+                       }
+               }
+
+               if (/^\* (\S+) (\(.*\) \d+ commits?)$/) {
+                       $topic = +{
+                               topic => $1,
+                               head => $_,
+                               names => "",
+                               text => "",
+                       };
+                       $wc{"topic hash"}{$topic->{"topic"}} = $topic;
+                       push @{$wc{" $group"}}, $topic;
+                       next;
+               }
+
+               if (/^ [-+.?] / || /^   \S/) {
+                       $topic->{"names"} .= $_;
+                       next;
+               }
+               $topic->{"text"} .= $_;
+       }
+
+       for ($head) {
+               s/\A\s+//s;
+               s/\s+\Z//s;
+       }
+       $wc{"head text"} = $head;
+       for $topic (values %{$wc{"topic hash"}}) {
+               for ($topic->{"text"}) {
+                       s/\A\s+//s;
+                       s/\s+\Z//s;
+               }
+       }
+       return \%wc;
+}
+
+sub print_whats_cooking {
+       my ($wc) = @_;
+
+       print $wc->{"head text"}, "\n";
+
+       for my $group (@{$wc->{"group list"}}) {
+               print "\n", "-" x 64, "\n";
+               print "[$group]\n";
+               for my $topic (@{$wc->{" $group"}}) {
+                       print "\n", $topic->{"head"};
+                       print $topic->{"names"};
+                       if ($topic->{"text"} ne '') {
+                               print "\n", $topic->{"text"}, "\n";
+                       }
+               }
+       }
+}
+
+sub delete_topic {
+       my ($wc, $topic) = @_;
+       $topic->{"status"} = "deleted";
+}
+
+sub merge_whats_cooking {
+       my ($old_wc, $new_wc) = @_;
+       my $group;
+
+       for $group (@{$old_wc->{"group list"}}) {
+               for my $topic (@{$old_wc->{" $group"}}) {
+                       my $name = $topic->{"topic"};
+                       my $newtopic = delete $new_wc->{"topic hash"}{$name};
+
+                       if (!defined $newtopic) {
+                               $topic->{"names"} = "";
+                               $topic->{"text"} = "<<deleted>>";
+                               next;
+                       }
+                       if (($newtopic->{"names"} ne $topic->{"names"}) ||
+                           ($newtopic->{"head"} ne $topic->{"head"})) {
+                               my $text = ("<<updated from\n" .
+                                           $topic->{"head"} .
+                                           $topic->{"names"} . ">>");
+
+                               if ($topic->{"text"} ne '') {
+                                       $text .= "\n\n" . $topic->{"text"};
+                               }
+                               for ($text) {
+                                       s/\A\s+//s;
+                                       s/\s+\Z//s;
+                               }
+                               $topic->{"text"} = $text;
+                               $topic->{"names"} = $newtopic->{"names"};
+                               $topic->{"head"} = $newtopic->{"head"};
+                       }
+               }
+       }
+
+       if (%{$new_wc->{"topic hash"}}) {
+               $group = "New Topics";
+               if (!exists $old_wc->{" $group"}) {
+                       unshift @{$old_wc->{"group list"}}, $group;
+                       $old_wc->{" $group"} = [];
+               }
+               for my $topic (values %{$new_wc->{"topic hash"}}) {
+                       my $name = $topic->{"topic"};
+                       $old_wc->{"topic hash"}{$name} = $topic;
+                       push @{$old_wc->{" $group"}}, $topic;
+                       $topic->{"text"} = $topic->{"text"};
+               }
+       }
+}
+
+if (@ARGV == 0) {
+       @ARGV = ('-');
+}
+if (@ARGV != 2 && @ARGV != 1) {
+       die "Usage: $0 old [new]\n";
+}
+
+my ($old_wc, $new_wc);
+
+if ($ARGV[0] eq '-') {
+       *FH = *STDIN;
+} else {
+       open FH, "$ARGV[0]";
+}
+$old_wc = parse_whats_cooking(\*FH);
+close FH;
+
+if (@ARGV > 1) {
+       open FH, "$ARGV[1]";
+} else {
+       open FH, "Meta/WC |";
+}
+$new_wc = parse_whats_cooking(\*FH);
+close FH;
+
+merge_whats_cooking($old_wc, $new_wc);
+print_whats_cooking($old_wc);

diff --git a/WC b/WC
index 5391f7b1ac8abfb8cfeef78264bb8ea629dd896b..ba5825a06f6b4f0a663a9a8813aa1a7dbfbd0c36 100755 (executable)
--- a/WC
+++ b/WC
@@ -17,4 +17,4 @@ order.
 
 EOF
 
-Meta/git-topic.perl --base=master | sed -e 's/^\*./*/'
+Meta/git-topic.perl --base=master | sed -e 's/^\*./\n*/'