Trailing-Edge
-
PDP-10 Archives
-
bb-h138f-bm
-
7-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) 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 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