git-debrebase: make-patched: Provide --quiet-would-amend

[dgit.git] / git-debrebase

diff --git a/git-debrebase b/git-debrebase
index 9a356df399f574da0c79bcb338e066f2b6708c61..e5cafd1c4850a7192fe21e06851931963eb12b26 100755 (executable)
--- a/git-debrebase
+++ b/git-debrebase
@@ -538,8 +538,8 @@ sub classify ($) {
     return $unknown->("complex merge");
 }
 
-sub keycommits ($;$$$) {
-    my ($head, $furniture, $unclean, $trouble) = @_;
+sub keycommits ($;$$$$) {
+    my ($head, $furniture, $unclean, $trouble, $fatal) = @_;
     # => ($anchor, $breakwater)
 
     # $unclean->("unclean-$tagsfx", $msg, $cl)
@@ -552,6 +552,8 @@ sub keycommits ($;$$$) {
     # $trouble is for things whnich prevent the return of
     #   anchor and breakwater information; if that is ignored,
     #   then keycommits returns (undef, undef) instead.
+    # $fatal is for unprocessable commits, and should normally cause
+    #    a failure.  If ignored, agaion, (undef, undef) is returned.
     #
     # If a callback is undef, fail is called instead.
     # If a callback is defined but false, the situation is ignored.
@@ -562,6 +564,7 @@ sub keycommits ($;$$$) {
     my ($anchor, $breakwater);
     my $clogonly;
     my $cl;
+    $fatal //= sub { fail $_[2]; };
     my $x = sub {
        my ($cb, $tagsfx, $why) = @_;
        my $m = "branch needs laundering (run git-debrebase): $why";
@@ -606,7 +609,10 @@ sub keycommits ($;$$$) {
                 "found dgit dsc import ($head)");
            return (undef,undef);
        } else {
-           fail "found unprocessable commit, cannot cope: $head; $cl->{Why}";
+           $x->($fatal, 'unprocessable',
+                "found unprocessable commit, cannot cope: $head; $cl->{Why}"
+               );
+           return (undef,undef);
        }
        $head = $cl->{Parents}[0]{CommitId};
     }
@@ -1363,6 +1369,83 @@ sub cmd_breakwater () {
     print "$bw\n" or die $!;
 }
 
+sub cmd_status () {
+    badusage "no arguments allowed" if @ARGV;
+
+    my $oldest = [ 0 ];
+    my $newest;
+    my $note = sub {
+       my ($badness, $ourmsg, $snagname, $kcmsg, $cl) = @_;
+       if ($oldest->[0] < $badness) {
+           $oldest = $newest = undef;
+       }
+       $oldest = \@_; # we're walking backwards
+       $newest //= \@_;
+    };
+    my ($anchor, $bw) = keycommits +(git_rev_parse 'HEAD'),
+       sub { $note->(1, 'branch contains furniture (not laundered)', @_); },
+       sub { $note->(2, 'branch is unlaundered', @_); },
+       sub { $note->(3, 'branch needs laundering', @_); },
+       sub { $note->(4, 'branch not in git-debrebase form', @_); };
+
+    my $prcommitinfo = sub {
+       my ($cid) = @_;
+       flush STDOUT or die $!;
+       runcmd @git, qw(--no-pager log -n1),
+           '--pretty=format:    %h %s%n',
+           $cid;
+    };
+
+    print "current branch contents, in git-debrebase terms:\n";
+    if (!$oldest->[0]) {
+       print "  branch is laundered\n";
+    } else {
+       print "  $oldest->[1]\n";
+       my $printed = '';
+       foreach my $info ($oldest, $newest) {
+           my $cid = $info->[4]{CommitId};
+           next if $cid eq $printed;
+           $printed = $cid;
+           print "  $info->[3]\n";
+           $prcommitinfo->($cid);
+       }
+    }
+
+    my $prab = sub {
+       my ($cid, $what) = @_;
+       if (!defined $cid) {
+           print "  $what is not well-defined\n";
+       } else {
+           print "  $what\n";
+           $prcommitinfo->($cid);
+       }
+    };
+    print "key git-debrebase commits:\n";
+    $prab->($anchor, 'anchor');
+    $prab->($bw, 'breakwater');
+
+    my ($ffqstatus, $ffq_msg, $current, $ffq_prev, $gdrlast) =
+       ffq_prev_branchinfo();
+
+    print "branch and ref status, in git-debrebase terms:\n";
+    if ($ffq_msg) {
+       print "  $ffq_msg\n";
+    } else {
+       $ffq_prev = git_get_ref $ffq_prev;
+       $gdrlast = git_get_ref $gdrlast;
+       if ($ffq_prev) {
+           print "  unstitched; previous tip was:\n";
+           $prcommitinfo->($ffq_prev);
+       } elsif (!$gdrlast) {
+           print "  stitched? (no record of git-debrebase work)\n";
+       } elsif (is_fast_fwd $gdrlast, 'HEAD') {
+           print "  stitched\n";
+       } else {
+           print "  not git-debrebase (diverged since last stitch)\n"
+       }
+    }
+}
+
 sub cmd_stitch () {
     my $prose = 'stitch';
     GetOptions('prose=s', \$prose) or die badusage("bad options to stitch");
@@ -1418,28 +1501,31 @@ sub make_patches ($) {
             '[git-debrebase: export and commit patches]',
         ];
     };
-    my $d = get_differs $head, $out;
-    if ($d == 0) {
-       return undef; # nothing to do
-    } elsif ($d == D_PAT_ADD) {
-       return $out; # OK
-    } else {
-       fail "Patch export produced patch amendments".
-           " (abandoned output commit $out).".
-           "  Try laundering first.";
-    }
+    return $out;
 }
 
 sub cmd_make_patches () {
+    my $opt_quiet_would_amend;
+    GetOptions('quiet-would-amend!', \$opt_quiet_would_amend)
+       or die badusage("bad options to make-patches");
     badusage "no arguments allowed" if @ARGV;
     my $old_head = get_head();
     my $new = make_patches $old_head;
-    snags_maybe_bail();
-    if (!$new) {
+    my $d = get_differs $old_head, $new;
+    if ($d == 0) {
        fail "No (more) patches to export." unless $opt_noop_ok;
        return;
+    } elsif ($d == D_PAT_ADD) {
+       snags_maybe_bail();
+       update_head_checkout $old_head, $new, 'make-patches';
+    } else {
+       print STDERR failmsg
+           "Patch export produced patch amendments".
+           " (abandoned output commit $new).".
+           "  Try laundering first."
+           unless $opt_quiet_would_amend;
+       finish 7;
     }
-    update_head_checkout $old_head, $new, 'make-patches';
 }
 
 sub cmd_convert_from_gbp () {