mk/make_emacs_changelog

   1 #!/usr/bin/perl
   2
   3 $commitrange = shift @ARGV;
   4 if (!$commitrange) {
   5   print STDERR "Enter commitrange: ";
   6   $commitrange = <>;
   7   $commitrange =~ s/\s*(.*?)\s+/$1/;
   8 }
   9
  10 $syncdate = shift @ARGV;
  11 if (!$syncdate) {
  12   print STDERR "Enter syncdate YYYY-MM-DD: ";
  13   $syncdate = <>;
  14   $syncdate =~ s/\s*(.*?)\s+/$1/;
  15 }
  16
  17 $kind = shift @ARGV;
  18 if (!$kind) {
  19   print STDERR 'Enter kind ("lisp" or "texi" or "card" or press RET): ';
  20   $kind = <>;
  21   $kind =~ s/\s*(.*?)\s+/$1/;
  22   $kind =~ s/"(.*?)"/$1/;
  23 }
  24
  25 if ($kind ne "lisp" and $kind ne "texi" and  $kind ne "card"
  26     and $kind ne "") {
  27   die "Invalid Changelog kind";
  28 }
  29
  30 # commit must touch these paths or files to be considered
  31 $fpath = "lisp/ doc/";
  32
  33 # Run git log to get the commits the messages
  34 open IN,"git log --no-merges --format='%aN%n<%aE>%n%b%x0c' $commitrange -- $fpath|";
  35 undef $/;
  36 $log = <IN>;
  37 @commits = split(/\f/,$log);
  38
  39 my %entries;
  40
  41 foreach my $commit (@commits) {
  42   $name    = ( $commit=~ s/([^\n]+)\n//m ) ? $1 : "N/A";
  43   $address = ( $commit=~ s/([^\n]+)\n//m ) ? $1 : "N/A";
  44   $tiny    = $commit =~ s/TINYCHANGE//mg ? "  (tiny change)" : "";
  45   $entry   = $commit;
  46
  47   if ($entry) {
  48
  49     # remove whitespace at beginning of line
  50     $entry =~ s/^[ \t]*//mg;
  51
  52     # add linebreaks before each starred line except the very first
  53     $entry =~ s/\A[\n\t]*/@/mg;
  54     $entry =~ s/^\*/\n\n*/mg;
  55     $entry =~ s/\A@//mg;
  56
  57     # normalize starred lines
  58     $entry =~ s/^(\*[^(]*\S)\(/\1 (/mg;
  59
  60     # remove blocks of more than one empty line
  61     $entry =~s/\n{3,}/\n\n/mg;
  62
  63     # Fix the path when directories have been omitted
  64     $entry =~ s/^\* ([-a-zA-Z]+\.el)/* lisp\/$1/mg;
  65     $entry =~ s/^\* (org[a-z]*\.texi?)/* doc\/$1/mg;
  66
  67     # remove stuff which is not for this output
  68     if ($kind =~ /\S/) {
  69       # do not delete or rename directories from the list as long as
  70       # Changelog entries referring to them exist!
  71       remove_parts(qw( contrib/ testing/ xemacs/ mk/ etc/ ));
  72       remove_parts(qw( .*Makefile README .+\.mk ));
  73     }
  74     if ($kind eq "lisp") { remove_parts("doc/")                               }
  75     if ($kind eq "texi") { remove_parts("lisp/","doc/orgcard","doc/orgguide") }
  76     if ($kind eq "card") { remove_parts("lisp/","doc/org\\.","doc/orgguide")  }
  77
  78     # remove/replace parts of the path
  79     $entry =~ s:^\* lisp/:* :mg;
  80     $entry =~ s:^\* doc/orgcard:* refcards/orgcard:mg;
  81     $entry =~ s:^\* doc/:* misc/:mg;
  82
  83     # remove empty space at beginning and end
  84     $entry =~ s/\A\s*//;
  85     $entry =~ s/\s*\Z//;
  86
  87     # remove everything that is not a starred entry
  88     my @entries = grep( /^\*/, split( /\n\n/, $entry ));
  89
  90     # If there is anything left in the entry, print it
  91     if (scalar @entries) {
  92         push @{ $entries{"$syncdate  $name  $address$tiny"} }, @entries;
  93     }
  94   }
  95 }
  96 foreach my $key ( sort keys %entries ) {
  97   next if (! exists $entries{"$key"} );
  98   print "$key\n";
  99   if ( exists $entries{"$key  (tiny change)"} ) {
 100     push @{ $entries{"$key"} }, @{ $entries{"$key  (tiny change)"} };
 101     delete $entries{"$key  (tiny change)"};
 102   }
 103   my @entries = @{ $entries{"$key"} };
 104   foreach my $entry ( @entries ) {
 105     # indent each line by exactly one TAB
 106     $entry =~ s/^/\t/mg;
 107     print "\n$entry\n";
 108   }
 109   print "\n\n";
 110 }
 111
 112 sub remove_parts {
 113   foreach $path (@_) {
 114     $re = "^[ \t]*\\*\\s+" . $path . "[^\\000]*?(?=^[ \\t]*\\*|\\Z)";
 115     $entry =~ s/$re/\n$1/mg;
 116   }
 117 }