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