#!/usr/local/bin/perl # # tgent -- retrieve a termcap entry, formatted for # this window size, or the -w width if given # read from /etc/termcap, or -f file, or stdin if isn't_atty # tchrist@cs.colorado.edu 9/17/93 ############################################ # CONFIGURATION SECTION $DEF_WIDTH = 80; $DEF_FILE = '/etc/termcap'; ############################################# main: { &parse_args; &getwinsz; &open_input; &run_filter; &gen_format; &find_entries; exit; } ############################################# sub usage { die "usage: $0 [-f tcapfile] [-w width] entry ...\n"; } ############################################# sub parse_args { require 'getopts.pl'; &Getopts("df:w:") || &usage; &usage unless @ARGV; @wanted{@ARGV} = (1) x @ARGV; } ############################################# sub getwinsz { $cols = 0; if ($opt_w) { $cols = $opt_w; return; } if (-t STDOUT) { ($rows, $cols) = split(' ', `stty size`); # still might be 0? } $cols = $DEF_WIDTH unless $cols; } ############################################# sub open_input { $FILE = do { if ($opt_f) { $opt_f } elsif (-f STDIN) { "<&STDIN" } else { $DEF_FILE } }; open FILE || die "can't open $FILE: $!"; } ############################################# sub gen_format { $cols -= 3; $format = "format STDOUT = \n"; $format .= '^' . '<' x $cols . "\n"; $format .= '$entry' . "\n"; $format .= "\t^" . "<" x ($cols-8) . "~~\n"; $format .= '$entry' . "\n"; $format .= ".\n"; print STDERR $format if $opt_d; eval $format; die "bad format:\n$format\n$@" if $@; $: = ":"; } ############################################# sub find_entries { LINE: while () { next LINE if /^#/; chop; if ( /\\$/ ) { chop; $_ .= ; redo LINE; } s/:\s*:/:/g; $entry = $_; NAME: for (split(/\|/, (split(/:/,$_,2))[0])) { if ($wanted{$_}) { write; next LINE; } } # for name } # while line } ############################################# sub run_filter { if ($pid = open(CHILD, "|-")) { open(STDOUT, ">&CHILD") || die "can't dup child to stdout: $!"; $| = 1; return; } die "can't fork: $!" unless defined $pid; $| = 1; $\ = "\n"; $saveline = ''; while () { chop; s/\s+$//; s/^\t([^:])/\t:$1/; print /^\S/ ? $saveline : "$saveline\\" if $saveline; $saveline = $_; } print $saveline if $saveline; exit; }