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