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) 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 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