/* Rexx replacement for DOS' CHOICE command            */
/* Version 1.02 for OS/2                               */
/* Written by Rob van der Woude                        */
/* http://www.robvanderwoude.com                       */
/* Needs Quercus System's RexxLib for timeout function */


/* 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
	/* Quercus System's RexxLib */
	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,  Version 1.01 for OS/2"
	say "OS/2 replacement for MS-DOS' CHOICE command"
	say "Written by Rob van der Woude"
	say "http://www.robvanderwoude.com"
	say
	say "Usage:  CHOICE  [ /C[:]choices ]  [ /N ]  [ /R ]  [ /S ]"
	say "                [ /T[:]default,timeout ] [ prompt ]"
	say
	say "/C[:]choices            available keys; default is 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"
	EXIT 0
return