org-mode/mk/make_emacs_changelog

#!/usr/bin/perl

$commitrange = shift @ARGV;
if (!$commitrange) {
  print STDERR "Enter commitrange: ";
  $commitrange = <>;
  $commitrange =~ s/\s*(.*?)\s+/$1/;
}

$syncdate = shift @ARGV;
if (!$syncdate) {
  print STDERR "Enter syncdate YYYY-MM-DD: ";
  $syncdate = <>;
  $syncdate =~ s/\s*(.*?)\s+/$1/;
}

$kind = shift @ARGV;
if (!$kind) {
  print STDERR 'Enter kind ("lisp" or "texi" or "card" or press RET): ';
  $kind = <>;
  $kind =~ s/\s*(.*?)\s+/$1/;
  $kind =~ s/"(.*?)"/$1/;
}

if ($kind ne "lisp" and $kind ne "texi" and  $kind ne "card"
    and $kind ne "") {
  die "Invalid Changelog kind";
}

# commit must touch these paths or files to be considered
$fpath = "lisp/ doc/";

# Run git log to get the commits the messages
open IN,"git log --no-merges --format='%aN%n<%aE>%n%b%x0c' $commitrange -- $fpath|";
undef $/;
$log = <IN>;
@commits = split(/\f/,$log);

my %entries;

foreach my $commit (@commits) {
  $name    = ( $commit=~ s/([^\n]+)\n//m ) ? $1 : "N/A";
  $address = ( $commit=~ s/([^\n]+)\n//m ) ? $1 : "N/A";
  $tiny    = $commit =~ s/TINYCHANGE//mg ? "  (tiny change)" : "";
  $entry   = $commit;

  if ($entry) {

    # remove whitespace at beginning of line
    $entry =~ s/^[ \t]*//mg;

    # add linebreaks before each starred line except the very first
    $entry =~ s/\A[\n\t]*/@/mg;
    $entry =~ s/^\*/\n\n*/mg;
    $entry =~ s/\A@//mg;

    # normalize starred lines
    $entry =~ s/^(\*[^(]*\S)\(/\1 (/mg;

    # remove blocks of more than one empty line
    $entry =~s/\n{3,}/\n\n/mg;

    # Fix the path when directories have been omitted
    $entry =~ s/^\* ([-a-zA-Z]+\.el)/* lisp\/$1/mg;
    $entry =~ s/^\* (org[a-z]*\.texi?)/* doc\/$1/mg;
    
    # remove stuff which is not for this output
    if ($kind =~ /\S/) { 
      # do not delete or rename directories from the list as long as
      # Changelog entries referring to them exist!
      remove_parts(qw( contrib/ testing/ xemacs/ mk/ etc/ ));
      remove_parts(qw( .*Makefile README .+\.mk ));
    }
    if ($kind eq "lisp") { remove_parts("doc/")                               }
    if ($kind eq "texi") { remove_parts("lisp/","doc/orgcard","doc/orgguide") }
    if ($kind eq "card") { remove_parts("lisp/","doc/org\\.","doc/orgguide")  }

    # remove/replace parts of the path
    $entry =~ s:^\* lisp/:* :mg;
    $entry =~ s:^\* doc/orgcard:* refcards/orgcard:mg;
    $entry =~ s:^\* doc/:* misc/:mg;

    # remove empty space at beginning and end
    $entry =~ s/\A\s*//;
    $entry =~ s/\s*\Z//;

    # remove everything that is not a starred entry
    my @entries = grep( /^\*/, split( /\n\n/, $entry ));

    # If there is anything left in the entry, print it
    if (scalar @entries) {
	push @{ $entries{"$syncdate  $name  $address$tiny"} }, @entries;
    }
  }
}
foreach my $key ( sort keys %entries ) {
  next if (! exists $entries{"$key"} );
  print "$key\n";
  if ( exists $entries{"$key  (tiny change)"} ) {
    push @{ $entries{"$key"} }, @{ $entries{"$key  (tiny change)"} };
    delete $entries{"$key  (tiny change)"};
  }
  my @entries = @{ $entries{"$key"} };
  foreach my $entry ( @entries ) {  
    # indent each line by exactly one TAB
    $entry =~ s/^/\t/mg;
    print "\n$entry\n";
  }
  print "\n\n";
}
 
sub remove_parts {
  foreach $path (@_) {
    $re = "^[ \t]*\\*\\s+" . $path . "[^\\000]*?(?=^[ \\t]*\\*|\\Z)";
    $entry =~ s/$re/\n$1/mg;
  }
}