******************************************************************************
*
*	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