Subject: Rolo.el: Perl script for non-Emacs users

From: Alan Stebbens <[email-masked]>
Date: Wed, 8 Jan 1992 16:25:21 GMT

For those of you who do not use Emacs ubiquitously, or to make the
rolodex database available to your non-Emacs friends (& enemies :^), the
following Perl script may help.  It uses the same database that the
Emacs rolo.el stuff uses (it does, however, allow certain programmatic
extensions, which should not negatively affect the Emacs usage).

Enjoy.

Alan Stebbens   Computer Resource Manager
		Center for Computational Sciences and Engineering (CCSE)
		University of California, Santa Barbara
		3111 Engineering I
		Santa Barbara, CA 93106

Internet: [email-masked]
BITNET:   [email-masked]
UUCP:     ...{ucbvax,sdcsvax,cepu}!ucsbcsl!aks
Voice:    (805) 893-8135 (CCSE Office: 893-3221)

============================= cut here ===================================
#!/usr/local/bin/perl
# $Header$
#
# rolo [opts] string ...
#
# Search the rolodex for "string"
#
# opts:
#  -l    list the filenames
#  -h    omit the file headers
#  -e    list the entries [default]
#  -t    don't print the level hierarchy (terse)
#  -w    match by word
#  -c    count and print just the number of matches
#
# Author:  Alan K. Stebbens <[email-masked]>
#	   University of California
#          Santa Barbara, CA  93106
#	
# The rolodex consists of the files
#
# 	~/.rolodex{.otl,}
# 	/usr/local/lib/rolodex/*
# 
# also if ROLOPATH is defined, it is used instead of /usr/local/lib/rolodex.
#
# The syntax of a rolodex file (hereafter called a "rolofile") is heirarchical
# and pretty simple.
#
# As configured by default, each rolofile can contain an initial "header" which 
# will be printed above any output produced from that file, the end of the header
# is recognized with a regular expression, called "RoloHeader".

# A new rolodex entry is recognized with a regular expression called "RoloEntry".

# Since the rolodex entries are heirarchical, and since the RoloEntry is configurable,
# there needs to be a way to determine the depth of each entry, relative to the
# others.  The standard "RoloEntry" is to recognize leading asterisks; the standard
# level, then, is the length of the asterisk string.  If you change the RoloEntry,
# you must also change RoloDepth to be a Perl expression which returns the depth
# of the current RoloEntry.

# A possible alternative for both might be:
#
#  RoloEntry:   "^(\d+)."
#  RoloLevel:   "(0+$1)"
#
# Note that RoloLevel is eval'ed immediately after RoloEntry succeeds, allowing
# pattern match substrings ($1, $2, etc.) to be used in RoloLevel.

# Comment lines may be embedded anywhere within the rolodex file, even in the header
# by beginning them with the string recognized by the regular expression contained
# in the variable "RoloComment".

# These strings have standard default values, but may be overridden, in each 
# file, by the first lines containing the following text (the values shown below
# are the defaults).  The strings *must* be quoted; embedded quotes must be escaped
# with a backslash.

#
#  RoloHeader:  "^==="
#  RoloEntry:   "^\*+"
#  RoloComment: "^#"

$RoloPath = '/usr/local/lib/rolodex' unless $RoloPath = $ENV{'ROLOPATH'};
@RoloFiles = (grep(!/^#|[#~]$/,<~/.rolodex*>));
push(@RoloFiles,grep(!/^#|[#~]$/,eval("<$RoloPath/*>")));

$RoloHeader  = "^===";
$RoloEntry   = "^\\*+";
$RoloLevel   = "(/^(\\*+)/ && length(\$1))";
$RoloComment = '^#';

# Scan the arguments

$Headers = 1;			# on by default
$FileNames = 0;			# off by default
$Entries = 1;			# on by default
$LevelTree = 1;			# on by default
$CountMatches = 0;		# off by default
$WordMatch = 0; 		# match keywords as words

@Search = ();			# search patterns

if ($#ARGV < $[) {
    print STDERR "usage: rolo [options] keyword ...
Options are:
   -c    count and print just the number of matches
   -e    list the entries [default]
   -l    list the filenames
   -h    omit the file headers
   -p    match with the following REGEXP pattern
   -t    don't print the level hierarchy (terse)
   -w    match by word
";
    exit 1;
}

while ($_ = shift) {
    if (/^-/) {
	$Headers = 0                     if /^-.*h/;
	($Entries = 0,$FileNames = 1)    if /^-.*l/;
	($Entries = 0,$CountMatches = 1) if /^-.*c/;
	$Entries = 1                     if /^-.*e/;
	($Headers = 0,$LevelTree = 0)    if /^-.*t/;
	push(@Search,shift)              if /^-.*p/;
	$WordMatch = 1                   if /^-.*w/;
	next;
    }
    s/([^\w])/\\$1/g;		# escape funny chars
    $_ = '\b'.$_.'\b' if $WordMatch; # do word matching maybe
    push(@Search,$_);
}
$Matches = 0;
$MatchLevel = 0;    
$Header = '';
$OutHeader = '';
$OutFile = '';

# Scan the files now

foreach $File (@RoloFiles) {
    open(FILE,$File) || do {
	warn "Can't open rolodex file $File because $!\n";
	next;
    };
    while (<FILE>) {
	next if /$RoloComment/;	# until it's changed
	last unless /^(Rolo\w+):\s*(\S.*\S)\s*$/; # configuration?
	eval("\$$1 = ".$2.";");
	warn "$@\n" if $@;
    }
    @RoloData = ();
    $#RoloData = 10;
    $Header = /$RoloComment/ ? '' : $_;
    $MatchLevel = 0;
    while (<FILE>) {
	next if /$RoloComment/;
	$Header .= $_;
	last if /$RoloHeader/;
    }
    if ($OutHeader) {
	$OutHeader =~ s/\s+/ /g;
	($NewHeader = $Header) =~ s/\s+/ /g;
	$Header = '' if (length($NewHeader) == length($OutHeader) &&
		     $NewHeader eq $OutHeader);
    }
    # Now scan the file looking for rolodex entries
    $level = 0;
line:while (<FILE>) {
	next if /$RoloComment/;
	if (/$RoloEntry/) {	# new entry?
	    $lastlevel = $level;
	    $level = eval($RoloLevel);
	    if ($MatchLevel && $MatchLevel < $level) {
		$RoloData[$MatchLevel] .= $_;
	    } else {
		&ShowLevel($MatchLevel) if $MatchLevel >= $level;
		$RoloData[$level] = $_;
	    }
	} else {
	    $RoloData[$level] .= $_;
	}
	next if $MatchLevel;
	foreach $pat (@Search) {
	    if (/$pat/i) {
		if ($Entries == 0 && $FileNames) {
		    print $File."\n";
		    last line;
		}
		$MatchLevel = $level;
	    }
	}
    }
    &ShowLevel($MatchLevel) if $MatchLevel;
    close FILE;
}
printf "%d matches\n", $Matches if $CountMatches;
exit;

sub ShowLevel {
    local($level) = $_[0];
    if ($FileNames && $OutFile ne $File) {
	print ">>>File: $File <<<\n";
	$OutFile = $File;
    }
    if ($Headers && $Header && $Entries) {
	print $Header;
	$OutHeader = $Header;
	$Header = '';	# we only do this once per file
    }
    for ($i = $LevelTree ? 1 : $level; $i <= $level; $i++) {
	print $RoloData[$i] if $Entries;
	$RoloData[$i] = '';
    }
    $MatchLevel = '';
    $Matches++;
}