Google
 

Trailing-Edge - PDP-10 Archives - bb-h138f-bm - 7-sources/setcomman.bli
There are 10 other files named setcomman.bli in the archive. Click here to see a list.
!SOFT:<EDT.44>SETCOMMAN.BLI  26-Mar-87, Edit by Perkins
!Edit 44, Fixed edit 35.  If EDT tried to read the EDTINI.EDT file from
!the default login directory  the file blocks would get destroyed.
!GREEN:<ZBRAD.20790>SETCOMMAN.BLI.9  4-Nov-85 13:48:56, Edit by MERRILL
!Edit 35, Fixup NADDR call, and copy file blocks correctly.
 %TITLE 'SETCOMMAN - set command file name'
MODULE SETCOMMAN (				! Set command file name
		IDENT = '3-006'			! File: SETCOMMAN.BLI Edit: CJG3006
		) =
BEGIN
!
! COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1982, 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 WHICH IS NOT SUPPLIED BY DIGITAL.
!

!++
! FACILITY:	EDT -- The DEC Standard Editor
!
! ABSTRACT:
!
!	Set help file name.
!
! ENVIRONMENT:	Runs at any access mode - AST reentrant
!
! AUTHOR: John Sauter, CREATION DATE: June 3, 1982
!
! MODIFIED BY:
!
! 1-001	- Original.  JBS 07-Jun-1982
! 1-002	- Don't open the file on the INCLUDE channel if the COMMAND channel
!	   is not already open.  This is because the initial opens from
!	   EDT$EDIT must have a default name which is only supplied on
!	   the COMMAND channel.  JBS 08-Jun-1982
! 1-003	- Close the correct file.  JBS 11-Jun-1982
! 1-004	- Set CMD_OPN when the command file is open.  JBS 11-Jun-1982
! 1-005	- Pass the default file name in the RHB parameter.  JBS 15-Jun-1982
! 1-006	- Accept the default name as a parameter.  JBS 23-Aug-1982
! 3-001 - Modify for TOPS10/20. CJG 23-Mar-1983
! 3-002 - Add updates from V3 sources. GB 03-may-1983
! 3-003 - Remove default name from argument list - its already been
!	    done by the parser. CJG 10-Jun-1983
! 3-004 - Remove call to EDT$$CALLFIO. CJG 10-Jun-1983
! 3-005 - Change the way that filespecs are handled. CJG 23-Jun-1983
! 3-006 - Modify ASSERT macro to include error code. CJG 30-Jan-1984
!--

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

REQUIRE 'EDTSRC:TRAROUNAM';

FORWARD ROUTINE
    EDT$$SET_COMFNAM;

!
! INCLUDE FILES:
!

REQUIRE 'EDTSRC:EDTREQ';

!
! MACROS:
!
!	NONE
!
! EQUATED SYMBOLS:
!
!	NONE
!
! OWN STORAGE:
!
!	NONE
!
! EXTERNAL REFERENCES:
!
!	In the routine
%SBTTL 'EDT$$SET_COMFNAM  - set command file name'

GLOBAL ROUTINE EDT$$SET_COMFNAM (		! Set command file name
    NADDR					! Address of new command file name
    ) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Set a new command file name.  If the file does not exist there is no
!	effect.  Otherwise the current command file is abandoned and the new
!	command file is read instead.
!
! FORMAL PARAMETERS:
!
!  NADDR		Address of new command file name, or 0 if none.
!
!
! IMPLICIT INPUTS:
!
!	CMD_NAM
!	CMD_OPN
!
! IMPLICIT OUTPUTS:
!
!	CMD_NAM
!	CMD_OPN
!
! ROUTINE VALUE:
!
!	0 = File not present, CMD_NAM unchanged (or error, accompanied by message)
!	1 = file present, CMD_NAM changed, or no file named.
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN

    EXTERNAL ROUTINE
	EDT$FILEIO,				! Do file I/O
	EDT$$DEA_HEAP : NOVALUE,		! Deallocate heap storage
	EDT$$ALO_HEAP,				! Allocate heap storage
	EDT$$FMT_MSG : NOVALUE,			! Put the text for a message in the format buffer
	EDT$$FIOPN_ERR : NOVALUE;		! Print a message if a file operation files


    EXTERNAL
	CMD_NAM : BLOCK [],			! Name of the command file
	CMD_OPN,				! 1 = command file is open
	INC_NAM : BLOCK [],
	IOFI_NFND;				! 1 = last open failed because of file not found

    EXTERNAL LITERAL
	EDT$K_INCLUDE_FILE,			! Channel for testing for presence of command file
	EDT$K_COMMAND_FILE,			! Command file channel
	EDT$K_OPEN_INPUT,			! Code for opening for input
	EDT$K_CLOSE;				! Code for closing a file

    LOCAL
	PTR,
	LEN,
	INCSTAT,				![44] Include status flag
	STATUS;

    MESSAGES ((INSMEM, COMFILCLO, COMFILNOP, COMFILNEX));

    MAP
	NADDR : REF BLOCK;



    INCSTAT = 0;				![44] Reset the flag

!+
! If the descriptor came from the initial command parser and a file is
! already open - then die.
!-

    IF ((.NADDR EQL CMD_NAM) AND (.CMD_OPN NEQ 0)) THEN ASSERT (24, 0);

!+
! Switch to the new command file, if it exists.
!-

    IF ((.NADDR NEQ 0) AND .CMD_OPN)
    THEN
	BEGIN
	INC_NAM [DSC$L_DESC] = .NADDR[DSC$L_DESC]; ![35] Copy the descriptor
	INC_NAM [DSC$W_JFN] = 0;

	STATUS = EDT$FILEIO (EDT$K_OPEN_INPUT, EDT$K_INCLUDE_FILE, INC_NAM);

	IF ( NOT .STATUS)
	THEN
	    BEGIN

	    IF ( NOT .IOFI_NFND) THEN EDT$$FIOPN_ERR (EDT$_COMFILNOP, INC_NAM);

	    RETURN (0)
	    END;
!+
! Copy back the expanded file pointer to NADDR space, for later use
!-
	NADDR[DSC$L_DESC] = .INC_NAM[DSC$L_DESC]; ![35]
!+
! Now that we know that the file exists we can close it on the INCLUDE channel.
!-
	STATUS = EDT$FILEIO (EDT$K_CLOSE, EDT$K_INCLUDE_FILE, 0);

	IF ( NOT .STATUS)
	THEN
	    BEGIN
	    EDT$$FIOPN_ERR (EDT$_COMFILCLO, INC_NAM);
	    RETURN (0);
	    END;

	END;

!+
! Either the file exists, or no command file is currently open, or no file name is specified.
! If the command file is currently open, close it.
!-

    IF .CMD_OPN
    THEN
	BEGIN
	STATUS = EDT$FILEIO (EDT$K_CLOSE, EDT$K_COMMAND_FILE, 0);

	IF ( NOT .STATUS)
	THEN
	    BEGIN
	    EDT$$FIOPN_ERR (EDT$_COMFILCLO, CMD_NAM);
	    RETURN (0);
	    END;

	CMD_OPN = 0;

!+[44]
! Set the include status flag to 1 so that when we start to move the file
! decsriptor block we can tell if we move it from CMD_NAM[*] to .INC_NAM[*]
! or from INC_NAM[*] to .CMD_NAM[*]
!-
	INCSTAT = 1;			![44]

!+
! Deallocate the previous string, if any.  Note that if CMD_OPN is zero
! the old space is not deallocated.  EDT$EDIT takes advantage of this.
!-

	IF (.CMD_NAM [DSC$W_LENGTH] NEQ 0) THEN
	    BEGIN
	    LEN = .CMD_NAM [DSC$W_LENGTH];
	    PTR = .CMD_NAM [DSC$A_POINTER];
	    EDT$$DEA_HEAP (LEN, PTR);
	    END;

	END;

!+
! If no new file has been specified, clean up and exit.
!-

    IF (.NADDR EQL 0)
    THEN
	BEGIN
	CMD_NAM [DSC$L_DESC] = 0;
	CMD_NAM [DSC$W_JFN] = 0;
	END
    ELSE
	BEGIN

!+
! The command file is not open and a file has been specified.  The file may
! not be present.  Open errors return an error code but print no message.
! There should be an open error only if this is the initial open.
!-

	IF (.NADDR NEQ CMD_NAM) THEN CMD_NAM [DSC$L_DESC] = .NADDR [DSC$L_DESC];

!+
! [35][44]
! If new command file name is the include file name, then copy the
! entire file descriptor block.  If it's not the include file name then
! CMD_NAM already contains the correct information.
!-
	IF (.CMD_NAM[DSC$L_DESC] EQL .INC_NAM[DSC$L_DESC]) THEN		![35]
		IF (.INCSTAT) THEN					![44]
			BEGIN						![35]
			CMD_NAM[DSC$A_DEVICE] = .INC_NAM[DSC$A_DEVICE]; ![35]
			CMD_NAM[DSC$A_DIRECT] = .INC_NAM[DSC$A_DIRECT]; ![35]
			CMD_NAM[DSC$A_FNAME] = .INC_NAM[DSC$A_FNAME];	![35]
			CMD_NAM[DSC$A_FEXTN] = .INC_NAM[DSC$A_FEXTN];	![35]
			END;						![35]

	STATUS = EDT$FILEIO (EDT$K_OPEN_INPUT, EDT$K_COMMAND_FILE, CMD_NAM);

	IF ( NOT .STATUS) THEN RETURN (0);
	CMD_OPN = 1;
	END;

    RETURN (1);
    END;					! of routine EDT$SET_COMFNAM


END
ELUDOM