#!/mit/watchmaker/vaxbin/perl -i~
        eval "exec /mit/watchmaker/vaxbin/perl -S $0 $*"
                if $running_under_some_shell;

# $Header: patcil.SH,v 2.0.1.2 88/08/05 00:51:51 lwall Exp $
#
# $Log:	patcil.SH,v $
# Revision 2.0.1.2  88/08/05  00:51:51  lwall
# patch1: created
# 
# Revision 2.0.1.1  88/08/05  00:29:17  lwall
# patch1: now depends on perlpath
# 
# Revision 2.0  88/06/29  00:21:39  lwall
# Baseline.
# 
# 

$defeditor = '/usr/athena/emacs';
die "patcil [files]\n" unless $#ARGV >= 0;

$RCSEXT = ',v' unless $RCSEXT;

system 'mkdir', 'RCS' unless -d 'RCS';

chop($pwd = `pwd`) unless -f '.package';
until (-f '.package') {
    die "No .package file!  Run packinit.\n" unless $pwd;
    chdir '..' || die "Can't cd ..";
    $pwd =~ s|(.*)/(.*)|$1|;
    $prefix = $2 . '/' . $prefix;
}
if ($prefix) {
    for (@ARGV) {
	s/^/$prefix/ unless m|^[-/]|;
    }
}
do readpackage();

if (-f 'patchlevel.h') {
    open(PL,"patchlevel.h") || die "Can't open patchlevel.h\n";
    while (<PL>) {
        $bnum = $1 if /^#define\s+PATCHLEVEL\s+(\d+)/;
    }
    die "Malformed patchlevel.h file.\n" if $bnum eq '';
    ++$bnum;
}
else {
    $bnum=1;
}

open(LOGS,">>bugs/.logs$bnum");		# remember logs for patmake

while ($ARGV[0] =~ /^-/) {
    $_ = shift;
    last if /--/;
    if ($_ eq '-p') {
	$patching++;
    }
    elsif ($_ eq '-q') {
	push(@sw,$_);
    }
    elsif ($_ eq '-f') {
	push(@sw,$_);
    }
    elsif ($_ eq '-b') {
	$batch++;
    }
    elsif ($_ eq '-a') {
	$all++;
    }
    elsif ($_ eq '-s') {
	$strip++;
    }
    else {
	die "Unrecognized switch: $_\n";
    }
}

if ($all) {
    open(MANI,"MANIFEST.new") || die "No MANIFEST.new found.\n";
    @ARGV = ();
    while (<MANI>) {
        chop;
	($_) = split(' ');
        push(@ARGV,$_);
    }
    close MANI;
}

@filelist = @ARGV;

sub CLEANUP {
    print "Warning: restore $ARGV\n";
    exit 1;
}

if ($strip) {
    open(TTY,">/dev/tty");
    select(TTY);
    $| = 1;
    select(stdout);
    $SIG{'INT'} = 'CLEANUP';
    while (<>) {
	if (/^(.*)\$Log[:\$]/) {
	    $comment = $1;
	    $len = length($comment);
	    print;
	    $lastnl = 1;
	    logline: while (<>) {
		$c = substr($_,0,$len);
		last logline unless $c eq $comment;
		$_ = substr($_,$len,999);
		if ($lastnl) {
		    unless (/^Revision\s+\d/) {
			$_ = $comment . $_;
			last logline;
		    }
		    $lastnl = 0;
		}
		else {
		    if ($_ eq "\n") {
			$lastnl = 1;
		    }
		}
	    }
	}
    }
    continue {
	print;
	if ($ARGV ne $oldargv) {
	    print TTY "Stripping $ARGV...\n";
	    $oldargv = $ARGV;
	}
    }
    $SIG{'INT'} = 'DEFAULT';
    close TTY;
}

if ($batch) {
    $flist=do rcsargs(@filelist);
    @flist=split(' ',$flist);
    system 'rcs', '-u', @flist;
    system 'rcs', "-l$revbranch", @flist;
    system 'ci', '-l', "-r$revbranch", @sw, @flist;
    exit 0;
}

open(MANI,"MANIFEST.new") || die "Can't open MANIFEST.new.\n";
while (<MANI>) {
    ($file) = split(' ');
    $inmani{$file} = 1;
}
close MANI;

file: foreach $file (@filelist) {
    $files = do rcsargs($file);
    @files = split(' ',$files);
    $file = $files[1] if $file =~ /\.$RCSEXT$/;
    unless ($inmani{$file}) {
	print "$file does not appear to be in your MANIFEST.new--add? [y] ";
	$ans = <stdin>;
	if ($ans !~ /^n/i) {
	    print "MANIFEST.new comment? ";
	    $ans = <stdin>;
	    `echo '$file	$ans' >>MANIFEST.new`;
	}
    }
    $revs=0;
    $rlog = `rlog -r$baserev -r$revbranch $files 2>&1`;
    ($total) = ($rlog =~ /total revisions: (\d+)/);
    ($revs) = ($rlog =~ /selected revisions: (\d+)/);
    $comment = do rcscomment($file);
    if (!$revs) {
	if ($total) {				# new trunk revision
	    if ($rlog !~ /locks:\s*;/) {
		system 'rcs', '-u', @files;	# unlock branch
	    }
	    system 'rcs', '-l', @files;		# lock trunk
	}
	else {
	    system 'rcs', '-i', "-c$comment", @files if $comment ne '';
	}
	if ($patching && !$total) {	# check in null as trunk revision
	    rename($file, "$file.xxx");
	    `cp /dev/null $file` unless -f $file;
	    if (system 'ci', "-l$baserev", @sw, @files) {
		print "Trying again...\n";
		system 'ci', "-r$baserev", @sw, @files;
		system 'rcs', '-u', @files unless $?;
		system 'co', "-l$baserev", @files unless $?;
	    }
	    system 'rcs', "-Nlastpat:$baserev", @files;
	    rename("$file.xxx", $file);
	    $mess = do getlog($file);
	    next file if $mess eq 'nope';
	    if (system 'ci', "-l$revbranch", @sw, @files) {
		print "Unlocking and trying again...\n";
		system 'rcs', '-u', @files;
		system 'ci', "-l$revbranch", @sw, @files unless $?;
	    }
	}
	else {
	    $mess = do getlog($file);
	    next file if $mess eq 'nope';
	    if (do feed($mess, 'ci', "-l$baserev", @sw, @files)) {
		print "Trying again...\n";
		do feed($mess, 'ci', "-r$baserev", @sw, @files);
		system 'rcs', '-u', @files unless $?;
		system 'co', "-l$baserev", @files unless $?;
	    }
	    system 'rcs', "-Nlastpat:$baserev", @files;
	}
    }
    elsif ($revs == 1) {
	$mess = do getlog($file);
	next file if $mess eq 'nope';
	if (do feed($mess, 'ci', @sw, "-l$revbranch", @files)) {
	    print "Unlocking and trying again...\n";
	    system 'rcs', '-u', @files;
	    do feed($mess, 'ci', @sw, "-l$revbranch", @files) unless $?;
	}
    }
    else {
	$mess = do getlog($file);
	next file if $mess eq 'nope';
	if (do feed($mess, 'ci', @sw, "-l$revbranch", @files)) {
	    print "Trying again with separate checkout...\n";
	    do feed($mess, 'ci', @sw, "-r$revbranch", @files);
	    system 'rcs', "-l$revbranch", @files unless $?;
	    system 'co', "-l$revbranch", @files unless $?;
	}
    }
}
unlink ".rlog$$";

sub feed {
    local($mess) = shift(@_);
    open(FORK,"|-") || exec @_;
    print FORK $mess;
    close FORK;
    $?;
}

sub getlog {
    local($file) = @_;
    local($mess) = '';
    local($prefix) = "patch$bnum: ";
    local($prompt) = $comment;
    $prompt = '>> ' unless $prompt;
    $prefix = '' unless $revs;
    print "Type log message for $file (finish with ., CR for previous):\n";
    try: for (;;) {
	line: for (print "$prompt$prefix";;print "$prompt$prefix") {
	    if ($always) {
		print "\n";
		$line = '';
	    }
	    else {
		$line = <stdin>;
	    }
	    if ($line =~ /^\.?$/) {
		if ($mess) {
		    last line;
		}
		else {
		    $line = 'p';
		}
	    }
	    if ($line =~ /^[h?]$/) {
		print "
CR or .	Terminate log message.
p	Append previous message.
l	List what I have so far.
v or e	Call editor.
V or E	Call editor with a diff listing.
x	Toggle patch# prefix.
n	Forget this file.
a	Always use this message.
r	Print out the rlog for this file.
h or ?	This help message.

";
		next line;
	    }
	    if ($line =~ /^[VE]$/) {
		$mess .= "\n" . `rcsdiff -c -rlastpat $files`;
	    }
	    if ($line =~ /^[VEve]$/) {
		$mess = do edit($mess);
		next line;
	    }
	    if ($line =~ /^r$/) {
		system "rlog $files";
		next line;
	    }
	    if ($line =~ /^a$/) {
		$always++ if $mess || $prevmess;
		next line;
	    }
	    if ($line =~ /^n$/) {
		$mess = 'nope';
		last line;
	    }
	    if ($line =~ /^l$/) {
		foreach $line (split(/\n/,$mess)) {
		    print $prompt,$line,"\n";
		}
		next line;
	    }
	    if ($line =~ /^p$/) {
		$mess .= $prevmess;
		foreach $line (split(/\n/,$prevmess)) {
		    print $prompt,$line,"\n";
		}
		next line;
	    }
	    if ($line =~ /^x$/) {
		$prefix = $prefix ? '' : "patch$bnum: ";
		next line;
	    }
	    $mess .= $prefix . $line;
	    if (length($mess) > 511) {
		print "You'll have to trim to less than 512 chars...\n";
		sleep(3);
		$mess = do edit($mess);
	    }
	}
	$mess = $prevmess if $mess eq '';
	if (!$mess) {
	    print "No previous message, try again.\n";
	    next try;
	}
	if (length($mess) > 511) {
	    print "Sorry, that's too long; rcs won't take it.  Try again...\n";
	    next try;
	}
	last try;
    }
    print LOGS $mess unless $mess eq 'nope';
    $prevmess = $mess unless $mess eq 'nope';
}

sub geteditor {
    local($editor) = $ENV{'VISUAL'};
    $editor = $ENV{'EDITOR'} unless $editor;
    $editor = $defeditor unless $editor;
    $editor = 'vi' unless $editor;
    $editor;
}

sub edit {
    $editor = do geteditor() unless $editor;
    local($text) = join("\n", @_);
    open(TMP,">/tmp/cil$$") || die "Can't create /tmp/cil$$";
    print TMP $text;
    close TMP;
    system $editor, "/tmp/cil$$";
    $text = `cat /tmp/cil$$`;
    unlink "/tmp/cil$$";
    $text;
}

sub readpackage {
    if (! -f '.package') {
        if (-f '../.package' || -f '../../.package') {
            die "Run in top level directory only.\n";
        }
        else {
            die "No .package file!  Run packinit.\n";
        }
    }
    open(package,'.package');
    while (<package>) {
        next if /^:/;
        next if /^#/;
        if (($var,$val) = /^\s*(\w+)=(.*)/) {
            $val = "\"$val\"" unless $val =~ /^['"]/;
            eval "\$$var = $val;";
        }
    }
    close package;
}

sub rcsargs {
    local($result) = '';
    local($_);
    while ($_ = shift(@_)) {
	if ($_ =~ /^-/) {
	    $result .= $_ . ' ';
	}
	elsif ($#_ >= 0 && do equiv($_,$_[0])) {
	    $result .= $_ . ' ' . $_[0] . ' ';
	    shift(@_);
	}
	else {
	    $result .= $_ . ' ' . do other($_) . ' ';
	}
    }
    $result;
}

sub equiv {
    local($s1, $s2) = @_;
    $s1 =~ s|.*/||;
    $s2 =~ s|.*/||;
    if ($s1 eq $s2) {
	0;
    }
    elsif ($s1 =~ s/$RCSEXT$// || $s2 =~ s/$RCSEXT$//) {
	$s1 eq $s2;
    }
    else {
	0;
    }
}

sub other {
    local($s1) = @_;
    ($dir,$file) = ('./',$s1) unless local($dir,$file) = ($s1 =~ m|(.*/)(.*)|);
    local($wasrcs) = ($file =~ s/$RCSEXT$//);
    if ($wasrcs) {
	`mkdir $dir` unless -d $dir;
	$dir =~ s|RCS/||;
    }
    else {
	$dir .= 'RCS/';
	`mkdir $dir` unless -d $dir;
	$file .= $RCSEXT;
    }
    "$dir$file";
}

sub rcscomment {
    local($file) = @_;
    local($comment) = '';
    open(FILE,$file);
    while (<FILE>) {
	if (/^(.*)\$Log[:\$]/) {		# they know better than us (hopefully)
	    $comment = $1;
	    last;
	}
    }
    close FILE;
    unless ($comment) {
	if ($file =~ /\.SH$|[Mm]akefile/) {
	    $comment = '# ';
	}
	elsif ($file =~ /\.U$/) {
	    $comment = '?RCS: ';
	}
	elsif ($file =~ /\.man$/) {
	    $comment = "''' ";
	}
    }
    $comment;
}

