Google
 

Trailing-Edge - PDP-10 Archives - BB-H138E-BM - 6-1-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) 1981, 1985 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!		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 WHICH 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