#!/bin/sh
# this is SoftList_shar.02 (part 2 of SoftList 3.0 Beta)
# do not concatenate these parts, unpack them in order with /bin/sh
# file README continued
#
touch 2>&1 | fgrep '[-amc]' > /tmp/s3_touch$$
if [ -s /tmp/s3_touch$$ ]
then
    TOUCH=can
else
    TOUCH=cannot
fi
rm -f /tmp/s3_touch$$
CurArch=2
if test ! -r s3_seq_.tmp
then echo "Please unpack part 1 first!"
     exit 1; fi
( read Scheck
  if test "$Scheck" != $CurArch
  then echo "Please unpack part $Scheck next!"
       exit 1;
  else exit 0; fi
) < s3_seq_.tmp || exit 1
echo "x - Continuing file README"
sed 's/^X//' << 'SHAR_EOF' >> README
X
X	Sausalito, California
X	September 1992
X
X
X---------------------------------------
XLocal Variables:
Xmode: outline
Xeval: (message "Emacs users: you may use hide-body, you're in outline mode")
XEnd:
SHAR_EOF
echo "File README is complete"
chmod 0644 README || echo "restore of README fails"
if [ $TOUCH = can ]
then
    touch -am 1207235692 README
fi
set `wc -c README`;Wc_c=$1
if test "$Wc_c" != "8802"
then echo original size 8802, current size $Wc_c;fi
# ============= SoftList ==============
echo "x - extracting SoftList (Text)"
sed 's/^X//' << 'SHAR_EOF' > SoftList &&
X#! /usr/bin/perl
X'di';
X'ig00';
X#	
X#	Beta Beta Beta Beta Beta Beta Beta Beta Beta Beta Beta Beta 
X#
X#	SoftList 3.0 in development - manage straightforword lists
X#
X#	Daniel Smith, dansmith@autodesk.com, January - December 1992
X#
X#	This perl script maintains lists of the form:
X#
X#	key_field:
X#	other_field:
X#	other_field:
X#	other_field: (etc.)
X#	(one or more line description, followed by a blank line)
X
X#	It's designed to be very interactive.  Enter '?' from any menu.
X#
X#	Lines 2-3 are for nroff.  This script contains its own manpage.
X#	ln -s SoftList /usr/<whatever>/man/man1 and then "man SoftList".
X#
X#	There is a file called "NOTES.SoftList-3.0" that should have come
X#       with the same distribution as this script.  It discusses
X#	strengths, weaknesses, and future plans.  Check it out before
X#	running rampant here :-)
X
X
X#	For configuration options, search for /^sub init_all/.  There is
X#	documentation in that routine for things likely to be redefined in
X#	your personal ~/.SoftListrc
X
X$instance = 1;
X$instance_name = "instance_$instance";
X
X#eval "package $instance_name";
X
X# this is not really SoftList, when production gets turned on then you'll
X# have menus and much more
Xundef($production);
Xif ($ENV{"SOFTLIST_MENUS"}) {
X    print "menu!\n"; sleep 3;
X    $production = "on";
X}
X
X&run_instance;	# stay tuned, we'll have multiple active lists and shells...
X
Xsub run_instance {
X
X	unless (defined($ENV{'SOFTLIST_GUI'})) {
X	    open (TTYIN, "</dev/tty") || die "can't read /dev/tty: $!";
X	    open (TTYOUT, ">/dev/tty") || die "can't write /dev/tty: $!";
X	    select (TTYOUT);
X	    $| = 1;
X	    select(STDOUT);
X	}
X	
X	
X	$clear_str = `clear`;
X	$| = 1;
X
X	#	something to look at while this is getting started
X	$about_str = <<'HowdyThere';
X
X                ______/           __/          /
X               /                 /            /
X              /                 /            /                   
X             /                 /     /      /                   / 
X           ------    _   /    __/   __/    /       _/   __/    __/
X                 /  /   /    /     /      /            /      /  
X                /  /   /    /     /      /        /  __      /   
X               /  /   /    /     /      /        /      /   /    
X        ______/  ____/   _/    _/    _______/  _/  ____/  _/     
X                                                                     
X                                                                     
X        			   
X		   Version 3.0b3 (beta of CLI Only)
X		 Copyright (c) 1991, 1992 Daniel Smith
X			 All rights reserved.
X
XHowdyThere
X
Xprint TTYOUT "
X$clear_str
X$about_str";
Xprint "                           Initializing...";
X
Xrequire 'stat.pl';
X
X#	make fastcwd one of the separate files in the SoftList distribution,
X#	since it does not appear to be one of the standard ones in
X#	perl.
Xrequire 'fastcwd.pl';
Xrequire 'utils.pl';
X
X	
X	#	look in &init_all() for configuration options...
X	&init_all;
X	if ($production) {
X	    &main_menu;
X	} else {
X	    eval $cmds{"eval_perl_expression"};
X	}
X}
X
X#	init_all - set lots of variables
X#
X#	This should be combined with reset.  There should be a few specific
X#	reset routines, and this would call each of them.
Xsub init_all {
X    
X    # put other system specific setup here
X    
X    # BSD is used for figuring out how to do the stty commands to put
X    # the tty in raw mode.
X    $BSD = -f "/vmunix";
X    $how_we_mail = "Mail -s";
X    #$lpr_action = "lpr -Plw";
X    # or.. you may want to try...
X    $lpr_action = "lpr -P$ENV{'PRINTER'}";
X
X
X    # you really should have these defined in your ~/.login, but just
X    # in case, I'll take a couple of good guesses.
X    $ENV{'PAGER'} = "more" unless $ENV{'PAGER'}; # or use "page"
X    $ENV{'EDITOR'} = "vi" unless $ENV{'EDITOR'};
X        
X    # %cmds handles autoloading, we set up %cmds by calling &add_cmds.
X    # An alternate way that this script used to use is to have:
X    #
X    # %cmds = (
X    #        # perl CLI
X    #	     'eval_perl_expression', '&load_routine("eval_perl.pl",
X    #						"eval_perl_expression")',
X    #  ..and so on
X    # with 100 routines or so, it gets to be a mess to edit.  This way
X    # lets you edit in a new routine/different file very easily
X
X    &arrive("cmds...");
X    &add_cmds("add_dyn.pl", <<'ADD_MENU_ROUTINES');
Xadd_menu
XADD_MENU_ROUTINES
X
X
X    &add_cmds("batch_menu.pl", <<'BATCH_MENU_ROUTINES');
Xbatch_menu
XBATCH_MENU_ROUTINES
X
X    &add_cmds("editing.pl", <<'EDITING_ROUTINES');
Xbackward_char
Xbackward_delete_char
Xbackward_word
Xbeginning_of_line
Xend_of_line
Xescape_prefix
Xexpand_known_word
Xforward_char
Xforward_delete_char
Xforward_word
Xkill_backward_word
Xkill_forward_word
Xkill_line
Xkill_to_beginning
Xkill_whole_line
Xnew_line
Xnext_history
Xprevious_history
Xquick_shell
Xredraw_line
Xself_insert
Xtab
Xtranspose
XEDITING_ROUTINES
X
X    &add_cmds("eval_perl.pl", <<'CLI_ROUTINES');
Xeval_perl_expression
XCLI_ROUTINES
X		
X    &add_cmds("search_menu.pl", <<'SEARCH_MENU_ROUTINES');
Xsearch_menu
XSEARCH_MENU_ROUTINES
X
X    &add_cmds("callbacks.pl", <<'CALLBACK_ROUTINES');
Xadd_callback
Xkeep_callback
Xdo_callbacks
XCALLBACK_ROUTINES
X
X    &add_cmds("expand.pl", <<'EXPAND_ROUTINES');
Xexpand
XEXPAND_ROUTINES
X
X    &add_cmds("references.pl", <<'REFERENCES_ROUTINES');
Xreference_menu
Xdynamic_ref_expand
Xfind_references
XREFERENCES_ROUTINES
X
X    &add_cmds("lists.pl", <<'LIST_MENU_ROUTINES');
Xlist_menu
XLIST_MENU_ROUTINES
X
X    &add_cmds("do_vardump.pl", <<'INTERNALS_ROUTINES');
Xdo_vardump
XINTERNALS_ROUTINES
X
X    $cmds{'man_page'} = '&man_page';
X    $cmds{'help'} =  '&load_routine ("help.pl", "help", $arg)';
X
X    # associative arrays for menu handling...
X    # I can't stand doing a bunch of if/else/bla bla to decide what routine
X    # to call.  This setup gives me the flexibility of a case statement.
X    # A user could also append to these arrays and call their own routines
X    # from the menus.
X    
X    %main_menu_cmds = (
X		       '?',	'$arg = "m"; eval $cmds{"help"}',
X		       'a',	'eval $cmds{"add_menu"}',
X		       'b',	'eval $cmds{"batch_menu"}',
X		       'l',	'eval $cmds{"list_menu"}',
X		       'o',	'&files_and_options',
X		       'q',	'&cleanup',
X		       's',	'eval $cmds{"search_menu"}',
X		       '!', 	'&quick_shell',
X		       ' ',	'&pop_level',
X		       '@',	'eval $cmds{"eval_perl_expression"}',
X		       '-',	'&push_previous_menu',
X    );
X    
X    %directory_menu_cmds = (
X			    '?',	'$arg = "o"; eval $cmds{"help"}',
X			    'e',	'eval $cmds{"eval_perl_expression"}',
X			    'm',	'&man_page',
X			    '!',	'&quick_shell',
X			    ' ',	'&pop_level',
X			    '@',	'eval $cmds{"eval_perl_expression"}',
X			    '-',	'&push_previous_menu',
X			    );
X
X
X	# these are the actions to take on found records, the $ans
X	# keystroke is the index
X	%record_actions = (
X		'E',	"system(\$ENV{'EDITOR'}, \@found_files);
X				&force_dir_update",			# edit
X		'M',	"&mail_records",				# mail
X		'P',	"&print_records", 				# print
X		'V',	"system(\$ENV{'PAGER'}, \@found_files)",	# view
X	);
X
X	@command_history='unknown';
X
X	# special commands for menus...you can push a main menu with ESC
X	$directory_menu_cmds{pack("c", 27)} = '&main_menu';	# ESC
X    
X    $SIG{'INT'} = 'cleanup';
X    $SIG{'PIPE'} = 'IGNORE';
X    $SIG{'CONT'} = 'cbreak_on';
X    $descstat = "not edited";
X    &cbreak_on;
X    $num = 0;
X    $reference_str = '';
X
X    $start_dir = &fastcwd;
X
X	# come up with a directory to work with, and make sure it is there....
X    if (defined $ENV{'SOFTLIST_DIR'}) {
X	$softlist = $ENV{'SOFTLIST_DIR'};
X    } else {
X	# this is screwy.... it should test to see if the directory
X	# is there, and if not, mkdir it, and in either case, try
X	# to cd to it....  redo this...
X	if (chdir($ENV{"HOME"} || $ENV{"LOGDIR"} ||
X		  (getpwuid($<))[7])) {
X	    chop($softlist =  `pwd`);
X	    $ENV{'HOME'} = $softlist; #make sure this is set...
X	    $softlist .= "/.SoftList_files";
X	    $ENV{'SOFTLIST_DIR'} = $softlist;
X	    $ENV{'PWD'} = $softlist;
X	} else {
X	    print TTYOUT "no \$HOME or \$SOFTLIST_DIR set, I give up.\n";
X	    exit 1;
X	}
X    }
X    
X    mkdir ($softlist, 0755);
X    if (! defined (@main_dir_stack)) {
X	@main_dir_stack = &fastcwd;
X    }
X    &cd($softlist) || die "can't cd to $softlist, I give up\n";
X    
X    # this will go away...	
X    $which_data_dir = "remote"; # or "local"
X    $other_data_dir = "local";
X    
X    # this can be put back once remote vs local are worked out...
X    #$dir_menu_msg = "in $which_data_dir directory";
X    $dir_menu_msg = "";
X    
X    # we know about all sorts of directories... here's where we start...
X    # this may give way to having directory stacks as the values, don't
X    # know yet.
X    
X    %DIRS = (
X	     'CATALOG', "$softlist",
X	     'CATALOG_FILE', "$softlist/catalog_$which_data_dir",
X	     'DATA', "$softlist/DATA_$which_data_dir",
X	     'LIB',  "/usr/local/lib/SoftList",
X	     'HOME', $ENV{'HOME'},
X	     'SHELL',$softlist,
X	     );
X    
X    # gether some required files, and update the screen...
X    $| = 1;
X    &depart; &arrive("editing...");
X    require "$DIRS{'LIB'}/editing.pl";
X    &depart; &arrive("callbacks...");
X    require "$DIRS{'LIB'}/callbacks.pl";
X    &depart; &arrive("parse...");
X    require "$DIRS{'LIB'}/parse_definition.pl";
X    &depart; &arrive("add menu...");
X    require "$DIRS{'LIB'}/add_dyn.pl";
X    &depart; &arrive("search menu...");
X    require "$DIRS{'LIB'}/search_menu.pl";
X    &depart; &arrive("template...");
X    &parse_definition;
X    &depart; &arrive("reset...");
X    &reset_variables;
X    
X    # %aliases() and other niceties may be set up in the ~/.SoftListrc
X    # file.  Lots of functionality can be had with just a few aliases,
X    # but if something seems too hard to accomplish from that direction,
X    # that's a tipoff to write some functions that would go in utils.pl
X    # or elsewhere
X    if ( -e "$ENV{'HOME'}/.SoftListrc") {
X	eval `cat $ENV{'HOME'}/.SoftListrc`;
X    }
X    
X    # later distributions will have $production turned on...
X    if ($production) {
X	$init_message = "(initialising catalog)";
X	&do_fork('&init_filenames', 'filenames_done', 'QUIT');
X    } else {
X	&cd($ENV{'HOME'});
X	&arrive("going to shell...");
X    }
X}
X 
X
X#	add_cmds - construct/update the %cmds array
Xsub add_cmds {
X    local($file, $routines) = @_;
X
X    foreach (split(/\n/, $routines)) {
X	$cmds{$_} = "&load_routine(\'$file\', \'$_\')";
X    }
X
X}
X
X#	main_menu - The user's (future) entry point
Xsub main_menu {
X	push (@menu_stack, "&main_menu");
X        while ($menu_stack[$#menu_stack] =~ "&main_menu") {
X                print TTYOUT <<"+++";
X$clear_str
X		SoftList Main Menu $init_message
X
X	current list: $list_syms{"LIST_TITLE"}
X
X	?       help
X
X	a       add
X	b	batch in/out
X	l	list to use/list creation
X	s       search/edit
X
X	o	options
X	q       quit
X
X+++
X
X
X		print TTYOUT "\tyour choice >> "; &flush;
X		read (TTYIN, $ans, 1);
X		eval ($main_menu_cmds{$ans}) ||
X				print TTYOUT "no such option: $ans\n";
X	}
X	1;
X}
X
X
X#	update - write out a record...
Xsub update {
X	local($ret) = 1;
X	# first, check to see if we have dealt with this exact same package
X	# before...
X
X	# note: yeah, that's the way it will be for now. Later we'll come back
X	# and allow this.  It's pretty valid for a package (or other key field)
X	# to be the same name, and then refer to differing information.
X
X	if ($all_packages{$package_name}) {
X		print TTYOUT "
X
X	This package is already known:
X	$package_name
X
X	Change the package name or edit the existing record.
X
X	If you want to quit entering records, type a 'q'
X
X";
X		$| = 1;
X		print TTYOUT "\tpress any key ('q' to quit batch)...";
X                read (TTYIN, $ans, 1);
X		if ($ans =~ "q") {
X			$ret = 0;
X		}
X	} else {
X		$start_file++;
X		$all_packages{$package_name} = $start_file;
X		$num_data_files++;
X		open(NEW_RECORD, ">$DIRS{'DATA'}/$start_file") ||
X			warn "can't open data file!: $!\n";
X
X# redo redo redo redo redo redo redo redo redo redo ....
X		print NEW_RECORD <<"EOR";
Xpackage: $package_name
Xcontact: $contact_name
Xlocation: $package_location
XEOR
X		print NEW_RECORD "$desc_str\n\n";
X		close(NEW_RECORD);
X		unlink "$DIRS{'CATALOG'}/description";
X	}
X	&force_dir_update;
X	$saved_stat="saved";
X	$ret;
X}
X
X
X#	force_dir_update - force the DATA directory to be modified
X#
X#	This will assure that the catalog file gets updated.  If the data file
X#	being updated is already known to the directory, then that doesn't
X#	update the directory, and consequently our catalog file won't be
X#	updated when it should be...
Xsub force_dir_update {
X	open(TOUCH_FILE, ">$DIRS{'DATA'}/touch_file");
X	close TOUCH_FILE;
X	unlink("$DIRS{'DATA'}/touch_file");
X	1;
X}
X
X
X#	files_and_options - change DATA dirs and other options
X#
X#	This will evolve into a configuration menu
Xsub files_and_options { 
X	push (@menu_stack, "&files_and_options");
X        while ($menu_stack[$#menu_stack] =~ "&files_and_options") {
X	                print TTYOUT <<"+++";
X$clear_str
X		Files, Configuration, and Options $init_message
X
X	current list: $list_syms{"LIST_TITLE"}
X
X	?       help
X
X	e	evaluate perl expressions
X	m	man page for SoftList
X
X+++
X	# this line can be put back once this works right...
X	#s	switch, start using $other_data_dir records
X
X	# and this line is dangerous, since it almost encourages you to
X	# change data directories, and then it doesn't sync things up
X	#d	directory to use
X
X		print TTYOUT "\tyour choice >> "; &flush;
X		read (TTYIN, $ans, 1);
X		eval ($directory_menu_cmds{$ans}) || 
X				print TTYOUT "hey, no such option: $ans\n";
X
X	}
X	1;
X}
X
X
X
X#	mail_records - send @found_records to someone
Xsub mail_records {
X	local ($pushd_arg[0]) = $DIRS{'DATA'};
X	&pushd (*main_dir_stack, *pushd_arg);
X	print TTYOUT "\n\n";
X	@command_history = @perl_history;
X	&get_input("\tenter recipient >> ");
X	$recipient = $command_history[$#command_history];
X	@perl_history = @command_history;
X	$| = 1;
X	if ($recipient =~ /^$/) {
X		print TTYOUT "skipping...\n";
X	} else {
X		print TTYOUT "\n";
X		$full_subject = "Output From SoftList - $search_pattern";
X		open (MAILPIPE, "|$how_we_mail \"$full_subject\" $recipient")
X				|| warn "can't set up pipe!: $!\n";
X		foreach $mailfile (@found_records) {
X			open (STUFF_TO_MAIL, $mailfile);
X			print TTYOUT "\tmailing $mailfile\r";
X			print MAILPIPE <STUFF_TO_MAIL>;
X			close (STUFF_TO_MAIL);
X		}
X		close (MAILPIPE);
X	}
X	&popd (*main_dir_stack);
X	1;
X}
X
X
X#	print_records
Xsub print_records {
X	local ($pushd_arg[0]) = $DIRS{'DATA'};
X	print "printing records...\n";
X
X	&pushd (*main_dir_stack, *pushd_arg);
X	system(@lpr_action, @found_files);
X	&popd (*main_dir_stack);
X	1;
X}
X
X#	cleanup - what to do before leaving SoftList
Xsub cleanup {
X	&cbreak_off;
X	exit;
X}
X
X
X#	init_filenames - a child process that may do lots of IO...
X#
X#	what goes on here is that this is called via a parent fork.  This child
X#	gathers lots of info concerning filenames and the state of the
X#	%all_packages associative array.  The child dumps very readable perl
X#	code about its findings into the file catalog_{remote,local}.
X#	When the child is done, it signals the parent, and the parent just
X#	does a quick "eval" on $catalog_file (in comparison to the parent
X#	doing all of the IO).  The upshot of all of this is that the user
X#	can get into the script much faster, and be entering data or
X#	reading help screens while this	work is going on.
X
X#	additional note: Sun Dec 22 14:12:18 PST 1991
X#
X#	the actual data is now going to be pushed down a level.  We'll have
X#	two directories, called DATA_remote and a DATA_local.  We can then
X#	have two files at the $SOFTLIST_DIR level, called catalog_remote
X#	and catalog_local.  By comparing the mtime of catalog_remote
X#	with DATA_remote, we have a quick way of telling whether or not
X#	we need to go and update the catalog_remote file at this time.
X#	Whenever a file changes in DATA_remote, we'll touch the DATA_remote
X#	dir to be sure the mtime is updated (this doesn't update if you
X#	merely touch an *existing* file in the data dir..)
Xsub init_filenames {
X	$need_rebuild = 0;	# start off optimistic...
X	if (-e $DIRS{'CATALOG_FILE'}) {
X		@directory_ary = stat(_);
X	} else {
X		$need_rebuild++;
X	}
X
X	if (-e $DIRS{'DATA'}) {
X		@data_ary = stat(_);
X	} else {
X		mkdir ($DIRS{'DATA'}, 0755) ||
X			die "can't create ($DIRS{'DATA'}:$!\n";
X		$need_rebuild++;
X	}
X
X	if ($need_rebuild == 0 &&
X		($data_ary[$ST_MTIME] > $directory_ary[$ST_MTIME])) {
X		$need_rebuild++; # yep, you guessed it...
X	}
X
X	# if we made this far without setting $need_rebuild, we're
X	# in good shape.  It would be possible to touch the directory
X	# file manually and have it appear to be up to date, and not have
X	# some of the entries that are in the DATA_* directory.  Rather
X	# than spinning the disk to slurp in 1000+ filenames to figure
X	# this out, I'll just say to you: "don't do that!".  Anyways, note
X	# that there's a menu item (in options) to force a directory update.
X
X	if ($need_rebuild) {
X		open (DIRECTORY, "> $DIRS{'CATALOG_FILE'}");
X
X		$date_str = `date`;
X
X		print DIRECTORY
X			"# this file created by SoftList on $date_str\n";
X		print DIRECTORY "%all_packages = (\n";
X
X		$/ = "\n";
X		$start_file = "00000";
X
X		opendir (THISDIR, $DIRS{'DATA'});
X		while ($_ = readdir (THISDIR)) {
X			if (!/\./o) {
X				$all_data_fnames {$_}++;
X			}
X		}
X		closedir (THISDIR);
X
X		foreach $search_fname (keys %all_data_fnames) {
X			open(CUR_SEARCH, "< $DIRS{'DATA'}/$search_fname") ||
X			warn "can't open $DIRS{'DATA'}/$search_fname: !$\n";
X			while (<CUR_SEARCH>) {
X				if (/^package/) {
X					chop;
X					($f, $package) = split (' ', $_, 2);
X					$start_file++;
X					print DIRECTORY
X					"\t\'$package\',  \"$search_fname\",\n";
X					last;
X				}
X			}
X		}
X		print DIRECTORY ");\n\n\n";
X
X	# and now, a sanity check...  the starting filename at this point
X	# should match up with the number of data files.  If it doesn't, it's
X	# a tip off that a data file has been manually removed or added.  In
X	# that case, we toss our hands up in the air and bump the
X	# starting filename to the highest data file name.  We'll figure that
X	# the user knows what they're doing...
X
X		@the_names = sort (keys %all_data_fnames);
X		if ($start_file =~ "00000") {
X			$num_data_files = 0;
X		} else {
X			$num_data_files = $#the_names + 1;
X		}
X
X		print DIRECTORY "\$start_file = \"$start_file\";\n";
X		print DIRECTORY "\$num_data_files = $num_data_files;\n";
X		close DIRECTORY;
X	}
X	1;
X}
X
X
X#   reset_variables - should just be a series of calls to local reset subs...
X
X#  actually...each file should just be responsible for resetting the
X# vars that it knows about.. and this function  could just call
X# do_callbacks("PARENT_RESET_VARS")....
Xsub reset_variables {
X    $package_name = "unknown";
X    $contact_name = "unknown";
X    $package_location = "unknown";
X    $saved_stat = "not saved";
X    $last_found_str = '';
X    $search_pattern = '';
X    $current_batch_file_in = $DIRS{'CATALOG'}."/batch_in";
X    $current_batch_file_out = $DIRS{'CATALOG'}."/batch_out";
X    &add_reset;
X    1;
X}
X
X#	filenames_done - parent is notified of child finishing catalog file
Xsub filenames_done {
X
X	# improvement needed...the parent should be making up the $catalog_dir
X	# var, that way it will know which file to eval...
X
X	$need_rebuild = 0;
X	eval `cat $DIRS{'CATALOG_FILE'}`;
X	$init_message = '';
X	if (! defined ($nobeep)) {
X		print TTYOUT pack("c", 7);
X	}
X	1;
X}
X
X
X
X#	man_page - show the man page
Xsub man_page {
X	local ($pushd_arg[0]) = $start_dir;
X	if (! defined ($man_str)) {
X		&pushd (*main_dir_stack, *pushd_arg);
X		$| = 1;
X		print TTYOUT "formatting man page...";
X		$man_str = `nroff -man $0`;
X		&popd(*main_dir_stack);
X	}
X	&pager (*man_str);
X	1;
X}
X
X###############################################################
X
X    # These next few lines are legal in both Perl and nroff.
X
X.00;                       # finish .ig
X
X'di           \" finish diversion--previous line must be blank
X.nr nl 0-1    \" fake up transition to first page again
X.nr % 0         \" start at page 1
X'; __END__ ##### From here on it's a standard manual page #####
X.TH SOFTLIST 1 Beta 2 "September 1992"
X.AT 3
X.SH NAME
XSoftList \- manage lists
X.SH SYNOPSIS
X.B SoftList
X.SH DESCRIPTION
X.I SoftList
Xmaintains straightforward lists such as addresses, software packages,
Xrecord collections, etc.  It allows you to define new types of lists on
Xthe fly.
X.SH CLI BETA ONLY
XThis distribution (3.0b2) is intended to be a beta of the CLI only.
XUse SoftList 2.0 for the time being if you are using the "Current
XVersions Of Software" list.  Consider the rest of this to be alpha.
X.SH ENVIRONMENT
X.I SOFTLIST_DIR
Xpoints at the directory where list data is kept. (default: ~/.SoftList_files)
X.SH FILES
XLots.
X.SH AUTHOR
XDaniel Smith, dansmith@autodesk.com
X.br
XP.O. Box 613, Sausalito, CA, 94966
X.SH "SEE ALSO"
XThe help screens in the script, accessible from any menu
Xvia the '?' key.
X.SH BUGS
XSome doubtless remain.
X
SHAR_EOF
chmod 0755 SoftList || echo "restore of SoftList fails"
if [ $TOUCH = can ]
then
    touch -am 1208003692 SoftList
fi
set `wc -c SoftList`;Wc_c=$1
if test "$Wc_c" != "20662"
then echo original size 20662, current size $Wc_c;fi
# ============= add_dyn.pl ==============
echo "x - extracting add_dyn.pl (Text)"
sed 's/^X//' << 'SHAR_EOF' > add_dyn.pl &&
X#	add menu routines
X
X#       update $cmds so that we just load once
X$cmds{"add_menu"} = '&add_menu';
X$cmds{"description"} = '&description';
X
X
X%add_menu_cmds = (
X		  '?',    '$arg = "a"; eval $cmds{"help"}',
X		  'B',    'eval $cmds{"batch_menu"}',
X		  'R',    '&reset_variables',
X		  'U',    '&update',
X		  '!',    '&quick_shell',
X		  ' ',    '&pop_level',
X		  '@',    'eval $cmds{"eval_perl_expression"}',
X		  '-',    '&push_previous_menu',
X		  );
X
X$add_menu_cmds{pack("c", 27)} = '&main_menu';           # ESC
X
X#	add_menu - add new records interactively
Xsub add_menu {
X    push(@menu_stack, "&add_menu");
X    while ($menu_stack[$#menu_stack] =~ "&add_menu") {
X	print TTYOUT <<"+++";
X$clear_str
X                Add Menu $init_message 
X
X        current values: $saved_stat, $num_data_files data files $dir_menu_msg
X
X        ?       help
X
X$list_syms{"ADD_MENU_STRS"}
X
X	B	batch input
X        R       reset variables
X        U       update
X
X+++
X        print TTYOUT "\tyour choice >> "; &flush;
X	read(TTYIN, $ans, 1);
X	eval($add_menu_cmds{$ans}) || 
X	    print TTYOUT "hey, no such option: $ans\n";
X
X    }
X    1;
X}
X
X
X
X#	make_data_input_routine
X#
X#	this generates a subroutine on the fly to be used for data
X#	input in the add menu.  Whatever %list_data template is
X#	active is the one we'll generate routines for.  We will usually
X#	be called by &parse_primary or &parse_data_field.  As a check
X#	to see if your template/routines "made it", you can try pushing
X#	the CLI, use the "dumpv" alias, and search for "add_menu_cmds".
Xsub make_data_input_routine {
X    local($the_keystroke, $the_routine_name, $the_value_var) = @_;
X    
X    # register with our add menu
X    $add_menu_cmds{"$the_keystroke"}  = "&GS_add_$the_routine_name";
X
X    eval <<EOS;
Xsub GS_add_$the_routine_name {
X    print TTYOUT "\n\n";
X    \@command_history = \@${the_routine_name}_history;
X    \&get_input("\tenter $the_routine_name >> ");
X    \$list_syms{"$the_value_var"} = \$command_history[\$#command_history];
X     \@${the_routine_name}_history = \@command_history;
X     if (\$list_syms{"$the_value_var"} =~ /^\$/) {
X    	\$list_syms{"$the_value_var"} = "unknown";
X     }
X     \&make_add_menu_strs;
X     \$saved_stat = "not saved";
X     1;
X}
XEOS
X
X    eval <<EOS;
Xsub GS_reset_$the_routine_name {
X    \$list_syms{"$the_value_var"} = '';
X    1;
X}
XEOS
X
X    # add to our reset list for later...
X    $list_syms{"RESET_LIST"} .=  "&GS_reset_$the_routine_name;";
X    1;
X}
X
X
Xsub add_reset {
X    eval $list_syms{"RESET_LIST"}; # you can see this via dumpv...
X    &make_add_menu_strs;
X    1;
X}
X
X
X#	init_add_menu_strs - called once when list is started
X#
X#	we basically want to get a handle on how many custom items there
X#	will be in the menu
Xsub init_add_menu_strs {
X    @field_stack = (sort grep(/DATA_[1-9]/, keys %list_syms));
X    &make_add_menu_strs;
X    1;
X}
X
X#	make_add_menu_strs - generate custom menu entries
Xsub make_add_menu_strs {
X    local($which_field) = 0;
X    $howmany = $#field_stack;
X    if ($#field_stack == -1) { return; }	# sanity check...
X
X    # main key first, then the rest of the data keys...
X    $list_syms{"ADD_MENU_STRS"} = sprintf("\t%-8s%-20s\"%s\"\n",
X					   $list_syms{"MAIN_KS"},
X					   $list_syms{"MAIN"},
X					   $list_syms{"MAIN_VAL"});
X    
X    while ($howmany-- >= 0) {
X        $which_field++;
X	$list_syms{"ADD_MENU_STRS"} .= sprintf("\t%-8s%-20s\"%s\"\n",
X		$list_syms{"DATA_KS$which_field"},
X		$list_syms{"DATA_$which_field"},
X		$list_syms{"DATA_VAL$which_field"});
X
X    }
X    $list_syms{"ADD_MENU_STRS"} .= sprintf("\t%-8s%-20s\"%s\"\n",
X			       	   $list_syms{"DESCRIPTION_KS"},
X					   $list_syms{"DESCRIPTION"},
X					   $list_syms{"DESCRIPTION_STAT"});
X    1;
X}
X
X#	make_description_input_routine - set up menu entry
Xsub make_description_input_routine {
X    local($the_keystroke) = @_;
X    $add_menu_cmds{"$the_keystroke"} = "&description";
X    1;
X}
X
X
X#	description - enter package description in $ENV{'EDITOR'}
Xsub description {
X    	local($desc_str) = @_;
X
X	print TTYOUT "$list_syms{'DESCRIPTION'}...";
X	&flush;
X	open(DESC_FILE, "> $DIRS{'CATALOG'}/description") ||
X	    warn "can't open description file...\n";
X
X		print DESC_FILE <<"Instructions";
X##      [start your description at the end of this file]
X##
X##      Note that all lines starting with "##" (such as this one) will
X##      *not* be inserted into the record
X##
X##	if you want to dynamically reference other files at search time
X##	specify them at the beginning of a line as:
X##
X##      $list_syms{"DYNAMIC_REF"}: <dynamic_path>/some_file_specification
X##
X##	The references can be commands to execute, or files to browse through.
X##      You would use this to point at online documentation, file lists, etc.
X##
X##	%dynamic_paths should be defined in your ~/.SoftListrc.  A sample
X##	reference would look like "dynamic: _X11_SRC/GumbyDraw/README"
X##
X##      uncomment these lines if needed (multiple $list_syms{'DYNAMIC_REF'}: lines are okay!)
X##$list_syms{'DYNAMIC_REF'}: _SRC/
X##$list_syms{'DYNAMIC_REF'}: _X11_SRC/
X##$list_syms{'DYNAMIC_REF'}: _BIN/
X##
X##      type in whatever is relevant to this record... 
X$list_syms{'DESCRIPTION'}:
XInstructions
X    
X    close(DESC_FILE);
X    system("$ENV{'EDITOR'} $DIRS{'CATALOG'}/description");
X    $descstat = "edited";
X    $saved_stat = "not saved";
X    $desc_str = `grep -v "^##" $DIRS{'CATALOG'}/description`;
X    1;
X}
X1;
X
X
X
SHAR_EOF
chmod 0644 add_dyn.pl || echo "restore of add_dyn.pl fails"
if [ $TOUCH = can ]
then
    touch -am 1205004592 add_dyn.pl
fi
set `wc -c add_dyn.pl`;Wc_c=$1
if test "$Wc_c" != "5343"
then echo original size 5343, current size $Wc_c;fi
# ============= batch_menu.pl ==============
echo "x - extracting batch_menu.pl (Text)"
sed 's/^X//' << 'SHAR_EOF' > batch_menu.pl &&
X# this needs attention...Sat Sep 19 18:07:18 PDT 1992
X
X# and it still does... Tue Nov  3 15:27:16 PST 1992
X
X
X#       update $cmds so that we just load once
X$cmds{"batch_menu"} = '&batch_menu';
X$cmds{"batch_input"} = '&batch_input';
X$cmds{"batch_found_record_output"} = '&batch_found_record_output';
X$cmds{"batch_output"} = '&batch_output';
X$cmds{"batch_file_input"} = '&batch_file_input';
X$cmds{"batch_file_output"} = '&batch_file_output';
X
X%batch_menu_cmds = (
X		    '?',	'$arg = "b"; eval $cmds{"help"}',
X		    'O',	'&batch_found_record_output',
X		    'i',	'&batch_input',
X		    'o',	'&batch_output',
X		    '!',	'&quick_shell',
X		    ' ',	'&pop_level',
X		    '@',        'eval $cmds{"eval_perl_expression"}',
X		    '-',	'&push_previous_menu',
X		    );
X
X$batch_menu_cmds{pack("c", 27)} = '&main_menu';         # ESC
X
X
X#	batch_menu - produce new records or write a report
Xsub batch_menu {
X    push(@menu_stack, "&batch_menu");
X    while ($menu_stack[$#menu_stack] =~ "&batch_menu") {
X	print TTYOUT <<"+++";
X$clear_str
X		Batch Input/Output Menu $init_message
X
X
X	?       help
X
X	i	input new records from file
X	o	output all records to a file
X	O	output only recently found records to a file
X
X	current in:	$current_batch_file_in
X	current out:	$current_batch_file_out
X
X+++
X        print TTYOUT "\tyour choice >> "; &flush;
X	read(TTYIN, $ans, 1);
X	eval($batch_menu_cmds{$ans}) || 
X	    print TTYOUT "hey, no such option: $ans\n";
X
X    }
X    1;
X}
X
X
X#	these three called from a menu... 
Xsub batch_input {
X    local($pushd_arg[0]) = $DIRS{'DATA'};
X    $force_input = $current_batch_file_in;
X    &file_prompt;
X    $current_batch_file_in = $filename_history[$#filename_history];
X    &pushd(*main_dir_stack, *pushd_arg);
X    &batch_file_input ($current_batch_file_in);
X    &popd(*main_dir_stack);
X    1;
X}
X
X
X#	batch_found_record_output - output just the most recently found files
Xsub batch_found_record_output {
X    $batch_found_output = 1;
X    &batch_output;
X    $batch_found_output = 0;
X}
X	
Xsub batch_output {
X    local($pushd_arg[0]) = $DIRS{'DATA'};
X    $force_input = $current_batch_file_out;
X    &file_prompt;
X    $current_batch_file_out = $filename_history[$#filename_history];
X    &pushd(*main_dir_stack, *pushd_arg);
X    &batch_file_output ($current_batch_file_out);
X    &popd(*main_dir_stack);
X    1;
X}
X
X
X#	batch_file_input - make up new records from an incoming stream
X#
X#	This first pass should break up things pretty well.  This is either
X#	called from an interactive menu via batch_input, or from a
X#	command line option a la crontab
X
X#	BUG: I've added to the standard input filename ("-") so that you
X#	can't access it.  If you use it more than once it core dumps.
Xsub batch_file_input {
X    local($batch_file) = @_;
X
X    # standard input case...
X    if ($batch_file =~ /- sigh, standard in is broken if used twice.../) {
X	print TTYOUT <<"+++";
X
X
X	You've selected standard input for batch input.  Type or paste your
Xentries here.  When you are done, enter your End Of File character
X(which usually will be Control-D) on a line by itself.
X
Xenter records:
X+++
X        unless (open(BATCH_INPUT, "< -")) {
X	    warn "can't open $batch_file: $!\n";
X	    sleep 2;
X	    return 1;
X	}
X        
X
X				# # this is all hosed... 
X        &cbreak_off;
X	} else { # filename case...
X
X		# temporary for 2.0
X		if ($batch_file =~ /-/) {
X			warn "don't use standard input for now...\n";
X			sleep 2;
X                        return 1;
X		}
X
X		unless (open(BATCH_INPUT, $batch_file)) {
X                        warn "\ncan't open $batch_file: $!\n";
X                        sleep 2;
X                        return 1;
X		}
X	}
X        $/ = "";
X	$rec_num = 1;
X
X	while (<BATCH_INPUT>) {
X                $/ = "\n";
X		undef ($desc_str);
X
X		# no doubt this is a slow way of assigning variables...I'm
X		# wide open to suggestions... (horrors! pg 96)
X		@cur_rec = split (/^/);
X		foreach $line (@cur_rec) {
X			chop ($line);
X			if ($line =~ /^package:/) {
X				($package_name = $line) =~ s=^package:\s==;
X				next;
X			} elsif ($line =~ /^contact:/) {
X				($contact_name = $line) =~ s=^contact:\s==;
X				next;
X			} elsif ($line =~ /^location:/) {
X				($package_location = $line) =~ s=^location:\s==;
X				next;
X			} else {
X				$desc_str .= $line;
X			}
X		}
X
X		$/ = "";
X		if (&update == 0) {
X			last;
X		} else {
X			print TTYOUT "\ndid $package_name";
X		}
X		print TTYOUT "\n";
X	}
X	&cbreak_on;
X	close (BATCH_INPUT);
X        &do_fork('&init_filenames', 'filenames_done', 'QUIT');
X	return 1;
X}
X
X
Xsub batch_file_output {
X    local($batch_file) = @_;
X    local(@the_files);
X
X    unless (open(BATCH_OUTPUT, "> $batch_file")) {
X	warn "can't open $batch_file: $!\n";
X	sleep 2;
X	return 1;
X    }
X
X    if ($batch_found_output) {
X	@keys_or_files = @found_records;
X	print BATCH_OUTPUT <<"+++";
X
X	These records matched the search pattern:
X
X		$search_pattern
X
X+++
X    } else {
X	@keys_or_files = sort keys %all_packages;
X    }
X    
X    foreach $output_key (@keys_or_files) {
X	print TTYOUT "working on $output_key\n";
X	if ($batch_found_output) {
X	    open (CUR_IN, "< $DIRS{'DATA'}/$output_key") ||
X		warn "cannot open: $!\n";
X	} else {
X	    open (CUR_IN, "< $DIRS{'DATA'}/$all_packages{$output_key}") ||
X		warn "cannot open: $!\n";
X	}
X	while (<CUR_IN>) {
X	    print BATCH_OUTPUT $_;
X	}
X	close(CUR_IN);
X    }
X    close(BATCH_OUTPUT);
X    1;
X}	
X
SHAR_EOF
chmod 0644 batch_menu.pl || echo "restore of batch_menu.pl fails"
if [ $TOUCH = can ]
then
    touch -am 1205004592 batch_menu.pl
fi
set `wc -c batch_menu.pl`;Wc_c=$1
if test "$Wc_c" != "5285"
then echo original size 5285, current size $Wc_c;fi
# ============= callbacks.pl ==============
echo "x - extracting callbacks.pl (Text)"
sed 's/^X//' << 'SHAR_EOF' > callbacks.pl &&
X#
X#	callbacks.c - maintain a list of functions to call when needed
X#	callbacks.pl
X#
X#	Daniel Smith, dansmith@autodesk.com, Late 1990 - 1992
X#
X#	The purpose of this is to be able to call functions that "clean-up"
X#	or reset states when we need them.  The logic is pretty much:
X#
X#		if (there are functions to call)
X#			traverse the list of functions, calling
X#			each one in turn, and then go on with what we
X#			were going to do...
X#
X#	I'm trying to write this in such a way where I can drop into
X#	a lot of different programs, hence the static-ness going on here.
X#	The only calls coming from the outside are going to be do_callbacks (),
X#	keep_callback (), and add_callback ().
X#
X#	History:
X#
X#	Sun Feb 16 14:15:19 PST 1992
X#	dropped this into SoftList lib, added $cmds lines.
X#
X#	Sometime in Late 1991
X#	ported from C to Perl
X#
X#	Tue Nov  6 10:22:08 PST 1990 daniel
X#	created
X#
X
X# these lines for SoftList...
X$cmds{"add_callback"} = '&add_callback';
X$cmds{"keep_callback"} = '&keep_callback';
X$cmds{"do_callbacks"} = '&do_callbacks';
X
X$num_keepers = $callback_idx = $keep_idx = $num_callbacks = 0;
X
X
X#
X#	add_callback - register a new callback in our list
X#
Xsub add_callback {
X    $callback_function[$num_callbacks++ + $callback_idx] = "@_";
X}
X
X#
X#	keep_callback - keep this callback around after calling do_callbacks
X#
Xsub keep_callback {
X    $callback_function[$num_keepers++ + $keep_idx] = "@_";
X}
X 
X
Xsub do_callbacks {
X    local($who_called) = @_;
X 
X    #
X    #	call each one in turn..."who_called" should be defined so
X    #	that the callback knows who its parent is
X    #
X	
X    for ($i = 0; $i < $num_callbacks; $i++) {
X	eval "$callback_function[$i + $callback_idx] ($who_called)";
X    }
X    $num_callbacks = $num_keepers;
X    $num_keepers = 0;
X
X    #
X    #	Some callbacks might want to be called again, so
X    #	we flip the indexes
X    #
X    $tmp = $callback_idx;
X    $callback_idx = keep_idx;
X    $keep_idx = $tmp;
X}
X1;
X
X__END__
X
X#	the following is a test program for callbacks...
X#
X#
X#
X#	print "test\n";
X#
X#	&add_callback ('&fooby');
X#	&add_callback ('&fuzzy');
X#	&add_callback ('&wuzzy');
X#	&do_callbacks ("0");
X#	&do_callbacks ("1");
X#	&do_callbacks ("0");
X#	&do_callbacks ("1");
X#
X#
X#
X#sub fooby {
X#
X#	local ($parent) = @_;
X#
X#	print " this is fooby... parent was $parent\n";
X#}
X#
X#sub fuzzy {
X#
X#	$parent = @_;
X#
X#	print " this is fuzzy... parent was $parent\n";
X#	&keep_callback('&fuzzy');
X#}
X#
X#sub wuzzy {
X#
X#	$parent = @_;
X#
X#	print " this is wuzzy... parent was $parent\n";
X#}
X
X
X#	ok, as a bonus, here's the original C version :-)
X
X/*
X**	callbacks.c - maintain a list of functions to call when needed
X**
X**	daniel@island.com, Daniel Smith
X**
X**	The purpose of this is to be able to call functions that "clean-up"
X**	or reset states when we need them.  The logic is pretty much:
X**
X**		if (there are functions to call)
X**			traverse the list of functions, calling
X**			each one in turn, and then go on with what we
X**			were going to do...
X**
X**	I'm trying to write this in such a way where I can drop into
X**	a lot of different programs, hence the static-ness going on here.
X**	The only calls coming from the outside are going to be do_callbacks (),
X**	keep_callback (), and add_callback ().
X**
X**	History:
X**
X**	Tue Nov  6 10:22:08 PST 1990 daniel
X**	created
X*/
X
X#define MAX_CALLBACKS 16384
Xstatic int num_callbacks = 0, num_keepers = 0, callback_idx = 0, keep_idx = 1;
X
X/*
X**	one indice is for callbacks, and the other stores "keepers"
X**	(callbacks that are going to be reused), by flipping indices
X**	we avoid copying pointers (from keeper to callback...)
X*/
Xstatic void (*callback_function[MAX_CALLBACKS][2]) ();
X
X/* the worker bees */
Xvoid add_callback ();
Xvoid keep_callback ();
Xvoid do_callback ();
X
X 
X/*
X**	add_callback - register a new callback in our list
X*/
Xvoid add_callback (user_function)
Xvoid (*user_function) ();
X{
X	if (num_callbacks < MAX_CALLBACKS - 1)
X		callback_function[num_callbacks++][callback_idx] =
X								user_function;
X}
X
X/*
X**	keep_callback - keep this callback around after calling do_callbacks
X*/
Xvoid keep_callback (user_function)
Xvoid (*user_function) ();
X{
X	if (num_keepers < MAX_CALLBACKS - 1)
X		callback_function[num_keepers++][keep_idx] = user_function;
X}
X 
X
X/*
X**	do_callbacks - traverse our list of callback functions
X**
X**	each callback should/can be set up like this:
X**
X**	void some_callback (parent)
X**	int parent
X**	{
X**		switch (parent) {
X**			case LINE_PARENT:
X**				bla bla bla...
X**			case ARC_PARENT:
X**				bla bla bla...
X**			default:
X**		}
X**	}
X*/
Xvoid do_callbacks (who_called)
Xint who_called;
X{
X	int i, tmp;
X 
X	/*
X	**	call each one in turn..."who_called" should be defined so
X	**	that the callback knows who its parent is
X	*/
X
X	for (i = 0; i < num_callbacks; i++) {
X		callback_function[i][callback_idx] (who_called);
X	}
X	num_callbacks = num_keepers;
X	num_keepers = 0;
X
X	/*
X	**	Some callbacks might want to be called again, so
X	**	we flip the indexes
X	*/
X	tmp = callback_idx, callback_idx = keep_idx, keep_idx = tmp;
X}
X1;
SHAR_EOF
chmod 0755 callbacks.pl || echo "restore of callbacks.pl fails"
if [ $TOUCH = can ]
then
    touch -am 1205004592 callbacks.pl
fi
set `wc -c callbacks.pl`;Wc_c=$1
if test "$Wc_c" != "4995"
then echo original size 4995, current size $Wc_c;fi
# ============= do_vardump.pl ==============
echo "x - extracting do_vardump.pl (Text)"
sed 's/^X//' << 'SHAR_EOF' > do_vardump.pl &&
X#
X#	vardump.pl - create or follow dynamic references
X#
X#	Daniel Smith, dansmith@autodesk.com, Mid Olympics, February 1992
X#
X#	reworked from Randal Shwartz's dumpvar.pl for SoftList
X
X$cmds{"do_vardump"} = '&do_vardump';
X
Xpackage dumpvar;
X
X# translate control chars to ^X - Randal Schwartz
Xsub unctrl {
X    local($_) = @_;
X    s/([\001-\037\177])/'^'.pack('c',ord($1)^64)/eg;
X    $_;
X}
X
X
X# this eval's for %_main at the moment, but I intend to put an
X# arg back in so that it may handle any package...
Xsub main'do_vardump {
X    local(*stab) = eval("*_main");
X    
X    @all = keys(%stab);
X    
X    unless (open (PAGER, "| $ENV{'PAGER'}")) {
X	warn "can't set up pager!: !$\n";
X	return 1;
X    }
X    print PAGER <<"EOM";
X    
X    This is the current state of variables in SoftList...
X    
X    we have $#all entries....	
XEOM
X	    
X    
X    
X    while (($key,$val) = each(%stab)) {
X	{
X	    next if @vars && !grep($key eq $_,@vars);
X	    local(*entry) = $val;
X	    if (defined $entry) {
X		print PAGER "\$$key = '",&unctrl($entry),"'\n";
X	    }
X	    if (defined @entry) {
X		print PAGER "\@$key = (\n";
X		foreach $num ($[ .. $#entry) {
X		    print PAGER "  $num\t'",&unctrl($entry[$num]),"'\n";
X		}
X		print PAGER ")\n";
X	    }
X	    
X	    
X	    
X	    if ($key ne "_main" && $key ne "_DB" && defined %entry) {
X		print PAGER "\%$key = (\n";
X		foreach $key (sort keys(%entry)) {
X		   print PAGER "  $key\t'",&unctrl($entry{$key}),"'\n";
X		}
X		print PAGER ")\n";
X	    }
X	}
X    }
X    close (PAGER);
X    }
X
X1;
SHAR_EOF
chmod 0644 do_vardump.pl || echo "restore of do_vardump.pl fails"
if [ $TOUCH = can ]
then
    touch -am 1205004592 do_vardump.pl
fi
set `wc -c do_vardump.pl`;Wc_c=$1
if test "$Wc_c" != "1492"
then echo original size 1492, current size $Wc_c;fi
# ============= dotSoftListrc ==============
echo "x - extracting dotSoftListrc (Text)"
sed 's/^X//' << 'SHAR_EOF' > dotSoftListrc &&
X#	Softlistrc - customization for Softlist PERL Script
X#
X#	Daniel Smith, dansmith@autodesk.com, January - November 1992
X#
X#	A Perl Playground
X#
X#	One of the primary purposes of this file is to define aliases that
X#	are used in the perl CLI.  The effect is that you can mix and
X#	match perl statements and shell commands.  You can add an alias
X#	to run a shell command by:
X#
X#	'the_command_name', '&sh(@alias_args)'
X#
X#	The "sha" alias is good to use on the fly to get the use of a shell
X#	command.  Try entering "sha cal", then "cal".  Wavy.
X#
X#	if you want to background a command, you can do so in the fashion:
X#	alias epoch   &sh("epoch &")
X#
X#	If you are going to change directories, call &cd(), Softlist
X#	needs to know where in the filesystem you are.  Better yet. use
X#	&pushd() and &popd().
X#
X#	Someone with some energy (or me, whoever gets to it first) will work
X#	out a way to write aliases and other information to this file
X#	interactively.  Also, I'm not handling globbing, pipes or job control.
X#	This started out as a simple list manager, and just look at it now :-)
X#
X#	Oh, and don't use contractions (') in your alias comments, throws
X#	everything off, and gobbles *time* trying to track it down.
X
X
X%aliases = (
X'alias',	'{ # 0 args shows all, 1 shows that alias def., 2+ defines
X	&set_alias(@alias_args);
X}',
X
X'basename',	'{ # delete any prefix ending in /
X	shift @alias_args;
X	$result = &basename(@alias_args);
X	print "\n$result";
X}',
X
X'basic_sh_cmd',	'{ # run "shell_command"
X	&sh(@alias_args);
X}',
X
X'catalog',	'{ # view the current catalog file
X	&sh($ENV{"PAGER"}, "$DIRS{\'CATALOG_FILE\'}");
X}',
X
X'call',		'{ # reference something in %cmds
X	shift @alias_args;
X	&call(@alias_args);
X}',
X
X'call_alias',	'{
X	shift @alias_args;
X	eval $aliases{$alias_args[$[]};
X}',
X
X'caller',	'{
X	($c_package,$c_filename,$c_line) = caller($alias_args[1]);
X	print "\npackage: $c_package\nfile: $c_filename\nline: $c_line";
X}',
X
X	
X'cd',   	'{ # the basic alias used to change directories
X	shift @alias_args;
X	if ($#alias_args == -1) {
X		$alias_args[0] = $ENV{"HOME"};
X	}
X	&cd($alias_args[0]);
X}',
X
X
X'cmds',		'{ # see functions known by Softlist
X	$alias_args[1] = "%cmds";
X	eval $aliases{"prass"};
X}',
X
X
X'crc16',	'{ # run perl based crc
X	&crc($alias_args[1]);
X	print "\n$checksum";
X}',
X
X'dref',		'{ # look up a dynamic reference
X	&call("dynamic_ref_expand");
X	&dynamic_ref_expand($alias_args[1]);
X}',
X
X'dirname',	'{ # all but the last level of the path name in string
X	$result = &dirname($alias_args[1]);
X	print "\n$result";
X}',
X
X
X'dumpv',	'{ # call do_vardump and see what is going on.
X	&call("do_vardump");
X}',
X
X
X'ext',	'{ # return filename prefix
X	shift @alias_args;
X	$result = &extension(@alias_args);
X	print "\n$result";
X}',
X
X
X'help',		'{ # help for Softlist
X	&call ("help", "s");
X}',
X
X'history',	'{ # command history
X	unless (open (PAGER, "| $ENV{\"PAGER\"}")) {
X		warn "hey!  can\'t open pager!: !$\n";
X		return 1;
X	}
X	print PAGER join("\n", @command_history);
X	close (PAGER);
X	1;
X}',
X
X
X'l',		'{ # ls alias used by other aliases
X	$alias_args[0]="ls";
X	&sh(@alias_args);
X}',
X
X'll',		'{ # long listing
X	shift @alias_args;
X	unshift (@alias_args, "ls", "-algF");
X	&sh(@alias_args);
X}',
X
X'load',		'{ # load a perl file
X	$load_instance++;
X	system("cp $DIRS{"LIB"}/$alias_args[1] /tmp/ML_$load_instance");
X	require "/tmp/ML_$load_instance";
X}',
X	
X
X'm',		'{ # view a file through a pager
X	$alias_args[0] = $ENV{"PAGER"};
X	&sh(@alias_args);
X}',
X
X
X'mktags',		'{ # generate perl tags for Softlist
X	print "\nmaking tags...";
X        local ($pushd_arg[0]) = $DIRS{"LIB"};
X	&pushd(*main_dir_stack, *pushd_arg);
X	system("ptags *");
X	&popd(*main_dir_stack);
X	print "done\n";
X}',
X
X'newest',		'{ # return newest file from a list
X	shift(@alias_args);
X	print "\n", &newest_file(@alias_args); &flush;
X
X}',
X
X'pkeys',	'{ # show the package names
X	foreach (sort keys %all_packages) {
X		print "\n$_";
X	}
X}',
X
X'prass',	'{ # print an associative array. use: prass %assoc_array
X	%some_assoc = eval $alias_args[1];
X	unless (open (PAGER, "| $ENV{\"PAGER\"}")) {
X		warn "hey!  can\'t open pager!: !$\n";
X		return 1;
X	}
X
X	print PAGER <<"+++";
X
X	The associative array "$alias_args[1]":
X
X+++
X
X	foreach $v (sort keys %some_assoc) {
X		print PAGER "$v\t=\t$some_assoc{$v}\n";
X	}
X	close (PAGER);
X	1;
X}',
X
X
X'prefix',	'{ # print a filename prefix
X	shift @alias_args;
X	$result = &file_prefix(@alias_args);
X	print "\n$result";
X}',
X
X## well here they are, the push and pop family.  Note that you can
X## make other aliases that use other stacks (that will coexist
X## with main_dir_stack just fine.)  Initialise any stack you
X## want to use like this:
X##
X##	@main_dir_stack = &fastcwd;
X##
X## that will give you csh/tcsh-like behavior right off the bat.
X##
X## as far as p +2 and element swapping in stacks goes:  I've never
X## needed to use it in 8 years!  If you want it, play around with
X## your dir_stack and mail me whatever you come up with so that
X## others may benefit.
X
X'p',		'{ # push one or more directories, or flip between two
X	shift @alias_args;
X	&pushd(*main_dir_stack, *alias_args);
X}',
X
X'pp',		'{ # pop a directory (return to previous one)
X	shift @alias_args;
X	&popd(*main_dir_stack);
X}',
X
X'dirs',		'{ # examine directory stack
X	&dirs(*main_dir_stack);
X}',
X
X
X'rc',		'{ # reconfigure the ~/.SoftListrc file from within Softlist
X	&sh("cp $ENV{\'HOME\'}/.SoftListrc $ENV{\'HOME\'}/.SoftListrc.bak");
X	&sh("$ENV{\'EDITOR\'} $ENV{\'HOME\'}/.SoftListrc");
X	if (eval `cat $ENV{\'HOME\'}/.SoftListrc` != 1) {
X		print TTYOUT pack("c", 7);
X		print "WARNING: the newly edited ~/.SoftListrc has problems!\n";
X		$save_flush = $|;
X		$| = 1;
X		print "going to backup copy....";
X		print TTYOUT pack("c", 7);
X		eval `cat $ENV{\'HOME\'}/.SoftListrc.bak`;
X		print "ok for now, but check that...\n";
X		$| = $save_flush;
X	}
X}',
X
X'setenv',	'{ # emulate csh setenv
X	shift @alias_args;
X	if ($#alias_args < 1) {
X		$alias_args[1] = "%ENV";
X		eval $aliases{"prass"};
X	} else {
X		$ENV{shift @alias_args} = "@alias_args";
X	}
X}',
X
X'sha',		'{ # set shell alias on the fly
X	&set_sh_alias(@alias_args);
X}',
X
X'lib',		'{ # for debugging fun...
X	local ($pushd_arg[0]) = $DIRS{"LIB"};
X	&pushd(*main_dir_stack, *pushd_arg);
X	$force_input = "eval `cat ";
X}',
X
X
X'ftag',		'{ # edit perl routine, and use (via require) result
X        local ($pushd_arg[0]) = $DIRS{"LIB"};
X	local ($routine, $filename, $ignore);
X	&pushd(*main_dir_stack, *pushd_arg);
X	$tag_ref++;
X	if (! -f "tags") {
X		print "\nyou must make a tags file with ptags first\n";
X		&popd(*main_dir_stack);
X		last;
X	}
X
X	&sh($ENV{"EDITOR"}, "-t", "$alias_args[1]");
X	open (TAGFILE, "< tags");
X	while (<TAGFILE>) {
X		if (/^$alias_args[1]/) {
X			($routine, $filename, $ignore) = split (\' \',$_, 3);
X			last if ($routine =~ $alias_args[1]);
X		}
X	}
X
X	$req_name = $DIRS{"LIB"} . "/" . $filename . ".req". $tag_ref;
X	close (TAGFILE);
X	open (SOURCE_FILE, "< $filename") ||
X			warn "can\'t open source file:$!\n";
X	open (TMP_REQUIRE_FILE, "> $req_name")
X		|| warn "can\'t open source file:$!\n";
X	while (<SOURCE_FILE>) {
X		print TMP_REQUIRE_FILE;
X	}
X	close(SOURCE_FILE);
X	close(TMP_REQUIRE_FILE);
X	require "$req_name";
X	unlink("$req_name");
X	&popd(*main_dir_stack);
X}',
X
X
X'tag',		'{ # edit perl routine for Softlist, and use (via require) result
X        local ($pushd_arg[0]) = $DIRS{"LIB"};
X	local ($routine, $filename, $ignore);
SHAR_EOF
echo "End of SoftList 3.0 Beta part 2"
echo "File dotSoftListrc is continued in part 3"
echo "3" > s3_seq_.tmp
exit 0
-- 
     Daniel Smith, Autodesk, Sausalito, California, (415) 332-2344 x 2580
	      Disclaimer: written by a highly caffeinated mammal
	    dansmith@autodesk.com            dansmith@well.sf.ca.us


------------------------------

** FOR YOUR REFERENCE **

The service addresses, to which questions about the list itself and requests
to be added to or deleted from it should be directed, are as follows:

    Internet: Perl-Users-Request@fuggles.acc.Virginia.EDU
              Perl-Users-Request@uvaarpa.Virginia.EDU
    BITNET:   Perl-Req@Virginia
    UUCP:     ...!uunet!virginia!perl-users-request

You can send mail to the entire list (and comp.lang.perl) via one of these
addresses:

    Internet: Perl-Users@uvaarpa.Virginia.EDU
    BITNET:   Perl@Virginia
    UUCP:     ...!uunet!virginia!perl-users

End of Perl-Users Digest
******************************
--[1700]--
