Trailing-Edge
-
PDP-10 Archives
-
LCG_Integration_Tools_Clearinghouse_T20_v7_30Apr86
-
tools/recog3/hlpio.b32
There are 3 other files named hlpio.b32 in the archive. Click here to see a list.
MODULE HLP$IO (
IDENT = 'V00A08'
) =
BEGIN
!
! COPYRIGHT (C) 1982 BY
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!
!++
! FACILITY: HELP
!
! ABSTRACT:
!
! I/O module for HELP.
!
! ENVIRONMENT:
!
!
! AUTHOR: Stanley Rabinowitz, CREATION DATE: 5-JUL-80
!
! EDIT HISTORY:
!
! V00A08 27-Apr-81 Stan Fixed bug affecting deletes of > 15 chars
! (REVISED_PROMPT buffer too small.)
! V00A03 25-Jul-80 Stan Allow digit as part of word constituent.
! V00A02 12-Jul-80 Stan Allow ^W to rubout initial spaces.
! V00A01 5-Jul-80 Stan Original version.
!--
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
LIB$$HLP$DEFAULT_OUTPUT,! Default user-output routine
HLP$PUT_OUTPUT, ! Outputs to the terminal
LIB$$HLP$GET_INPUT; ! Gets input from the terminal
!
! INCLUDE FILES:
!
REQUIRE 'HLP.R32';
!
! MACROS:
!
!
! EQUATED SYMBOLS:
!
LITERAL ! Special characters recognized by terminal code:
K_TAB = 9, ! TAB - same as ESCAPE
K_LF = 10, ! LF - ignored
K_CR = 13, ! CR - end of line
K_QMARK = %C'?',! ? - request incremental help
K_DEL = 127, ! DEL - rubout character
K_ESCAPE= 27, ! ESC - request recognition
K_CTRLR = 18, ! ^R - retype line
K_CTRLU = 21, ! ^U - rubout line
K_CTRLW = 23, ! ^W - rubout word
K_CTRLH = 8, ! ^H - retype previous line to point of error
K_CTRLZ = 26; ! ^Z - end of file
!
! OWN STORAGE:
!
!
! EXTERNAL REFERENCES:
!
!EXTERNAL ROUTINE
GLOBAL ROUTINE LIB$$HLP$GET_INPUT(P_CAB,TRMBLK) =
BEGIN
!++
!
! FUNCTIONAL DESCRIPTION:
!
! Gets input from a VMS terminal.
!
! FORMAL PARAMETERS:
!
! P_CAB Address of CAB
!
! We use the following information from the CAB:
!
! FLAG=.CAB[CAB$V_HLP];
! CAB[CAB$A_PMT]
! CAB[CAB$W_CHN],
! CAB[CAB$Q_IOSB],
! CAB[CAB$W_EFN],
! CAB[CAB$V_ASY]
! CAB[CAB$A_ASTADR]
! CAB[CAB$L_ASTPRM],
! CAB[CAB$A_CBF],
! CAB[CAB$W_CSZ],
! CAB[CAB$V_TMO],
! CAB[CAB$B_TMO],
! CAB[CAB$W_PTR],
!
! TRMBLK
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! SS$_NORMAL if everything goes okay
!
! RMS$_EOF if CTRL/Z was typed
!
! other status return from QIO
!
! SIDE EFFECTS:
!
! NONE
!
! RESTRICTIONS:
!
! This code has a few inefficiencies; however since the VMS group
! is planning to implement recognition, there is an extremely good
! chance that they will improve their terminal driver so that
! we will be able to get rid of this routine entirely.
!
! Deficiency Reason
!
! TABS are treated as spaces VMS provides no way of finding
! out what scope column the cursor is
! at, so it is "hard" to rub out tabs
! properly. This could be coded
! around by manual counting.
!
! Don't redisplay previous line VMS doesn't tell you when it has
! when rubbing out past column 1 automatically "wrapped" a line.
! of a multi-line input. Could be coded around with
! some difficulty.
!
! Don't redisplay line after VMS gives us no way of knowing
! a break-through write. that a break-through write has
! occurred. Permanent restriction
! until they modify the terminal
! service. Note that if we do QIO
! requests with redisplay request on
! break-through writes, then the
! prompt and initial string would
! not get redisplayed.
!
! Don't handle non-scope Haven't bothered to code yet.
! terminals. Should add non-scope mode rubouts
! if the VMS group doesn't upgrade
! the terminal handler. (Easy to do.)
!
! Process wakes up on DEL, ^U, Necessitated so that we can handle
! ^R, etc. initial strings on input requests.
! This deficiency (and in fact this
! entire routine) will go away when
! VMS supplies that functionality.
!--
LOCAL
STATUS,
REPROMPT, ! TRUE if we must re-prompt
PTR; ! index into INPUT_BUF
BIND
CAB = .P_CAB : $CAB_DECL,
INPUT_BUF = .CAB[CAB$A_CBF] : VECTOR[,BYTE],
PROMPT = .CAB[CAB$A_PMT] : BLOCK[,BYTE],
CHAN = CAB[CAB$W_CHN] : WORD,
IOSB = CAB[CAB$Q_IOSB] : VECTOR[4,WORD],
EFN = CAB[CAB$W_EFN] : WORD,
ASTADR = (IF .CAB[CAB$V_ASY]
THEN CAB[CAB$A_ASTADR]
ELSE UPLIT(0)),
ASTPRM = CAB[CAB$L_ASTPRM] : LONG,
BUFSIZ = CAB[CAB$W_CSZ] : WORD,
TIMOUT = CAB[CAB$B_TMO] : BYTE,
INISIZ = CAB[CAB$W_CLN] : WORD;
!+
! Assume the initial data is already in the user's input buffer.
! Point past it.
!-
PTR=.INISIZ;
!+
! Decide whether or not to initially prompt, based on user's request.
!-
REPROMPT=.CAB[CAB$V_HLP];
WHILE 1 DO
BEGIN
IF .REPROMPT
THEN BEGIN
!+
! Display the prompt (and cancel CTRL/O).
!-
REPROMPT=FALSE;
$OUT(PROMPT,HLP$K_PROMPT_LINE);
! *** ABOVE LINE DOESN'T STORE INTO IOSB !
! *** NOR DOES IT ALLOW FOR AN ERROR TO OCCUR!
!+
! Display the initial data and read more.
!-
STATUS=$QIOW( CHAN = .CHAN,
IOSB = IOSB,
FUNC = IO$_READPROMPT OR
IO$M_NOFILTR OR
! IO$M_REFRESH OR
! IO$M_DSABLMBX OR
IO$M_TRMNOECHO OR
(IO$M_TIMED*.CAB[CAB$V_TMO]),
ASTADR = .ASTADR,
ASTPRM = .ASTPRM,
EFN = .EFN,
P1 = INPUT_BUF[.PTR],
P2 = .BUFSIZ-.INISIZ,
P3 = .TIMOUT,
P4 = .TRMBLK,
P5 = INPUT_BUF,
P6 = .PTR);
IF NOT .STATUS THEN RETURN .STATUS;
IF NOT .IOSB[0] THEN RETURN .IOSB[0]
END
ELSE BEGIN
!+
! Assume the prompt and the initial data
! is there and read more.
!-
STATUS=$QIOW( CHAN = .CHAN,
IOSB = IOSB,
FUNC = IO$_READVBLK OR
! IO$M_DSABLMBX OR
! IO$M_REFRESH OR
IO$M_NOFILTR OR
IO$M_TRMNOECHO OR
(IO$M_TIMED*.CAB[CAB$V_TMO]),
ASTADR = .ASTADR,
ASTPRM = .ASTPRM,
EFN = .EFN,
P1 = INPUT_BUF[.PTR],
P2 = .BUFSIZ-.INISIZ,
P3 = .TIMOUT,
P4 = .TRMBLK);
IF NOT .STATUS THEN RETURN .STATUS;
IF NOT .IOSB[0] THEN RETURN .IOSB[0]
END;
!+
! Bump PTR to point to the end of the line.
!-
PTR = .PTR+.IOSB[1];
!+
! Dispatch on the terminator to perform various and sundry actions.
!-
SELECTONE .IOSB[2] OF
SET
[K_CR]:
!+
! +--------+
! | RETURN |
! +--------+
!
! Terminate input.
!-
BEGIN
STATUS=HLP$PUT_OUTPUT(%ASCID '',TRUE,.CHAN,0);
IF NOT .STATUS THEN RETURN .STATUS;
EXITLOOP
END;
[K_QMARK]:
!+
! +---+
! | ? |
! +---+
!
! Terminate input and signal start of incremental help.
!-
BEGIN
EXITLOOP
END;
[K_ESCAPE]:
!+
! +--------+
! | ESCAPE |
! +--------+
!
! Terminate input and signal start of recognition.
!-
BEGIN
EXITLOOP
END;
[K_CTRLR]:
!+
! +--------+
! | CTRL/R |
! +--------+
!
! Redisplay current line of input.
!-
BEGIN
STATUS=HLP$PUT_OUTPUT(%ASCID '^R',TRUE,.CHAN,0);
IF NOT .STATUS THEN RETURN .STATUS;
REPROMPT=TRUE
END;
[K_CTRLH]:
!+
! +--------+
! | CTRL/H |
! +--------+
!
! Redisplay previous line to point of error.
!-
IF .PTR EQL 0
THEN BEGIN
STATUS=HLP$PUT_OUTPUT(%ASCID '^H',TRUE,.CHAN,0);
IF NOT .STATUS THEN RETURN .STATUS;
PTR=.CAB[CAB$W_ERR_PTR];
INISIZ=.PTR;
REPROMPT=TRUE
END;
[K_CTRLU]:
!+
! +--------+
! | CTRL/U |
! +--------+
!
! Delete current line of input.
!-
BEGIN
STATUS=HLP$PUT_OUTPUT(%ASCID '^U',TRUE,.CHAN,0);
IF NOT .STATUS THEN RETURN .STATUS;
PTR=0;
REPROMPT=TRUE
END;
[K_TAB]:
!+
! +-----+
! | TAB |
! +-----+
!
! Same as ESCAPE.
!-
BEGIN
IOSB[2]=K_ESCAPE;
EXITLOOP
END;
[K_DEL]:
!+
! +--------+
! | DELETE |
! +--------+
!
! Delete last character.
!-
BEGIN
OWN ERASE : VECTOR[3,BYTE] INITIAL(BYTE(8,32,8)),
ERASE_DESC : VECTOR[2] INITIAL(3,ERASE);
BIND DEP = CAB[CAB$L_DEVDEPEND] : BLOCK[,BYTE];
IF .PTR NEQ 0
THEN BEGIN
IF .DEP[TT$V_SCOPE]
THEN HLP$PUT_OUTPUT(ERASE_DESC,FALSE,.CHAN,0)
ELSE HLP$PUT_OUTPUT(%ASCID '\',FALSE,.CHAN,0);
PTR=.PTR-1
END
END;
[K_CTRLZ]:
!+
! +--------+
! | CTRL/Z |
! +--------+
!
! Signal end-of-file (end-of-input).
!-
BEGIN
HLP$PUT_OUTPUT(%ASCID '^Z',TRUE,.CHAN,0);
RETURN RMS$_EOF;
END;
[K_CTRLW]:
!+
! +--------+
! | CTRL/W |
! +--------+
!
! Delete characters back to punctuation character.
! First delete any spaces.
!-
BEGIN
OWN ERASE : VECTOR[3,BYTE] INITIAL(BYTE(8,32,8)),
ERASE_DESC : VECTOR[2] INITIAL(3,ERASE);
LOCAL COUNT;
!+
! Delete any spaces we are currently at.
!-
WHILE .PTR NEQ 0 DO
IF .INPUT_BUF[.PTR-1] EQL %C' '
THEN BEGIN
HLP$PUT_OUTPUT(ERASE_DESC,FALSE,.CHAN,0);
PTR=.PTR-1
END
ELSE EXITLOOP;
COUNT=0;
WHILE .PTR NEQ 0 DO
SELECTONE .INPUT_BUF[.PTR-1] OF
SET
[%C'a' TO %C'z',
%C'A' TO %C'Z',
%C'0' TO %C'9',
%C'_',%C'$']:
BEGIN
HLP$PUT_OUTPUT(ERASE_DESC,FALSE,.CHAN,0);
COUNT=.COUNT+1;
PTR=.PTR-1
END;
[OTHERWISE]:
EXITLOOP
TES;
!+
! If we are at a punctuation mark, then treat ^W as DEL.
!-
IF .COUNT EQL 0 AND .PTR NEQ 0
THEN BEGIN
HLP$PUT_OUTPUT(ERASE_DESC,FALSE,.CHAN,0);
PTR=.PTR-1
END
END;
[OTHERWISE]:
TES;
END;
!+
! Adjust the length in the I/O status block
! to reflect the actual length of the line,
! after editing, including the initial string.
!-
IOSB[1]=.PTR;
RETURN SS$_NORMAL
END;
GLOBAL ROUTINE LIB$$HLP$DEFAULT_OUTPUT(P_OUTPUT_DESC,TYPE,P_CAB) =
BEGIN
!++
!
! FUNCTIONAL DESCRIPTION:
!
! Outputs a string on the terminal.
!
! FORMAL PARAMETERS:
!
! P_OUTPUT_DESC Address of descriptor for string to be output.
!
! TYPE Type of line being output.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! SS$_NORMAL Everything went okay.
!
! SIDE EFFECTS:
!
! NONE
!
!--
BIND
CAB = .P_CAB : $CAB_DECL;
!+
! Low order bit of type word specifies whether or
! not a CRLF should be appended.
! TRUE means append a CRLF.
! If the line is a prompt line, then we want to
! cancel control-O.
!-
HLP$PUT_OUTPUT(.P_OUTPUT_DESC,.TYPE,.CAB[CAB$W_CHN],
IF .TYPE EQL HLP$K_PROMPT_LINE
THEN IO$M_CANCTRLO
ELSE 0)
END;
ROUTINE HLP$PUT_OUTPUT(P_OUTPUT_DESC,FLAG,CHAN,FUNC) =
BEGIN
!++
!
! FUNCTIONAL DESCRIPTION:
!
! Outputs a string on the terminal.
!
! FORMAL PARAMETERS:
!
! P_OUTPUT_DESC Address of descriptor for string to be output.
!
! FLAG Flag word, if TRUE then output a CRLF after
! the string, else don't.
!
! CHAN The channel number to use.
!
! FUNC Function modifier.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! SS$_NORMAL Everything went okay.
!
! SIDE EFFECTS:
!
! NONE
!
!--
BIND
OUTPUT_DESC = .P_OUTPUT_DESC : BLOCK[,BYTE];
LOCAL
STATUS;
!+
! Perform the write to the terminal.
!-
STATUS=$QIOW( CHAN = .CHAN,
FUNC = IO$_WRITEVBLK OR .FUNC,
P1 = .OUTPUT_DESC[DSC$A_POINTER],
P2 = .OUTPUT_DESC[DSC$W_LENGTH]);
IF NOT .STATUS THEN RETURN .STATUS;
!+
! If FLAG is TRUE, then output a CR/LF pair.
!-
IF .FLAG
THEN BEGIN
STATUS=$QIOW( CHAN = .CHAN,
FUNC = IO$_WRITEVBLK,
P1 = UPLIT BYTE(K_CR,K_LF),
P2 = 2);
IF NOT .STATUS THEN RETURN .STATUS;
END;
RETURN SS$_NORMAL
END;
END
ELUDOM