Trailing-Edge
-
PDP-10 Archives
-
bb-r775c-bm_tops20_ks_upd_3
-
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) 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:
!
! 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