(view source code of choice.rex as plain text)
/* Rexx replacement for DOS' CHOICE command */
/* Version 2.00 for OS/2 and Windows */
/* Written by Rob van der Woude */
/* http://www.robvanderwoude.com */
/* Needs Quercus System's RexxLib for timeout function, */
/* but will not fail if RexxLib isn't available -- in */
/* that case the timeout option will just be ignored. */
/* Initialize RexxUtil */
If RxFuncQuery( "sysloadfuncs" ) <> 0 Then Do
Call RxFuncAdd "sysloadfuncs", "RexxUtil", "sysloadfuncs"
Call sysloadfuncs
End
/* Parse command line */
Parse Arg commandline
/* /? switch */
If commandline = "/?" Then Call Syntax
If commandline = "?" Then Call Syntax
/* /S (case sensitive) switch */
Select
When Pos( "/S", commandline ) > 0 Then case = 1
When Pos( "/s", commandline ) > 0 Then case = 1
Otherwise case = 0
End
/* /C (choices) switch */
Parse Value commandline With "/C"options .
If options = "" Then Do
Parse Value commandline With "/c"options .
If options = "" Then Do
options = "YN"
End
End
If Left( options, 1 ) = ":" Then Do
options = SubStr( options, 2 )
End
If case = 0 Then options = Translate( options )
/* /T (default/timeout) switch */
Parse Value commandline With "/T"defchoice","timeout .
If timeout = "" Then Parse Value commandline With "/t"defchoice","timeout .
If Left( defchoice, 1 ) = ":" Then defchoice = SubStr( defchoice, 2 )
If timeout <> "" Then Do
If DataType( timeout, "W" ) <> 1 Then Call Syntax
/* Initialize Quercus System's RexxLib */
If RxFuncQuery( "RexxLibRegister" ) <> 0 Then Do
Call RxFuncAdd "RexxLibRegister", "RexxLib", "RexxLibRegister"
Call RexxLibRegister
End
/* Ignore timeout switch if RexxLib isn't available */
If RxFuncQuery( "RexxLibRegister" ) <> 0 Then Do
defchoice = ""
timeout = ""
End
End
/* /N (don't display choices) switch */
Select
When Pos( "/N", commandline ) > 0 Then dispchoices = 0
When Pos( "/n", commandline ) > 0 Then dispchoices = 0
Otherwise dispchoices = 1
End
/* /R (redirect) switch */
Select
When Pos( "/R", commandline ) > 0 Then redirect = 1
When Pos( "/r", commandline ) > 0 Then redirect = 1
Otherwise redirect = 0
End
/* Message/prompt */
lastslash = LastPos( "/", commandline )
If lastslash > 0 Then Do
Parse Value SubStr( commandline, lastslash ) With "/". message
End
Else Do
message = ""
End
/* Prepare message/prompt */
prompt = message
If dispchoices = 1 Then prompt = prompt||"? ["||options||"]"
/* Check if vertical scrolling will occur */
Parse Value SysTextScreenSize( ) With rows cols
/* Check where answer should be displayed */
Parse Value SysCurPos( ) With row col
promptlen = Length( prompt )
If row > rows - 2 Then row = row - 1
/* Display message/prompt */
Say prompt
Call SysCurPos row, col + promptlen
Call SysCurState "OFF"
valid = 0
Do i = 0 by 1 Until valid > 0
If i > 0 Then Call Beep 220, 240
/* Simple SysGetKey to retrieve input */
Select
When redirect = 1 Then Do
Parse Pull choice
If case = 0 Then Do
choice = Translate( choice )
End
If choice <> "" Then Do
choice = Left( choice, 1 )
End
End
When timeout <> "" Then Do
choice = ""
Do j = 1 To timeout
choice = InKey( "N", "F" )
If choice <> "" Then leave
Call SysSleep 1
End
If choice = "" Then Do
choice = defchoice
End
End
Otherwise Do
choice = SysGetKey( "NOECHO" )
End
End
If case = 0 Then Do
choice = Translate( choice )
End
valid = Pos( choice, options )
End
Say choice
Exit valid
Syntax: Procedure
Say
Say "Choice,rex Version 2.00 for OS/2 and Windows"
Say "Rexx replacement for MS-DOS' CHOICE command"
Say
Say "Usage: CHOICE.REX [ /C[:]choices ] [ /N ] [ /R ] [ /S ]"
Say " [ /T[:]default,timeout ] [ prompt ]"
Say
Say " /C[:]choices available keys (default YN)"
Say " /N don't display choices and ?"
Say " /R use with redirected input"
Say " /S case sensitive keys"
Say " /T[:]default, timeout chooses default after timeout"
Say " (needs Quercus System's RexxLib)"
Say
Say "Do not combine /R and /T switches."
Say "/T swith will be ignored if Quercus System's RexxLib isn't available."
Say "Since RexxLib is available only for OS/2 this means /T is not valid in Windows."
Say
Say "Written by Rob van der Woude"
Say "http://www.robvanderwoude.com"
Exit 0
Return
page last modified: 2024-04-16; loaded in 0.0078 seconds