SUBROUTINE PROMPT_USER (PROMPT, BUFFER, BUFSIZE) C C Prompt local terminal and wait for response. The prompt and C the response are also written to the log file if open. C C Inputs: C PROMPT - Address of character string descriptor. C BUFFER - Address to store characters read. C BUFSIZE - Maximum number of bytes to read. C C Outputs: C LBYTE_COUNT = Number of bytes read. C TERMINATOR = Terminating character. C BACKUP = .TRUE. if exclamation point typed. C else set to .FALSE. C Calls FINISH to exit if CTRL/Z was typed. C INCLUDE 'COM.INC/NOLIST' CHARACTER*(*) PROMPT LOGICAL*1 BUFFER(1) BUFFER(1) = 0 ! Initialize first byte. LDESC(1) = 0 ! Initialize the count LDESC(2) = %LOC(BUFFER) ! and the address. BACKUP = .FALSE. ! Presume not backing up. WANTS_HELP = .FALSE. ! Presume no help wanted. LENGTH = LEN(PROMPT) ! Get the prompt length. IF (LOG_LOCAL) THEN CALL WRITE_LOGFILE (%REF(PROMPT), LENGTH) ENDIF C C Prompt the user. C IF ( BATCH_MODE .OR. (.NOT. SYSCOM_TERM) ) THEN WRITE (OUT_UNIT,25) PROMPT 25 FORMAT(A) READ (IN_UNIT,50,END=9900) NBYTES,(BUFFER(I),I=1,NBYTES) 50 FORMAT (Q,A1) TERMINATOR = CR ! Always terminated BUFFER(NBYTES+1) = CR ! by carriage return. LBYTE_COUNT = NBYTES ! Copy the byte count. LDESC(1) = NBYTES ! Fill in the descriptor. TYPE *, SS ! Fake CR/LF sequence. GO TO 225 ! Continue ... ENDIF C C Use QIO to a terminal. C 100 LOCAL_STATUS = SYS$QIOW (%VAL(LEFN_IN),%VAL(LCHAN_IN), 1 %VAL(IO$_READPROMPT), 1 LIOSB,,,BUFFER,%VAL(BUFSIZE),,, 1 %REF(PROMPT),%VAL(LENGTH)) 200 CALL CHECK_STATUS ('PROMPT_USER',LOCAL_STATUS) C C If the user types either CTRL/C or CTRL/Y, they get returned C to DCL level (possibly to SPAWN). If they type CONTINUE, we C detect the status code and then reissue the prompt. C IF (LIOSB(1) .EQ. SS$_CONTROLC .OR. 1 LIOSB(1) .EQ. SS$_CONTROLY) THEN GO TO 100 ENDIF LBYTE_COUNT = LIOSB(2) ! Save the bytecount. LDESC(1) = LIOSB(2) ! Fill in the descriptor. TERMINATOR = LIOSB(3) ! Save the terminator. 225 CALL CVT_UPPER (LDESC) ! Convert to upper case. IF (BUFFER(1) .EQ. '!') 1 BACKUP = .TRUE. ! Show we should backup. C C Since the VMS terminal driver only echos newline when a C carriage return is typed, the following code will echo a C newline for all other terminators as well as format the C buffer to be written to the log file. C IF (TERMINATOR .EQ. CR) THEN BUFFER(LBYTE_COUNT+2) = LF ELSE BUFFER(LBYTE_COUNT+1) = CR BUFFER(LBYTE_COUNT+2) = LF TYPE *, NULL ENDIF IF (LOG_LOCAL) THEN CALL WRITE_LOGFILE (BUFFER,(LBYTE_COUNT+2)) ENDIF C C Get help on question mark as well as escape. C IF ( (BUFFER(1) .EQ. '?') .OR. (TERMINATOR .EQ. ESCAPE) ) THEN TERMINATOR = ESCAPE ! Force help information. WANTS_HELP = .TRUE. ! Show user wants help. ENDIF IF (TERMINATOR .EQ. EOF) THEN 9900 CALL FINISH() ! Exit if user typed CTRL/Z. ENDIF RETURN END SUBROUTINE WRITE_USER (MSG) C C Write a buffer to the user and the log file if open. C C Inputs: C MSG - string descriptor with message. C INCLUDE 'COM.INC/NOLIST' CHARACTER*(*) MSG INTEGER SIZE, STATUS SIZE = LEN(MSG) IF (LOG_LOCAL) CALL WRITE_LOGFILE(%REF(MSG),SIZE) GO TO 100 ENTRY WRITE_BUFF (MSG) C C Entry to write to the log file and the terminal. C SIZE = LEN(MSG) CALL WRITE_LOGFILE (%REF(MSG), SIZE) GO TO 100 ENTRY WRITE_TTY (MSG) C C Entry to write to the terminal only. C SIZE = LEN(MSG) 100 IF ( BATCH_MODE .OR. (.NOT. SYSOUT_TERM) ) THEN WRITE (OUT_UNIT,500) MSG 500 FORMAT(A) ELSE STATUS = SYS$QIOW (%VAL(LEFN_OUT),%VAL(LCHAN_OUT), 1 %VAL(IO$_WRITELBLK + IO$M_NOFORMAT), 1 LIOSB,,,%REF(MSG),%VAL(SIZE),,,,) IF (.NOT. STATUS) THEN CALL LIB$SIGNAL (%VAL(STATUS)) CALL SYS$EXIT (%VAL(STATUS)) ENDIF ENDIF RETURN END