Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

 %TITLE 'LCLEAR - CLEAR command'
MODULE LCLEAR (				! CLEAR command
		IDENT = '3-005'			! File: LCLEAR.BLI Edit: CJG3005
		) =
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 line mode CLEAR command.
!
! ENVIRONMENT:	Runs at any access mode - AST reentrant
!
! AUTHOR: Bob Kushlis, CREATION DATE: February 3, 1978
!
! MODIFIED BY:
!
! 1-001	- Original.  DJS 02-FEB-1981.  This module was created by
!	extracting the routine EDT$$CLR_CMD  from the routine EXEC.BLI.
! 1-002	- Regularize headers.  JBS 19-Mar-1981
! 1-003 - Implement virtual memory deallocation TMV 5-Aug-81
! 1-004 - Close the input buffer on a CLEAR MAIN.  SMB 3-May-1982
! 1-005	- Regularize format.  JBS 04-May-1982
! 1-006	- Flag the screen as changed if we delete the current buffer.  JBS 07-Jul-1982
! 1-007	- Change SCR_CHGD to REBUILD.  JBS 09-Oct-1982
! 3-001 - Make arguments to CH$EQL into string ptrs.  GB 1-Mar-1983
! 3-002 - Don't need RHB code on TOPS20. CJG 19-Apr-1983
! 3-003 - Add updates from V3 source kit.  GB 28-Apr-1983
! 3-004 - Remove call to EDT$$CALLFIO. CJG 10-Jun-1983
! 3-005 - Fix the calls to EDT$$FND_BUF to use byte pointers. CJG 8-Jul-1983
!--

%SBTTL 'Declarations'
!
! TABLE OF CONTENTS:
!

REQUIRE 'EDTSRC:TRAROUNAM';

FORWARD ROUTINE
    EDT$$CLR_CMD : NOVALUE;			! Process the CLEAR command

!
! INCLUDE FILES:
!

REQUIRE 'EDTSRC:EDTREQ';

!
! MACROS:
!
!	NONE
!
! EQUATED SYMBOLS:
!

EXTERNAL LITERAL
    EDT$K_INPUT_FILE,
    EDT$K_CLOSE;

! OWN STORAGE:
!
!	NONE
!
! EXTERNAL REFERENCES:
!
!	In the routine
%SBTTL 'EDT$$CLR_CMD  - CLEAR command'

GLOBAL ROUTINE EDT$$CLR_CMD 			! CLEAR line-mode command
    : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Command processing for CLEAR.   Position to the buffer to
!	be cleared, then call the work file system to clear it.
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	CUR_BUF
!	EXE_CURCMD
!
! IMPLICIT OUTPUTS:
!
!	SCR_REBUILD
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	The input file is closed (if not already) when a CLEAR MAIN occurs.
!
!--

    BEGIN

    EXTERNAL ROUTINE
	EDT$FILEIO,
	EDT$$FMT_MSG,
	EDT$$DEA_HEAP,
	EDT$$FND_BUF,
	EDT$$WF_CLRBUF,
	EDT$$RD_CURLN;

    EXTERNAL
	INPUT_OPN,			! input file is still open
	SCR_REBUILD,			! Set if the screen must be rebuilt
	BUF_LST,
	CUR_BUF : REF TBCB_BLOCK,
	EXE_CURCMD : REF NODE_BLOCK;	! Pointer to the current command.

    MESSAGES ((INPFILCLO));

    LOCAL
	LEN,
	SAVE_TBCB,
	PREV : REF TBCB_BLOCK,
	NEXT : REF TBCB_BLOCK,
	RANGE : REF NODE_BLOCK;

!+
! Save the current TBCB so we can get back.
!-
    SAVE_TBCB = .CUR_BUF;
    RANGE = .EXE_CURCMD [RANGE1];
!+
! Did we find or allocate a buffer successfully ?
!-

    IF EDT$$FND_BUF (.RANGE [BUF_NAME], .RANGE [BUF_LEN])
    THEN
	BEGIN
!+
! The MAIN and the PASTE buffers cannot be deleted, they can be cleared only
!-

	IF (CH$EQL (.RANGE [BUF_LEN],.RANGE [BUF_NAME], 4, CH$PTR (UPLIT('MAIN')))) OR 	!
	    (CH$EQL (.RANGE [BUF_LEN],.RANGE [BUF_NAME], 5, CH$PTR (UPLIT('PASTE'))))
	THEN
	    BEGIN
!+
! If MAIN is being CLEARed and the input file is still open, then close it
!-

	    IF ((CH$EQL (.RANGE [BUF_LEN],.RANGE [BUF_NAME], 4,
		 CH$PTR (UPLIT('MAIN')))) AND .INPUT_OPN)
	    THEN

		IF EDT$FILEIO (EDT$K_CLOSE, EDT$K_INPUT_FILE, 0)
		THEN
		    BEGIN
		    CUR_BUF [TBCB_INPUT_RAB] = 0;
		    INPUT_OPN = 0;
		    END
		ELSE
		    EDT$$FMT_MSG (EDT$_INPFILCLO);

	    EDT$$WF_CLRBUF ();
	    END
	ELSE
	    BEGIN
!+
! Delete the buffer by disconnecting the TBCB header from the list
!-
	    PREV = .CUR_BUF [TBCB_PREV_BUF];
	    NEXT = .CUR_BUF [TBCB_NEXT_BUF];
!+
! If we want to clear the first buffer which is not MAIN we have to
! readjust the buffer list header pointer.
!-

	    IF (.PREV EQL 0) THEN BUF_LST = .NEXT;

!+
! Unlink the deleted buffer header
!-

	    IF (.NEXT NEQ 0) THEN NEXT [TBCB_PREV_BUF] = .PREV;

	    IF (.PREV NEQ 0) THEN PREV [TBCB_NEXT_BUF] = .NEXT;

!+
! Get the name length, and the beginning address, then deallocate header
!-
	    LEN = .CUR_BUF [TBCB_NAME_LEN];
	    EDT$$DEA_HEAP (%REF (TBCB_SIZE + .LEN), CUR_BUF);
	    END;

!+
! If the current buffer was deleted then the text part of the screen must be rebuilt.
!-

	IF (.CUR_BUF EQLA .SAVE_TBCB) THEN SCR_REBUILD = 1;

!+
! If the current buffer other than MAIN was deleted, go to the MAIN buffer
!-

	IF (.CUR_BUF EQLA .SAVE_TBCB)
	THEN
	    EDT$$FND_BUF (CH$PTR (UPLIT ('MAIN')), 4)
!+
! Otherwise go back to the original buffer.
!-
	ELSE
	    CUR_BUF = .SAVE_TBCB;

	END;

    EDT$$RD_CURLN ();
    END;					! of routine EDT$$CLR_CMD


END
ELUDOM