Trailing-Edge
-
PDP-10 Archives
-
BB-H138F-BM_1988
-
7-sources/ranrpos.bli
There are 10 other files named ranrpos.bli in the archive. Click here to see a list.
%TITLE 'RANRPOS - position to the first line of a range'
MODULE RANRPOS ( ! Position to the first line of a range
IDENT = '3-002' ! File: RANRPOS.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:
!
! Position to the first line of a range.
!
! ENVIRONMENT: Runs at any access mode - AST reentrant
!
! AUTHOR: Bob Kushlis, CREATION DATE: February 3, 1978
!
! MODIFIED BY:
!
! 1-001 - Original. DJS 19-FEB-1981. This module was created by
! extracting routine RPOS from module RANGE.
! 1-002 - Regularize headers. JBS 12-Mar-1981
! 1-003 - Change to use the ASSERT macro. JBS 01-Jun-1981
! 1-004 - Use the new message codes. JBS 04-Aug-1981
! 1-005 - Use the new PREV_RANGE field for ALL. JBS 02-Nov-1981
! 1-006 - In THRU, if part of the range is not found the whole
! range fails. JBS 19-Nov-1981
! 1-007 - Fix any size problems in arithmetic and compares. SMB 25-Jan-1982
! 1-008 - Remove original line numbers. SMB 28-Jan-1982
! 1-009 - Add error message and change display for original line numbers. SMB 6-Feb-1982
! 1-010 - Change the way buffer pos. is saved for AND ranges. SMB 15-Feb-1982
! 1-011 - Don't change buffer pos if we have /STAY. STS 21-Apr-1982
! 1-012 - Worry about string truncation. JBS 05-May-1982
! 1-013 - Add error checks for incomplete select ranges. SMB 01-Jul-1982
! 1-014 - Make sure range ok on "No select range". SMB 02-Jul-1982
! 1-015 - Put edt$$rng_retfrst in line. STS 11-Oct-1982
! 1-016 - Modify to use new compare macro. STS 20-Oct-1982
! 1-017 - Remove setting of G_TXT_ONSCR with select range. SMB 13-Dec-1982
! 3-001 - Add updates from V3 sources. GB 16-May-1983
! 3-002 - Modify ASSERT macro to include error code. CJG 30-Jan-1984
!--
%SBTTL 'Declarations'
!
! TABLE OF CONTENTS:
!
REQUIRE 'EDTSRC:TRAROUNAM';
FORWARD ROUTINE
EDT$$RNG_REPOS;
!
! INCLUDE FILES:
!
REQUIRE 'EDTSRC:EDTREQ';
!
! MACROS:
!
! NONE
!
! EQUATED SYMBOLS:
!
! NONE
!
! OWN STORAGE:
!
! NONE
!
! EXTERNAL REFERENCES:
!
! In the routine
%SBTTL 'EDT$$RNG_REPOS - position to the first line of a range'
GLOBAL ROUTINE EDT$$RNG_REPOS ( ! Position to the first line of a range
RANGE ! Range to position to
) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine positions to the first line of a range.
!
! FORMAL PARAMETERS:
!
! RANGE The range node.
!
! IMPLICIT INPUTS:
!
! SEL_BUF
! SEL_LN
! CUR_BUF
! PRV_BUF
! LN_BUF
! RNG_ORIGPOS
! SEL_POS
! WK_LN
!
! IMPLICIT OUTPUTS:
!
! RNG_MORELN
! RNG_NOOFLN
! RNG_EOL
! PRV_BUF
! CUR_BUF
! SEL_BUF
! RNG_SAVPOS
! RNG_CURRNG
! RNG_ORIGPOS
!
! ROUTINE VALUE:
!
! 0 = no such line
! 1 = positioned successfully
!
! SIDE EFFECTS:
!
! Current text buffer is re-positioned
!
!--
BEGIN
EXTERNAL ROUTINE
EDT$$CMP_LNO,
EDT$$FMT_MSG,
EDT$$RNG_REPOS,
EXE_SBITS,
EDT$$FND_STR,
EDT$$FND_BUF,
EDT$$SET_SEASTR,
EDT$$WF_BOT,
EDT$$RD_PRVLN,
EDT$$RD_CURLN,
EDT$$RD_NXTLN,
EDT$$TOP_BUF,
EDT$$LOC_LN;
EXTERNAL
CUR_COL, ! Current cursor column
LNO5 : LN_BLOCK, ! 10**5
SEL_BUF, ! Select buffer
SEL_LN, ! Select line
PRV_BUF, ! The previous TBCB for LAST range.
CUR_BUF : REF TBCB_BLOCK, ! The current text buffer
LN_BUF, ! Line buffer
RNG_MORELN, ! Used by EDT$$NXT_LNRNG to indicate more lines.
RNG_FRSTLN, ! Indicates first line in a range.
RNG_NOOFLN, ! Count of number of lines in a range.
RNG_ORIGPOS : POS_BLOCK, ! To save the position at start of command.
RNG_EOL : LN_BLOCK, ! The line number at which this range ends
RNG_CURRNG : REF NODE_BLOCK, ! The current range node
RNG_SAVPOS : POS_BLOCK, ! To save the beginning of range
SEL_POS, ! Select position
WK_LN : REF LIN_BLOCK; ! The current line pointer.
MESSAGES ((NOSELRAN, NOSUCHLIN, STRNOTFND, INSMEM, NOORIGNUM, INVSTR, INVSRAN));
MAP
RANGE : REF NODE_BLOCK;
!+
! Make sure the parameter is a range node.
!-
ASSERT (19, .RANGE [NODE_TYPE] EQL RANGE_NODE);
!+
! Initialize for first line of range.
!-
RNG_MORELN = 1;
RNG_NOOFLN = 0;
!+
! Case on range type.
!-
CASE .RANGE [RAN_TYPE] FROM 0 TO NUM_RAN OF
SET
!+
! If range is '.' or REST, the original position is the first line.
!-
[RAN_DOT, RAN_NULL, RAN_REST] : ! Use the current position
BEGIN
EDT$$CPY_MEM (POS_SIZE, RNG_ORIGPOS, .CUR_BUF);
EDT$$RD_CURLN ();
END;
!+
! Line number range. Find the line.
!-
[RAN_NUMBER] :
BEGIN
RNG_MORELN = EDT$$LOC_LN (RANGE [RAN_VAL]);
END;
!+
! Range is BEFORE. Try going back a line to find out if there are any,
! then save that number as the last line number in the range.
!-
[RAN_BEFORE] :
BEGIN
RNG_MORELN = EDT$$RD_PRVLN ();
MOVELINE (WK_LN [LIN_NUM], RNG_EOL);
EDT$$TOP_BUF ();
END;
!+
! Range is WHOLE or BEGIN. Position to the first line in the buffer.
!-
[RAN_WHOLE, RAN_BEGIN] :
EDT$$TOP_BUF ();
!+
! Range is SELECT. Check to see if there is a select range in effect.
! If it not in the current buffer, then switch to the buffer which has
! the select. Then position to the first line of the select range.
!-
[RAN_SELECT] :
BEGIN
LOCAL
TMPRAN : LN_BLOCK;
IF (.SEL_BUF EQLA 0)
THEN
BEGIN
EDT$$FMT_MSG (EDT$_NOSELRAN);
RNG_MORELN = 0;
RNG_CURRNG = .RANGE;
IF (.RNG_FRSTLN) THEN EDT$$CPY_MEM (POS_SIZE, .CUR_BUF, RNG_SAVPOS);
RETURN (0);
END
ELSE
BEGIN
IF (.SEL_BUF NEQA .CUR_BUF)
THEN
BEGIN
PRV_BUF = .CUR_BUF;
CUR_BUF = .SEL_BUF;
EDT$$RD_CURLN ();
END;
SUBLINE (CUR_BUF [TBCB_CUR_LIN], SEL_LN, TMPRAN);
RANGE [RAN_VAL] = .TMPRAN; !Only want to move a word
!+
! For line mode commands the select range must be in whole lines
!-
IF (.CUR_COL NEQ 0) OR (.TMPRAN EQL 0)
THEN
BEGIN
EDT$$FMT_MSG (EDT$_INVSRAN);
RNG_MORELN = 0;
RNG_CURRNG = .RANGE;
IF (.RNG_FRSTLN) THEN EDT$$CPY_MEM (POS_SIZE, .CUR_BUF, RNG_SAVPOS);
RETURN (0);
END
ELSE
IF (.RANGE [RAN_VAL] LSS 0)
THEN
BEGIN
RANGE [RAN_VAL] = -.RANGE [RAN_VAL];
DECR I FROM .RANGE [RAN_VAL] - 1 TO 0 DO
EDT$$RD_PRVLN ();
END;
IF CH$PTR_NEQ (.SEL_POS, CH$PTR (LN_BUF))
THEN
RANGE [RAN_VAL] = .RANGE [RAN_VAL] + 1;
SEL_BUF = 0;
END;
END;
!+
! Range is END. Position to the end of the buffer.
!-
[RAN_END] :
BEGIN
EDT$$WF_BOT ();
RNG_MORELN = 0;
END;
!+
! Range is ORIGINAL. This is no longer a feature of EDT, so print a warning
! and type the real line number corresponding to the line input
!-
[RAN_ORIG] :
BEGIN
LOCAL
LINNO : LN_BLOCK;
EDT$$CPY_MEM (POS_SIZE, .CUR_BUF, RNG_SAVPOS);
EDT$$FMT_MSG (EDT$_NOORIGNUM);
MULTLINE (LNO5, RANGE [RAN_VAL], LINNO);
WHILE (EDT$$CMP_LNO (WK_LN [LIN_NUM], LINNO) NEQ 0) DO
IF ( NOT EDT$$RD_NXTLN ())
THEN
BEGIN
RNG_MORELN = 0;
EDT$$CPY_MEM (POS_SIZE, RNG_SAVPOS, .CUR_BUF);
EDT$$RD_CURLN ();
EDT$$FMT_MSG (EDT$_NOSUCHLIN);
RETURN (0);
END;
END;
!+
! Range is MINUS. Make a recursive call to position to the range then
! move back the specified number of lines.
!-
[RAN_MINUS] :
BEGIN
IF EDT$$RNG_REPOS (.RANGE [SUB_RANGE])
THEN
BEGIN
RNG_MORELN = 1;
INCR I FROM 1 TO .RANGE [RAN_VAL] DO
IF ( NOT EDT$$RD_PRVLN ())
THEN
BEGIN
RNG_MORELN = 0;
EXITLOOP;
END
END
ELSE
RNG_MORELN = 0;
END;
!+
! Range is Plus. Make a recursive call to position to the range then
! move forward the specified number of lines.
!-
[RAN_PLUS] :
BEGIN
IF EDT$$RNG_REPOS (.RANGE [SUB_RANGE])
THEN
BEGIN
RNG_MORELN = 1;
INCR I FROM 1 TO .RANGE [RAN_VAL] DO
IF ( NOT EDT$$RD_NXTLN ())
THEN
BEGIN
RNG_MORELN = 0;
EXITLOOP;
END
END
ELSE
RNG_MORELN = 0;
END;
!+
! Range is FOR or #. Just position to the original range.
!-
[RAN_FOR] :
RNG_MORELN = EDT$$RNG_REPOS (.RANGE [SUB_RANGE]);
!+
! Range is a search string. Save the current position, search for the
! string in the specified direction. If the string is not found, then
! reposition and return failure.
!-
[RAN_STR, RAN_MINSTR] :
BEGIN
LOCAL
FIND_STATUS;
EDT$$CPY_MEM (POS_SIZE, .CUR_BUF, RNG_SAVPOS);
FIND_STATUS = EDT$$FND_STR (.RANGE [STR_PNT], .RANGE [RAN_VAL], (.RANGE [RAN_TYPE] EQL RAN_STR));
CASE .FIND_STATUS FROM 0 TO 2 OF
SET
[0] : ! String not found
BEGIN
EDT$$FMT_MSG (EDT$_STRNOTFND);
RNG_MORELN = 0;
EDT$$CPY_MEM (POS_SIZE, RNG_SAVPOS, .CUR_BUF);
EDT$$RD_CURLN ();
RETURN (0);
END;
[1] : ! String found
BEGIN
0
END;
[2] : ! String invalid
BEGIN
EDT$$FMT_MSG (EDT$_INVSTR);
RNG_MORELN = 0;
EDT$$CPY_MEM (POS_SIZE, RNG_SAVPOS, .CUR_BUF);
EDT$$RD_CURLN ();
RETURN (0);
END;
TES;
END;
!+
! Range is THRU or : . Position to the first range, then find the line
! number of the end of the range. Special case when the end range is a
! line number or END. Otherwise, save the current position and position to
! the end to get the end range. If either the first or last cannot be
! found the whole range fails.
!-
[RAN_THRU] :
BEGIN
LOCAL
SAV_BUFPOS : POS_BLOCK;
BIND
END_RANGE = .RANGE [RANGE2] : NODE_BLOCK;
BIND
START_RANGE = .RANGE [RANGE1] : NODE_BLOCK;
IF ( NOT EDT$$RNG_REPOS (START_RANGE)) THEN RETURN (0);
IF (.END_RANGE [RAN_TYPE] EQL RAN_NUMBER) !
THEN
MOVELINE (END_RANGE [RAN_VAL], RNG_EOL)
ELSE
IF (.END_RANGE [RAN_TYPE] EQL RAN_END)
THEN
RANGE [RAN_TYPE] = RAN_REST
ELSE
BEGIN
LOCAL
END_FOUND;
EDT$$CPY_MEM (POS_SIZE, .CUR_BUF, SAV_BUFPOS);
END_FOUND = EDT$$RNG_REPOS (END_RANGE);
IF .END_FOUND THEN
MOVELINE (WK_LN [LIN_NUM], RNG_EOL);
EDT$$CPY_MEM (POS_SIZE, SAV_BUFPOS, .CUR_BUF);
EDT$$RD_CURLN ();
IF ( NOT .END_FOUND) THEN RETURN (0);
END;
RNG_MORELN = 1;
END;
!+
! Range is ALL range. Look at the range to which ALL applies. If it is
! null, assume WHOLE. Position to that range, then set up the ALL string
! as the current search string. Note that RNG_CURRNG will be not
! that ALL range but its subordinate. PREV_RANGE will point back to the
! ALL range.
!-
[RAN_ALL] :
BEGIN
LOCAL
SUB_RAN : REF NODE_BLOCK;
SUB_RAN = .RANGE [NEXT_RANGE];
ASSERT (19, .SUB_RAN [PREV_RANGE] EQLA .RANGE);
IF (.SUB_RAN [RAN_TYPE] EQL RAN_NULL) THEN SUB_RAN [RAN_TYPE] = RAN_WHOLE;
RNG_FRSTLN = 1;
EDT$$CPY_MEM (POS_SIZE, .CUR_BUF, RNG_ORIGPOS);
IF ( NOT EDT$$RNG_REPOS (.RANGE [NEXT_RANGE])) THEN RETURN (0);
IF ( NOT EDT$$SET_SEASTR (.RANGE [STR_PNT], .RANGE [RAN_VAL]))
THEN
BEGIN
EDT$$FMT_MSG (EDT$_INVSTR);
RETURN (0);
END;
RETURN (1);
END;
!+
! The range contains a buffer specification. Switch to the new buffer, then
! position to the range within the buffer. If the range within the buffer
! was null, assume WHOLE.
!-
[RAN_BUFFER] :
BEGIN
LOCAL
SUB_RANGE : REF NODE_BLOCK;
IF EDT$$FND_BUF (.RANGE [BUF_NAME], .RANGE [BUF_LEN])
THEN
BEGIN
SUB_RANGE = .RANGE [RANGE1];
IF ( NOT .EXE_SBITS<OPB_STAY>) !
THEN
EDT$$CPY_MEM (POS_SIZE, .CUR_BUF, RNG_ORIGPOS);
EDT$$TOP_BUF ();
IF (.SUB_RANGE [RAN_TYPE] EQL RAN_NULL) THEN SUB_RANGE [RAN_TYPE] = RAN_WHOLE;
RETURN (EDT$$RNG_REPOS (.SUB_RANGE));
END
ELSE
BEGIN
EDT$$FMT_MSG (EDT$_INSMEM);
RETURN (0);
END
END;
!+
! Range is LAST. Switch back to the buffer pointed to by PRV_BUF
! at it's current position.
!-
[RAN_LAST] :
BEGIN
LOCAL
TEMP;
TEMP = .CUR_BUF;
CUR_BUF = .PRV_BUF;
PRV_BUF = .TEMP;
EDT$$RD_CURLN ();
END;
[INRANGE, OUTRANGE] :
ASSERT (19, 0);
TES;
!+
! Save the range node and the current position.
!-
RNG_CURRNG = .RANGE;
IF (.RNG_FRSTLN) THEN EDT$$CPY_MEM (POS_SIZE, .CUR_BUF, RNG_SAVPOS);
RETURN (1);
END; ! of routine EDT$$RNG_REPOS
END ! of module EDT$RANRPOS
ELUDOM