265 lines
8.8 KiB
Plaintext
265 lines
8.8 KiB
Plaintext
|
******************************************************************************
|
||
|
|
*
|
||
|
|
* YESNO subroutine for PI/open COPY verb
|
||
|
|
*
|
||
|
|
* Module %M% Version %I% Date %H%
|
||
|
|
*
|
||
|
|
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
|
||
|
|
* This is unpublished proprietary source code of Ardent Software Inc.
|
||
|
|
* The copyright notice above does not evidence any actual or intended
|
||
|
|
* publication of such source code.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* Maintenance log - insert most recent change descriptions at top
|
||
|
|
*
|
||
|
|
* Date.... GTAR# WHO Description.........................................
|
||
|
|
* 10/14/98 23801 SAP Change copyrights.
|
||
|
|
* 07/16/93 10871 EAP Minor changes for Universe compatibility
|
||
|
|
* 06/25/93 10871 EAP Ported PI/open COPY verb to Universe
|
||
|
|
******************************************************************************** START-HISTORY:
|
||
|
|
*
|
||
|
|
* START-DESCRIPTION:
|
||
|
|
*
|
||
|
|
* This function is used to ensure that a correct response is typed
|
||
|
|
* in answer to a question requiring a yes/no/quit style answer.
|
||
|
|
*
|
||
|
|
* The function has the following calling sequence:
|
||
|
|
*
|
||
|
|
* REPLY = YESNO( PROMPT.MESS, ALLOWED.RESPONSE, DEFAULT.RESPONSE)
|
||
|
|
*
|
||
|
|
* Input arguments:
|
||
|
|
*
|
||
|
|
* PROMPT.MESS A string which contains the prompt to which an
|
||
|
|
* answer is required. The string will be printed
|
||
|
|
* on the users terminal without a terminating
|
||
|
|
* newline character. If the prompt is held in
|
||
|
|
* a message file then the caller should extract
|
||
|
|
* it with any necessary arguments and pass the
|
||
|
|
* result to the yesno function.
|
||
|
|
*
|
||
|
|
* ALLOWED.RESPONSE An integer value which specifies which options
|
||
|
|
* the yesno function will allow the user to type.
|
||
|
|
* A number of constants are defined in the file
|
||
|
|
* "YESNO.INS.IBAS" to aid in specifying the
|
||
|
|
* permitted responses. Adding these constants
|
||
|
|
* together selects a set of possible responses.
|
||
|
|
* The constants provided are:
|
||
|
|
*
|
||
|
|
* YN$YES - Permit "YES" type responses
|
||
|
|
* YN$NO - Permit "NO" type responses
|
||
|
|
* YN$QUIT - Permit "QUIT" type responses
|
||
|
|
* YN$DFLT - Permit "<RETURN>" response but return
|
||
|
|
* a default value to caller. The default
|
||
|
|
* value may be YN$NULL if the caller
|
||
|
|
* wishes to identify use of the <RETURN>
|
||
|
|
* key as a discrete event.
|
||
|
|
*
|
||
|
|
* If the value provided as this argument is not
|
||
|
|
* a combination of the above constants then a default
|
||
|
|
* value is set. The default is
|
||
|
|
* YN$YES + YN$NO + YN$QUIT
|
||
|
|
*
|
||
|
|
* DEFAULT.RESPONSE If YN$DFLT is selected as an ALLOWED.RESPONSE
|
||
|
|
* then this is the value returned to the caller.
|
||
|
|
* No checking is done on this value.
|
||
|
|
*
|
||
|
|
* Returned values:
|
||
|
|
*
|
||
|
|
* The possible return values are specified in the file "YESNO.INS.IBAS"
|
||
|
|
* and are as follows:
|
||
|
|
*
|
||
|
|
* YN$YES.RES A yes response was typed by the user
|
||
|
|
*
|
||
|
|
* YN$NO.RES A no response was typed by the user
|
||
|
|
*
|
||
|
|
* YN$QUIT.RES A quit response was typed by the user
|
||
|
|
*
|
||
|
|
* YN$NULL.RES The <RETURN> key was typed by the user
|
||
|
|
*
|
||
|
|
* N.B. If the YN$DFLT option is enabled and the <RETURN> key is
|
||
|
|
* typed the default value passed by the caller will be returned
|
||
|
|
* it need not be one of the values given above.
|
||
|
|
*
|
||
|
|
* END-DESCRIPTION
|
||
|
|
*
|
||
|
|
* START-DESIGN:
|
||
|
|
*
|
||
|
|
* Check call args;
|
||
|
|
* Get test strings;
|
||
|
|
* REPEAT
|
||
|
|
* Print the prompt message;
|
||
|
|
* Get users response;
|
||
|
|
* IF response is <RETURN>
|
||
|
|
* THEN Handle default situation;
|
||
|
|
* IF Yes enabled THEN Check for legal yes response;
|
||
|
|
* IF No enabled THEN Check for legal no response;
|
||
|
|
* IF quit enabled THEN Check for legal quit response;
|
||
|
|
* IF ambiguous OR illegal response
|
||
|
|
* THEN Print an error message;
|
||
|
|
* UNTIL legal response received
|
||
|
|
*
|
||
|
|
* END-DESIGN
|
||
|
|
*
|
||
|
|
* START-FUTURES:
|
||
|
|
*
|
||
|
|
* END-FUTURES
|
||
|
|
*
|
||
|
|
* START-CODE:
|
||
|
|
*
|
||
|
|
*
|
||
|
|
FUNCTION YESNO (PROMPT.MESS, ALLOWED.RESPONSE, DEFAULT.RESPONSE)
|
||
|
|
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE YESNO.H
|
||
|
|
|
||
|
|
EQUATE YN$YES.TEXT.ID TO '86011'
|
||
|
|
EQUATE YN$NO.TEXT.ID TO '86012'
|
||
|
|
EQUATE YN$QUIT.TEXT.ID TO '86013'
|
||
|
|
EQUATE YN$RETURN.TEXT.ID TO '86014'
|
||
|
|
EQUATE YN$YESNO.ERROR.ID TO '86010'
|
||
|
|
*
|
||
|
|
EQUATE UNDEF.RES TO -1
|
||
|
|
EQUATE AMBIG.RES TO -2
|
||
|
|
|
||
|
|
DEFFUN UVREADMSG(msg,args) CALLING '*UVREADMSG'
|
||
|
|
|
||
|
|
*
|
||
|
|
* Validate call - Ensure that the ALLOWED parameter is set to give
|
||
|
|
* some action if its not set default
|
||
|
|
*
|
||
|
|
GOSUB CHECK.ARGS
|
||
|
|
*
|
||
|
|
* Set up initial values and test strings
|
||
|
|
*
|
||
|
|
@SYSTEM.SET=0
|
||
|
|
*
|
||
|
|
YES.TEXT = UVREADMSG(YN$YES.TEXT.ID,"")
|
||
|
|
NO.TEXT = UVREADMSG(YN$NO.TEXT.ID,"")
|
||
|
|
QUIT.TEXT = UVREADMSG(YN$QUIT.TEXT.ID,"")
|
||
|
|
RETURN.TEXT = UVREADMSG(YN$RETURN.TEXT.ID,"")
|
||
|
|
*
|
||
|
|
* Create a string containing the permitted responses for
|
||
|
|
* inclusion in the error message produced for illegal responses
|
||
|
|
*
|
||
|
|
GOSUB MAKE.LEGAL
|
||
|
|
ISATTY = (@TTY NE 'phantom')
|
||
|
|
*
|
||
|
|
LOOP
|
||
|
|
*
|
||
|
|
* Print the caller supplied prompt and input the users response
|
||
|
|
* stripping leading and trailing spaces and converting to upper case
|
||
|
|
*
|
||
|
|
TEXT.FRAGMENTS = DCOUNT(PROMPT.MESS, @TM)
|
||
|
|
FOR FRAGMENT = 1 TO (TEXT.FRAGMENTS - 1)
|
||
|
|
PRINT FIELD(PROMPT.MESS, @TM, FRAGMENT, 1)
|
||
|
|
NEXT FRAGMENT
|
||
|
|
PRINT FIELD(PROMPT.MESS, @TM, TEXT.FRAGMENTS, 1):
|
||
|
|
INPUT USR.RESPONSE
|
||
|
|
IF NOT(ISATTY) THEN
|
||
|
|
PRINT " ":USR.RESPONSE
|
||
|
|
END
|
||
|
|
USR.RESPONSE = OCONV(TRIM(USR.RESPONSE), 'MCU')
|
||
|
|
YN.RESULT = UNDEF.RES
|
||
|
|
*
|
||
|
|
* Handle the default situation if use of the <RETURN> key enabled
|
||
|
|
*
|
||
|
|
IF USR.RESPONSE = '' AND BITAND(ALLOWED.RESPONSE, YN$DFLT) THEN
|
||
|
|
RETURN(DEFAULT.RESPONSE)
|
||
|
|
END
|
||
|
|
*
|
||
|
|
* For each possible response check whether it is in the allowed
|
||
|
|
* set. If it is check the users response against the strings
|
||
|
|
* for the possble response.
|
||
|
|
*
|
||
|
|
IF BITAND(ALLOWED.RESPONSE, YN$YES) THEN
|
||
|
|
CR.RES.VAL = YN$YES.RES
|
||
|
|
CR.PERMITTED = YES.TEXT
|
||
|
|
GOSUB CHECK.REPLY
|
||
|
|
END
|
||
|
|
IF BITAND(ALLOWED.RESPONSE, YN$NO) THEN
|
||
|
|
CR.RES.VAL = YN$NO.RES
|
||
|
|
CR.PERMITTED = NO.TEXT
|
||
|
|
GOSUB CHECK.REPLY
|
||
|
|
END
|
||
|
|
IF BITAND(ALLOWED.RESPONSE, YN$QUIT) THEN
|
||
|
|
CR.RES.VAL = YN$QUIT.RES
|
||
|
|
CR.PERMITTED = QUIT.TEXT
|
||
|
|
GOSUB CHECK.REPLY
|
||
|
|
END
|
||
|
|
*
|
||
|
|
* If the user has not responded with a legal response then print a message
|
||
|
|
* to this effect and repeat the loop until a legal response is received
|
||
|
|
*
|
||
|
|
IF YN.RESULT = UNDEF.RES OR YN.RESULT = AMBIG.RES THEN
|
||
|
|
ERR.MESS = UVREADMSG(YN$YESNO.ERROR.ID, LEGAL.STR)
|
||
|
|
CRT ERR.MESS
|
||
|
|
END
|
||
|
|
*
|
||
|
|
WHILE YN.RESULT = UNDEF.RES OR YN.RESULT = AMBIG.RES
|
||
|
|
REPEAT
|
||
|
|
*
|
||
|
|
RETURN (YN.RESULT)
|
||
|
|
*
|
||
|
|
*
|
||
|
|
CHECK.REPLY:
|
||
|
|
*
|
||
|
|
* Subroutine to check users response against a set of strings separated
|
||
|
|
* by field marks. Users reponse is acceptable provided the typed
|
||
|
|
* string matches the test string over the length of the typed string.
|
||
|
|
* If the typed string also matches a string from a different set of
|
||
|
|
* test strings it will be rejected.
|
||
|
|
*
|
||
|
|
FOR J=1 TO 99999
|
||
|
|
SUBSTR = FIELD(CR.PERMITTED, @FM, J, 1)
|
||
|
|
WHILE SUBSTR # ""
|
||
|
|
IF LEN(USR.RESPONSE) <= LEN(SUBSTR) AND USR.RESPONSE = SUBSTR[1,LEN(USR.RESPONSE)] THEN
|
||
|
|
IF YN.RESULT = UNDEF.RES THEN
|
||
|
|
YN.RESULT = CR.RES.VAL
|
||
|
|
END ELSE
|
||
|
|
IF YN.RESULT # CR.RES.VAL THEN
|
||
|
|
YN.RESULT = AMBIG.RES
|
||
|
|
END ELSE
|
||
|
|
YN.RESULT = CR.RES.VAL
|
||
|
|
END
|
||
|
|
END
|
||
|
|
END
|
||
|
|
NEXT J
|
||
|
|
RETURN(0)
|
||
|
|
*
|
||
|
|
*
|
||
|
|
CHECK.ARGS:
|
||
|
|
*
|
||
|
|
* Subroutine to check that the ALLOWED.RESPONSE argument is set
|
||
|
|
* if it is not then set up a default action
|
||
|
|
*
|
||
|
|
IF BITAND(ALLOWED.RESPONSE, BITNOT(YN$YES+YN$NO+YN$QUIT+YN$DFLT)) OR ALLOWED.RESPONSE = 0 THEN
|
||
|
|
ALLOWED.RESPONSE = YN$YES+YN$NO+YN$QUIT
|
||
|
|
END
|
||
|
|
RETURN(0)
|
||
|
|
*
|
||
|
|
*
|
||
|
|
MAKE.LEGAL:
|
||
|
|
*
|
||
|
|
* Subroutine to form a string containing the permitted responses
|
||
|
|
*
|
||
|
|
LEGAL.STR = ''
|
||
|
|
IF BITAND(ALLOWED.RESPONSE, YN$YES) THEN
|
||
|
|
LEGAL.STR = LEGAL.STR : YES.TEXT : @FM
|
||
|
|
END
|
||
|
|
IF BITAND(ALLOWED.RESPONSE, YN$NO) THEN
|
||
|
|
LEGAL.STR = LEGAL.STR : NO.TEXT : @FM
|
||
|
|
END
|
||
|
|
IF BITAND(ALLOWED.RESPONSE, YN$QUIT) THEN
|
||
|
|
LEGAL.STR = LEGAL.STR : QUIT.TEXT : @FM
|
||
|
|
END
|
||
|
|
IF BITAND(ALLOWED.RESPONSE, YN$DFLT) THEN
|
||
|
|
LEGAL.STR = LEGAL.STR : RETURN.TEXT : @FM
|
||
|
|
END
|
||
|
|
CONVERT @FM TO ' ' IN LEGAL.STR
|
||
|
|
LEGAL.STR = TRIM(LEGAL.STR)
|
||
|
|
RETURN(0)
|
||
|
|
*
|
||
|
|
END
|
||
|
|
*
|
||
|
|
* END-CODE
|