Trailing-Edge
-
PDP-10 Archives
-
BB-AE97C-BM
-
sources/chmexverb.bli
There are 11 other files named chmexverb.bli in the archive. Click here to see a list.
%TITLE 'CHMEXVERB - execute certain change-mode commands'
MODULE CHMEXVERB ( ! Execute certain change-mode commands
IDENT = '3-002' ! File: CHMEXVERB.BLI Edit: CJG3002
) =
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 those change mode commands which
! 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 routine EXECUTE_VERB from module CHANGE.BLI.
! 1-002 - Regularize headers. JBS 02-Mar-1981
! 1-003 - Fix bug in processing the SR entity. As preparation for
! doing a string search, the cursor was moved to the left, the
! search was done, and the cursor was moved back to the right
! if the search failed. Since the value returned from EDT$$CS_LEFT
! was ignored, it was possible to end up at a different place
! than you began. DJS 04-Mar-1981
! 1-004 - Correct minor errors in the headers. JBS 12-Mar-1981
! 1-005 - Build in T_ADV AND T_BACK. JBS 31-Mar-1981
! 1-006 - Use the ASSERT macro. JBS 01-Jun-1981
! 1-007 - Repair a comment. JBS 02-Jun-1981
! 1-008 - Correct the test for legit entities. JBS 02-Jun-1981
! 1-009 - Use new message codes. JBS 04-Aug-1981
! 1-010 - Add a check for change case verbs. STS 21-Sep-1981
! 1-011 - Add search and select verb. STS 24-Sep-1981
! 1-012 - Add return value for end of journal file. JBS 02-Oct-1981
! 1-013 - Add new word type and para types. STS 26-Oct-1981
! 1-014 - Remove an unused external reference. JBS 18-Dec-1981
! 1-015 - Fix problem with repeated CHGCSR's and run through PRETTY. JBS 29-Dec-1981
! 1-016 - Fix bug in ADV comparison - string length incorrect. SMB 30-Jan-1982
! 1-017 - Worry about string truncation. JBS 05-May-1982
! 1-018 - Set a flag if control C actually aborts something. JBS 24-May-1982
! 1-019 - Don't try to keep moving left if at beginning of buffer. STS 21-Jun-1982
! 1-020 - Change string matching. JBS 16-Jul-1982
! 1-021 - Remove some redundent code. JBS 23-Jul-1982
! 1-022 - New screen update logic. JBS 13-Sep-1982
! 1-023 - Make call to edt$$tst_eob in line. STS 22-Sep-1982
! 1-024 - Remove EDT$$G_LN_NO for new screen update logic. JBS 29-Sep-1982
! 1-025 - Correct a typo in edit 1-024. JBS 30-Sep-1982
! 1-026 - Make tests for ADV and BACK be case insensitive. JBS 10-Nov-1982
! 1-027 - Change call to EDT$$MRK_LNCHG. JBS 27-Dec-1982
! 1-028 - Plant traps for a problem involving unreasonable character position. JBS 27-Dec-1982
! 1-029 - Improve those traps. JBS 28-Dec-1982
! 1-030 - Add conditional for WPS support. JBS 10-Feb-1983
! 1-031 - Remove an ASSERT which causes an internal error. SMB 11-Feb-1983
! 1-032 - Don't look for ADV or BACK beyond the end of the command. JBS 04-Mar-1983
! 3-001 - Change some calls to CPY_MEM to CPY_STR and allow for bigger bytes. GB 3-Mar-1982
! 3-002 - Modify ASSERT macro to include error code. CJG 30-Jan-1984
!--
%SBTTL 'Declarations'
!
! TABLE OF CONTENTS:
!
REQUIRE 'EDTSRC:TRAROUNAM';
FORWARD ROUTINE
EDT$$EXE_CHMCMD2, ! Execute the verbs which take an entity specification
CHANGE_CASE : NOVALUE; ! Change case in a range
!
! INCLUDE FILES:
!
REQUIRE 'EDTSRC:EDTREQ';
!
! MACROS:
!
! NONE
!
! EQUATED SYMBOLS:
!
! NONE
!
! OWN STORAGE:
!
! NONE
!
! EXTERNAL REFERENCES:
!
! In the routine
%SBTTL 'EDT$$EXE_CHMCMD2 - execute certain change-mode commands'
GLOBAL ROUTINE EDT$$EXE_CHMCMD2 ( ! Execute certain change-mode commands
ENTITY, ! the entity to use
COUNT, ! the number of entities to include
VERB ! the command to execute
) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine executes verbs which take an entity specification.
!
! First it isolates the text defined by the entity type and the entity
! count which are passed as parameters, then performs the verb on the
! selected text. It then executes the verb on the text it has selected.
!
! FORMAL PARAMETERS:
!
! ENTITY the entity to use
!
! COUNT the number of entities to include
!
! VERB the command to execute.
!
! IMPLICIT INPUTS:
!
! DEL_CH
! DEL_LN
! DEL_WD
! CMD_PTR
! CMD_END
! SEA_PTR
! SEL_BUF
! SEL_POS
! SEA_LEN
! VERT
! US_ENT
! SEA_BEG
! CUR_BUF
! TI_TYP
! LN_BUF
! LN_END
! LN_LEN
! LN_PTR
! SEA_STRLEN
! SEA_STR
! PARTYP
! WK_LN
!
! IMPLICIT OUTPUTS:
!
! DIRN
! VERT
! LN_PTR
! CMD_
! DEL_CHLEN
! DEL_WDLEN
! DEL_LNLEN
! CAS_TYP
! ALT_BUF
! CUR_BUF
! LN_LEN
! CC_DONE
!
! ROUTINE VALUE:
!
! 1 = ok, 0 = hit a boundry, 2 = end of journal file
!
! SIDE EFFECTS:
!
! MANY
!
!--
BEGIN
EXTERNAL ROUTINE
EDT$$FND_BSEN : NOVALUE, ! Find the beginning of a sentence
EDT$$FND_BWD, ! Move backwards to the beginning of a word
EDT$$DEL_TXTLN : NOVALUE, ! Delete whole lines of text
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$$TADJ_CMD : NOVALUE, ! Execute the TADJ command
EDT$$FND_EWD, ! Find the end of a word
EDT$$FND_ENT, ! Search for a page or paragraph entity
EDT$$STR_SEACMD, ! Search for a specific string
EDT$$FILL_TXT, ! Do a text fill
EDT$$INS_MOD, ! Process no-keypad insertion
EDT$$CS_BOTBUF, ! Move to bottom of buffer
EDT$$RPL_CHGDLN, ! Declare current line as changed
EDT$$CS_DWN, ! Move down a line
EDT$$GET_TXTLN, ! Get current line in line buffer
EDT$$CS_LEFT, ! Move left a character
EDT$$CS_RIGHT, ! Move right a character
EDT$$CS_TOP, ! Move to top of buffer
EDT$$CS_UP, ! Move up a line
EDT$$TST_ONSTR, ! Compare the current character position with a string descriptor
EDT$$RPOS : NOVALUE, ! Restore the saved buffer position
EDT$$SAV_BUFPOS : NOVALUE, ! Save the current buffer position
EDT$$SAV_DELTXT : NOVALUE, ! Save a deleted word or line in an undelete buffer
EDT$$SC_MATCHCOL, ! Match column
EDT$$SC_CPUNEWCOLPOS, ! Compute new column
EDT$$SEL_RNGPOS, ! Compare the select line with the current line
EDT$$FND_SENDLIM, ! Look for a sentence delimiter
EDT$$STR_CMP,
EDT$$SET_SEASTR, ! Setup string search buffer
EDT$$WF_BOT, ! Go to bottom of file
EDT$$WF_CLRBUF, ! Clear a buffer
EDT$$END_INS, ! End an insert sequence
EDT$$DEL_CURLN, ! Delete a line from buffer
EDT$$RPL_LN, ! Replace a line in text buffer
EDT$$RD_PRVLN, ! Move backward a line
EDT$$RD_CURLN, ! Get the current line
EDT$$FND_WPARA, ! find a wps paragraph
EDT$$START_INS; ! Start an insert sequence
EXTERNAL
CAS_TYP,
DEL_CH : BLOCK ! Deleted character buffer.
[CH$ALLOCATION (2, BYTE_SIZE)],
DEL_CHLEN, ! Length of deleted character buffer
DEL_LN : BLOCK ! Deleted line buffer.
[CH$ALLOCATION (257, BYTE_SIZE)],
DEL_LNLEN, ! Deleted line length.
DIRN, ! The current direction.
DEL_WD : BLOCK ! Deleted word buffer.
[CH$ALLOCATION (81, BYTE_SIZE)],
DEL_WDLEN, ! Length of del word string.
CMD_END,
CMD_PTR, ! Command string pointer
SEA_PTR, ! Address of search string.
SEL_BUF, ! Pointer to select buffer.
SEL_LN : LN_BLOCK, ! Relative line number of select.
SEL_POS, ! select position.
SEA_LEN, ! Length of search string.
VERT, ! Last entity was VERT flag.
ALT_BUF : REF TBCB_BLOCK, ! Alternate buffer used for cut/paste.
US_ENT : VECTOR, ! Pointers to user defined entities
SEA_BEG, ! Leave search at begining if on
CUR_BUF : REF TBCB_BLOCK, ! The current buffer tbcb
TI_TYP, ! Terminal type.
LN_BUF, ! Current line buffer
LN_END, ! End of current line pointer
LN_LEN, ! Length of current line
LN_PTR, ! Current character pointer
SEA_STRLEN, ! Length of current search string
SEA_STR, ! Current search string
PARTYP, ! type of paragraph
WK_LN : REF LIN_BLOCK, ! Current line pointer
EOB_LN,
CC_DONE, ! Set to 1 if control C actually aborts something
LNO0 : LN_BLOCK; ! Line number with value 1
MESSAGES ((NOSELRAN, SELALRACT, INVENT, ATTCUTAPP, STRNOTFND, TOPOFBUF, BOTOFBUF, INVSTR, BADRANGE));
LOCAL
START_POS : POS_BLOCK, ! Position of start of text.
END_POS : POS_BLOCK, ! Position of end of text.
ORIG_LNO : LN_BLOCK, ! Original relative line.
NUM_LINES : LN_BLOCK, ! Number of lines in the range.
SR, ! Set if range was a select range.
NC, ! Number of characters included in this entity.
SUCCEED; ! Set to zero if we hit a boundary.
SUCCEED = 1;
SR = 0;
NC = 0;
!+
! Setup the search string if it is a quoted string.
!-
IF (.ENTITY EQL ENT_K_QUOTE)
THEN
BEGIN
IF ( NOT EDT$$SET_SEASTR (.SEA_PTR, .SEA_LEN))
THEN
BEGIN
SUCCEED = 0;
EDT$$MSG_BELL (EDT$_INVSTR);
RETURN (.SUCCEED);
END;
!+
! If the next command is advance or backup, set the direction now
! so we can use the advance and backup keys to terminate the search
! string like KED does.
!-
WHILE (CH$RCHAR (.CMD_PTR) EQL %C' ') AND (CH$PTR_LEQ (CH$PLUS (.CMD_PTR, 3), .CMD_END)) DO
CMD_PTR = CH$PLUS (.CMD_PTR, 1);
IF (CH$PTR_LEQ (CH$PLUS (.CMD_PTR, 3), .CMD_END))
THEN
BEGIN
IF EDT$$STR_CMP (.CMD_PTR, CH$PTR (UPLIT ('BACK')), 4, 3)
THEN
DIRN = DIR_BACKWARD
ELSE
IF EDT$$STR_CMP (.CMD_PTR, CH$PTR (UPLIT ('ADV')), 3, 3)
THEN
DIRN = DIR_FORWARD;
END;
END;
!+
! To make the line, word, sent, etc entities work properly for deletes
! we must first move to the beginning of the entity. This does not
! apply for moves.
!-
IF ((.VERB NEQ VERB_K_MOVE) AND !
(.VERB NEQ VERB_K_CHGC) AND !
(.VERB NEQ VERB_K_CHGU) AND !
(.VERB NEQ VERB_K_CHGL))
THEN
CASE .ENTITY/2 FROM ENT_K_CHAR/2 TO LAST_K_ENT/2 OF
SET
[ENT_K_LINE/2] :
LN_PTR = CH$PTR (LN_BUF, 0, BYTE_SIZE);
[ENT_K_WORD/2] :
EDT$$FND_BWD (0);
[ENT_K_SEN/2] :
EDT$$FND_BSEN ();
[ENT_K_PAGE/2] :
BEGIN
EDT$$CS_RIGHT ();
SUCCEED = EDT$$FND_ENT (.US_ENT [2 + (.ENTITY EQL ENT_K_PAGE)], DIR_BACKWARD, 1);
IF (.SUCCEED EQL 2) THEN SUCCEED = 0 ELSE SUCCEED = 1;
END;
[ENT_K_PAR/2] :
BEGIN
EDT$$CS_RIGHT ();
IF (.PARTYP EQL WPSPARA)
THEN
SUCCEED = EDT$$FND_WPARA (DIR_BACKWARD)
ELSE
BEGIN
SUCCEED = EDT$$FND_ENT (.US_ENT [2], DIR_BACKWARD, 1);
IF (.SUCCEED EQL 2) THEN SUCCEED = 0 ELSE SUCCEED = 1;
END;
END;
[INRANGE] :
BEGIN
0
END;
[OUTRANGE] :
ASSERT (6, 0);
TES;
!+
! Save the original position in the buffer.
!-
EDT$$SAV_BUFPOS (START_POS);
ASSERT (7, .START_POS [POS_CHAR_POS] LEQU 255);
MOVELINE (CUR_BUF [TBCB_CUR_LIN], ORIG_LNO);
!+
! Loop over the entity count moving by one entity each time.
!-
INCR I FROM 1 TO .COUNT DO
BEGIN
IF (EDT$$CHK_CC () NEQ 0)
THEN
BEGIN
CC_DONE = 1;
EXITLOOP;
END;
!+
! Process one entity of the specified type.
!-
CASE .ENTITY + .DIRN FROM 1 TO LAST_K_ENT + 1 OF
SET
[ENT_K_CHAR + DIR_FORWARD] :
BEGIN
IF (SUCCEED = EDT$$CS_RIGHT ()) THEN NC = 1;
END;
[ENT_K_CHAR + DIR_BACKWARD] :
BEGIN
IF (SUCCEED = EDT$$CS_LEFT ()) THEN NC = 1;
END;
[ENT_K_VERT + DIR_FORWARD] :
BEGIN
IF (.VERT EQL 0) THEN EDT$$SC_CPUNEWCOLPOS ();
IF (.WK_LN EQLA EOB_LN)
THEN
SUCCEED = 0
ELSE
BEGIN
EDT$$CS_DWN ();
EDT$$SC_MATCHCOL ();
END;
VERT = 1;
END;
[ENT_K_VERT + DIR_BACKWARD] :
BEGIN
IF (.VERT EQL 0) THEN EDT$$SC_CPUNEWCOLPOS ();
SUCCEED = EDT$$CS_UP ();
EDT$$SC_MATCHCOL ();
VERT = 1;
END;
[ENT_K_BW + DIR_FORWARD, ENT_K_BW + DIR_BACKWARD, ENT_K_WORD + DIR_BACKWARD] :
BEGIN
IF EDT$$CS_LEFT () THEN NC = EDT$$FND_BWD (0) + 1 ELSE SUCCEED = 0;
DIRN = DIR_BACKWARD;
END;
[ENT_K_BSEN + DIR_FORWARD, ENT_K_BSEN + DIR_BACKWARD, ENT_K_SEN + DIR_BACKWARD] :
BEGIN
IF EDT$$CS_LEFT ()
THEN
BEGIN
LOCAL
STAT : INITIAL (1);
IF (CH$RCHAR (.LN_PTR) EQL ASC_K_CR)
THEN
EDT$$CS_LEFT ()
ELSE
WHILE ((CH$RCHAR (.LN_PTR) EQL %C' ')
AND ( .STAT NEQ 0))
DO
STAT = EDT$$CS_LEFT ();
EDT$$FND_BSEN ();
END
ELSE
SUCCEED = 0;
DIRN = DIR_BACKWARD;
END;
[ENT_K_EW + DIR_FORWARD, ENT_K_EW + DIR_BACKWARD, ENT_K_WORD + DIR_FORWARD] :
BEGIN
IF (.WK_LN EQLA EOB_LN) THEN SUCCEED = 0 ELSE NC = EDT$$FND_EWD ();
DIRN = DIR_FORWARD;
END;
[ENT_K_SEN + DIR_FORWARD] :
BEGIN
IF (.WK_LN EQLA EOB_LN)
THEN
SUCCEED = 0
ELSE
WHILE EDT$$CS_RIGHT () DO
IF EDT$$FND_SENDLIM (1) THEN EXITLOOP;
END;
[ENT_K_ESEN + DIR_FORWARD, ENT_K_ESEN + DIR_BACKWARD] :
BEGIN
IF (.WK_LN EQLA EOB_LN)
THEN
SUCCEED = 0
ELSE
WHILE EDT$$CS_RIGHT () DO
IF EDT$$FND_SENDLIM (0) THEN EXITLOOP;
DIRN = DIR_FORWARD;
END;
[ENT_K_NL + DIR_FORWARD, ENT_K_NL + DIR_BACKWARD, ENT_K_LINE + DIR_FORWARD] :
BEGIN
IF (.WK_LN EQLA EOB_LN)
THEN
SUCCEED = 0
ELSE
BEGIN
NC = CH$DIFF (.LN_END, .LN_PTR) + 1;
SUCCEED = EDT$$CS_DWN ();
END;
END;
[ENT_K_EL + DIR_FORWARD] :
BEGIN
IF (.WK_LN EQLA EOB_LN)
THEN
SUCCEED = 0
ELSE
BEGIN
NC = 0;
IF CH$PTR_EQL (.LN_END, .LN_PTR)
THEN
BEGIN
EDT$$CS_DWN ();
NC = 1;
END;
NC = .NC + CH$DIFF (.LN_END, .LN_PTR);
LN_PTR = .LN_END;
END;
END;
[ENT_K_EL + DIR_BACKWARD] :
BEGIN
LOCAL
LEN;
LEN = CH$DIFF (.LN_PTR, CH$PTR (LN_BUF,, BYTE_SIZE));
IF (SUCCEED = EDT$$CS_UP ())
THEN
BEGIN
NC = .LEN;
LN_PTR = .LN_END;
END;
END;
[ENT_K_BL + DIR_FORWARD, ENT_K_BL + DIR_BACKWARD, ENT_K_LINE + DIR_BACKWARD] :
BEGIN
IF CH$PTR_EQL (.LN_PTR, CH$PTR (LN_BUF,, BYTE_SIZE))
THEN
BEGIN
IF (SUCCEED = EDT$$CS_UP ()) THEN NC = .LN_LEN + 1;
END
ELSE
BEGIN
NC = CH$DIFF (.LN_PTR, CH$PTR (LN_BUF,, BYTE_SIZE));
LN_PTR = CH$PTR (LN_BUF,, BYTE_SIZE);
END;
DIRN = DIR_BACKWARD;
END;
[ENT_K_PAGE + DIR_FORWARD, ENT_K_EPAGE + DIR_FORWARD, ENT_K_EPAGE + DIR_BACKWARD] :
BEGIN
SUCCEED = EDT$$FND_ENT (.US_ENT [3], DIR_FORWARD, .ENTITY EQL ENT_K_PAGE);
IF (.SUCCEED EQL 2) THEN SUCCEED = 0;
DIRN = DIR_FORWARD;
END;
[ENT_K_EPAR + DIR_FORWARD, ENT_K_EPAR + DIR_BACKWARD] :
BEGIN
SUCCEED = EDT$$FND_ENT (.US_ENT [2], DIR_FORWARD, 0);
IF (.SUCCEED EQL 2) THEN SUCCEED = 0;
DIRN = DIR_FORWARD;
END;
[ENT_K_PAGE + DIR_BACKWARD, ENT_K_BPAGE + DIR_BACKWARD, ENT_K_BPAGE + DIR_FORWARD] :
BEGIN
SUCCEED = EDT$$FND_ENT (.US_ENT [3], DIR_BACKWARD, 1);
IF (.SUCCEED EQL 2) THEN SUCCEED = 0;
DIRN = DIR_BACKWARD;
END;
[ENT_K_BPAR + DIR_BACKWARD, ENT_K_BPAR + DIR_FORWARD] :
BEGIN
SUCCEED = EDT$$FND_ENT (.US_ENT [2], DIR_BACKWARD, 1);
IF (.SUCCEED EQL 2) THEN SUCCEED = 0;
DIRN = DIR_BACKWARD;
END;
[ENT_K_PAR + DIR_BACKWARD] :
BEGIN
IF (.PARTYP EQL WPSPARA)
THEN
SUCCEED = EDT$$FND_WPARA (DIR_BACKWARD)
ELSE
BEGIN
SUCCEED = EDT$$FND_ENT (.US_ENT [2], DIR_BACKWARD, 1);
IF (.SUCCEED EQL 2) THEN SUCCEED = 0;
DIRN = DIR_BACKWARD;
END;
END;
[ENT_K_PAR + DIR_FORWARD] :
BEGIN
IF (.PARTYP EQL WPSPARA)
THEN
SUCCEED = EDT$$FND_WPARA (DIR_FORWARD)
ELSE
BEGIN
SUCCEED = EDT$$FND_ENT (.US_ENT [2], DIR_FORWARD, 1);
IF (.SUCCEED EQL 2) THEN SUCCEED = 0;
DIRN = DIR_FORWARD;
END;
END;
[ENT_K_BR + DIR_FORWARD, ENT_K_BR + DIR_BACKWARD] :
BEGIN
EDT$$CS_TOP ();
DIRN = DIR_BACKWARD;
END;
[ENT_K_ER + DIR_FORWARD, ENT_K_ER + DIR_BACKWARD] :
BEGIN
EDT$$CS_BOTBUF ();
DIRN = DIR_FORWARD;
END;
[ENT_K_QUOTE + DIR_FORWARD, ENT_K_QUOTE + DIR_BACKWARD] :
BEGIN
SUCCEED = EDT$$STR_SEACMD (SEA_STR, .SEA_STRLEN, 1, .DIRN);
IF (.SUCCEED EQL 2) THEN SUCCEED = 0;
IF .SUCCEED
THEN
IF ((.SEA_BEG EQL 0) AND (.VERB NEQ VERB_K_SSEL))
THEN
DECR I FROM .SEA_STRLEN - 1 TO 0 DO
EDT$$CS_RIGHT ();
END;
[ENT_K_SR + DIR_FORWARD, ENT_K_SR + DIR_BACKWARD] :
BEGIN
IF (.SEL_BUF EQL .CUR_BUF)
THEN
BEGIN
ASSERT (7, CH$PTR_GEQ (.SEL_POS, CH$PTR (LN_BUF,, BYTE_SIZE)));
!+
! Determine the direction.
!-
SELECTONE EDT$$SEL_RNGPOS () OF
SET
[-1] : ! Select line is before current line
DIRN = DIR_BACKWARD;
[0] : ! Select line is current line, check character position
DIRN = CH$PTR_LSS (.LN_PTR, .SEL_POS);
[1] : ! Select line is after current line
DIRN = DIR_FORWARD;
[OTHERWISE] :
ASSERT (8, 0);
TES;
!+
! Move up or down until we get to the right line.
!-
WHILE 1 DO
SELECTONE EDT$$SEL_RNGPOS () OF
SET
[-1] : ! Select line is before current line
EDT$$CS_UP ();
[0] : ! Select line is current line
EXITLOOP;
[1] : ! Select line is after current line
EDT$$CS_DWN ();
[OTHERWISE] :
ASSERT (8, 0);
TES;
!+
! Point to the selected position.
!-
LN_PTR = .SEL_POS;
ASSERT (7, CH$DIFF (.LN_PTR, CH$PTR (LN_BUF,, BYTE_SIZE)) LEQU 255);
!+
! And turn off the select range, now that we've used it.
!-
SEL_BUF = 0;
SR = .SR + 1;
EXITLOOP;
END
ELSE
BEGIN
LOCAL
CURSOR_MOVES;
CURSOR_MOVES = 0;
IF ((.SEA_BEG EQL 0) AND (.VERB NEQ VERB_K_SEL))
THEN
DECR I FROM .SEA_STRLEN - 1 TO 0 DO
IF EDT$$CS_LEFT () THEN CURSOR_MOVES = .CURSOR_MOVES + 1;
IF ((.COUNT EQL 1) AND !
(.SEA_STRLEN GTR 0) AND EDT$$TST_ONSTR (SEA_STR, .SEA_STRLEN))
THEN
IF (.SEA_BEG NEQ 0)
THEN
BEGIN
DECR I FROM .SEA_STRLEN - 1 TO 0 DO
EDT$$CS_RIGHT ();
DIRN = DIR_FORWARD;
END
ELSE
DIRN = DIR_BACKWARD
ELSE
BEGIN
IF (.SEA_BEG EQL 0 AND .VERB NEQ VERB_K_SSEL)
THEN
DECR I FROM .CURSOR_MOVES - 1 TO 0 DO
EDT$$CS_RIGHT ();
IF ((.VERB EQL VERB_K_CHGC) OR (.VERB EQL VERB_K_CHGU) OR (.VERB EQL VERB_K_CHGL))
THEN
IF (.DIRN EQL DIR_BACKWARD) THEN EDT$$CS_LEFT () ELSE EDT$$CS_RIGHT ()
ELSE
BEGIN
EDT$$MSG_BELL (EDT$_NOSELRAN);
RETURN (0);
END;
END;
END;
END;
[OUTRANGE] :
ASSERT (6, 0);
TES;
IF ( NOT .SUCCEED) THEN EXITLOOP;
END;
!<BLF/PAGE>
!+
! If the verb was delete, then save the last entity in the proper
! save buffer.
!-
IF ((.NC NEQ 0) AND ((.VERB EQL VERB_K_DELETE) OR (.VERB EQL VERB_K_REPLACE)))
THEN
CASE .ENTITY/2 FROM 0 TO ENT_K_EL/2 OF
SET
[ENT_K_CHAR/2] :
BEGIN
EDT$$SAV_DELTXT (.NC, DEL_CH, 1);
DEL_CHLEN = MIN (.NC, 1);
END;
[ENT_K_WORD/2, ENT_K_BW/2, ENT_K_EW/2] :
BEGIN
EDT$$SAV_DELTXT (.NC, DEL_WD, 80);
DEL_WDLEN = MIN (.NC, 80);
END;
[ENT_K_LINE/2, ENT_K_NL/2, ENT_K_BL/2, ENT_K_EL/2] :
BEGIN
EDT$$SAV_DELTXT (.NC, DEL_LN, 256);
DEL_LNLEN = MIN (.NC, 256);
END;
[INRANGE, OUTRANGE] :
ASSERT (6, 0);
TES;
!+
! If the entity was not VERT then turn off the vert flag.
!-
IF (.ENTITY NEQ ENT_K_VERT) THEN VERT = 0;
!+
! Calculate the number of lines in the range.
!-
SUBLINE (CUR_BUF [TBCB_CUR_LIN], ORIG_LNO, NUM_LINES);
IF ((.NUM_LINES [LN_HI] AND %X'8000') NEQ 0) !
THEN
SUBLINE (ORIG_LNO, CUR_BUF [TBCB_CUR_LIN], NUM_LINES);
ADDLINE (LNO0, NUM_LINES, NUM_LINES);
!+
! Now set up the start and end position blocks, and position to the front of the range.
!-
ASSERT (7, .START_POS [POS_CHAR_POS] LEQU 255);
ASSERT (7, CH$DIFF (.LN_PTR, CH$PTR (LN_BUF,, BYTE_SIZE)) LEQU 255);
IF (.DIRN EQL DIR_BACKWARD)
THEN
BEGIN
EDT$$CPY_MEM (POS_SIZE, START_POS, END_POS);
ASSERT (7, .END_POS [POS_CHAR_POS] LEQU 255);
EDT$$SAV_BUFPOS (START_POS);
END
ELSE
BEGIN
EDT$$SAV_BUFPOS (END_POS);
ASSERT (7, .END_POS [POS_CHAR_POS] LEQU 255);
EDT$$RPOS (START_POS);
END;
ASSERT (7, .START_POS [POS_CHAR_POS] LEQU 255);
ASSERT (7, .END_POS [POS_CHAR_POS] LEQU 255);
!+
! Now, execute the command.
!-
CASE .VERB FROM VERB_K_MOVE TO VERB_K_APPEND OF
SET
[VERB_K_MOVE] :
BEGIN
IF (.DIRN EQL DIR_FORWARD) THEN EDT$$RPOS (END_POS);
END;
[VERB_K_CHGC] :
BEGIN
CAS_TYP = CASE_K_CHGC;
IF ((.NUM_LINES [LN_HI] NEQU 0) OR (.NUM_LINES [LN_MD] NEQU 0))
THEN
BEGIN
EDT$$MSG_BELL (EDT$_BADRANGE);
RETURN (0);
END
ELSE
CHANGE_CASE (.NUM_LINES [LN_LO], START_POS, END_POS);
IF (.SR NEQ 0)
THEN
IF (.DIRN EQL DIR_BACKWARD) THEN EDT$$RPOS (END_POS) ELSE EDT$$RPOS (START_POS);
END;
[VERB_K_CHGU] :
BEGIN
CAS_TYP = CASE_K_CHGU;
IF ((.NUM_LINES [LN_HI] NEQU 0) OR (.NUM_LINES [LN_MD] NEQU 0))
THEN
BEGIN
EDT$$MSG_BELL (EDT$_BADRANGE);
RETURN (0);
END
ELSE
CHANGE_CASE (.NUM_LINES [LN_LO], START_POS, END_POS);
IF (.SR NEQ 0)
THEN
IF (.DIRN EQL DIR_BACKWARD) THEN EDT$$RPOS (END_POS) ELSE EDT$$RPOS (START_POS);
END;
[VERB_K_CHGL] :
BEGIN
CAS_TYP = CASE_K_CHGL;
IF ((.NUM_LINES [LN_HI] NEQU 0) OR (.NUM_LINES [LN_MD] NEQU 0))
THEN
BEGIN
EDT$$MSG_BELL (EDT$_BADRANGE);
RETURN (0);
END
ELSE
CHANGE_CASE (.NUM_LINES [LN_LO], START_POS, END_POS);
IF (.SR NEQ 0)
THEN
IF (.DIRN EQL DIR_BACKWARD) THEN EDT$$RPOS (END_POS) ELSE EDT$$RPOS (START_POS);
END;
[VERB_K_SSEL] : ! search and select command
BEGIN
IF (.ENTITY NEQ ENT_K_QUOTE) ! we are only allowing the search for strings
THEN
BEGIN
EDT$$MSG_BELL (EDT$_INVENT); ! not a string -give error message and
RETURN (0); ! get out.
END;
IF (.SUCCEED EQL 1)
THEN
BEGIN ! we were able to find the string
IF (.DIRN EQL DIR_FORWARD)
THEN
EDT$$RPOS (END_POS)
ELSE ! position to the beginning of string
DECR I FROM .SEA_STRLEN - 1 TO 0 DO
EDT$$CS_RIGHT ();
IF (.SEL_BUF NEQA 0)
THEN
BEGIN
EDT$$MSG_BELL (EDT$_SELALRACT);
IF (.DIRN EQL DIR_FORWARD) THEN EDT$$RPOS (START_POS) ELSE EDT$$RPOS (END_POS);
RETURN (0);
END
ELSE
BEGIN
SEL_LN [LN_LO] = .CUR_BUF [TBCB_CUR_LIN];
SEL_LN [LN_MD] = .CUR_BUF [TBCB_CUR_LINM];
SEL_LN [LN_HI] = .CUR_BUF [TBCB_CUR_LINH];
SEL_BUF = .CUR_BUF;
SEL_POS = .LN_PTR;
END;
SUCCEED = EDT$$EXE_CHMCMD2 (ENT_K_CHAR, .SEA_STRLEN, VERB_K_MOVE)
!move across the string with select on
END;
END;
[VERB_K_TADJ] :
BEGIN
IF ((.NUM_LINES [LN_HI] NEQU 0) OR (.NUM_LINES [LN_MD] NEQU 0))
THEN
BEGIN
EDT$$MSG_BELL (EDT$_BADRANGE);
RETURN (0);
END
ELSE
INCR I FROM 1 TO (.NUM_LINES [LN_LO] - (.END_POS [POS_CHAR_POS] EQL 0)) DO
BEGIN
EDT$$TADJ_CMD ();
EDT$$CS_DWN ();
END;
END;
[VERB_K_DELETE, VERB_K_REPLACE] :
BEGIN
ALT_BUF = 0;
IF ((.NUM_LINES [LN_HI] NEQU 0) OR (.NUM_LINES [LN_MD] NEQU 0))
THEN
BEGIN
EDT$$MSG_BELL (EDT$_BADRANGE);
RETURN (0);
END
ELSE
BEGIN
EDT$$DEL_TXTLN (.NUM_LINES [LN_LO],
CH$PTR (LN_BUF, .END_POS [POS_CHAR_POS], BYTE_SIZE));
IF (.VERB EQL VERB_K_REPLACE) THEN SUCCEED = EDT$$INS_MOD ();
END;
END;
[VERB_K_FILL] :
BEGIN
IF ((.NUM_LINES [LN_HI] NEQU 0) OR (.NUM_LINES [LN_MD] NEQU 0))
THEN
BEGIN
EDT$$MSG_BELL (EDT$_BADRANGE);
RETURN (0);
END
ELSE
BEGIN
EDT$$RPL_CHGDLN ();
EDT$$FILL_TXT (.NUM_LINES [LN_LO] - (.END_POS [POS_CHAR_POS] EQL 0));
EDT$$GET_TXTLN ();
END;
END;
[VERB_K_CUT, VERB_K_APPEND] :
BEGIN
LOCAL
SAVE_BUF;
IF (.ALT_BUF EQL 0) THEN RETURN (0);
IF (.ALT_BUF EQL .CUR_BUF)
THEN
BEGIN
EDT$$MSG_BELL (EDT$_ATTCUTAPP);
RETURN (0);
END;
IF ((.NUM_LINES [LN_HI] NEQU 0) OR (.NUM_LINES [LN_MD] NEQU 0))
THEN
BEGIN
EDT$$MSG_BELL (EDT$_BADRANGE);
RETURN (0);
END
ELSE
BEGIN
SAVE_BUF = .CUR_BUF;
CUR_BUF = .ALT_BUF;
IF (.VERB EQL VERB_K_APPEND) THEN EDT$$WF_BOT () ELSE EDT$$WF_CLRBUF ();
EDT$$START_INS ();
CUR_BUF = .SAVE_BUF;
EDT$$DEL_TXTLN (.NUM_LINES [LN_LO],
CH$PTR (LN_BUF, .END_POS [POS_CHAR_POS], BYTE_SIZE));
EDT$$RPL_CHGDLN ();
CUR_BUF [TBCB_CHAR_POS] = CH$DIFF (.LN_PTR, CH$PTR (LN_BUF,, BYTE_SIZE));
CUR_BUF = .ALT_BUF;
EDT$$RD_CURLN ();
EDT$$END_INS ();
!+
! If this is an append, combine first line appended with previous line.
!-
IF (.VERB EQL VERB_K_APPEND)
THEN
BEGIN
DECR I FROM .NUM_LINES - 1 TO 0 DO
EDT$$RD_PRVLN ();
EDT$$GET_TXTLN ();
IF EDT$$RD_PRVLN ()
THEN
IF ((.LN_LEN + .WK_LN [LIN_LENGTH]) LEQ 255)
THEN
BEGIN
EDT$$CPY_STR (.LN_LEN, CH$PTR (LN_BUF,, BYTE_SIZE),
CH$PTR (LN_BUF, .WK_LN [LIN_LENGTH], BYTE_SIZE));
EDT$$CPY_STR (.WK_LN [LIN_LENGTH],
CH$PTR (WK_LN [LIN_TEXT],, BYTE_SIZE),
CH$PTR (LN_BUF,, BYTE_SIZE));
LN_LEN = .LN_LEN + .WK_LN [LIN_LENGTH];
EDT$$DEL_CURLN ();
EDT$$RPL_LN (CH$PTR (LN_BUF,, BYTE_SIZE), .LN_LEN);
END;
END;
CUR_BUF = .SAVE_BUF;
EDT$$GET_TXTLN ();
END;
END;
[INRANGE, OUTRANGE] :
ASSERT (6, 0);
TES;
IF (.SUCCEED EQL 0)
THEN
EDT$$MSG_BELL (
IF (.ENTITY EQL ENT_K_QUOTE)
THEN
EDT$_STRNOTFND
ELSE
IF (.DIRN EQL DIR_BACKWARD) THEN EDT$_TOPOFBUF ELSE EDT$_BOTOFBUF);
RETURN (.SUCCEED);
END; ! of routine EDT$$EXE_CHMCMD2
%SBTTL 'CHANGE_CASE - Change the case of characters in a range'
ROUTINE CHANGE_CASE ( ! Change the case of characters in a range
NUM_LINES, ! Number of lines to process
START_POS, ! Place to start in first line
END_POS ! Place to stop in last line
) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine scans over a range and changes the case of the characters
! in that range.
!
! FORMAL PARAMETERS:
!
! NUM_LINES the number of lines to process
!
! START_POS the character position in the first line at which we
! should start
!
! END_POS the character position in the last line at which we should stop
!
! IMPLICIT INPUTS:
!
! DIR
! LN_BUF
! LN_PTR
! LN_END
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
MAP
END_POS : REF POS_BLOCK;
EXTERNAL ROUTINE
EDT$$CS_DWN, ! Move down a line
EDT$$RPOS : NOVALUE, ! Restore the saved buffer position
EDT$$MRK_LNCHG : NOVALUE, ! Mark changes in a line
EDT$$CHG_CAS : NOVALUE; ! Change the case of characters
EXTERNAL
DIRN, ! The current direction.
LN_BUF, ! Current line buffer
LN_PTR, ! Current character pointer
LN_END; ! End of current line pointer
LOCAL
LC;
ASSERT (7, .END_POS [POS_CHAR_POS] LEQ 255);
!+
! Loop through all lines.
!-
INCR I FROM 1 TO .NUM_LINES DO
BEGIN
!+
! Set up pointer to last character in line.
!-
LC = .LN_END;
IF (.I EQL .NUM_LINES) THEN LC = CH$PTR (LN_BUF,
.END_POS [POS_CHAR_POS], BYTE_SIZE);
!+
! We must not ask for a negative amount of text to be processed.
!-
ASSERT (7, CH$PTR_LEQ (.LN_PTR, .LC));
ASSERT (7, CH$DIFF (.LC, CH$PTR (LN_BUF,, BYTE_SIZE)) LEQ 255);
EDT$$CHG_CAS (.LN_PTR, .LC);
!+
! Mark that part of the line as changed.
!-
EDT$$MRK_LNCHG (SCR_EDIT_MODIFY, CH$DIFF (.LN_PTR,
CH$PTR (LN_BUF,, BYTE_SIZE)));
EDT$$CS_DWN ();
END;
!+
! If the direction was backward, then position to the start of the range.
! If forward, position to the end of the range.
!-
IF (.DIRN EQL DIR_BACKWARD) THEN EDT$$RPOS (.START_POS) ELSE EDT$$RPOS (.END_POS);
END; ! of routine CHANGE_CASE
!<BLF/PAGE>
END ! of module EDT$CHMEXVERB
ELUDOM