make_emacs_changelog 3.3 KB

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