[alt.sources] pstree

aas@boeygen.nr.no (Gisle Aas) (11/21/90)

Once I posted perl program called "pstree" which produced an
illustration (in the form of a PostScript program) of the
file hierarchy structure.  This is a new version of "pstree", where
the major improvement is that the output is an EPSF file, which means
that you can import it as a figure into many document processing
systems (like LaTeX with the psfig package). The output can also be
feed directly to a PS-printer or some postscript previewer.

The file "pstree" is both a valid perl script, and a valid [tn]roff
source man page. To install:
   1. Edit the first line to reflect the location of your perl
      interpreter.
   2. Move the file to the location where your executables live.
   3. Make a link from the man-directory to the file.

Also man page by:
  $ nroff -man pstree

-----cut here-----
#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 11/21/1990 11:51 UTC by aas@boeygen
# Source directory /home/boeygen/aas/Bin
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#   6371 -r-xr-xr-x pstree
#
# ============= pstree ==============
if test -f 'pstree' -a X"$1" != X"-c"; then
	echo 'x - skipping pstree (File already exists)'
else
echo 'x - extracting pstree (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'pstree' &&
#!/local/bin/perl
'di';
'ig00';
# pstree(1) - produce directory map in PostScript.
# $Id: pstree,v 1.1 90/11/21 12:22:15 aas Exp $
X
sub PAGE_TOP          { 792; }
#sub PAGE_RIGHT_EDGE   { 595; }
sub TB_MARGIN         { 60; }
sub LEFT_MARGIN       { 60; }
sub FONT              { "Times-Roman"; }
sub FONT_SIZE         { 10; }
sub DIR_LEVEL_INDENT  { 90; }
X
$y = &PAGE_TOP - &TB_MARGIN;
$prev_level = 0;
$average_char_width = &FONT_SIZE / 2;
$max_x_pos = 0;  # keep track of it in order produce bounding box
X
open(tmp,"+>/tmp/tree$$") || die "Can't create temporary file";
unlink("/tmp/tree$$");
select(tmp);
X
print  "/s {show} bind def\n";
print  "/m {moveto} bind def\n";
printf "/%s findfont %d scalefont setfont\n",&FONT,&FONT_SIZE;
print  "0.1 setlinewidth\n";
X
push(@ARGV,'.');
if ($ARGV[0] =~ /^-/) {
X   $_ = shift;
X   last if (/^--$/);
X   if (/f/) {
X      $list_files = 1;
X   }
X   else {
X      print STDERR "Usage: $0 [-f] [dirname]\n";
X      exit(1);
X   }
}
&list_dir($ARGV[0],0);
X
print "showpage\n";
seek(tmp,0,0); # rewind the temporary file
X
select(STDOUT);
print "%!PS-Adobe-2.0 EPSF-2.0\n";
print "%%Title: (Directory map of $ARGV[0])\n";
print "%%Creator: pstree, (C) 1990 Gisle Aas, NR\n";
printf "%%%%DocumentFonts: %s\n", &FONT;
X
if ($y < &TB_MARGIN) {
X   $page_size = (&PAGE_TOP - 2 * &TB_MARGIN);
X   $scale_factor = ($page_size)/((&PAGE_TOP - &TB_MARGIN ) - $y);
X   printf "%%%%BoundingBox: %.0f %.0f %.0f %.0f\n",
X       &LEFT_MARGIN, &TB_MARGIN + &FONT_SIZE * $scale_factor,
X       &LEFT_MARGIN + $max_x_pos * $scale_factor,
X       &PAGE_TOP - &TB_MARGIN + &FONT_SIZE * $scale_factor;
X   printf "%.1f %.3f translate\n", &LEFT_MARGIN,
X                                   (-$y)*$scale_factor + &TB_MARGIN;
X   printf "%.5f dup scale\n", $scale_factor;
} else {
X   printf "%%%%BoundingBox: %.0f %.0f %.0f %.0f\n",
X       &LEFT_MARGIN, $y + &FONT_SIZE,
X       &LEFT_MARGIN + $max_x_pos,
X       &PAGE_TOP - &TB_MARGIN + &FONT_SIZE;
X   printf "%.1f 0 translate\n", &LEFT_MARGIN;
};
X
# copy temporary file to standard out
while (<tmp>) {
X   print;
}
exit;
X
#------------------------------------------
X
X
sub list_dir
{
X   local($dirname) = shift;
X   local($level) = shift;
X   local(@content);
X   opendir(d,$dirname);
X   @content = sort(grep(!/^\.\.?$/,readdir(d)));
X   closedir(d);
X   while ($file = shift(@content)) {
X      $file = "$dirname/$file";
X      if (-d $file) {
X	 if (-l $file) {     # symbolic link; do not follow these
X	    &emitt(substr($file,rindex($file,'/')+1,14) . " -> " .
X		  readlink($file), $level + 1);
X	 }
X	 else {
X            &list_dir($file,$level+1);
X         }
X      }
X      elsif ($list_files) {
X	 &emitt(substr($file,rindex($file,'/')+1,14), $level+1);
X      }
X   }
X   &emitt(substr($dirname,rindex($dirname,'/')+1,14), $level);
}
X
# Uses the following global variables:
#    $y          : current vertical position (initial value = 'top of page')
#    $prev_level : the level reportet last time on emit (init value = 0)
#    @top        : current top position at different levels
#    @bottom     : current bottom position at different levels
#    @pos        : string of positions at different levels
sub emitt
{
X   local($text) = shift;
X   local($level) = shift;
X
X   # Do some substitutions on the $text so that it can be used as a
X   # PostScript string constant.
X   $text =~ s/[\\\(\)]/\\$&/g;
X
X   if ($level == $prev_level) {
X      &write($level,$y,$text);
X      $pos[$level] .= " $y";
X      $bottom[$level] = $y;
X      $y -= &FONT_SIZE;
X   }
X   elsif ($level > $prev_level) {
X      &write($level,$y,$text);
X      local($i);
X      for ($i=$prev_level+1;$i<$level;$i++) {
X          $pos[$i] = '';
X      }
X      $pos[$level] = "$y";
X      $top[$level] = $y;
X      $bottom[$level] = $y;
X      $y -= &FONT_SIZE;
X   }
X   elsif ($level == ($prev_level - 1)) {
X      local($ypos) = ($top[$level+1] - $bottom[$level+1]) / 2 + 
X                     $bottom[$level+1];
X      &write($level,$ypos,$text);
X      &lines($level,$ypos,$pos[$level+1],$text);
X      if ($pos[$level]) {
X         $pos[$level] .= " $ypos";
X         $bottom[$level] = $ypos;
X      }
X      else {
X         $pos[$level] = "$ypos";
X         $top[$level] = $ypos;
X         $bottom[$level] = $ypos;
X      }
X   }
X   else {
X      die "Humm..., jump from level $prev_level to level $level";
X   }
X   $prev_level = $level;
}
X
sub write
{
X   local($x,$y,$text) = @_;
X   $x = $x * &DIR_LEVEL_INDENT;
X   printf "%.f %.f m(%s)s\n", $x, $y, $text;
X   $x += length($text) * $average_char_width;
X   $max_x_pos = $x if ($x > $max_x_pos);
}
X
sub lines
{
X   local($x,$y,$to,$text) = @_;
X   local(@to) = split(/ /,$to);
X   $x = $x * &DIR_LEVEL_INDENT;
X   $y += &FONT_SIZE/3;
X   printf "($text) stringwidth pop %.1f add %.1f m\n",$x+1,$y;
X   printf "[";
X   for (@to) { printf " %.1f", $_ + &FONT_SIZE/3; }
X   printf "]\n";
X   printf "{gsave %.1f exch lineto stroke grestore} forall\n",
X          $x + &DIR_LEVEL_INDENT - 4;
}
X
###########################################################################
X	# These next few lines are legal in both Perl and nroff.
X
.00;			# finish .ig
X 
'di			\" finish diversion--previous line must be blank
.nr nl 0-1		\" fake up transition to first page again
.nr % 0			\" start at page 1
';<<'.ex'; #__END__ #### From here on it's a standard manual page #########
.TH PSTREE 1 "November 1990"
.SH NAME
pstree \- produce directory map in PostScript
.SH SYNOPSIS
.B pstree
[
.B \-f
] [
.I dirname
]
.SH DESCRIPTION
The output from this program is a PostScript program that will
produce a "map" of the directory tree from the current directory
and down. If a 
.I dirname
is given the directory map from the given
directory and down is produced.
The output conforms to Adobe's 
document structuring conventions (version 2.1), and the EPSF
specification version 2.0.
.SH OPTIONS
.TP 5
.B \-f
Include ordinary files in the map. Without this flag only
the overall directory structure is shown.
.SH SEE ALSO
.BR find (1),
.BR ls (1),
.BR perl(1),
.BR postscript(7)
.SH BUGS
Pstree truncates all directory names to 14 characters.
The image is not scaled down if it overflows the right edge of the page.
.SH AUTHOR
(C) Gisle Aas, Norwegian Computing Centre (NR), 1990. <Gisle.Aas@nr.no>
.SH NOTES
PostScript is a trademark of Adobe Systems, Incorporated.
Perl is written by Larry Wall and is distributed under the
terms of the GNU General Public License.
.ex
SHAR_EOF
chmod 0555 pstree ||
echo 'restore of pstree failed'
Wc_c="`wc -c < 'pstree'`"
test 6371 -eq "$Wc_c" ||
	echo 'pstree: original size 6371, current size' "$Wc_c"
fi
exit 0
--
Gisle Aas               |  snail: Boks 114 Blindern, N-0314 Oslo, Norway
Norsk Regnesentral      |  X.400: G=Gisle;S=Aas;O=nr;P=uninett;C=no
voice: +47-2-453561     |  inet:  Gisle.Aas@nr.no