Google
 

Trailing-Edge - PDP-10 Archives - bb-h138f-bm - 7-sources/chmexcom.bli
There are 11 other files named chmexcom.bli in the archive. Click here to see a list.
 %TITLE 'CHMEXCOM - execute certain change-mode commands'
MODULE CHMEXCOM (				! Execute certain change-mode commands
		IDENT = '3-007'			! File: CHMEXCOM.BLI Edit: CJG3007
		) =
BEGIN
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1988.  ALL RIGHTS RESERVED.
!
!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 THAT IS NOT SUPPLIED BY DIGITAL.
!
!
!++
! FACILITY:	EDT -- The DEC Standard Editor
!
! ABSTRACT:
!
!	This module executes the change mode commands which
!	do not take an entity.
!
! ENVIRONMENT:	Runs at any access mode - AST reentrant
!
! AUTHOR: Bob Kushlis, CREATION DATE: Unknown
!
! MODIFIED BY:
!
! 1-001	- Original.  DJS 04-Feb-1981.  This module was created by
!	   extracting the routine EXECUTE_COM from module CHANGE.BLI.
! 1-002	- Regularized headers.  JBS 25-Feb-1981
! 1-003	- Fix module name.  JBS 02-Mar-1981
! 1-004	- Change SPLIT_LINE to EDT$$SPLT_LNINS .  JBS 30-Mar-1981
! 1-005	- Use the ASSERT macro.  JBS 01-Jun-1981
! 1-006	- Remove explicit journaling.  JBS 18-Jun-1981
! 1-007	- Use new message codes.  JBS 04-Aug-1981
! 1-008 - Add bell verb. STS 11-Aug-1981
! 1-009 - Add the date verb. STS 31-Aug-1981
! 1-010 - Add verbs to set up default verb. STS 21-Sep-1981
! 1-011 - Add verbs for toggle select and delete select. STS 23-Sep-1981
! 1-012 - Added command to set success to 0 if verb was select and select
!	  range was already active.  I needed this status for search and
!	  select. STS 28-Sep-1981
! 1-013	- Add a return value to indicate end of journal file.  JBS 02-Oct-1981
! 1-014 - Remove parameter from EDT$$SUB_CMD call.  SMB 28-Oct-1981
! 1-015 - Revise Tab Compute calculation when SHFL not zero.  SMB 06-Nov-1981
! 1-016	- Add range checking to ASC command.  JBS 10-Feb-1982
! 1-017	- Correct spelling of error code.  JBS 12-Feb-1982
! 1-018 - Add a flag for EXT command mode entered.  SMB 26-Feb-1982
! 1-019	- Rewrite word wrapping code.  JBS 07-Apr-1982
! 1-020	- Give messages on error returns from setting search strings.  JBS 04-May-1982
! 1-021	- Set a flag if control C actually aborts something.  JBS 24-May-1982
! 1-022 - Change setting of output format routine.  SMB 30-Jun-1982
! 1-023 - Set format output to TI_WRSTR for EXT output.  SMB 02-Jul-1982
! 1-024 - Make KS move the cursor even if PST_CNT = 0.  SMB 22-Jul-1982
! 1-025 - Add the XLATE command. STS 13-Aug-1982
! 1-026	- Flag screen changed for HELP, SHL and SHR.  JBS 13-Sep-1982
! 1-027	- Remove EDT$$G_LN_NO for new screen update logic.  JBS 29-Sep-1982
! 1-028	- Remove external declaration of EDT$$FMT_LIT, not used.  JBS 05-Oct-1982
! 1-029 - Remove call to SC_INIT, set a flag instead.  SMB 06-Oct-1982
! 1-030	- Change EDT$$G_SCR_CHGD to EDT$$G_SCR_REBUILD in a few places.  JBS 09-Oct-1982
! 1-031	- Rebuild the screen data base if selection is too complex.  JBS 02-Dec-1982
! 1-032	- Revise handling of EDT$$G_SHF.  JBS 14-Dec-1982
! 1-033	- Put WPS and VT220 support under a conditional.  JBS 10-Feb-1983
! 1-034 - Remove declarations of routines which aren't called.  SMB 23-Feb-1983
! 1-035	- Add new value for EDT$$G_SCR_CHGD.  JBS 02-Mar-1983
! 3-001 - Add updates from V3 source kit.  GB 27-Apr-1983
! 3-002 - Remove call to EDT$$GET_XLATE - TOPS-20 does not use it. CJG 2-Jun-1983
! 3-003 - Fix problem with screen update after help command GB 17-Jun-1983
! 3-004 - Fix problem with <GOLD> nn ^x getting bad data. CJG 25-Sep-1983
! 3-005 - Call EDT$$STORE_FMTCH and EDT$$GET_DATE directly. CJG 5-Jan-1984
! 3-006 - Add FMT_FREE to improve speed of format routines. CJG 11-Jan-1984
! 3-007 - Modify ASSERT macro to include error code. CJG 30-Jan-1984
!--

%SBTTL 'Declarations'
!
! TABLE OF CONTENTS:
!

REQUIRE 'EDTSRC:TRAROUNAM';

FORWARD ROUTINE
    EDT$$EXE_CHMCMD1;			! Execute the verbs which do not take an entity specification

!
! INCLUDE FILES:
!

REQUIRE 'EDTSRC:EDTREQ';

!
! MACROS:
!
!	NONE
!
! EQUATED SYMBOLS:
!
!	NONE
!
! OWN STORAGE:
!
!	NONE
!
! EXTERNAL REFERENCES:
!
!	In the routine
%SBTTL 'EDT$$EXE_CHMCMD1  - execute certain change-mode commands'

GLOBAL ROUTINE EDT$$EXE_CHMCMD1 (		! Execute certain change-mode commands
    VERB, 					! Command number
    COUNT, 					! Repeat count (char value for ASC)
    OPERAND, 					! Pointer to start of operand
    EXPLICIT					! 1 = the count is explicit
    ) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine executes a command which is not of the verb entity form.
!
! FORMAL PARAMETERS:
!
!  VERB			command number
!  COUNT		repeat count (char value for ASC)
!  OPERAND		Pointer to start of operand for insert, insert_cc etc.
!  EXPLICIT		1 = the count is explicit
!
! IMPLICIT INPUTS:
!
!	TI_SCROLL
!	SCR_LNS
!	DEL_CH
!	DEL_CHLEN
!	DIRN
!	DEL_LN
!	DEL_LNLEN
!	DIR_MOD
!	DEL_WD
!	DEL_WDLEN
!	EXI
!	PST_CNT
!	RPL_STR
!	RPL_LEN
!	SEA_PTR
!	SEL_BUF
!	OLD_SEL
!	SEL_LN
!	SEL_POS
!	SHF
!	TRUN
!	SEA_LEN
!	TOP_LN
!	EXITD
!	TAB_SIZ
!	CUR_BUF
!	TAB_LVL
!	TI_TYP
!	FMT_BUF
!	FMT_CUR
!	LN_BUF
!	LN_PTR
!
! IMPLICIT OUTPUTS:
!
!	SHF
!	TAB_LVL
!	FMT_CUR
!	FMT_FREE
!	LN_PTR
!	VERT
!	DFLT_VERB
!	SEL_BUF
!	CC_DONE
!	SCR_CHGD
!	SCR_REBUILD
!
! ROUTINE VALUE:
!
!	0 = failure, 1 = success, 2 = end of journal file
!
! SIDE EFFECTS:
!
!	MANY
!
!--

    BEGIN

    EXTERNAL ROUTINE
	EDT$$INS_STR,			! Insert a string of characters at the current position
	EDT$$INS_CHS,			! Insert a string of characters which may include carriage returns
	EDT$$MOV_TOCOL,			! Insert tabs and spaces
	EDT$$GET_DATE,			! System date routine
!	EDT$$GET_XLATE,			! call translation routine
	EDT$$UNDL,			! Insert the contents of an undelete buffer
	EDT$$MSG_BELL : NOVALUE,	! Output a message to the terminal with a warning bell
	EDT$$CHK_CC,			! Check to see if a CTRL/C has been typed
	EDT$$LN_DEFK,			! Define a key for keypad editing
	EDT$$PST_CMD,			! Execute the paste command
	EDT$$SUB_CMD,			! Execute the SUBSTITUTE command
	EDT$$EXT_CMD,			! Extend command handler
	EDT$$STORE_FMTCH,		! Store a formatted character
	EDT$$OUT_FMTBUF,		! Dump the format buffer
	EDT$$KPAD_HLP,			! Keypad mode help processor
	EDT$$TI_WRLN,			! Write to terminal
	EDT$$TI_WRSTR,			! Write to terminal unformatted
	EDT$$RPL_CHGDLN,		! Declare current line as changed
	EDT$$GET_TXTLN,			! Get current line in line buffer
	EDT$$CS_LEFT,			! Move left a character
	EDT$$SC_CPUCSPOS,		! Compute cursor position
	EDT$$WORD_WRAP,			! Try doing word wrapping
	EDT$$SC_POSCSIF,		! Put cursor position in format buffer
	EDT$$SC_NONREVID,		! End reverse video
	EDT$$SC_FULLSCLL,		! Reset the scrolling region
	EDT$$SC_SETSCLLREG,		! Set the scrolling region
	EDT$$STOP_WKINGMSG,		! Terminate working AST
	EDT$$SET_SEASUBSTR;		! Setup SUBSTITUTE strings

    EXTERNAL
	TI_SCROLL,			! Scrolling terminal
	SCR_LNS,			! Number of screen lines
	FMT_WRRUT,			! Holds address of output format routine
	EXT_MOD,			! 1=in EXT command mode
	DEL_CH : BLOCK 			! Deleted character buffer.
	    [CH$ALLOCATION (2, BYTE_SIZE)],
	DEL_CHLEN,			! Length of deleted character buffer
	DIRN,				! The current direction.
	DEL_LN : BLOCK 			! Deleted line buffer.
	    [CH$ALLOCATION (257, BYTE_SIZE)],
	DEL_LNLEN,			! Deleted line length.
	DIR_MOD,			! The directional mode.
	DEL_WD : BLOCK 			! Deleted word buffer.
	    [CH$ALLOCATION (81, BYTE_SIZE)],
	DEL_WDLEN,			! Length of del word string.
	EXI,				! Change mode has been exited.
	PST_CNT,			! No. of characters pasted.
	RPL_STR,			! Address of replace string.
	RPL_LEN,			! Length of replace string.
	SEA_STRLEN,			! Length of serach string
	SEA_PTR,			! Address of search string.
	SEL_BUF,			! Pointer to select buffer.
	OLD_SEL,			! Pointer to old select buffer
	SEL_LN : LN_BLOCK,		! Relative line number of select.
	SEL_POS,			! select position.
	SHF,				! The number of columns shifted.
	TRUN,				! 0 = Set no truncate
	SEA_LEN,			! Length of search string.
	TOP_LN : LN_BLOCK,		! The forced to top line.
	VERT,				! Last entity was VERT flag.
	EXITD,				! Exit from EDT
	SCR_CHGD,			! Was screen changed by EXT command?
	SCR_REBUILD,			! Set if text part of screen must be rebuilt from work file
	TAB_SIZ,			! Structured tab size
	CUR_BUF : REF TBCB_BLOCK,	! The current buffer tbcb
	TAB_LVL,			! Structured tab level.
	TI_TYP,				! Terminal type.
	FMT_BUF,			! Format buffer
	FMT_CUR,			! Pointer into format buffer
	FMT_FREE,			! Space left in format buffer
	LN_BUF,				! Current line buffer
	LN_PTR,				! Current character pointer
	DFLT_VERB,			! Default verb
	CC_DONE;			! Set to 1 if control C aborts something

!+
! Declare the message codes to be used.
!-
    MESSAGES ((SELALRACT, INVSUBCOM, CLDNOTALN, INVASCCHR, INVSTR));

    LOCAL
	SUCCEED,
	START_POS : POS_BLOCK,
	END_POS : POS_BLOCK,
	NUM_LINES;

!+
! If verb is SUBSTITUTE, set up the search and substitute strings.
!-

    IF (.VERB EQL VERB_K_SUBS)
    THEN
	SUCCEED = EDT$$SET_SEASUBSTR (.SEA_PTR, 	!
	    .SEA_LEN, 			!
	    .RPL_STR, 			!
	    .RPL_LEN)
    ELSE
	SUCCEED = 1;

    IF ( NOT .SUCCEED)
    THEN
	EDT$$MSG_BELL (EDT$_INVSTR)
    ELSE

	DO
	    BEGIN

	    CASE .VERB FROM VERB_K_SEL TO LAST_K_VERB OF
		SET

		[VERB_K_UNDC] :
		    BEGIN
		    SUCCEED = EDT$$UNDL (DEL_CH, .DEL_CHLEN);
		    END;

		[VERB_K_UNDW] :
		    BEGIN
		    SUCCEED = EDT$$UNDL (DEL_WD, .DEL_WDLEN);
		    END;

		[VERB_K_UNDL] :
		    BEGIN
		    SUCCEED = EDT$$UNDL (DEL_LN, .DEL_LNLEN);
		    END;

		[VERB_K_INSERT] :
		    BEGIN
		    SUCCEED = EDT$$INS_CHS (.OPERAND, .SEA_LEN);

		    IF .SUCCEED THEN SUCCEED = EDT$$WORD_WRAP ();

		    END;

		[VERB_K_XLATE] :
		    BEGIN

!		    SUCCEED = EDT$$GET_XLATE (.OPERAND, .SEA_LEN);
		    EDT$$MSG_BELL (EDT$_INVSUBCOM);
		    SUCCEED = 0;
		    END;

		[VERB_K_CC] :
		    BEGIN
		    LOCAL
			TEMP;			! old control char here

		    CH$WCHAR (CH$RCHAR (.OPERAND) - %C'@', CH$PTR (TEMP,, BYTE_SIZE));
		    SUCCEED = EDT$$INS_CHS (CH$PTR (TEMP,, BYTE_SIZE), 1);
		    END;

		[VERB_K_BACK] :
		    BEGIN
		    DIR_MOD = DIR_BACKWARD;
		    EXITLOOP;
		    END;

		[VERB_K_ADV] :
		    BEGIN
		    DIR_MOD = DIR_FORWARD;
		    EXITLOOP;
		    END;

		[VERB_K_DLWC] :
		    BEGIN
		    DFLT_VERB = VERB_K_CHGL;	! set up default verb to change case lower
		    EXITLOOP;
		    END;

		[VERB_K_DUPC] :
		    BEGIN
		    DFLT_VERB = VERB_K_CHGU;	! set up default verb to change case upper
		    EXITLOOP;
		    END;

		[VERB_K_DMOV] :
		    BEGIN
		    DFLT_VERB = VERB_K_MOVE;	! set up default verb to move
		    EXITLOOP;
		    END;

		[VERB_K_EXIT, VERB_K_QUIT] :
		    BEGIN
		    EXI = 1;

		    IF (.VERB EQL VERB_K_QUIT) THEN EXITD = 1;

		    RETURN (1);
		    END;

		[VERB_K_PASTE] :
		    BEGIN
		    SUCCEED = EDT$$PST_CMD ();
		    END;

		[VERB_K_SEL] :
		    BEGIN

		    IF (.SEL_BUF NEQA 0)
		    THEN
			BEGIN
			EDT$$MSG_BELL (EDT$_SELALRACT);
			SUCCEED = 0;
			END
		    ELSE
			BEGIN
			MOVELINE (CUR_BUF [TBCB_CUR_LIN], SEL_LN);
			SEL_BUF = .CUR_BUF;
			SEL_POS = .LN_PTR;
			IF (.OLD_SEL NEQA 0) THEN SCR_REBUILD = 1;
			END;

		    EXITLOOP;
		    END;

		[VERB_K_REF] :
		    BEGIN
		    SCR_CHGD = 2;	! Initialize the terminal and repaint the screen
		    EXITLOOP;
		    END;

		[VERB_K_BELL] :
		    BEGIN
		    EDT$$STORE_FMTCH (7);
		    EDT$$OUT_FMTBUF ();
		    EXITLOOP;
		    END;

		[VERB_K_DATE] :
		    BEGIN
		    LOCAL
			LEN,					! length of date string
			BUF : BLOCK [CH$ALLOCATION (24)];	! buffer for string

		    LEN = 0;
		    EDT$$GET_DATE (LEN, BUF);
		    SUCCEED = EDT$$INS_CHS (CH$PTR (BUF), .LEN);
		    END;

		[VERB_K_DEFK] :
		    BEGIN
		    SUCCEED = EDT$$LN_DEFK ();
		    EXITLOOP;
		    END;

		[VERB_K_TOP] :
		    BEGIN
		    MOVELINE (CUR_BUF [TBCB_CUR_LIN], TOP_LN);
		    EXITLOOP;
		    END;

		[VERB_K_HELP] :
		    BEGIN

		    LOCAL
			KPAD_STATUS;

		    EDT$$SC_NONREVID ();
		    EDT$$STOP_WKINGMSG ();
		    KPAD_STATUS = EDT$$KPAD_HLP ();
		    SCR_CHGD = 2;	! Repaint the screen

		    IF (.KPAD_STATUS EQL 0) THEN SUCCEED = 2;

		    EXITLOOP;
		    END;

		[VERB_K_ASC] :
		    BEGIN

		    IF ((.COUNT GTR 255) OR (.COUNT LSS 0))
		    THEN
			BEGIN
			EDT$$MSG_BELL (EDT$_INVASCCHR);
			SUCCEED = 0;
			END
		    ELSE
			BEGIN
			LOCAL
			    CHAR;
			CH$WCHAR (.COUNT, CH$PTR (CHAR,, BYTE_SIZE));
			EDT$$INS_STR (CH$PTR (CHAR,, BYTE_SIZE), 1);
			EXITLOOP;
			END;

		    END;

		[VERB_K_SUBS, VERB_K_SN] :
		    BEGIN
		    SUCCEED = EDT$$SUB_CMD ();
		    END;

		[VERB_K_KS] : 			! Adjust for KED SUBSTITUTE.
		    BEGIN

!+
! The cursor should move left one even if PST_CNT is zero
!-

		    IF (.DIRN EQL DIR_BACKWARD) AND (.PST_CNT NEQ 0)
		    THEN

			DECR I FROM .PST_CNT - 1 TO 0 DO
			    EDT$$CS_LEFT ()

		    ELSE
			EDT$$CS_LEFT ();

		    END;

		[VERB_K_SHL] :
		    BEGIN
		    SHF = .SHF + 8;

		    IF ((.SHF GEQ 32767) OR (.SHF LSS 0)) THEN SHF = 0;

		    SCR_CHGD = 1;	! repaint the screen

		    IF ( NOT .TRUN) THEN SCR_REBUILD = 1;
		    END;

		[VERB_K_SHR] :
		    BEGIN
		    SHF = .SHF - 8;

		    IF ((.SHF GEQ 32767) OR (.SHF LSS 0)) THEN SHF = 0;

		    SCR_CHGD = 1;	! repaint the screen

		    IF ( NOT .TRUN) THEN SCR_REBUILD = 1;
		    END;

		[VERB_K_TAB] :
		    BEGIN

		    LOCAL
			TAB_COUNT;

		    IF (CH$PTR_NEQ (.LN_PTR, CH$PTR (LN_BUF,, BYTE_SIZE)) OR
			(.TAB_SIZ EQL 0))
		    THEN
			TAB_COUNT = 8
		    ELSE
			TAB_COUNT = .TAB_LVL*.TAB_SIZ;

		    SUCCEED = EDT$$MOV_TOCOL (.TAB_COUNT);
		    END;

		[VERB_K_TC] :
		    BEGIN

		    LOCAL
			COL,
			LIN;

		    IF (.TAB_SIZ EQL 0) THEN EXITLOOP;

		    EDT$$SC_CPUCSPOS (LIN, COL);

		    COL = .COL + .SHF;

		    IF ((.COL MOD .TAB_SIZ) NEQ 0)
		    THEN
			EDT$$MSG_BELL (EDT$_CLDNOTALN)
		    ELSE
			TAB_LVL = (MAX (0, .COL))/.TAB_SIZ;

		    EXITLOOP;
		    END;

		[VERB_K_TD] :
		    BEGIN
		    TAB_LVL = MAX (0, .TAB_LVL - 1);
		    END;

		[VERB_K_TI] :
		    BEGIN
		    TAB_LVL = .TAB_LVL + 1;
		    END;

		[VERB_K_EXT] :
		    BEGIN
		    EDT$$SC_FULLSCLL ();

		    IF ((.TI_TYP EQL TERM_VT52) OR 	!
			(.TI_TYP EQL TERM_VT100))
		    THEN
			FMT_WRRUT = EDT$$TI_WRSTR
		    ELSE
			BEGIN
			EDT$$STOP_WKINGMSG ();
			FMT_WRRUT = EDT$$TI_WRLN;
			END;

		    EDT$$RPL_CHGDLN ();
		    CUR_BUF [TBCB_CHAR_POS] = CH$DIFF (.LN_PTR,
					      CH$PTR (LN_BUF,, BYTE_SIZE));
		    EXT_MOD = 1;
		    EDT$$EXT_CMD ();
		    EXT_MOD = 0;
		    FMT_FREE = FMT_BUFLEN;
		    FMT_CUR = CH$PTR (FMT_BUF,, BYTE_SIZE);
		    EDT$$GET_TXTLN ();
		    LN_PTR = CH$PTR (LN_BUF, .CUR_BUF [TBCB_CHAR_POS], BYTE_SIZE);
		    IF (.TI_SCROLL) THEN EDT$$SC_SETSCLLREG (0, .SCR_LNS);

		    EXITLOOP;
		    END;

		[VERB_K_DESEL] :
		    BEGIN
		    SEL_BUF = 0;		! No select range active
		    END;

		[VERB_K_TGSEL] :
		    BEGIN

		    IF (.SEL_BUF EQLA 0)
		    THEN
			BEGIN
			MOVELINE (CUR_BUF [TBCB_CUR_LIN], SEL_LN);
			SEL_BUF = .CUR_BUF;
			SEL_POS = .LN_PTR;
			IF (.OLD_SEL NEQA 0) THEN SCR_REBUILD = 1;
			END
		    ELSE
			BEGIN
			SEL_BUF = 0;
			END

		    END;

		[VERB_K_CLSS] :
		    BEGIN

		    SEA_STRLEN = 0;	! reset search string

		    END;

		[OUTRANGE] :
		    ASSERT (6, 0);
		TES;

	    IF (.EXPLICIT NEQ 0) THEN COUNT = .COUNT - 1;

	    IF (.SUCCEED NEQ 1) THEN EXITLOOP;

	    IF EDT$$CHK_CC ()
	    THEN
		BEGIN

		IF (.COUNT GTR 0) THEN CC_DONE = 1;

		EXITLOOP;
		END;

	    END
	UNTIL (.COUNT LEQ 0);

!+
! Unless the command was advance or backup, turn off the VERT  flag.
!-

    IF ((.VERB NEQ VERB_K_ADV) AND (.VERB NEQ VERB_K_BACK)) THEN VERT = 0;

    RETURN (.SUCCEED);
    END;					! of routine EDT$$EXE_CHMCMD1


END
ELUDOM