Google
 

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