home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #19 / NN_1992_19.iso / spool / comp / lang / perl / 5566 < prev    next >
Encoding:
Text File  |  1992-08-27  |  29.4 KB  |  1,079 lines
  1. Newsgroups: comp.lang.perl
  2. Path: sparky!uunet!zaphod.mps.ohio-state.edu!moe.ksu.ksu.edu!ux1.cso.uiuc.edu!news.iastate.edu!corvette.cc.iastate.edu!skunz
  3. From: skunz@iastate.edu (Steven L Kunz)
  4. Subject: menu.pl version 1.1
  5. Message-ID: <skunz.714955045@corvette.cc.iastate.edu>
  6. Summary: perl menu package
  7. Sender: news@news.iastate.edu (USENET News System)
  8. Organization: Iowa State University, Ames IA
  9. Date: Thu, 27 Aug 1992 22:37:25 GMT
  10. Lines: 1067
  11.  
  12. A few months ago I posted a perl package to do curses-based menu functions.
  13. This package uses "curseperl" (in the usub directory of the perl distribution).
  14. The version I posted was my first (development) version and was menu.pl
  15. version .9 (beta).  Since then the routines have been tweeked a bit and
  16. this is the current release (1.1).  Best documentation is the "menu.pl"
  17. package itself - look at the front of each routine.  
  18.  
  19. Comments/bugs welcome.
  20.  
  21. Steve Kunz (skunz@iastate.edu)
  22.  
  23. ------------------------- menu.pl package follows ------------------------
  24. #!/bin/sh
  25. # to extract, remove the header and type "sh filename"
  26. if `test ! -s ./README`
  27. then
  28. echo "writing ./README"
  29. cat > ./README << '\End\Of\Shar\'
  30.                                    menu.pl
  31.                                  Perl Menus
  32.                                  Version 1.1
  33.  
  34.                                Steven L. Kunz
  35.                          Networking & Communications
  36.                   Iowa State University Computation Center
  37.                             Iowa State University
  38.                                  Ames,  Iowa
  39.                   
  40.  
  41. This is "menu.pl" - a set of perl routines that will perform full screen
  42. menu functions using "curseperl".  What you should have after unpacking 
  43. this package is the following:
  44.  
  45.   README         (this file)
  46.  
  47.   RELEASE_NOTES  Differences between this version and previous versions.
  48.  
  49.   demo           A simple menu demo.
  50.  
  51.   ezview         A more involved demo showing how menus can be used to call
  52.                  routines, select files, etc.
  53.  
  54.   menu.pl        The perl menu subroutines in a package (usually placed 
  55.                  somewhere like /usr/local/lib/perl/menu.pl)
  56.  
  57.   ultpatch       Patches I had to apply to the bsdcurses.mus file to make 
  58.                  it work on an ULTRIX (BSD based) system.
  59.  
  60. Installation:
  61.  
  62.   1) If you don't have curseperl working and installed somewhere, go into
  63.      your perl.4.35 distribution (in the "usub" directory) and construct it
  64.      following the instructions there.  Be forewarned that when I put it 
  65.      together it didn't work on my ULTRIX 4.2a system - I had to install some
  66.      patches I got off comp.lang.perl (posted by drw@nevanlinna.mit.edu)
  67.      and some changes I had to add myself.  The file "ultpatch" is the
  68.      diffs between what I run and what is distributed with perl.  Patch
  69.      your original bsdcurses.mus with this if you are having trouble
  70.      getting curseperl to work with ULTRIX.
  71.  
  72.      You will probably have to modify the first lines of both demo scripts
  73.      (demo and ezmail) to point to where your curseperl is.
  74.  
  75.   2) Put "menu.pl" with the rest of your perl packages (usually in something
  76.      like "/usr/local/lib/perl").  The demo programs will work just leaving
  77.      in the same directory as the demo/ezview scripts.
  78.  
  79. Use:
  80.  
  81.   Construct your applications to use "curseperl" instead of "perl".
  82.  
  83.   There are five calls to use perl menus - usually you will only use the
  84.   following three:
  85.  
  86.      &menu_init(1,"title"); # Init menu
  87.  
  88.      &menu_item("Selection text 1","return_string_1"); # Add item
  89.      &menu_item("Selection text 2","return_string_2"); # Add item
  90.      ...
  91.      &menu_item("Selection text n","return_string_n"); # Add last item
  92.  
  93.      $sel = &menu_display("Prompt text"); # Get user selection
  94.  
  95.   The "menu_init" call resets the menu array and indexes.  It must be called
  96.   to reset/clear any old menu.  The first parameter is a boolean flag 
  97.   indicating whether or not the menu should be numbered and have a selection
  98.   arrow "->" provided (a non-zero value indicates a numbered menu).
  99.   Unnumbered menus provide a nice way of paging text files - see the 
  100.   "ezview" demo file for an example (in the "view_file" routine).
  101.   If the first character of the title is a dash ("-") then the title will
  102.   not be presented in "standout" rendition.
  103.  
  104.   The "menu_item" call provides selection text (what the user sees on the
  105.   screen) and "action_text" (not seen - but returned if that item is
  106.   selected).  There is no practical limit (other than memory or maximum
  107.   array index size) of the number of items in a menu.  The items are
  108.   presented in the order you add them and the top (first) item is always
  109.   the default.
  110.  
  111.   The "menu_display" call is the only call that actually writes data on the
  112.   screen.  When it returns you either have the string "%UP%" (indicating the
  113.   user did not select anything but pressed "u" to exit the menu), "EMPTY%
  114.   (indicating no calls were made to "menu_item"), or you have one of the
  115.   selection-action strings given on a "menu_item" call.  You can either
  116.   provide your own prompt as a call parameter to "menu_display"  or you can
  117.   provide a null string (&menu_display("")) in which an automatic prompt is
  118.   provided.  All paging functions are handled within the call to
  119.   "menu_display" automatically.  Note that support is provided for just simply
  120.   typing the selection number of the items on the screen - you do not have to
  121.   move the selection arrow to the item if you prefer to type the number
  122.   (followed by "return"). 
  123.  
  124.   It is assumed that the application calling the menu routines is not a
  125.   "curseperl" application (i.e. it is a "stock" perl script).  However,
  126.   if you are writing an "all-curses" application you should call
  127.   "menu_curses_application" FIRST (once).  This sets a flag so that the
  128.   "initscr" and "endwin" calls are NOT done by the menu.pl package calls
  129.   (and assumes you will do them).  
  130.  
  131.   The menu routines will process a "q" for "quit" locally.  In other words,
  132.   if the user presses "q" while a menu is displayed (and responds to the
  133.   "Do you really want to quit?" prompt with a "y") the perl program will
  134.   immediately exit.  However, support is provided for a "user" exit that
  135.   will be called just before dropping out the program (to perform any
  136.   "cleanup" duties).  Calling "&menu_quit_routine("rtn_name");" will set
  137.   the exit routine.
  138.    
  139. General notes:
  140.   If you are running my demos make sure the first line points to where
  141.   your "curseperl" is and the "require" line looks in the right place
  142.   (if in a non-standard library).
  143.  
  144.   Also note that the call to menu_display will ALWAYS turn back on echo - so
  145.   if you really want it off you will have to call noecho again after each
  146.   menu_display.
  147.  
  148. ---
  149. Steven L. Kunz
  150. Networked Applications
  151. Iowa State University Computation Center, Iowa State University, Ames  IA
  152. INET: skunz@iastate.edu     BITNET: gr.slk@isumvs.bitnet
  153. \End\Of\Shar\
  154. else
  155.   echo "will not over write ./README"
  156. fi
  157. if `test ! -s ./RELEASE_NOTES`
  158. then
  159. echo "writing ./RELEASE_NOTES"
  160. cat > ./RELEASE_NOTES << '\End\Of\Shar\'
  161.  
  162. Changes between menu.pl version .9 (beta) and version 1.1:
  163.  
  164. - Declaration of "curses_application" fixed ("main`" prepended).
  165. - Cleanup of "cbreak" and "echo" handling.  Calls to "menu_display"
  166.   always return with "echo" and "cbreak" set.
  167. - Return key now functions on systems that do not have termcap entries
  168.   for either a "newline" or "return" key.
  169. - "menu_display" will return "%EMPTY%" if no calls to "menu_item" were
  170.   done between a "menu_init" call and a "menu_display" call.
  171. - Hitting the "space bar" is now the same as "f" or "n" for forward movement
  172.   within a multi-page selection menu.
  173. - The title strings in "menu_init" calls can now begin with a "-" to suppress
  174.   the "standout" attribute (normally a bold or reverse-video rendition).
  175. - menu_display will no longer return "%QUIT%" - returns "%UP" instead.  The
  176.   menu routines process a "q" (for "quit") locally and will exit from
  177.   there (after the user responds to a "Do you really want to quit?" prompt).
  178. - Direct number entry for selecting entries "pops" the arrow to the 
  179.   "best fit" selection on the screen, indicating what selection will be 
  180.   made when return is hit.
  181.  
  182. - The "ezview" demo now displays the correct modification date on its file
  183.   display.
  184. \End\Of\Shar\
  185. else
  186.   echo "will not over write ./RELEASE_NOTES"
  187. fi
  188. if `test ! -s ./demo`
  189. then
  190. echo "writing ./demo"
  191. cat > ./demo << '\End\Of\Shar\'
  192. #!../bin/curseperl
  193. #
  194. # demo --  Simple perl menu demo
  195. #
  196. # Note:    Requires curseperl
  197. #
  198. # Author:  Steven L. Kunz
  199. #          Networking & Communications
  200. #          Iowa State University Computation Center
  201. #          Ames, IA  50011
  202. #          Email: skunz@iastate.edu
  203. #
  204. # Date:    May, 1992
  205. #
  206.  
  207. require "menu.pl";
  208.  
  209.   &test_short_menu;
  210.   &test_long_menu;
  211.   exit;
  212.  
  213. #
  214. #  Build a short (one page) demo menu.
  215. #
  216. sub test_short_menu {
  217.  
  218. # Init a numbered menu with a title
  219.   &menu_init(1,"Short Menu (fits on one page)");
  220.  
  221. # Add several items
  222.   &menu_item("Dog","animal");
  223.   &menu_item("Cat","animal");
  224.   &menu_item("Granite","mineral");
  225.   &menu_item("Mouse","animal");
  226.   &menu_item("Shale","mineral");
  227.   &menu_item("Onion","vegetable");
  228.   &menu_item("Carrot","vegetable");
  229.  
  230. # Get selection
  231.   $sel= &menu_display("");
  232.  
  233.   if ($sel eq "%UP%") {
  234.     exit;
  235.   }
  236.  
  237.   print "You picked a $sel.\n";
  238.   $ch = <>;
  239. }
  240.  
  241. #
  242. # Build demo long menu (several pages)
  243. #
  244. sub test_long_menu {
  245.   local($sel_num);
  246.  
  247. # Init a numbered menu with title
  248.   &menu_init(1,"Long Menu (fits on several pages)");
  249.  
  250. # Build 50 entries in the menu
  251.   $i = 0;
  252.   while ($i < 50) {
  253.     $sel_num = $i + 1;
  254.     &menu_item("Item $sel_num","action-$sel_num");
  255.     $i++;
  256.   }
  257.  
  258. # Get user selection
  259.   $sel = &menu_display("");
  260.  
  261.   if ($sel eq "%UP%") {
  262.     exit;
  263.   }
  264.  
  265.   print "You picked the item with selection-action $sel.\n";
  266.   $ch = <>;
  267. }
  268. \End\Of\Shar\
  269. else
  270.   echo "will not over write ./demo"
  271. fi
  272. if `test ! -s ./ezview`
  273. then
  274. echo "writing ./ezview"
  275. cat > ./ezview << '\End\Of\Shar\'
  276. #!../bin/curseperl
  277. #
  278. # EasyView -- Unix File Viewer/Editor Interface
  279. #             (a "practical" demo for menu.pl)
  280. #
  281. # Note:    Requires curseperl
  282. #
  283. # Author:  Steven L. Kunz
  284. #          Networking & Communications
  285. #          Iowa State University Computation Center
  286. #          Ames, IA  50011
  287. #          Email: skunz@iastate.edu
  288. #
  289. # Date:    May, 1992
  290. #
  291.  
  292. require "menu.pl";
  293.  
  294.     $lines = $LINES; $lines1 = $lines - 1; $lines2 = $lines - 2;
  295.     $cols = $COLS;   $cols1  = $cols  - 1; $cols2  = $cols  - 2;;
  296.  
  297.     $SIG{'INT'} = 'cleanup';
  298.     $| = 1;        # command buffering on stdout
  299.  
  300. #
  301. #  MAIN_MENU -- Main (top level) menu
  302. #
  303.   while (1) {
  304.     &menu_init(1,"EasyView Version 1.1");
  305.     &menu_item("Exit","%UP%");
  306.     &menu_item("List files in current directory","dir_list");
  307.     &menu_item("View a text file","view_file");
  308.     &menu_item("Edit a text file","edit_file");
  309.  
  310.     $subr=&menu_display("");
  311.     if ($subr eq "%UP%") { 
  312.       &cleanup;
  313.     }
  314.     if ($subr ne "") { &$subr; }    # Call subroutine selected
  315.   }
  316.  
  317. #**********
  318. #  DIR_LIST -- Provide directory list
  319. #**********
  320. sub dir_list {
  321.    &dir_select(0,".","Directory Contents");
  322. }
  323.  
  324. #***********
  325. #  VIEW_FILE -- View a file in the current directory
  326. #
  327. #  Arguments:  None
  328. #
  329. #  Returns:    Nothing
  330. #
  331. #  Note: Uses file as an unnumbered menu
  332. #***********
  333. sub view_file {
  334.   local($filename);
  335.  
  336. # Call utility function to select file
  337.   $title = "Select file to view";
  338.   $filename = &dir_select(1,".","Select file to page through");
  339.   if ($filename eq "%UP%") {
  340.     return;
  341.   }
  342.  
  343. # Load file as an unnumbered menu - let menu_display do the paging
  344. #
  345. # Special thanks: The tab expansion used here was lifted from the
  346. # "pager" program distributed with perl.4.19 in the "usub" directory.
  347. # Don't know who wrote it but it fit the bill.  SLK
  348. #
  349.   &menu_init(0,"File: $filename");
  350.   open(TEMP,$filename);
  351.   while (<TEMP>) {
  352.     s/^(\t+)/'        ' x length($1)/e;
  353.     &expand($_) if /\t/;
  354.     &menu_item($_,"");
  355.   }
  356.   &menu_display("");
  357.   close(TEMP);
  358. }
  359.  
  360. sub expand {
  361.     while (($off = index($_[0],"\t")) >= 0) {
  362.         substr($_[0], $off, 1) = ' ' x (8 - $off % 8);
  363.     }
  364. }
  365.  
  366.  
  367. #***********
  368. #  EDIT_FILE -- Edit a file in the current directory
  369. #***********
  370. sub edit_file {
  371.   &clear;
  372.   $title = "Select file to edit";
  373.   $filename = &dir_select(1,".","Select file to edit");
  374.   if ($filename eq "%UP%") {
  375.     return;
  376.   }
  377.   system("vi $filename");
  378. }
  379.  
  380. #************
  381. #  DIR_SELECT -- Load a formatted directory list into a menu.
  382. #
  383. #  Arguments:  Boolean flag indicating numbered menu (1=yes), directory 
  384. #              name string and top-title string for menu
  385. #
  386. #  Returns:    File name (or "%UP%")
  387. #************
  388. sub dir_select {
  389.   local($numbered,$directory,$title) = @_;
  390.   opendir(DIR,$directory);
  391.   &menu_init($numbered,$title);
  392. dir_entry:
  393.   while ($filename = readdir(DIR)) {
  394.     next dir_entry if ($filename eq "."); 
  395.     next dir_entry if ($filename eq ".."); 
  396.     ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  397.      $blksize,$blocks) = stat($filename);
  398.     ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($mtime);
  399.     $mon++;
  400.     $sel_action = $filename;
  401.     $filename=$filename.substr("                    ",0,20-length($filename));
  402.     $sel_text = sprintf("%s%s%02d/%02d/%02d %02d:%02d  %s\n",
  403.                 $filename,$filler,$mon,$mday,$year,$hour,$sec,getpwuid($uid));
  404.     &menu_item($sel_text,$sel_action);
  405.   }
  406.   $fn = &menu_display("");
  407.   $fn;
  408. }
  409.  
  410. sub cleanup {
  411.   &clear;
  412.   &refresh;
  413.   exit;
  414. }
  415. \End\Of\Shar\
  416. else
  417.   echo "will not over write ./ezview"
  418. fi
  419. if `test ! -s ./menu.pl`
  420. then
  421. echo "writing ./menu.pl"
  422. cat > ./menu.pl << '\End\Of\Shar\'
  423. #****************************************************************************
  424. # menu.pl -- Perl Menu Support Facility 
  425. #
  426. # Version: 1.1
  427. #
  428. # Author:  Steven L. Kunz
  429. #          Networking & Communications
  430. #          Iowa State University Computation Center
  431. #          Ames, IA  50011
  432. #
  433. # Bugs:    skunz@iastate.edu
  434. # Cheers:  skunz@iastate.edu
  435. #
  436. # Date:    May, 1992
  437. #
  438. # Notes:   This package requires curseperl
  439. #          (distributed with perl 4.19 in the usub directory).
  440. #
  441. #          Use:
  442. #             &menu_init(1,"title");
  443. #             &menu_item("Topic 1","got_1");
  444. #             &menu_item("Topic 2","got_2");
  445. #             ...
  446. #             &menu_item("Topic n","got_n");
  447. #             $sel_text = &menu_display("Select using arrow keys");
  448. #
  449. #****************************************************************************
  450.  
  451. package perlmenu;
  452.  
  453. $did_initterm = 0;
  454. $curses_application = 0;
  455. $menu_exit_routine = "main'clear";
  456.  
  457. #**********
  458. #  MENU_CURSES_APPLICATION
  459. #
  460. #  Function:    Indicate application is using curses calls.  If called, 
  461. #        the menu routines will not do initscr and endwin calls 
  462. #        (the application must do them).
  463. #
  464. #  Call format:    &menu_curses_application;
  465. #
  466. #  Arguments:    None
  467. #
  468. #  Returns:    Nothing
  469. #**********
  470. sub main'menu_curses_application {
  471.   $curses_application = 1;
  472. }
  473.  
  474. #**********
  475. #  MENU_QUIT_ROUTINE
  476. #
  477. #  Function:    Specify a "cleanup" routine to be called before a "quit"
  478. #        from the application is processed.
  479. #
  480. #  Call format:    &menu_quit_routine("string");
  481. #
  482. #  Arguments:    String containing name of exit routine to call.
  483. #
  484. #  Returns:    Nothing.
  485. #
  486. #**********
  487. sub main'menu_quit_routine {
  488.   $menu_exit_routine = "main'@_";
  489. }
  490.  
  491. #**********
  492. #  MENU_INIT
  493. #
  494. #  Function:    Initialize menu type (numbered or unnumbered), arrays and 
  495. #        title.
  496. #
  497. #  Call format:    &menu_init([0|1],"Top Title");
  498. #
  499. #  Arguments:   Boolean flag indicating whether or not a arrows and numbers
  500. #               are desired (0=no, 1=yes) and title text (for the top line
  501. #               of menu).
  502. #
  503. #  Returns:    Nothing
  504. #
  505. #  Notes:    If the title string begins with a "-" the title is not
  506. #        presented in reverse-video ("standout") representation.
  507. #**********
  508. sub main'menu_init {
  509.  
  510. #
  511. #  Perform initscr if not a curses application
  512. #
  513.   if (!$curses_application) {
  514.     &main'initscr;
  515.   }
  516.  
  517. #
  518. #  Load "magic sequence" array based on terminal type
  519. #
  520.   if (!$did_initterm) {        # Get terminal info (if we don't have it).
  521.     &defbell unless defined &bell;
  522.  
  523.     $ku = &main'getcap('ku');    # Cursor-up
  524.     $kd = &main'getcap('kd');    # Cursor-down
  525.     $cr = &main'getcap('cr');    # Carriage-return
  526.     $nl = &main'getcap('nl');    # New-line
  527.     $ansi_ku = "\033[A";    # Ansi cursor-up (for DEC xterm)
  528.     $ansi_kd = "\033[B";    # Ansi cursor-down (for DEC xterm)
  529.  
  530.     @magic_seq = ($ku,$ansi_ku,$kd,$ansi_kd,$cr,$nl,"\n",
  531.           "n","N","p","P","f","F"," ","b","B");
  532.     $did_initterm = 1;
  533.   }
  534.  
  535.   $menu_numbered = @_[0];
  536.   $menu_top_title = @_[1];
  537.  
  538. # Check for title format character.
  539.   $menu_top_title_attr = 0;
  540.   if (substr($menu_top_title,0,1) eq '-') {
  541.     $menu_top_title = substr($menu_top_title,1);
  542.     $menu_top_title_attr = 1;
  543.   }
  544.  
  545. # Center top title
  546.   if (length($menu_top_title) > $main'COLS) {
  547.     $menu_top_title = substr($menu_top_title,0,$main'COLS);
  548.     $menu_top_title_col = 0;
  549.   }
  550.   else {
  551.     $menu_top_title_col = int($main'COLS/2) - int(length($menu_top_title)/2);
  552.   }
  553.  
  554. # Init selection array
  555.   @menu_sel_text = ();        # Clear menu arrays
  556.   @menu_sel_action = ();
  557.   $menu_index = 0;        # Reset flags
  558.  
  559.   $first_line = 2;
  560.   $last_line = $main'LINES - 3;
  561.   $items_per_screen = $last_line - $first_line + 1;
  562. }
  563.  
  564. #***********
  565. #  MENU_ITEM
  566. #
  567. #  Function:    Add an item to the active menu.
  568. #
  569. #  Call format:    &menu_item("What you see","test_rtn");
  570. #
  571. #  Arguments:    String presented in menu, string returned if selected
  572. #
  573. #  Returns:    Number of items currently in the menu.
  574. #***********
  575. sub main'menu_item {
  576.   local($item_text,$item_sel) = @_;
  577.   local($sel_num,$sel_str);
  578.  
  579. # Prepend selection number (if a numbered menu)
  580.   if ($menu_numbered) {
  581.     $sel_num = $menu_index + 1;
  582.     $sel_str = "  ";
  583.     if ($sel_num < 1000) { $sel_str .= " "; }
  584.     if ($sel_num < 100) { $sel_str .= " "; }
  585.     if ($sel_num < 10) { $sel_str .= " "; }
  586.     $sel_str .= "$sel_num) ";
  587.     $item_text = $sel_str.$item_text;
  588.   }
  589.  
  590. # Truncate lines that would wrap
  591.   if (length($item_text) > $main'COLS - 1) {
  592.     $item_text = substr($item_text,0,$main'COLS - 1);
  593.   }
  594.  
  595. # Load into arrays and adjust index
  596.   @menu_sel_text[$menu_index] = $item_text;
  597.   @menu_sel_action[$menu_index] = $item_sel;
  598.   $menu_index++;
  599. }
  600.  
  601. #**********
  602. #  MENU_DISPLAY 
  603. #
  604. #  Function:    Display items in menu_sel_text array, allow selection, and
  605. #        return appropriate selection-string.
  606. #
  607. #  Call format:    $sel = &menu_display("Prompt text");
  608. #
  609. #  Arguments:   Prompt text (for the bottom line of menu)
  610. #
  611. #  Returns:     Select action string (from second param on &menu_init) OR
  612. #        "%UP%" (if "u"|"U" pressed) OR
  613. #               "%EMPTY% if nothing in menu to display
  614. #
  615. #  Notes:    1) This routine ALWAYS sets "nocbreak" and "echo" terminal 
  616. #           modes before returning.
  617. #        2) This routine exits directly (after calling the optional 
  618. #           "quit" routine) if "q"|"Q" is pressed.
  619. #**********
  620. sub main'menu_display {
  621.   $total_items = $#menu_sel_text + 1;
  622.   if ($total_items <= 0) {
  623.     &main'nocbreak;        # ALWAYS turn off "cbreak" mode
  624.     &main'echo;            # ALWAYS turn on "echo"
  625.     return("%EMPTY%");
  626.   }
  627.  
  628.   &main'cbreak;            # cbreak mode (each character available)
  629.   &main'noecho;            # Menus are always "noecho"
  630.  
  631.   if ($total_items <= $items_per_screen) { $menu_single_page = 1; }
  632.   else { $menu_single_page = 0; }
  633.  
  634.   $menu_prompt = @_[0];
  635.   if ($menu_prompt eq "") {
  636.     if ($menu_single_page) {
  637.       $menu_prompt = "Move with up/down arrows  q=quit u=up-a-menu";
  638.     }
  639.     else {
  640.       $menu_prompt = 
  641.     "Move with up/down arrows, f=fwd-page b=back-page q=quit u=up-a-menu";
  642.     }
  643.   }
  644.   if (length($menu_prompt) > $main'COLS - 7) {
  645.     $menu_prompt = substr($menu_prompt,0,$main'COLS - 7);
  646.   }
  647.  
  648.   $arrow_line = $first_line;
  649.   $menu_top_item = 0;
  650. #
  651. # Clear screen and add top title and bottom prompt
  652. #
  653.   &menu_top_bot;
  654.   $move_amt = 0;
  655.   $number = 0;
  656.    
  657.   while (1) {
  658.     $number_shown = $menu_top_item + $items_per_screen;
  659.     if ($number_shown > $total_items) { $number_shown = $total_items; }
  660.     $percent = int($number_shown * 100 /$total_items);
  661.  
  662.     &menu_page;            # Display current page
  663.     &main'refresh;        # Update screen
  664. #
  665. # Collect key sequences until something we recoginize 
  666. # (or we know we don't care)
  667. #
  668.     $collect = "";
  669.     $action = "";
  670.     $possible = $#magic_seq;    # Set number of possible matches 
  671.  
  672. seq_seek:
  673.     while ($possible > 0) {
  674.       $ch = &main'getch;
  675.  
  676.       if ($collect eq "") {    # Numbers/refresh allowed yet ...
  677.     if (($ch eq "r") || ($ch eq "R")) {        # Refresh
  678.       &main'clear;
  679.       &menu_top_bot;
  680.       &menu_page;
  681.       &main'refresh;
  682.       next seq_seek;
  683.     }
  684.     if (($ch eq "\177") || ($ch eq "\010")) {    # Delete/BS num-reset
  685.       $number = 0;
  686.       $arrow_line = $first_line;
  687.       &menu_page;
  688.       &main'refresh;
  689.       next seq_seek;
  690.     }
  691.     $digit_val = index("0123456789",$ch);
  692.     if ($digit_val >= 0) {                # It IS a number ...
  693.       $number = $number * 10 + $digit_val;
  694.       if ($number >= $menu_top_item + 1) { 
  695.         if ($number <= $menu_bot_item + 1) {
  696.           $arrow_line = $number - $menu_top_item + $first_line - 1;
  697.         } else {
  698.           &bell;
  699.           $number = 0;
  700.           $arrow_line = $first_line;
  701.         }
  702.         &menu_page;
  703.         &main'refresh;
  704.       }
  705.       next seq_seek;
  706.     }
  707.       }
  708.  
  709.       $collect = $collect.$ch;
  710.  
  711.       if (($collect eq "Q") || ($collect eq "q")) {
  712.         &main'clear;
  713.     &main'move(0,0);
  714.     &main'addstr("Do you really want to quit? y");
  715.     &main'move(0,28);
  716.     &main'refresh;
  717.     $ch = &main'getch;
  718.     if (($ch eq $cr) || ($ch eq $nl) || ($ch eq "\n")) { $ch = "y"; }
  719.     $ch =~ tr/A-Z/a-z/;
  720.     if ($ch eq "y") {
  721.       if ($menu_exit_routine ne "") {
  722.         &$menu_exit_routine;
  723.       }
  724.       if (!$curses_application) { &main'endwin; }
  725.       &main'nocbreak;
  726.       &main'echo; 
  727.       &main'clear;
  728.       &main'refresh; 
  729.       exit(0);
  730.     }
  731.     &menu_top_bot;        # Re-display current page
  732.     &menu_page;
  733.     &main'refresh;
  734.     $collect = "";
  735.       }
  736.       if (($collect eq "U") || ($collect eq "u")) {
  737.     if (!$curses_application) { &main'endwin; }
  738.     &main'nocbreak;
  739.     &main'echo;
  740.     &main'clear;
  741.     &main'refresh;
  742.     return("%UP%");
  743.       }
  744.  
  745.       $i = 0;
  746.       $possible = 0;
  747. try:
  748.       while ($i <= $#magic_seq) {
  749.         if (length($collect) > length($magic_seq[$i])) {
  750.       $i++;
  751.       next try;
  752.         }
  753.     if (substr($magic_seq[$i],0,length($collect)) eq $collect) {
  754.           $possible++;
  755.       if ($collect eq $magic_seq[$i]) {
  756.             $action = $magic_seq[$i];
  757.             last seq_seek;
  758.           }
  759.         }
  760.         $i++;
  761.       } # end while
  762.     }
  763. #
  764. #  Perform action based on keystroke(s) received
  765. #
  766.     $move_amt = 0;
  767.     if ($action ne "") {
  768.       $last_arrow_line = $arrow_line;
  769.       if (($action eq $kd) || ($action eq $ansi_kd)) {        # down-arrow
  770.         if ($arrow_line < $max_sel_line) { $arrow_line++; }
  771.         else {
  772.       if ($arrow_line == $last_line) { $move_amt = 1; }
  773.         }
  774.       }
  775.       elsif (($action eq $ku) || ($action eq $ansi_ku)) {    # up-arrow
  776.         if ($arrow_line > $min_sel_line) { $arrow_line--; }
  777.         else { $move_amt = -1; }
  778.       }
  779.       elsif (($action eq "n") || ($action eq "N") ||     # next/forward
  780.          ($action eq "f") || ($action eq "F") || ($action eq " ")) {
  781.     $move_amt = $items_per_screen;
  782.       }
  783.       elsif (($action eq "p") || ($action eq "P") ||    # previous/backward
  784.          ($action eq "b") || ($action eq "B")) {
  785.     $move_amt = -$items_per_screen;
  786.       }
  787.       elsif (($action eq $cr) || ($action eq $nl) || 
  788.          ($action eq "\n")) {            # select
  789.     if ($number) { $item = $number - 1; }
  790.     else { $item = $menu_top_item + $arrow_line - $first_line; }
  791.     if (($item < $menu_top_item) || ($item > $menu_bot_item)) {
  792.       &bell;
  793.       $number = 0;
  794.     }
  795.     else {
  796.       if (!$curses_application) { &main'endwin; }
  797.       &main'nocbreak;
  798.       &main'echo;
  799.       &main'clear;
  800.       &main'refresh;
  801.       return(@menu_sel_action[$item]);
  802.     }
  803.       }
  804. #
  805. # Check for paging of the menu text
  806. #
  807.       if ($move_amt != 0) {
  808.     if ($move_amt < 0) { # Move backward
  809.       $menu_top_item = $menu_top_item + $move_amt;
  810.       if ($menu_top_item < 0) { $menu_top_item = 0; }
  811.     }
  812.     else { # Move forward
  813.       if ($menu_top_item + $move_amt < $total_items) {
  814.         $menu_top_item = $menu_top_item + $move_amt;
  815.       }
  816.     } 
  817.       }
  818. #
  819. # Erase the last selection arrow
  820. #
  821.       if ($menu_numbered) {
  822.     &main'move($last_arrow_line,0);
  823.     &main'addstr("  ");
  824.       }
  825.     }
  826.   } # end until
  827. }
  828.  
  829. #**********
  830. #  MENU_TOP_BOT -- Display top and bottom lines of current menu
  831. #**********
  832. sub menu_top_bot {
  833.   &main'clear;
  834.   &main'move(0,$menu_top_title_col);
  835.   if ($menu_top_title_attr == 0) { &main'standout; }
  836.   &main'addstr($menu_top_title);
  837.   if ($menu_top_title_attr == 0) { &main'standend; }
  838.  
  839.   &main'move($last_line+2,7);
  840.   &main'addstr($menu_prompt);
  841. }
  842.  
  843. #**********
  844. #  MENU_PAGE -- Display one page of menu selection items.
  845. #**********
  846. sub menu_page {
  847.  
  848. # Update percentage on bottom line
  849.   &main'move($last_line+2,0);
  850.   &main'standout;
  851.   if ($menu_single_page) { &main'addstr("(All) "); }
  852.   else { &main'addstr(sprintf("\(%3d%%\)",$percent)); }
  853.   &main'standend;
  854.  
  855. # Display current page of menu
  856.   $item = $menu_top_item;
  857.   $menu_bot_item = $menu_top_item;
  858.   $curr_line = $first_line;
  859.   $min_sel_line = $first_line;
  860.   $max_sel_line = $first_line;
  861.   while ($curr_line <= $last_line) {
  862.     &main'move($curr_line,0);
  863.     &main'clrtoeol;
  864.     $sel_num = $item + 1;
  865.     if ($item < $total_items) {
  866.       &main'addstr("$menu_sel_text[$item]");
  867.       $max_sel_line = $curr_line;
  868.       $menu_bot_item = $item;
  869.     }
  870.     $item++;
  871.     $curr_line++;
  872.   }
  873.  
  874. #  Position the selection arrow on the screen (if numbered menu)
  875.   if ($arrow_line > $max_sel_line) { $arrow_line = $max_sel_line; }
  876.   &main'move($arrow_line,0);
  877.   if ($menu_numbered) { &main'addstr("->"); }
  878. }
  879.  
  880. sub defbell {
  881.   eval q#
  882.     sub bell { print "\007"; }
  883.   #;
  884. }
  885.  
  886. 1;
  887. \End\Of\Shar\
  888. else
  889.   echo "will not over write ./menu.pl"
  890. fi
  891. if `test ! -s ./ultpatch`
  892. then
  893. echo "writing ./ultpatch"
  894. cat > ./ultpatch << '\End\Of\Shar\'
  895. *** bsdcurses.mus.dist    Tue Jun  9 11:02:56 1992
  896. --- bsdcurses.mus    Tue Jun  9 11:04:40 1992
  897. ***************
  898. *** 54,60 ****
  899.       US_erase,
  900.       US_werase,
  901.       US_flushok,
  902. -     US_idlok,
  903.       US_insch,
  904.       US_winsch,
  905.       US_insertln,
  906. --- 54,59 ----
  907. ***************
  908. *** 83,101 ****
  909.       US_noraw,
  910.       US_scanw,
  911.       US_wscanw,
  912. -     US_baudrate,
  913.       US_delwin,
  914.       US_endwin,
  915. -     US_erasechar,
  916.       US_getcap,
  917.       US_getyx,
  918.       US_inch,
  919.       US_winch,
  920.       US_initscr,
  921. -     US_killchar,
  922.       US_leaveok,
  923.       US_longname,
  924. -     US_fullname,
  925.       US_mvwin,
  926.       US_newwin,
  927.       US_nl,
  928. --- 82,96 ----
  929. ***************
  930. *** 102,109 ****
  931.       US_nonl,
  932.       US_scrollok,
  933.       US_subwin,
  934. -     US_touchline,
  935. -     US_touchoverlap,
  936.       US_touchwin,
  937.       US_unctrl,
  938.       US_gettmode,
  939. --- 97,102 ----
  940. ***************
  941. *** 161,167 ****
  942.       make_usub("erase",        US_erase,    usersub, filename);
  943.       make_usub("werase",        US_werase,    usersub, filename);
  944.       make_usub("flushok",    US_flushok,    usersub, filename);
  945. -     make_usub("idlok",        US_idlok,    usersub, filename);
  946.       make_usub("insch",        US_insch,    usersub, filename);
  947.       make_usub("winsch",        US_winsch,    usersub, filename);
  948.       make_usub("insertln",    US_insertln,    usersub, filename);
  949. --- 154,159 ----
  950. ***************
  951. *** 190,208 ****
  952.       make_usub("noraw",        US_noraw,    usersub, filename);
  953.       make_usub("scanw",        US_scanw,    usersub, filename);
  954.       make_usub("wscanw",        US_wscanw,    usersub, filename);
  955. -     make_usub("baudrate",    US_baudrate,    usersub, filename);
  956.       make_usub("delwin",        US_delwin,    usersub, filename);
  957.       make_usub("endwin",        US_endwin,    usersub, filename);
  958. -     make_usub("erasechar",    US_erasechar,    usersub, filename);
  959.       make_usub("getcap",        US_getcap,    usersub, filename);
  960.       make_usub("getyx",        US_getyx,    usersub, filename);
  961.       make_usub("inch",        US_inch,    usersub, filename);
  962.       make_usub("winch",        US_winch,    usersub, filename);
  963.       make_usub("initscr",    US_initscr,    usersub, filename);
  964. -     make_usub("killchar",    US_killchar,    usersub, filename);
  965.       make_usub("leaveok",    US_leaveok,    usersub, filename);
  966.       make_usub("longname",    US_longname,    usersub, filename);
  967. -     make_usub("fullname",    US_fullname,    usersub, filename);
  968.       make_usub("mvwin",        US_mvwin,    usersub, filename);
  969.       make_usub("newwin",        US_newwin,    usersub, filename);
  970.       make_usub("nl",        US_nl,        usersub, filename);
  971. --- 182,196 ----
  972. ***************
  973. *** 209,216 ****
  974.       make_usub("nonl",        US_nonl,    usersub, filename);
  975.       make_usub("scrollok",    US_scrollok,    usersub, filename);
  976.       make_usub("subwin",        US_subwin,    usersub, filename);
  977. -     make_usub("touchline",    US_touchline,    usersub, filename);
  978. -     make_usub("touchoverlap",    US_touchoverlap,usersub, filename);
  979.       make_usub("touchwin",    US_touchwin,    usersub, filename);
  980.       make_usub("unctrl",        US_unctrl,    usersub, filename);
  981.       make_usub("gettmode",    US_gettmode,    usersub, filename);
  982. --- 197,202 ----
  983. ***************
  984. *** 312,322 ****
  985.   I    bool        boolf
  986.   END
  987.   
  988. - CASE int idlok
  989. - I    WINDOW*        win
  990. - I    bool        boolf
  991. - END
  992. - 
  993.   CASE int insch
  994.   I    char        c
  995.   END
  996. --- 298,303 ----
  997. ***************
  998. *** 466,474 ****
  999.   CASE int noraw
  1000.   END
  1001.   
  1002. - CASE int baudrate
  1003. - END
  1004. - 
  1005.   CASE int delwin
  1006.   I    WINDOW*        win
  1007.   END
  1008. --- 447,452 ----
  1009. ***************
  1010. *** 476,484 ****
  1011.   CASE int endwin
  1012.   END
  1013.   
  1014. - CASE int erasechar
  1015. - END
  1016. - 
  1017.       case US_getcap:
  1018.       if (items != 1)
  1019.           fatal("Usage: &getcap($str)");
  1020. --- 454,459 ----
  1021. ***************
  1022. *** 522,530 ****
  1023.   CASE WINDOW* initscr
  1024.   END
  1025.   
  1026. - CASE int killchar
  1027. - END
  1028. - 
  1029.   CASE int leaveok
  1030.   I    WINDOW*        win
  1031.   I    bool        boolf
  1032. --- 497,502 ----
  1033. ***************
  1034. *** 535,545 ****
  1035.   IO    char*        name
  1036.   END
  1037.   
  1038. - CASE int fullname
  1039. - I    char*        termbuf
  1040. - IO    char*        name
  1041. - END
  1042. - 
  1043.   CASE int mvwin
  1044.   I    WINDOW*        win
  1045.   I    int        y
  1046. --- 507,512 ----
  1047. ***************
  1048. *** 570,587 ****
  1049.   I    int        cols
  1050.   I    int        begin_y
  1051.   I    int        begin_x
  1052. - END
  1053. - 
  1054. - CASE int touchline
  1055. - I    WINDOW*        win
  1056. - I    int        y
  1057. - I    int        startx
  1058. - I    int        endx
  1059. - END
  1060. - 
  1061. - CASE int touchoverlap
  1062. - I    WINDOW*        win1
  1063. - I    WINDOW*        win2
  1064.   END
  1065.   
  1066.   CASE int touchwin
  1067. --- 537,542 ----
  1068. \End\Of\Shar\
  1069. else
  1070.   echo "will not over write ./ultpatch"
  1071. fi
  1072. echo "Finished archive 1 of 1"
  1073. exit
  1074. -- 
  1075. Steven L. Kunz
  1076. Networked Applications | Usenet News Admin.
  1077. Iowa State University Computation Center, Iowa State University, Ames  IA
  1078. INET: skunz@iastate.edu     BITNET: gr.slk@isumvs.bitnet
  1079.