|
@@ -54,6 +54,7 @@ my $dograph = sub {
|
|
|
#
|
|
|
# "commit" is optional if the commit name starts with uppercase or digit
|
|
|
# keywords can be abbreviated:
|
|
|
+# align -> a
|
|
|
# branch -> b
|
|
|
# commit -> c
|
|
|
# edge -> e
|
|
@@ -63,6 +64,7 @@ my $dograph = sub {
|
|
|
# remote -> r
|
|
|
# symref -> s
|
|
|
# tag -> t
|
|
|
+# up -> u
|
|
|
#
|
|
|
# empty definition part (e.g. ;;) splits into a new cluster which adds extra
|
|
|
# padding
|
|
@@ -78,6 +80,7 @@ my $gitgraph = sub {
|
|
|
my %edges;
|
|
|
my @clusters = ([]);
|
|
|
my @align;
|
|
|
+ my @force_up;
|
|
|
|
|
|
my $getident = sub {
|
|
|
return $1 if $_[0] =~ s{^\s*([\w/.-]+['?]?)\s*}{};
|
|
@@ -125,6 +128,8 @@ my $gitgraph = sub {
|
|
|
};
|
|
|
if ($id =~ /^(.+)'$/ && $nodes{$1}) {
|
|
|
$node->{orig} = $1;
|
|
|
+ } elsif ($id =~ /^(.+)'$/ && $nodes{"$1?"}) {
|
|
|
+ $node->{orig} = "$1?";
|
|
|
}
|
|
|
push @{$clusters[$cluster]}, $node;
|
|
|
}
|
|
@@ -265,7 +270,7 @@ my $gitgraph = sub {
|
|
|
$tmp_d = $d;
|
|
|
}
|
|
|
return $fail->("'align' needs at least two identifiers: ". $mark->($bkup, $d)) if @args < 2;
|
|
|
- @align = @args;
|
|
|
+ push @align, \@args;
|
|
|
} elsif ($cmd =~ /^c(ommit)?$/) {
|
|
|
my $prev;
|
|
|
while (my $commit = $parse_commit->($d, $bkup)) {
|
|
@@ -310,6 +315,18 @@ my $gitgraph = sub {
|
|
|
return $fail->("target for symref is not a known node: ". $mark->($bkup, $tmp_d));
|
|
|
}
|
|
|
$symref_node->($arg, $ref);
|
|
|
+ } elsif ($cmd =~ /^u(p)?$/) {
|
|
|
+ my $tmp_d = $d;
|
|
|
+ my $arg1 = $getident->($d) or return $fail->("missing base node for 'up': ". $mark->($bkup, $d));
|
|
|
+ return $fail->("unknown base node for 'up': ". $mark->($bkup, $tmp_d)) unless $nodes{$arg1};
|
|
|
+ my @args;
|
|
|
+ while (my $arg = $getident->($d)) {
|
|
|
+ return $fail->("unknown identifier for 'up': ". $mark->($bkup, $tmp_d)) unless $nodes{$arg};
|
|
|
+ push @args, $arg;
|
|
|
+ $tmp_d = $d;
|
|
|
+ }
|
|
|
+ return $fail->("'up' needs at least one node to move up: ". $mark->($bkup, $d)) if @args < 1;
|
|
|
+ push @force_up, [$arg1, @args];
|
|
|
} else {
|
|
|
return $fail->("unrecognizable definition line: $bkup");
|
|
|
}
|
|
@@ -399,8 +416,13 @@ EOT
|
|
|
$cur_cluster++;
|
|
|
}
|
|
|
# Force alignment of nodes to same rank
|
|
|
- if (@align > 1) {
|
|
|
- $out .= '{ rank=same; '. join('; ', map { qq["$_"] } @align) . '; }';
|
|
|
+ for my $align (@align) {
|
|
|
+ $out .= '{ rank=same; '. join('; ', map { qq["$_"] } @$align) . '; }';
|
|
|
+ }
|
|
|
+ # Force ranking above a base node
|
|
|
+ for my $up (@force_up) {
|
|
|
+ my $arg1 = shift @$up;
|
|
|
+ $out .= join('', map { qq{"$_" -> "$arg1" [style=invis]; } } @$up);
|
|
|
}
|
|
|
|
|
|
$dograph->('digraph', $out);
|