From: skunz@iastate.edu (Steven L Kunz)
Subject: menu.pl v1.3 - curseperl menu facility
Organization: Iowa State University, Ames IA
Date: Fri, 18 Dec 1992 17:18:20 GMT

This is a new/improved distribution of my "menu.pl" package.
The current version is "menu.pl version 1.3".  The last version I
distributed via "comp.lang.perl" was version 1.1.

For PREVIOUS users of "menu.pl", this version contains bug fixes, "top" level
menu support, "latched" (remembered) menu position support, and (maybe most
important) a user document for the routines.  This version is compatible
with all old calls (so your old code should still work with the new
package).

For NEW menu.pl package users (from the top of MENU_DOC) ...
                  
--------
Overview
--------

  The "menu.pl" package is a perl package (built into your perl program
  with a "require menu.pl" command) that automates curses-based full screen
  menus.  Using three simple calls, any number of items may be selected from a
  single or multiple-page menu by moving an arrow to the desired item or
  directly entering the selection number displayed on the screen.  Paging
  through multiple-page menus is handled automatically.  Menu titles and 
  prompts are supported. 

  The "menu.pl" package uses curses interface routine calls supplied by the
  "curseperl" package.  The "curseperl" package is distributed with the normal
  perl distribution in the "usub" directory.  The "curseperl" binary is a
  complete perl interpreter with the addition of many "curses" routines
  dealing with screen manipulation (cursor positioning, display of text at the
  current cursor location, etc).  Applications using "menu.pl" must be
  constructed to use "curseperl" instead of "perl". 

  Most applications using perl menus will use the following three calls
  (with the "menu_item" routine used multiple times to provide the menu
  selections) as follows:

     #!/usr/bin/curseperl
     ...
     &menu_init(1,"Select an Animal"); # Init menu

     &menu_item("Collie","dog"); # Add item
     &menu_item("Shetland","pony"); # Add item
     &menu_item("Persian","cat"); # Add last item

     $sel = &menu_display("Which animal?"); # Get user selection

     if ($sel eq "dog") { ... }
     ...

---------------------- menu.pl version 1.3 distribution --------------------
#!/bin/sh
# to extract, remove the header and type "sh filename"
if `test ! -s ./demo`
then
echo "writing ./demo"
cat > ./demo << '\End\Of\Shar\'
#!../bin/curseperl
#
# demo --  Simple perl menu demo
#
# Note:    Requires curseperl
#          Demonstrates "latched" (remembered) menu position technique 
#          in "long" menu routine.
#
# Author:  Steven L. Kunz
#          Networking & Communications
#          Iowa State University Computation Center
#          Ames, IA  50011
#          Email: skunz@iastate.edu
#
# Date:    Dec, 1992
#

require "./menu.pl";

  $menu_default_top = 0; # Storage for mainline top item number.
  $menu_default = 0;     # Storage for mainline arrow location.

  while (1) {
    &menu_init(1,"Demo Selection");
    &menu_item("Exit this demo","exit");
    &menu_item("See a single-page menu demo","test_short_menu");
    &menu_item("See a multiple-page menu demo","test_long_menu");

    $sel = &menu_display("Which demo would you like to see?",
                         $menu_default,$menu_default_top);

    if ($sel eq "exit") { last; }
    if ($sel ne "%UP%") { 
      
      &$sel; # Note that this assumes the "action_text" is a subroutine name	
    }
  }
  exit;

#
#  Build a short (one page) demo menu.
#
sub test_short_menu {
  local($sel);

  while (1) {

# Init a numbered menu with a title
    &menu_init(1,"Short Menu (fits on one page)");

# Add item to return to main menu.
    &menu_item("Exit \"Short Menu\" demo","exit");

# Add several items
    &menu_item("Dog","animal");
    &menu_item("Cat","animal");
    &menu_item("Granite","mineral");
    &menu_item("Mouse","animal");
    &menu_item("Shale","mineral");
    &menu_item("Onion","vegetable");
    &menu_item("Carrot","vegetable");

# Display menu and process selection.
# Note that previous position is not remembered because parms 2 and 3 
# are not supplied to store values used on subsequent call.
    $sel= &menu_display("");

    if (($sel eq "%UP%") || ($sel eq "exit")) { return; }
    print "You picked a $sel.\n";
    $ch = <>;
  }
}

#
# Build demo long menu (several pages)
#
sub test_long_menu {
  local($sel_num);

  local($menu_default_top) = 0; # Storage for local top menu item number.
  local($menu_default) = 0;     # Storage for local arrow location.

  while (1) {

# Init a numbered menu with title
    &menu_init(1,"Long Menu (fits on several pages)");

# Add item to return to main menu.
    &menu_item("Exit \"Long Menu\" demo","exit");

# Build 50 entries in the menu
    $i = 1;
    while ($i < 50) {
      $sel_num = $i + 1;
      &menu_item("Item $sel_num","action-$sel_num");
      $i++;
    }

# Get user selection.
# Note that local parms 2 and 3 are provided to provide storage of the
# default arrow location and top menu item on the screen for subsequent call.
    $sel = &menu_display("",$menu_default,$menu_default_top);

    if (($sel eq "%UP%") || ($sel eq "exit")) { return; }
    print "You picked the item with selection-action $sel.\n";
    $ch = <>;
  }
}
\End\Of\Shar\
else
  echo "will not over write ./demo"
fi
if [ `wc -c ./demo | awk '{printf $1}'` -ne 2867 ]
then
echo `wc -c ./demo | awk '{print "Got " $1 ", Expected " 2867}'`
fi
if `test ! -s ./README`
then
echo "writing ./README"
cat > ./README << '\End\Of\Shar\'
                                   menu.pl
                                 Perl Menus
                                 Version 1.3
                              December 18, 1992

                               Steven L. Kunz
                         Networking & Communications
                  Iowa State University Computation Center
                            Iowa State University
                                 Ames,  Iowa
                  

This is "menu.pl" - a set of perl routines that will perform full screen
menu functions using "curseperl".  What you should have after unpacking 
this package is the following:

  README         (this file)

  RELEASE_NOTES  Differences between this version and previous versions.

  MENU_DOC       A user's guide to the menu.pl routines.

  demo           A simple menu demo.

  demotop        A simple menu demo with "top" menus.

  ezview         A more involved demo showing how menus can be used to call
                 routines, select files, etc.

  menu.pl        The perl menu subroutines in a package (usually placed 
                 somewhere like /usr/local/lib/perl/menu.pl)

  ultpatch       Patches I had to apply to the bsdcurses.mus file to make 
                 it work on an ULTRIX (BSD based) system.

Installation:

  1) If you don't have curseperl working and installed somewhere, go into
     your perl.4.35 distribution (in the "usub" directory) and construct it
     following the instructions there.  Be forewarned that when I put it 
     together it didn't work on my ULTRIX 4.2a system - I had to install some
     patches I got off comp.lang.perl (posted by drw@nevanlinna.mit.edu)
     and some changes I had to add myself.  The file "ultpatch" is the
     diffs between what I run and what is distributed with perl.  Patch
     your original bsdcurses.mus with this if you are having trouble
     getting curseperl to work with ULTRIX.  These patches mainly involve
     commenting out routine calls absent in the ULTRIX curses package.

     Install your "curseperl" in the same location as your normal "perl"
     binary.

     You will probably have to modify the first lines of the demo scripts
     ("demo", "demotop", and "ezmail") to point to where your "curseperl" 
     is installed.

  2) Put "menu.pl" with the rest of your perl packages (usually in something
     like "/usr/local/lib/perl").  The demo programs will work by just leaving
     a copy of "menu.pl" in the same directory as the demo scripts.


---
Steven L. Kunz
Networked Applications
Iowa State University Computation Center, Iowa State University, Ames  IA
INET: skunz@iastate.edu     BITNET: gr.slk@isumvs.bitnet
\End\Of\Shar\
else
  echo "will not over write ./README"
fi
if [ `wc -c ./README | awk '{printf $1}'` -ne 2682 ]
then
echo `wc -c ./README | awk '{print "Got " $1 ", Expected " 2682}'`
fi
if `test ! -s ./ezview`
then
echo "writing ./ezview"
cat > ./ezview << '\End\Of\Shar\'
#!../bin/curseperl
#
# EasyView -- Unix File Viewer/Editor Interface
#             (a "practical" demo for menu.pl)
#
# Note:    Requires curseperl
#
# Author:  Steven L. Kunz
#          Networking & Communications
#          Iowa State University Computation Center
#          Ames, IA  50011
#          Email: skunz@iastate.edu
#
# Date:    May, 1992
#

require "./menu.pl";

    $lines = $LINES; $lines1 = $lines - 1; $lines2 = $lines - 2;
    $cols = $COLS;   $cols1  = $cols  - 1; $cols2  = $cols  - 2;;

    $SIG{'INT'} = 'cleanup';
    $| = 1;		# command buffering on stdout

  $last_arrow = 0;
  $last_top = 0;
#
#  MAIN_MENU -- Main (top level) menu
#
  while (1) {
    &menu_init(1,"EasyView Version 1.1");
    &menu_item("Exit","%UP%");
    &menu_item("List files in current directory","dir_list");
    &menu_item("Page through a text file","page_file");
    &menu_item("Edit a text file","edit_file");

    $subr = &menu_display("",$last_arrow,$last_top);
    if ($subr eq "%UP%") { 
      &cleanup;
    }
    if ($subr ne "") { &$subr; }	# Call subroutine selected
  }

#**********
#  DIR_LIST -- Provide directory list
#**********
sub dir_list {
   &dir_select(0,".","Directory Contents");
}

#***********
#  PAGE_FILE -- Page through a file in the current directory
#
#  Arguments:  None
#
#  Returns:    Nothing
#
#  Note: Uses file as an unnumbered menu
#***********
sub page_file {
  local($filename,$last_arrow,$last_top);

# Call utility function to select file
  $title = "Select file to page through";
  $filename = &dir_select(1,".","Select file to page through");
  if ($filename eq "%UP%") {
    return;
  }

# Load file as an unnumbered menu - let menu_display do the paging
#
# Special thanks: The tab expansion used here was lifted from the
# "pager" program distributed with perl.4.19 in the "usub" directory.
# Don't know who wrote it but it fit the bill.  SLK
#
  &menu_init(0,"File: $filename");
  open(TEMP,$filename);
  while (<TEMP>) {
    s/^(\t+)/'        ' x length($1)/e;
    &expand($_) if /\t/;
    &menu_item($_,"");
  }
  &menu_display("",$last_arrow,$last_top);
  close(TEMP);
}

sub expand {
    while (($off = index($_[0],"\t")) >= 0) {
        substr($_[0], $off, 1) = ' ' x (8 - $off % 8);
    }
}


#***********
#  EDIT_FILE -- Edit a file in the current directory
#***********
sub edit_file {
  &clear;
  $title = "Select file to edit";
  $filename = &dir_select(1,".","Select file to edit");
  if ($filename eq "%UP%") {
    return;
  }
  system("vi $filename");
}

#************
#  DIR_SELECT -- Load a formatted directory list into a menu.
#
#  Arguments:  Boolean flag indicating numbered menu (1=yes), directory 
#              name string and top-title string for menu
#
#  Returns:    File name (or "%UP%")
#************
sub dir_select {
  local($numbered,$directory,$title) = @_;
  local($last_arrow,$last_top) = 0;
  opendir(DIR,$directory);
  &menu_init($numbered,$title);
dir_entry:
  while ($filename = readdir(DIR)) {
    next dir_entry if ($filename eq "."); 
    next dir_entry if ($filename eq ".."); 
    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat($filename);
    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($mtime);
    $mon++;
    $sel_action = $filename;
    $filename=$filename.substr("                    ",0,20-length($filename));
    $sel_text = sprintf("%s%s%02d/%02d/%02d %02d:%02d  %s\n",
                $filename,$filler,$mon,$mday,$year,$hour,$sec,getpwuid($uid));
    &menu_item($sel_text,$sel_action);
  }
  $fn = &menu_display("",$last_arrow,$last_top);
  $fn;
}

sub cleanup {
  &clear;
  &refresh;
  exit;
}
\End\Of\Shar\
else
  echo "will not over write ./ezview"
fi
if [ `wc -c ./ezview | awk '{printf $1}'` -ne 3670 ]
then
echo `wc -c ./ezview | awk '{print "Got " $1 ", Expected " 3670}'`
fi
if `test ! -s ./menu.pl`
then
echo "writing ./menu.pl"
cat > ./menu.pl << '\End\Of\Shar\'
#****************************************************************************
# menu.pl -- Perl Menu Support Facility 
#
# Version: 1.3
#
# Author:  Steven L. Kunz
#          Networking & Communications
#          Iowa State University Computation Center
#          Ames, IA  50011
#
# Bugs:    skunz@iastate.edu
# Cheers:  skunz@iastate.edu
#
# Date:    Version 1.0 -- May, 1992 -- Original version 
#          Version 1.1 -- Aug, 1992 -- Minor enhancements, bugfixes
#          Version 1.2 -- Nov, 1992 -- Selection bugfix
#          Version 1.3 -- Dec, 1992 -- "top" and "latch" functions added
#
# Notes:   This package requires curseperl
#          (distributed with perl 4.35 in the usub directory).
#
#          Use:
#             &menu_init(1,"title");
#             &menu_item("Topic 1","got_1");
#             &menu_item("Topic 2","got_2");
#             ...
#             &menu_item("Topic n","got_n");
#             $sel_text = &menu_display("Select using arrow keys");
#
#****************************************************************************

package perlmenu;

$did_initterm = 0;
$curses_application = 0;
$menu_exit_routine = "main'clear";
$menu_is_first_one = 1;
$menu_is_top_one = 0;
$menu_top_activated = 0;
$finding_top = 0;

#**********
#  MENU_CURSES_APPLICATION
#
#  Function:	Indicate application is using curses calls.  If called, 
#		the menu routines will not do initscr and endwin calls 
#		(the application must do them).
#
#  Call format:	&menu_curses_application;
#
#  Arguments:	None
#
#  Returns:	Nothing
#**********
sub main'menu_curses_application { $curses_application = 1; }

#**********
#  MENU_QUIT_ROUTINE
#
#  Function:	Specify a "cleanup" routine to be called before a "quit"
#		from the application is processed.
#
#  Call format:	&menu_quit_routine("string");
#
#  Arguments:	String containing name of exit routine to call.
#
#  Returns:	Nothing.
#
#**********
sub main'menu_quit_routine { $menu_exit_routine = "main'@_"; }

#**********
#  MENU_INIT
#
#  Function:	Initialize menu type (numbered or unnumbered), arrays, 
#		title, and "top" flags.
#
#  Call format:	&menu_init([0|1],"Top Title");
#
#  Arguments:   Boolean flag indicating whether or not a arrows and numbers
#               are desired (0=no, 1=yes) and title text (for the top line
#               of menu) and an optional boolean top-menu indicator.
#
#  Returns:	Nothing
#
#  Notes:	1) If the title string begins with a "-" the title is not
#		   presented in reverse-video ("standout") representation.
#               2) If this is the FIRST menu_init call and the optional
#                  third opernd is "1", it is the "top" menu.
#**********
sub main'menu_init {
  ($menu_numbered,$menu_top_title,$menu_is_top_one) = @_;

# Perform initscr if not a curses application
  if (!$curses_application) { &main'initscr; }

# Load "magic sequence" array based on terminal type
  if (!$did_initterm) {		# Get terminal info (if we don't have it).
    &defbell unless defined &bell;

    $ku = &main'getcap('ku');	# Cursor-up
    $kd = &main'getcap('kd');	# Cursor-down
    $cr = &main'getcap('cr');	# Carriage-return
    $nl = &main'getcap('nl');	# New-line
    $ansi_ku = "\033[A";	# Ansi cursor-up (for DEC xterm)
    $ansi_kd = "\033[B";	# Ansi cursor-down (for DEC xterm)

    @magic_seq = ($ku,$ansi_ku,$kd,$ansi_kd,$cr,$nl,"\n",
		  "n","N","p","P","f","F"," ","b","B");
    $did_initterm = 1;
  }

# Check for title format character.
  $menu_top_title_attr = 0;
  if (substr($menu_top_title,0,1) eq '-') {
    $menu_top_title = substr($menu_top_title,1);
    $menu_top_title_attr = 1;
  }

# Center top title
  if (length($menu_top_title) > $main'COLS) {
    $menu_top_title = substr($menu_top_title,0,$main'COLS);
    $menu_top_title_col = 0;
  }
  else {
    $menu_top_title_col = int($main'COLS/2) - int(length($menu_top_title)/2);
  }

# Enable "top menu" functions if first menu is a top menu.
  if (($menu_is_first_one) && ($menu_is_top_one)) { $menu_top_activated = 1; }
  $menu_is_first_one = 0;

# Init selection array
  @menu_sel_text = ();		# Clear menu arrays
  @menu_sel_action = ();
  $menu_index = 0;		# Reset flags

  $first_line = 2;
  $last_line = $main'LINES - 3;
  $items_per_screen = $last_line - $first_line + 1;
  $arrow_line = $first_line;
  $menu_top_item = 0;
}

#***********
#  MENU_ITEM
#
#  Function:	Add an item to the active menu.
#
#  Call format:	&menu_item("What you see","test_rtn");
#
#  Arguments:	String presented in menu, string returned if selected
#
#  Returns:	Number of items currently in the menu.
#***********
sub main'menu_item {
  local($item_text,$item_sel) = @_;
  local($sel_num,$sel_str);

# Prepend selection number (if a numbered menu)
  if ($menu_numbered) {
    $sel_num = $menu_index + 1;
    $sel_str = "  ";
    if ($sel_num < 1000) { $sel_str .= " "; }
    if ($sel_num < 100) { $sel_str .= " "; }
    if ($sel_num < 10) { $sel_str .= " "; }
    $sel_str .= "$sel_num) ";
    $item_text = $sel_str.$item_text;
  }

# Truncate lines that would wrap
  if (length($item_text) > $main'COLS - 1) {
    $item_text = substr($item_text,0,$main'COLS - 1);
  }

# Load into arrays and adjust index
  @menu_sel_text[$menu_index] = $item_text;
  @menu_sel_action[$menu_index] = $item_sel;
  $menu_index++;
}

#**********
#  MENU_DISPLAY 
#
#  Function:	Display items in menu_sel_text array, allow selection, and
#		return appropriate selection-string.
#
#  Call format:	$sel = &menu_display("Prompt text");
#
#  Arguments:   Prompt text (for the bottom line of menu)
#
#  Returns:     Select action string (from second param on &menu_init) OR
#		"%UP%" (if "u"|"U" pressed or "t"|"T" and looking for top) OR
#               "%EMPTY% if nothing in menu to display
#
#  Notes:	1) This routine ALWAYS sets "nocbreak" and "echo" terminal 
#		   modes before returning.
#		2) This routine exits directly (after calling the optional 
#		   "quit" routine) if "q"|"Q" is pressed.
#**********
sub main'menu_display {
  ($menu_prompt,$arrow_spec,$menu_top_item) = @_;

# If looking for top menu, return with "%UP%".
  if ($finding_top) {
    if ($menu_is_top_one) { $finding_top = 0; } 
    else { return("%UP%"); }
  }

# Check for no "menu_item" calls.
  $total_items = $#menu_sel_text + 1;
  if ($total_items <= 0) {
    &main'nocbreak;		# ALWAYS turn off "cbreak" mode
    &main'echo;			# ALWAYS turn on "echo"
    return("%EMPTY%");
  }

  &main'cbreak;			# cbreak mode (each character available)
  &main'noecho;			# Menus are always "noecho"

  if ($total_items <= $items_per_screen) { $menu_single_page = 1; }
  else { $menu_single_page = 0; }

  if ($menu_prompt eq "") {
    $menu_prompt = "Move w/up&down-arrows q=quit";
    if (! $menu_single_page) { $menu_prompt .= " f=fwd-pg b=back-pg"; }
    if (! $menu_top_activated) {
      $menu_prompt .= " u=up-a-menu";
    } else {
      if (! $menu_is_top_one) { $menu_prompt .= " u=up-a-menu t=top-menu"; }
    }
  }
  if (length($menu_prompt) > $main'COLS - 7) {
    $menu_prompt = substr($menu_prompt,0,$main'COLS - 7);
  }

# Validate/adjust paramaters.
  $arrow_line = $arrow_spec + $first_line;
  if ($menu_top_item + 1 > $total_items) { $menu_top_item = $total_items - 1; }
  if ($arrow_line < $first_line) { $arrow_line = $first_line; }
  if ($arrow_line > $last_line) { $arrow_line = $last_line; }

# Clear screen and add top title and bottom prompt
  &menu_top_bot;
  $move_amt = 0;
  $number = 0;
   
  while (1) {
    $number_shown = $menu_top_item + $items_per_screen;
    if ($number_shown > $total_items) { $number_shown = $total_items; }
    $percent = int($number_shown * 100 /$total_items);

    &menu_page;			# Display current page
    &main'refresh;		# Update screen

# Collect key sequences until something we recoginize 
# (or we know we don't care)
    $collect = "";
    $action = "";
    $possible = $#magic_seq;	# Set number of possible matches 

seq_seek:
    while ($possible > 0) {
      $ch = &main'getch;

      if ($collect eq "") {	# Numbers/refresh allowed yet ...
	if (($ch eq "r") || ($ch eq "R")) {		# Refresh
	  &main'clear;
	  &menu_top_bot;
	  &menu_page;
	  &main'refresh;
	  next seq_seek;
	}
	if (($ch eq "\177") || ($ch eq "\010")) {	# Delete/BS num-reset
	  $number = 0;
	  $arrow_line = $first_line;
	  &menu_page;
	  &main'refresh;
	  next seq_seek;
	}
	$digit_val = index("0123456789",$ch);
	if ($digit_val >= 0) {				# It IS a number ...
	  $number = $number * 10 + $digit_val;
	  if ($number >= $menu_top_item + 1) { 
	    if ($number <= $menu_bot_item + 1) {
	      $arrow_line = $number - $menu_top_item + $first_line - 1;
	    } else {
	      &bell;
	      $number = 0;
	      $arrow_line = $first_line;
	    }
	    &menu_page;
	    &main'refresh;
	  }
	  next seq_seek;
	}
      }

      $collect = $collect.$ch;

      if (($collect eq "Q") || ($collect eq "q")) {
        &main'clear;
	&main'move(0,0);
	&main'addstr("Do you really want to quit? y");
	&main'move(0,28);
	&main'refresh;
	$ch = &main'getch;
	if (($ch eq $cr) || ($ch eq $nl) || ($ch eq "\n")) { $ch = "y"; }
	$ch =~ tr/A-Z/a-z/;
	if ($ch eq "y") {
	  if ($menu_exit_routine ne "") { &$menu_exit_routine; }
	  &menu_return_prep;
	  exit(0);
	}
	&menu_top_bot;		# Re-display current page
	&menu_page;
	&main'refresh;
	$collect = "";
      }
      if (($collect eq "U") || ($collect eq "u")) {
	&menu_return_prep;
	$finding_top = 0;
	return("%UP%");
      }
      if (($collect eq "T") || ($collect eq "t")) {
        if (($menu_top_activated) && (! $menu_is_top_one)) {
	  &menu_return_prep;
	  $finding_top = 1;
	  return("%UP%");
	}
      }
      $i = 0;
      $possible = 0;
try:
      while ($i <= $#magic_seq) {
        if (length($collect) > length($magic_seq[$i])) {
	  $i++;
	  next try;
        }
	if (substr($magic_seq[$i],0,length($collect)) eq $collect) {
          $possible++;
	  if ($collect eq $magic_seq[$i]) {
            $action = $magic_seq[$i];
            last seq_seek;
          }
        }
        $i++;
      } # end while
    }

#  Perform action based on keystroke(s) received
    $move_amt = 0;
    if ($action ne "") {
      $last_arrow_line = $arrow_line;
      if (($action eq $kd) || ($action eq $ansi_kd)) {		# down-arrow
        $number = 0;
        if ($arrow_line < $max_sel_line) { $arrow_line++; }
        else {
	  if ($arrow_line == $last_line) { $move_amt = 1; }
        }
      }
      elsif (($action eq $ku) || ($action eq $ansi_ku)) {	# up-arrow
        $number = 0;
        if ($arrow_line > $min_sel_line) { $arrow_line--; }
        else { $move_amt = -1; }
      }
      elsif (($action eq "n") || ($action eq "N") ||     # next/forward
	     ($action eq "f") || ($action eq "F") || ($action eq " ")) {
        $number = 0;
	$move_amt = $items_per_screen;
      }
      elsif (($action eq "p") || ($action eq "P") ||	# previous/backward
	     ($action eq "b") || ($action eq "B")) {
        $number = 0;
	$move_amt = -$items_per_screen;
      }
      elsif (($action eq $cr) || ($action eq $nl) || 
	     ($action eq "\n")) {			# select
	if ($number) { $item = $number - 1; }
	else { $item = $menu_top_item + $arrow_line - $first_line; }
	if (($item < $menu_top_item) || ($item > $menu_bot_item)) {
	  &bell;
	  $number = 0;
	}
	else {
	  &menu_return_prep;
          if ($#_ > 0) { @_[1] = $arrow_line - $first_line; }
          if ($#_ > 0) { @_[2] = $menu_top_item; }
	  return(@menu_sel_action[$item]);
	}
      }

# Check for paging of the menu text
      if ($move_amt != 0) {
	if ($move_amt < 0) { # Move backward
	  $menu_top_item = $menu_top_item + $move_amt;
	  if ($menu_top_item < 0) { $menu_top_item = 0; }
	}
	else { # Move forward
	  if ($menu_top_item + $move_amt < $total_items) {
	    $menu_top_item = $menu_top_item + $move_amt;
	  }
	} 
      }

# Erase the last selection arrow
      if ($menu_numbered) {
	&main'move($last_arrow_line,0);
	&main'addstr("  ");
      }
    }
  }
}

#**********
#  MENU_TOP_BOT -- Display top and bottom lines of current menu
#**********
sub menu_top_bot {
  &main'clear;
  &main'move(0,$menu_top_title_col);
  if ($menu_top_title_attr == 0) { &main'standout; }
  &main'addstr($menu_top_title);
  if ($menu_top_title_attr == 0) { &main'standend; }
  &main'move($last_line+2,7);
  &main'addstr($menu_prompt);
}

#**********
#  MENU_PAGE -- Display one page of menu selection items.
#**********
sub menu_page {

# Update percentage on bottom line
  &main'move($last_line+2,0);
  &main'standout;
  if ($menu_single_page) { &main'addstr("(All) "); }
  else { &main'addstr(sprintf("\(%3d%%\)",$percent)); }
  &main'standend;
 
# Display current page of menu
  $item = $menu_top_item;
  $menu_bot_item = $menu_top_item;
  $curr_line = $first_line;
  $min_sel_line = $first_line;
  $max_sel_line = $first_line;
  while ($curr_line <= $last_line) {
    &main'move($curr_line,0);
    &main'clrtoeol;
    $sel_num = $item + 1;
    if ($item < $total_items) {
      &main'addstr("$menu_sel_text[$item]");
      $max_sel_line = $curr_line;
      $menu_bot_item = $item;
    }
    $item++;
    $curr_line++;
  }
 
#  Position the selection arrow on the screen (if numbered menu)
  if ($arrow_line > $max_sel_line) { $arrow_line = $max_sel_line; }
  &main'move($arrow_line,0);
  if ($menu_numbered) { &main'addstr("->"); }
}

sub menu_return_prep {
  if (!$curses_application) { &main'endwin; }
  &main'nocbreak;
  &main'echo; 
  &main'clear;
  &main'refresh; 
}

sub defbell {
  eval q#
    sub bell { print "\007"; }
  #;
}

1;
\End\Of\Shar\
else
  echo "will not over write ./menu.pl"
fi
if [ `wc -c ./menu.pl | awk '{printf $1}'` -ne 13453 ]
then
echo `wc -c ./menu.pl | awk '{print "Got " $1 ", Expected " 13453}'`
fi
if `test ! -s ./ultpatch`
then
echo "writing ./ultpatch"
cat > ./ultpatch << '\End\Of\Shar\'
*** bsdcurses.mus.dist	Tue Jun  9 11:02:56 1992
--- bsdcurses.mus	Tue Jun  9 11:04:40 1992
***************
*** 54,60 ****
      US_erase,
      US_werase,
      US_flushok,
-     US_idlok,
      US_insch,
      US_winsch,
      US_insertln,
--- 54,59 ----
***************
*** 83,101 ****
      US_noraw,
      US_scanw,
      US_wscanw,
-     US_baudrate,
      US_delwin,
      US_endwin,
-     US_erasechar,
      US_getcap,
      US_getyx,
      US_inch,
      US_winch,
      US_initscr,
-     US_killchar,
      US_leaveok,
      US_longname,
-     US_fullname,
      US_mvwin,
      US_newwin,
      US_nl,
--- 82,96 ----
***************
*** 102,109 ****
      US_nonl,
      US_scrollok,
      US_subwin,
-     US_touchline,
-     US_touchoverlap,
      US_touchwin,
      US_unctrl,
      US_gettmode,
--- 97,102 ----
***************
*** 161,167 ****
      make_usub("erase",		US_erase,	usersub, filename);
      make_usub("werase",		US_werase,	usersub, filename);
      make_usub("flushok",	US_flushok,	usersub, filename);
-     make_usub("idlok",		US_idlok,	usersub, filename);
      make_usub("insch",		US_insch,	usersub, filename);
      make_usub("winsch",		US_winsch,	usersub, filename);
      make_usub("insertln",	US_insertln,	usersub, filename);
--- 154,159 ----
***************
*** 190,208 ****
      make_usub("noraw",		US_noraw,	usersub, filename);
      make_usub("scanw",		US_scanw,	usersub, filename);
      make_usub("wscanw",		US_wscanw,	usersub, filename);
-     make_usub("baudrate",	US_baudrate,	usersub, filename);
      make_usub("delwin",		US_delwin,	usersub, filename);
      make_usub("endwin",		US_endwin,	usersub, filename);
-     make_usub("erasechar",	US_erasechar,	usersub, filename);
      make_usub("getcap",		US_getcap,	usersub, filename);
      make_usub("getyx",		US_getyx,	usersub, filename);
      make_usub("inch",		US_inch,	usersub, filename);
      make_usub("winch",		US_winch,	usersub, filename);
      make_usub("initscr",	US_initscr,	usersub, filename);
-     make_usub("killchar",	US_killchar,	usersub, filename);
      make_usub("leaveok",	US_leaveok,	usersub, filename);
      make_usub("longname",	US_longname,	usersub, filename);
-     make_usub("fullname",	US_fullname,	usersub, filename);
      make_usub("mvwin",		US_mvwin,	usersub, filename);
      make_usub("newwin",		US_newwin,	usersub, filename);
      make_usub("nl",		US_nl,		usersub, filename);
--- 182,196 ----
***************
*** 209,216 ****
      make_usub("nonl",		US_nonl,	usersub, filename);
      make_usub("scrollok",	US_scrollok,	usersub, filename);
      make_usub("subwin",		US_subwin,	usersub, filename);
-     make_usub("touchline",	US_touchline,	usersub, filename);
-     make_usub("touchoverlap",	US_touchoverlap,usersub, filename);
      make_usub("touchwin",	US_touchwin,	usersub, filename);
      make_usub("unctrl",		US_unctrl,	usersub, filename);
      make_usub("gettmode",	US_gettmode,	usersub, filename);
--- 197,202 ----
***************
*** 312,322 ****
  I	bool		boolf
  END
  
- CASE int idlok
- I	WINDOW*		win
- I	bool		boolf
- END
- 
  CASE int insch
  I	char		c
  END
--- 298,303 ----
***************
*** 466,474 ****
  CASE int noraw
  END
  
- CASE int baudrate
- END
- 
  CASE int delwin
  I	WINDOW*		win
  END
--- 447,452 ----
***************
*** 476,484 ****
  CASE int endwin
  END
  
- CASE int erasechar
- END
- 
      case US_getcap:
  	if (items != 1)
  	    fatal("Usage: &getcap($str)");
--- 454,459 ----
***************
*** 522,530 ****
  CASE WINDOW* initscr
  END
  
- CASE int killchar
- END
- 
  CASE int leaveok
  I	WINDOW*		win
  I	bool		boolf
--- 497,502 ----
***************
*** 535,545 ****
  IO	char*		name
  END
  
- CASE int fullname
- I	char*		termbuf
- IO	char*		name
- END
- 
  CASE int mvwin
  I	WINDOW*		win
  I	int		y
--- 507,512 ----
***************
*** 570,587 ****
  I	int		cols
  I	int		begin_y
  I	int		begin_x
- END
- 
- CASE int touchline
- I	WINDOW*		win
- I	int		y
- I	int		startx
- I	int		endx
- END
- 
- CASE int touchoverlap
- I	WINDOW*		win1
- I	WINDOW*		win2
  END
  
  CASE int touchwin
--- 537,542 ----
\End\Of\Shar\
else
  echo "will not over write ./ultpatch"
fi
if [ `wc -c ./ultpatch | awk '{printf $1}'` -ne 4098 ]
then
echo `wc -c ./ultpatch | awk '{print "Got " $1 ", Expected " 4098}'`
fi
if `test ! -s ./RELEASE_NOTES`
then
echo "writing ./RELEASE_NOTES"
cat > ./RELEASE_NOTES << '\End\Of\Shar\'

Changes between menu.pl version 1.1 and version 1.3:

- Fixed bug in the "numeric direct entry code".  Once a number was entered 
  it was not cleared if an arrow key was used to move the pointer off the
  selection.
- Added the "top menu" feature.  Allows for a "t" ("top") menu hot-key to
  move to the top (first displayed) menu.
- Added the "latched" menu feature.  Allows calls to "menu_display" to have
  two additional parameters that remember the screen/arrow location upon
  return from the call.  When recalling "menu_display" (with the same
  parameters) the menu will be restored to the original location/selection.

Changes between menu.pl version .9 (beta) and version 1.1:

- Declaration of "curses_application" fixed ("main`" prepended).
- Cleanup of "cbreak" and "echo" handling.  Calls to "menu_display"
  always return with "echo" and "cbreak" set.
- Return key now functions on systems that do not have termcap entries
  for either a "newline" or "return" key.
- "menu_display" will return "%EMPTY%" if no calls to "menu_item" were
  done between a "menu_init" call and a "menu_display" call.
- Hitting the "space bar" is now the same as "f" or "n" for forward movement
  within a multi-page selection menu.
- The title strings in "menu_init" calls can now begin with a "-" to suppress
  the "standout" attribute (normally a bold or reverse-video rendition).
- menu_display will no longer return "%QUIT%" - returns "%UP" instead.  The
  menu routines process a "q" (for "quit") locally and will exit from
  there (after the user responds to a "Do you really want to quit?" prompt).
- Direct number entry for selecting entries "pops" the arrow to the 
  "best fit" selection on the screen, indicating what selection will be 
  made when return is hit.
- The "ezview" demo now displays the correct modification date on its file
  display.
\End\Of\Shar\
else
  echo "will not over write ./RELEASE_NOTES"
fi
if [ `wc -c ./RELEASE_NOTES | awk '{printf $1}'` -ne 1858 ]
then
echo `wc -c ./RELEASE_NOTES | awk '{print "Got " $1 ", Expected " 1858}'`
fi
if `test ! -s ./demotop`
then
echo "writing ./demotop"
cat > ./demotop << '\End\Of\Shar\'
#!../bin/curseperl
#
# demo --  Perl menu demo - Usage of "top menu" functions.
#
# Note:    Requires curseperl.
#          Demonstrates technique to use "top" menu feature.
#
# Author:  Steven L. Kunz
#          Networking & Communications
#          Iowa State University Computation Center
#          Ames, IA  50011
#          Email: skunz@iastate.edu
#
# Date:    Dec, 1992
#

require "./menu.pl";

while (1) {
  &menu_init(1,"Top Menu",1);
  &menu_item("Exit this demo","exit");
  &menu_item("Animal","animal");
  &menu_item("Mineral","mineral");
  &menu_item("Vegetable","vegetable");

# Get selection
  $sel= &menu_display("");

# Process selection (ignore "up" at top level)
  if ($sel ne "%UP%") {
    if ($sel eq "exit") { exit; }
    if ($sel eq "animal") { &animal; }
    elsif ($sel eq "mineral") { &mineral; }
    elsif ($sel eq "vegetable") { &vegetable; }
  }
}

sub animal {
  while (1) {
    &menu_init(1,"Lower animal menu");
    &menu_item("Dog","dog");
    &menu_item("Cat","cat");
    $sel = &menu_display("");
    if ($sel eq "%UP%") { return; } # "up" or "top"
    if ($sel eq "dog") { &dog; }
    if ($sel eq "cat") { &cat; }
  }
}

sub dog {
  while (1) {
    &menu_init(1,"Lower dog menu");
    &menu_item("Lab","");
    &menu_item("Collie","");
    $sel = &menu_display("");
    if ($sel eq "%UP%") { return; } # "up" or "top"
  }
}

sub cat {
  while (1) {
    &menu_init(1,"Lower cat menu");
    &menu_item("Tabby","");
    &menu_item("Siamese","");
    $sel = &menu_display("");
    if ($sel eq "%UP%") { return; } # "up" or "top"
  }
}

sub mineral {
  while (1) {
    &menu_init(1,"Lower mineral menu");
    &menu_item("Shale","");
    &menu_item("Limestone","");
    $sel = &menu_display("");
    if ($sel eq "%UP%") { return; } # "up" or "top"
  }
}

sub vegetable {
  while (1) {
    &menu_init(1,"Lower vegetable menu");
    &menu_item("Carrot","");
    &menu_item("Pea","");
    $sel = &menu_display("");
    if ($sel eq "%UP%") { return; } # "up" or "top"
  }
}
\End\Of\Shar\
else
  echo "will not over write ./demotop"
fi
if [ `wc -c ./demotop | awk '{printf $1}'` -ne 2002 ]
then
echo `wc -c ./demotop | awk '{print "Got " $1 ", Expected " 2002}'`
fi
if `test ! -s ./MENU_DOC`
then
echo "writing ./MENU_DOC"
cat > ./MENU_DOC << '\End\Of\Shar\'
                                   menu.pl
                                 Perl Menus
                                 Version 1.3
                              December 18, 1992

                               Steven L. Kunz
                           Networked Applications
                  Iowa State University Computation Center
                            Iowa State University
                                 Ames,  Iowa
                  
--------
Overview
--------

  The "menu.pl" package is a perl package (built into your perl program
  with a "require menu.pl" command) that automates curses-based full screen
  menus.  Using three simple calls, any number of items may be selected from a
  single or multiple-page menu by moving an arrow to the desired item or
  directly entering the selection number displayed on the screen.  Paging
  through multiple-page menus is handled automatically.  Menu titles and 
  prompts are supported. 

  The "menu.pl" package uses curses interface routine calls supplied by the
  "curseperl" package.  The "curseperl" package is distributed with the normal
  perl distribution in the "usub" directory.  The "curseperl" binary is a
  complete perl interpreter with the addition of many "curses" routines
  dealing with screen manipulation (cursor positioning, display of text at the
  current cursor location, etc).  Applications using "menu.pl" must be
  constructed to use "curseperl" instead of "perl". 

  Most applications using perl menus will use the following three calls
  (with the "menu_item" routine used multiple times to provide the menu
  selections) as follows:

     #!/usr/bin/curseperl
     ...
     &menu_init(1,"Select an Animal"); # Init menu

     &menu_item("Collie","dog"); # Add item
     &menu_item("Shetland","pony"); # Add item
     &menu_item("Persian","cat"); # Add last item

     $sel = &menu_display("Which animal?"); # Get user selection

     if ($sel eq "dog") { ... }
     ...

  When this code is executed, only the call to "menu_display" will actually 
  cause the constructed menu to be displayed to the user for selection.
  The title is centered and displayed at the top of the screen in reverse
  video.  The selection items are automatically numbered and presented in
  the order they were added.  The prompt is displayed at the bottom of the
  screen preceded by an indication of how many of the items in the menu
  are presented on the current screen ("All" or some percentage).  In the 
  above example, the menu would look like:

                              Select an Animal

     -> 1) Collie
        2) Shetland
        3) Persian

     (All)  Which animal?

  Only one menu may be active at a time.  In applications with "layers" of
  menus, only the "current layer" menu is maintained in memory.  As you use
  the "up" function to "pop up" to a previous menu, your application must
  return to a subroutine (or upper program layer) that reconstructs the menu
  for that layer of the application and displays it.  Since the lower layer
  used a "menu_init" to construct that menu, the "upper layer" must reconstruct
  the entire menu appropriate at that level.  Support is provided (with
  proper programming of the application) to go directly to the "top" (first)
  menu and to remember the selection position in a previous menu. 


-------------------------------------
Initializing a new menu - "menu_init"
-------------------------------------

  Syntax:    &menu_init(num_flag,"title string")

  The "menu_init" call resets the menu array and indexes.  It must be called
  to reset/clear any old menu.  The first parameter is a boolean flag
  indicating whether or not the menu should be numbered and have a selection
  arrow "->" provided (a non-zero value indicates a numbered menu).  By
  default, the "title string" is centered at the top of the screen and
  presented in "standout" rendition (usually reverse video or bold).  If the
  first character of the title is a dash ("-") then the title will be
  presented in "normal" rendition ("standout" will be suppressed).  Title
  text that exceeds the width of the screen is automatically truncated on
  the right to fit the available width. 


------------------------------------
Adding items to a menu - "menu_item"
------------------------------------

  Syntax:    &menu_item("Selection text","action_text");

  The "menu_item" call provides selection text (what the user sees on the
  screen) and "action_text" (not seen - but returned if that item is
  selected).  There is no practical limit (other than memory or maximum
  array index size) on the number of items in a menu.  The items are
  presented in the order you add them and the top (first) item is always
  the default (except when using the "latched" menu support outlined in
  a later section).  Selection text that exceeds the width of the terminal
  is automatically truncated on the right by the "menu_item" call.  The 
  "action_text" may be a null string (in which case a null string is 
  returned upon selection).


-------------------------------------------------
Displaying/selecting from a menu - "menu_display"
-------------------------------------------------

  Syntax:    $sel_var = &menu_display("Prompt text");

  The "menu_display" call is the only call that actually writes data on the
  screen.  When it returns you have one of the following strings:

    "%UP%"          -- indicating the user did not select anything but 
                       pressed "u" (or possibly "t" - for "top menu", see
                       below) to exit the menu.

    "%EMPTY%"       -- indicating no calls were made to "menu_item" since 
                       the last "menu_init" call.

    "<action-text>" -- one of the selection-action strings given on a 
                       "menu_item" call.  

  You can either provide your own prompt as a call parameter to
  "menu_display"  or you can provide a null string (&menu_display("")) in
  which an automatic prompt is provided.  All paging functions are handled
  within the call to "menu_display" automatically.  

  Support is provided for just simply typing the selection number of the
  item on the screen - you do not have to move the selection arrow to the item
  if you prefer to type the number (followed by "return").  The arrow ("->")
  displayed on the screen will automatically jump to the selection that is the
  "best fit" for what is typed so far.  For example, if items 1-20 are
  currently on the screen, pressing a "2" will cause the arrow to jump to the
  "2)" selection.  Typing "0" (to indicate "20") causes the arrow to next jump
  to the "20)" selection.  A "return" key actually activates the selection.  A
  "delete" or "backspace" key (or any cursor-movement key) clears the "direct
  entry" selection process at any time before "return" is pressed.  

  One final note.  The call to "menu_display" will ALWAYS turn back on echo
  - so if you really want it off you will have to call "noecho" again after 
  each call to "menu_display". 


--------------------
"Top" Menu Support
(New in version 1.3)
--------------------

  There is limited support for "top" menus.  By following a careful program
  structure you can allow the user to type a "t" at any menu display and have
  the next menu presented be the "top" (first) menu presented.  This provides
  a convenient means for the user to jump to the top of a multiple-level menu
  structure from several menu-levels down. 

  Since there is only one menu active at a time, pressing "t" to indicate
  the "top" menu merely generates a "%UP%" return from the current menu
  (refer to the "menu_display" call).  However, top's "%UP%" return is
  different from a normal "u" up-action in that an internal flag is set so
  that all subsequent calls to ANY "menu_display" immediately return with an
  "%UP%" selection.  This action continues until a menu is displayed that was
  initialized with a special flag in the "menu_init" call that indicates it is
  the "top" menu.  Once a "menu_display" is called for a menu that has this
  special "menu_init" call, the "automatic %UP% return" stops and the "top
  menu" is displayed.  This special "top menu" is initialized as follows:  

      &menu_init(num_flag,"title string",1); # A "top" menu_init call

  The third parameter (a "1") indicates this is the "top" menu.

  The "top" menu support requires special care in programming.  With
  careless programming you could enter a loop if a "t" was pressed and the
  curseperl program provided no "top menu_init" call.  To provide some level
  of protection, the "t" menu hot-key and "top" support is disabled
  automatically UNLESS the FIRST "menu_init" call is also a "top menu_init"
  call (indicating the software was programmed with "top" menus in mind). 

  The "demotop" program distributed with this release of "menu.pl" provides
  an example of correct usage of the "top menu" features.   


--------------------
"Latched" Menus
(New in version 1.3)
--------------------

"Latched" menu support offers the ability to remember where you were in a
menu when it is re-displayed later.  This is often useful in traversing
a menu-tree down and them returning to previous menus (and selection
locations) when "popping back up" the tree (with the "up" hot-key).  The
only action necessary to remember position is the addition to two parameters
on the "menu_display" call as follows:

     $sel_var = &menu_display("Prompt text",$arrow_loc_var,$top_item_var);

These two values indicate the location of the arrow line on the menu screen
and the index number of the top "menu_item" on the menu screen.  If you want
the first item the first time, these values should both be initialized to
zero (first item on the first page).  This will generate the same action as
if they were not specified - the default "non-latched" call.  These two
optional parameters also are used to RETURN the value of the top item on
a menu-page and arrow location AFTER the user selected something (and the
"menu_display" routine returns).  If you do not modify the two parameters,
rebuild the menu the same way, and call "menu_display" supplying the returned
values, the menu will be displayed in the original "selection" location.

By letting "menu_display" store selection locations before moving to a lower
level in your "menu-tree" (via a subroutine call to another menu-generator),
a return from the lower level can regenerate any given levels menu and
reposition the selection location automatically.  Make sure you store your
"latch" variables in "local" storage (one set for each menu-generator
routine that has a "menu_display" call).

One final note - the "menu_display" routine will check and automatically
adjust the values to meet current menu limits.  For example, if your menus
are "dynamic" and items "disappeared" (making your last latch position off
the end of the reconstructed menu), the "menu_display" routine will adjust
to point to the the last item in the menu (adjusting the "top item" as
needed). 
 

------------------------
Other "menu.pl" Routines
------------------------

  Routine: menu_curses_application

  Syntax:  &menu_curses_application;

  It is assumed that the application calling the menu routines is not a
  "curseperl" application (i.e. it is a "stock" perl script except for calls
  to "menu.pl" routines).  However, if you are writing an "all-curses"
  application (calling curses functions from your routines) you should call
  "menu_curses_application" FIRST (once).  This sets a flag so that the
  "initscr" and "endwin" calls are NOT done by the menu.pl package calls (and
  assumes you will do them).  

  Routine: menu_quit_routine

  Syntax:  &menu_quit_routine("routine_name");

  The menu routines will process a "q" for "quit" locally.  In other words,
  if the user presses "q" while a menu is displayed (and responds to the
  "Do you really want to quit?" prompt with a "y") the perl program will
  immediately exit.  However, support is provided for a "user" exit that
  will be called just before dropping out the program (to perform any
  "cleanup" duties).  Calling "&menu_quit_routine("rtn_name");" will set
  the exit routine.
   

\End\Of\Shar\
else
  echo "will not over write ./MENU_DOC"
fi
if [ `wc -c ./MENU_DOC | awk '{printf $1}'` -ne 12238 ]
then
echo `wc -c ./MENU_DOC | awk '{print "Got " $1 ", Expected " 12238}'`
fi
echo "Finished archive 1 of 1"
exit
-- 
Steven L. Kunz
Networked Applications | Usenet News Admin.
Iowa State University Computation Center, Iowa State University, Ames  IA
INET: skunz@iastate.edu     BITNET: gr.slk@isumvs.bitnet
Newsgroups: comp.lang.perl