#!/usr/bin/perl
# grog -- guess options for groff command
# Inspired by doctype script in Kernighan & Pike, Unix Programming
# Environment, pp 306-8.

$prog = $0;
$prog =~ s@.*/@@;

push(@command, "groff");

while ($ARGV[0] =~ /^-./) {
    $arg = shift(@ARGV);
    last if $arg eq "--";
    push(@command, $arg);
}

if (@ARGV) {
    foreach $arg (@ARGV) {
	&process($arg, 0);
    }
}
else {
    &process("-", 0);
}

sub process {
    local($filename, $level) = @_;
    local(*FILE);

    if (!open(FILE, $filename eq "-" ? $filename : "< $filename")) {
	print STDERR "$prog: can't open \`$filename': $!\n";
	exit 1 unless $level;
	return;
    }
    while (<FILE>) {
	if (/^\.TS/) {
	    $_ = <FILE>;
	    if (!/^\./) {
		$tbl++;
		$soelim++ if $level;
	    }
	}
	elsif (/^\.EQ/) {
	    $_ = <FILE>;
	    if (!/^\./ || /^\.[0-9]/) {
		$eqn++;
		$soelim++ if $level;
	    }
	}
	elsif (/^\.PS([ 0-9.<].*)?$/) {
	    $_ = <FILE>;
	    if (!/^\./ || /^\.ps/) {
		$pic++;
		$soelim++ if $level;
	    }
	}
	elsif (/^\.R1/ || /^\.\[/) {
	    $refer++;
	    $soelim++ if $level;
	}
	elsif (/^\.[PLI]P/) {
	    $PP++;
	}
	elsif (/^\.P$/) {
	    $P++;
	}
	elsif (/^\.TH/) {
	    $TH++;
	}
	elsif (/^\.SH/) {
	    $SH++;
	}
	elsif (/^\.[pnil]p/) {
	    $me++;
	}
	elsif (/^\.Dd/) {
	    $mdoc++;
	}
	if (/^\.so/) {
	    chop;
	    s/^.so *//;
	    s/\\\".*//;
	    s/ .*$//;
	    &process($_, $level + 1) unless /\\/ || $_ eq "";
	}
    }
    close(FILE);
}

if ($pic || $tbl || $eqn || $refer) {
    $s = "-";
    $s .= "s" if $soelim;
    $s .= "R" if $refer;
    $s .= "p" if $pic;
    $s .= "t" if $tbl;
    $s .= "e" if $eqn;
    push(@command, $s);
}

if ($me > 0) {
    push(@command, "-me");
}
elsif ($SH > 0 && $TH > 0) {
    push(@command, "-man");
}
elsif ($PP > 0) {
    push(@command, "-ms");
}
elsif ($P > 0) {
    push(@command, "-mm");
}
elsif ($mdoc > 0) {
    push(@command, "-mdoc");
}

push(@command, "--") if @ARGV && $ARGV[0] =~ /^-./;

push(@command, @ARGV);

# We could implement an option to execute the command here.

foreach (@command) {
    next unless /[\$\\\"\';&()|<> \t\n]/;
    s/\'/\'\\\'\'/;
    $_ = "'" . $_ . "'";
}

print join(' ', @command), "\n";
