home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / skeleton.zip / AskUser.cmd next >
OS/2 REXX Batch file  |  1995-08-03  |  4KB  |  87 lines
  1. /*****************************************************************************\
  2. | Query user with a prompt asking for a single keystroke response.            |
  3. |                                                                             |
  4. | $Revision:   1.0  $
  5. |     $Date:   03 Aug 1995 20:10:06  $                                        |
  6. | Libraries:   REXXSAA, REXXUTIL                                              |
  7. |  Category:   Utility                                                        |
  8. |     Class:   General                                                        |
  9. |      Type:   UI-cmd                                                         |
  10. |    Author:   Bob Rice - CompuServe: 72421,3016                              |
  11. |                                                                             |
  12. | Copyright (c) 1995 Empirical Heuristics                                     |
  13. \**************************************************************************r4*/
  14. /*  !tr! = value('TRACE',,'OS2ENVIRONMENT'); parse source . . !who!          */
  15. /*  if !tr! \= '' then say '--> Entering' !who!; trace value !tr!; nop       */
  16.   if arg(1) = '' | left(arg(1),1) = '?' then do
  17.     parse source . . !pgm!; call TellHelp arg(1), !pgm!; exit 2; end
  18.  
  19.   parse arg keys, prompt
  20.   exit AskUser(keys,prompt)
  21.  
  22.   /*=========================================================================*\
  23.   | Query user with a prompt asking for a single keystroke response which is  |
  24.   | not echoed to the screen.                                                 |
  25.   \*=========================================================================*/
  26. AskUser: procedure
  27.   parse arg keys, prompt
  28.   /*---------------------------------------------*\
  29.   | Build list of acceptable response characters. |
  30.   \*---------------------------------------------*/
  31.   caps = xrange('A','Z')
  32.   default = ''
  33.   keystr  = ''
  34.   do i = 1 to length(keys)
  35.     key = substr(keys,i,1)
  36.     if pos(key,caps) > 0 then default = key
  37.     keystr = keystr || key || '/'
  38.   end
  39.   keystr = left(keystr,length(keystr)-1)        /* Remove trailing /         */
  40.   /*---------------*\
  41.   | Query the user. |
  42.   \*---------------*/
  43.   say '['keystr']' prompt
  44.   ans = translate(SysGetKey('NOECHO'))
  45.   if c2d(ans) = 13 then ans = default
  46.   if pos(ans,translate(keys)) = 0 then ans = default
  47.   return ans
  48. /*--Begin Help-----------------------------------------------------------------
  49. Query user with a prompt asking for a single keystroke response.
  50. The keystroke is not echoed to the screen.
  51.  
  52. Params: keys, prompt
  53.  
  54.   keys        is a string of characters, one of which may be upper cased,
  55.               to tell the user which keystrokes are acceptable.  The upper
  56.               case character denotes the default should the user press
  57.               <Enter> or <Esc> or a character not in the list.
  58.  
  59.   prompt      is a character string that will be presented to the user on
  60.               the next available screen line.
  61.  
  62. ________________
  63. Alternate Params: [ ? | ?? | ??? | ???? ]
  64.  
  65. where:
  66.  
  67.   ?     Displays up to the "Syntax:" or "Params:" portion of this help text.
  68.  
  69.   ??    Displays this entire help text except for the technical information.
  70.  
  71.   ???   Displays this entire help text.
  72.  
  73.   ????  Puts this help text into a file whose name is the same as the name of
  74.         this program and whose extent is .ABS.  The file is written to the same
  75.         directory as that in which this program resides.
  76.  
  77. _______________
  78. Technical Notes
  79.  
  80. ___________________
  81. Development History
  82. $Log:   Q:/rxdv/skeleton/vcs/askuser.cm!  $
  83.   
  84.      Rev 1.0   03 Aug 1995 20:10:06
  85.   Initial revision.
  86. --End Help-------------------------------------------------------------------*/
  87.