%TITLE 'EDT - EDT interface'
MODULE edt (IDENT = '002',
		MAIN = edt_main,
		LANGUAGE (BLISS32) ,
		ADDRESSING_MODE ( EXTERNAL = GENERAL
				 ,NONEXTERNAL = LONG_RELATIVE)
		) =
BEGIN
!
!			COPYRIGHT (c) 1984 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! 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.  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.
!
! THERE IS NO EXPRESSED OR IMPLIED SUPPORT FOR THIS MODULE.  IT IS PROVIDED
! ONLY "AS IS".
!
! This module was supplied as part of an SPR response with the following 
! statement from DEC.  
!
! "There is no (and will not be any) real documentation for that program."
! (ie this flavor of EDT)  "It was generated by someone who was just 
! trying to see if he could make use of XLATE and is now used by a very
! small set of people here.  It is being provided to you to make your
! use and implementation of XLATE easier.  You are free to give it away, but
! not to sell it.  We make no guarantee that it will work with later versions
! of EDT -- although, at present, we see no reason why it shouldn't.
!

!++
! FACILITY:	 EDT interface program providing XLATE support
!
! ABSTRACT:	 This program acts as a front end to the EDT editor.  The
!		 major difference between this module and the officially
!		 supplied EDT command line interface, is that this one
!		 provides an XLATE routine that actually does something.
!
!   It defines the following logical name:
!	EDT$CURRENT_FILE - current file name
!
!   It defines the following CLI symbols:
!	CURRENT_FILE - current file name
!	CURRENT_EXTN - current file extension
!
! ENVIRONMENT:	 VAX/VMS User Mode
%SBTTL 'Revision History'
!
! AUTHOR:	 J.P.K.
!
! CREATION DATE: February 1983
!
! MODIFIED BY:
!
!	002	REM00002	10-Feb-1984
!		Cleaned up code removing context specific logic that would
!		  be meaningless to anyone except the original author.
!		Added reference to the CLI$_LOC... external literals.
!
!--
%SBTTL 'Module level definitions'
!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
    edt_main,					! Main program
    edt_xlate;

!
! INCLUDE FILES:
!

LIBRARY 'SYS$LIBRARY:STARLET.L32';

!
! MACROS:
!
!
! EQUATED SYMBOLS:
!

LITERAL
    true = 1,
    false = 0;

!
! OWN STORAGE:
!

OWN
    tmp : BLOCK [dsc$k_d_bln, BYTE]			! Temporary string
	    PRESET (
		[dsc$w_length]  = 0,
		[dsc$b_dtype]   = dsc$k_dtype_t,
		[dsc$b_class]   = dsc$k_class_d,
		[dsc$a_pointer] = 0
	    ),
    in_file : BLOCK [dsc$k_d_bln, BYTE]			! Input file
	    PRESET (
		[dsc$w_length]  = 0,
		[dsc$b_dtype]   = dsc$k_dtype_t,
		[dsc$b_class]   = dsc$k_class_d,
		[dsc$a_pointer] = 0
	    ),
    out_file : BLOCK [dsc$k_d_bln, BYTE]		! Output file
	    PRESET (
		[dsc$w_length]  = 0,
		[dsc$b_dtype]   = dsc$k_dtype_t,
		[dsc$b_class]   = dsc$k_class_d,
		[dsc$a_pointer] = 0
	    ),
    com_file : BLOCK [dsc$k_d_bln, BYTE]		! Command file
	    PRESET (
		[dsc$w_length]  = 0,
		[dsc$b_dtype]   = dsc$k_dtype_t,
		[dsc$b_class]   = dsc$k_class_d,
		[dsc$a_pointer] = 0
	    ),
    jou_file : BLOCK [dsc$k_d_bln, BYTE]		! Journal file
	    PRESET (
		[dsc$w_length]  = 0,
		[dsc$b_dtype]   = dsc$k_dtype_t,
		[dsc$b_class]   = dsc$k_class_d,
		[dsc$a_pointer] = 0
	    );

OWN
    xlate_bpv : VECTOR [2] INITIAL (edt_xlate, 0),	! Procedure description for edt_xlate
    xlate_executed : INITIAL (false);			! Set to true if edt_xlate is executed

!
! EXTERNAL REFERENCES:
!

EXTERNAL LITERAL
    cli$_present,		! Qualifier explicitly given
    cli$_negated,		! Qualifier explicitly negated
    cli$_defaulted,		! Qualifier present by default
    cli$_absent,		! Qualifier not present
    cli$_locpres,		! Qualifier present and asserted on parameter
    cli$_locneg,		! Qualifier present and negated on parameter
    edt$m_nooutput,		! Set if /NOOUTPUT or /READ_ONLY
    edt$m_nocommand,		! Set if /NOCOMMAND
    edt$m_command,		! Set if /COMMAND=file specified
    edt$m_nojournal,		! Set if /NOJOURNAL
    edt$m_recover,		! Set if /RECOVER
    edt$m_nocreate;		! Set if /NOCREATE

EXTERNAL
    edtclitab;

EXTERNAL ROUTINE
    cli$dcl_parse,
    cli$get_value,
    cli$present,
    edt$edit,
    lib$set_logical,
    lib$set_symbol,
    lib$get_command,
    lib$get_foreign,
    lib$do_command,
    lib$spawn,
    lib$sys_trnlog,
    str$concat,
    str$copy_dx,
    str$copy_r,
    str$prefix;
%SBTTL 'edt_main - main program'
ROUTINE edt_main =
!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This is the main program. It retrieves the command line,
!	parses it, prompts for an input file if necessary, defines
!	logical names and then invokes EDT.
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	The command line
!
! IMPLICIT OUTPUTS:
!
!	Logical names described above are defined if a new input file is given.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	Error values returned from routines called
!
! SIDE EFFECTS:
!
!	None
!--

    BEGIN

    LOCAL
	options,
	status;

    options = 0;

    !
    ! Get command line and parse it
    !
    lib$get_foreign (tmp);
    str$prefix (tmp, %ASCID'EDT ');

    IF NOT cli$dcl_parse (tmp, edtclitab) THEN RETURN ss$_normal;

    !
    ! Check for input file specified
    !
    IF cli$present (%ASCID 'INPUT')
    THEN
	cli$get_value (%ASCID 'INPUT', in_file)	! Input file name present
    ELSE
	BEGIN
	!
	! No input file name specified
	!
	IF lib$sys_trnlog (%ASCID 'EDT$CURRENT_FILE', 0, in_file) NEQ ss$_normal
	THEN
	    BEGIN
	    !
	    ! No default file name. Prompt until we get one
	    !
	    DO
		lib$get_command (in_file, %ASCID '$_File: ')
	    UNTIL .in_file [dsc$w_length] NEQ 0;

	    END;

	END;

    !
    ! /[NO]OUTPUT=filespec
    !
    SELECTONE cli$present (%ASCID 'OUTPUT') OF
	SET

	[cli$_negated, cli$_locneg] :
	    options = .options OR edt$m_nooutput;

	[cli$_present, cli$_defaulted, cli$_locpres] :
	    !
	    ! User specified an output file name.
	    !
	    cli$get_value (%ASCID 'OUTPUT', out_file);

	[OTHERWISE] :
	    ;

	TES;

    !
    ! /[NO]REMEMBER
    !
    IF cli$present (%ASCID 'REMEMBER')
    THEN
	BEGIN
	!
	! User wishes to remember the output file.
	!
	LOCAL
	    rms_fab : $fab (),
	    rms_nam : $nam (),
	    esa_buf : VECTOR [nam$c_maxrss, BYTE],
	    len,
	    ptr;

	IF .out_file [dsc$w_length] NEQ 0
	THEN
	    BEGIN
	    !
	    ! User explicitly specified an output file
	    !
	    len = .out_file [dsc$w_length];
	    ptr = .out_file [dsc$a_pointer];
	    END
	ELSE
	    BEGIN
	    !
	    ! Use input file name
	    !
	    len = .in_file [dsc$w_length];
	    ptr = .in_file [dsc$a_pointer];
	    END;

	$fab_init ( fab = rms_fab
		   ,nam = rms_nam
		   ,fna = .ptr
		   ,fns = .len);
	$nam_init ( nam = rms_nam
		   ,esa = esa_buf
		   ,ess = nam$c_maxrss);

	IF NOT $parse (fab = rms_fab) THEN SIGNAL_STOP ( .rms_fab [fab$l_sts]
							,.rms_fab [fab$l_stv]);

	len = .rms_nam [nam$b_esl];
	ptr = .rms_nam [nam$l_esa];
	str$copy_r (tmp, len, .ptr);

	!
	! Define EDT$CURRENT_FILE 
	!
	lib$set_logical (%ASCID 'EDT$CURRENT_FILE', tmp);

	!
	! Define current_file and current_extn
	!
	len = .rms_nam [nam$b_type] - 1;
	ptr = CH$PLUS (CH$PTR (.rms_nam [nam$l_type]), 1);
	str$copy_r (tmp, len, .ptr);
	lib$set_symbol ( %ASCID 'CURRENT_EXTN'
			,tmp
			,%REF (lib$k_cli_global_sym));

	len = .rms_nam [nam$b_name];
	ptr = .rms_nam [nam$l_name];
	str$copy_r (tmp, len, .ptr);
	lib$set_symbol ( %ASCID 'CURRENT_FILE'
			,tmp
			,%REF (lib$k_cli_global_sym));
	END;

    !
    ! /[NO]COMMAND=filespec
    !
    SELECTONE cli$present (%ASCID 'COMMAND') OF
	SET

	[cli$_negated, cli$_locneg] :
	    options = .options OR edt$m_nocommand;

	[cli$_present, cli$_defaulted, cli$_locpres] :
	    BEGIN
	    cli$get_value (%ASCID 'COMMAND', com_file);
	    options = .options OR edt$m_command
	    END;

	[OTHERWISE] :
	    ;

	TES;

    !
    ! /[NO]JOURNAL=filespec
    !
    SELECTONE cli$present (%ASCID 'JOURNAL') OF
	SET

	[cli$_negated, cli$_locneg] :
	    options = .options OR edt$m_nojournal;

	[cli$_present, cli$_defaulted, cli$_locpres] :
	    cli$get_value (%ASCID 'JOURNAL', jou_file);

	[OTHERWISE] :
	    ;

	TES;

    !
    ! /[NO]READ_ONLY
    !
    IF cli$present (%ASCID 'READ_ONLY') THEN options = .options OR edt$m_nooutput;

    !
    ! /[NO]RECOVER
    !
    IF cli$present (%ASCID 'RECOVER') THEN options = .options OR edt$m_recover;

    !
    ! /[NO]CREATE
    !

    tmp = cli$present (%ASCID 'CREATE');
    IF (.tmp  EQL cli$_negated)  OR  (.tmp  EQL cli$_locneg)

    THEN
	options = .options OR edt$m_nocreate;

    !
    ! Execute EDT
    !
    status = edt$edit (  in_file
			,out_file
			,com_file
			,jou_file
			,options
			,0
			,0
			,xlate_bpv);

    !
    ! Clean up temp files if EDT executed successfully and edt_xlate was executed.
    !
    IF .status AND .xlate_executed THEN lib$do_command (%ASCID'$ DELETE/NOLOG SYS$SCRATCH:0edt*.tmp;*');

    RETURN .status;
    END;
%SBTTL 'edt_xlate - process XLATE command'
ROUTINE edt_xlate (instring : REF BLOCK [, BYTE]) =
!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine is called by EDT to process the XLATE command.
!
!	If INSTRING is null, the user wants to start a subprocess session.
!	LIB$SPAWN is called with SYS$INPUT and SYS$OUTPUT as the command streams.
!
!	If INSTRING is not null, the user is processing one command and has
!	created SYS$SCRATCH:0EDTIN.TMP as the input stream and wants
!	SYS$SCRATCH:0EDTOUT.TMP to be used to capture the output of the command.
!
! FORMAL PARAMETERS:
!
!	INSTRING	- Address of input string descriptor
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	XLATE_EXECUTED	- Set to true if user executes single command to be
!			  included in the current buffer.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	Returns the value of LIB$SPAWN 
!
! SIDE EFFECTS:
!
!	Creates a subprocess via LIB$SPAWN. Returns when the subprocess has
!	terminated execution.
!
!--
    BEGIN

    LOCAL
	status;

    IF .instring [dsc$w_length] EQL 0
    THEN
	BEGIN
	!
	! User wants to spawn an interactive session
	!
	LOCAL
	    sys_in_buf : VECTOR [nam$c_maxrss, BYTE],
	    sys_in_dsc : BLOCK [dsc$k_s_bln, BYTE],
	    dsc_ptr    : REF BLOCK [, BYTE];

	dsc_ptr = %ASCID 'SYS$INPUT';

	!
	! Translate SYS$INPUT
	!
	sys_in_dsc [dsc$w_length]  = nam$c_maxrss;
	sys_in_dsc [dsc$b_dtype]   = dsc$k_dtype_t;
	sys_in_dsc [dsc$b_class]   = dsc$k_class_s;
	sys_in_dsc [dsc$a_pointer] = sys_in_buf;

	IF NOT (status = $trnlog ( lognam = .dsc_ptr
				  ,rslbuf = sys_in_dsc
				  ,rsllen = sys_in_dsc [dsc$w_length]))
	THEN
	    RETURN .status;

	!
	! Use the translation only if it is not a process permanent file.
	!
	IF CH$RCHAR (CH$PTR (sys_in_buf)) NEQ %X'1B' THEN dsc_ptr = sys_in_dsc;

	!
	! Spawn the subprocess
	!
	status = lib$spawn (0, .dsc_ptr, .dsc_ptr);
	END
    ELSE
	BEGIN
	!
	! User wants to execute a single command.
	! SYS$INPUT  => SYS$SCRATCH:0EDTIN.TMP
	! SYS$OUTPUT => SYS$SCRATCH:0EDTOUT.TMP
	!
	xlate_executed = true;

	status = lib$spawn ( .instring
			    ,%ASCID 'SYS$SCRATCH:0EDTIN.TMP'
			    ,%ASCID 'SYS$SCRATCH:0EDTOUT.TMP');

	END;

    str$copy_dx (.instring, %ASCID'');		! Return a null string

    RETURN .status;
    END;

END						! End of module
ELUDOM