C+++
C	ARRAY_EDIT	data, length, row, col
C
C	ARRAY_EDIT is a subroutine which invokes the EDT
C	editor on an in-core character array.  All functions
C	of EDT are available to the user (including "include"
C	files, "write" commands, and the EDTINI file). Current
C	implementation of ARRAY_EDIT does NOT support the XLATE
C	function of AAIS EDT, mostly because one is never sure
C	of the environment in which one is executing.  Version 1.1
C	of ARRAY_EDIT should have XLATE support in it.
C
C	Calling ARRAY_EDIT:
C
C	CHARACTER*80	data(45)
C	INTEGER*4	length
C	INTEGER*4	row
C	INTEGER*4	column
C
C	data :: A character array, of any width (up to 255 characters,
C		a limit imposed by EDT) and up to 100 lines long. The
C		constant 100 is max_col, defined in
C		ARRAY_EDIT_COMMON.INCLUDE.  Increasing max_col should
C		have no effect on the program other than increasing
C		the size of the virtual file.  Space cost is 8 bytes
C		per max_col entry, plus row bytes (dynamically allocated
C		at run time). Data is the input to ARRAY_EDIT and the
C		output from ARRAY_EDIT.  There is no real reason why
C		there cannot be two character arrays, one input and
C		one output. 
C
C	length :: An INTEGER*4 variable (READ/WRITE) which indicates
C		the current number of filled-in lines in the character
C		array (for example, if the ADD template were in the
C		array, LENGTH would be the length of the ADD template.
C		If length is zero, then the array is empty and EDT displays
C		a clear screen.
C
C	row :: the line length in characters, up to a maximum of 255. This
C		should be (but is not necessarily) the width of the
C		character array. If row is GT than the width of the
C		character array, unpredictable results are possible.
C		Unfortunately, it is impossible to test the width of the
C		character array at run-time.  If row is LT the width
C		of the character array, ARRAY_EDIT will not pass back
C		more than row characters per line. 
C
C	col :: the number of lines in the character array, up to 100.
C		(see above note on max_col).  This parameter is
C		checked, and if incorrect, ARRAY_EDIT returns a status
C		of SS$_BADPARAM.
C
C	Example call to ARRAY_EDIT:
C
C	status  =  array_edit(data,length,row,col)
C	if (status .ne. SS$_NORMAL) then
C		write (6,*) 'Error in ARRAY_EDIT!'
C	endif
C
C	RETURN STATUS FROM ARRAY_EDIT:
C
C	SS$_NORMAL:	OK
C	SS$_BADPARAM: 	Bad parameter
C	SS$_INSFMEM	Insufficient virtual memory for your row*col array.
C
C	PACKAGE INFORMATION:C
C
C	FILE: ARRAY_EDIT.FOR		Main source code
C	      ARRAY_EDIT_COMMON.INCLUDE	Include file for COMMON definitions
C	      EDTDEF.INCLUDE		Include file for EDT$EDIT constants
C					derived from sys$library:edtshr.exe
C---	

	integer function array_edit(passed_data,passed_length,row,col)
C+++
C MODULE NAME:	array_edit	FILE NAME: array_edit.for
C MODULE OVERVIEW:
C	This subroutine invokes the EDT editor on an array of
C	character data. 
C	Given an array of data (up to max_col lines long), this
C	routine will send it to EDT and, upon termination of
C	EDT, return the data in a standard FORTRAN character
C	array.  Users may use all features of EDT except journal
C	files.
C
C FORMAL PARAMETERS:
C	passed_data : the address of a fixed string descriptor for
C			a FORTRAN character data array. READ/WRITE
C	passed_length : the current number of lines filled in the
C			array. READ/WRITE
C	row : the width of the array, in bytes (ie, the line length) READ
C	col : the length of the array, up to max_col (defined as 100
C		in array_edit_common.include) lines long READ
C
C CALLS:
C	EDT$EDIT : to edit the data.
C
C IMPLICIT INPUTS:
C	none
C
C IMPLICIT OUTPUTS:
C	none
C
C SIDE EFFECTS:
C	any side effects possible with EDT (including "write")
C
C COMPLETION CODES:
C	SS$_NORMAL -- for normal return
C	SS$_BADPARAM -- for illegal parameters
C	SS$_INSFMEM -- unable to allocate sufficient virtual memory
C
C AUTHOR: jms 		CREATION DATE: May 21, 1985
C MAINTENANCE RECORD: (edit increment number, description, date, initials)
C	V1.00-00	jms	Original version
C
C---

	implicit none

C	arguments

	character*(*) passed_data(*)		! the passed data block
	integer passed_length			! how many lines are filled
	integer row				! number of rows in input
	integer col				! number of columns in input

C	include files

	include 'array_edit_common.include/list'
	include '($SSDEF)'

C	local variables

	integer		com_data(2,max_col)	! pointers to string data
	integer		null_string(2)		! a null string, for length
	integer		cur_len			! length of a string
	integer		index			! do loop index variable
	character*1 	null_character		! the null character

	integer 	fileio_bpv(2)		! BPV data type for EDT$EDIT
	integer		fileio			! subroutine to handle I/O
	external 	fileio

C	RTL functions

	integer		str$left		! extract substring of a string
	integer		str$copy_dx		! copy by descriptor src->dst
	integer		lib$sget1_dd		! get 1 dynamic string
	integer		str$find_first_in_set	! find 1st char in set of chars
	integer		edt$edit		! callable EDT editor 

	array_edit = SS$_NORMAL			! set default return status
	length=passed_length			! fill in common block
	fileio_bpv(1) = %loc(fileio)		! and create the descriptor
	fileio_bpv(2) = 1			! for the BPV.

C	parameter bounds checking. 
	if (col.gt.max_col .or. col.lt.0 .or. row.lt.0 .or. 
	1	passed_length.lt.0) then
		array_edit = SS$_BADPARAM
		return
	endif

C+++
C Witness a major kludge -- getting FORTRAN fixed string descriptors
C to convert to VMS dynamic string descriptors.  First, create a
C "null_string" descriptor, which contains the string ^@.  This is
C done because FORTRAN does not pad strings with blanks, but with
C NULs.  In order to determine the end of a string, one must compare
C it with a string containing "NUL."  Then, for each row in the
C array, get a dynamic string of length row.  Copy the FORTRAN entry
C at row I into the dynamic string descriptor, and then shorten
C the dynamic string to the correct length.
C---
	if (lib$sget1_dd(1,null_string(1)) .ne. SS$_NORMAL) then
		array_edit = SS$_INSFMEM
		return
	endif
	call str$copy_dx( null_string(1) , null_character(1:1) )
	do index=1,col
		if (lib$sget1_dd(row,data(1,index)) .ne. SS$_NORMAL) then
			array_edit = SS$_INSFMEM
			return
		endif
		call str$copy_dx( data(1,index) , passed_data(index)(1:col) )
		cur_len = str$find_first_in_set (data(1,index), null_string(1))
		call str$left( data(1,index), data(1,index), cur_len-1)
	end do

C+++
C Now, call the editor.
C---
	call edt$edit ( 'an input file',! input file
	1		'you edited',	! output file
	2		,		! command file
	3		,		! journal file
	4		"44,		! bits 1B5,1B2
	5		fileio_bpv,	! fileio routine
	6		,		! workio routine
	7		,)		! xlate routine


C+++
C copy the data back into the FORTRAN array, and
C update the length. Since str$copy_dx signals all
C errors (except STR$_TRU, which we don't care about
C anyway), no need to check status. Return from whence we came.
C---
	do index=1,col
		call str$copy_dx( passed_data(index) , data(1,index) )
	end do
	passed_length=length
	return

	end

	integer function fileio(code, stream, record, rhb)

C+++
C MODULE NAME:	fileio		FILE NAME:	array_edit.for
C MODULE OVERVIEW:
C	This subroutine is passed to the EDT$EDIT subroutine
C	to simulate disk i/o. In this way, arrays of data
C	can be edited with the EDT editor.
C
C FORMAL PARAMETERS:
C	code : the action desired (defined by EDTSHR.EXE)
C	stream : the file for which "code" action is desired
C	record : the record to read/write OR the filename to open
C	rhb : the record header block (not VMS) OR the related filename to open
C
C IMPLICIT INPUTS:
C	from common block /ARRAY_EDIT_COMMON/
C		length : the length of the data (read/write)
C		data : the original data (not updated until EDT exits)
C
C IMPLICIT OUTPUTS:
C	none
C
C SIDE EFFECTS:
C	none
C
C COMPLETION CODES:
C	SS$_NORMAL : all normal errors
C	RMS$_EOF : for end of file on read
C	all other errors are signaled.
C
C AUTHOR: jms		CREATION DATE:	May 21, 1985
C MAINTENANCE RECORD:
C	V1.00-0		Original Version	JMS
C
C---

	implicit none

C passed arguments

	integer*4 code				! code passed in from EDT
	integer*4 stream			! stream to act upon
	integer*4 record(2)			! DSD for record
	integer*4 rhb(2)			! DSD for record header block

C common block definitions

	include 'array_edit_common.include/nolist'

C included libraries and constant files

	include '($ssdef)'
	include '($rmsdef)'
	include 'edtdef.include/nolist'

C RTL routines
	
	integer		edt$fileio

C local variables

	integer		in_ptr			!input file pointer
	integer		out_ptr			!output file pointer

C set status initially to be normal

	fileio = SS$_NORMAL

C+++
C Determine what to do based on what file is being requested.
C For most files (all except input and output), we pass the I/O
C request on to the system EDT$FILEIO routine.  For input and
C output files, handle the I/O to/from an array. This is particularily
C easy since the input file is opened and read once, and the output
C file is opened and written once.
C---

	if (stream .eq. edt$k_input_file) then
C+++
C Handle case of input file. Check request. Normal requests
C are to open_input and get.  edt$k_close is also a legal
C request, which is ignored.  All othe requests are illegal,
C but we ignore them without returning error conditions.
C---
		if (code .eq. edt$k_get) then
C+++
C Read data until length lines have been reached.
C When done, return RMS$_EOF and do not copy.
C---
			if (in_ptr .gt. length) then
				fileio = RMS$_EOF
			else
				call str$copy_dx ( record, data(1,in_ptr) )
				in_ptr=in_ptr+1
			endif

		else if (code .eq. edt$k_open_input) then
C+++
C Reset input pointer to 1 when opening input file
C---
			in_ptr=1

		else if (code .eq. edt$k_open_output_seq) then

			continue				! error

		else if (code .eq. edt$k_open_output_noseq) then

			continue				! error

		else if (code .eq. edt$k_open_in_out) then

			continue				! error

		else if (code .eq. edt$k_put) then

			continue				! error

		else if (code .eq. edt$k_close_del) then

			continue				! no action

		else if (code .eq. edt$k_close) then

			continue				! no action

		endif

	else if (stream .eq. edt$k_output_file) then
C+++
C Handle case of output file. Legal actions are open_output_noseq,
C put, and close.  Close is used to reset the length to the
C length of the file. Open resets pointers, and put is used to
C write the data out. All other possible codes are checked for,
C but none are handled.
C---
		if (code .eq. edt$k_put) then

			if (out_ptr .le. max_col) then
				call str$copy_dx ( data(1,out_ptr), record )
				out_ptr = out_ptr+1
			endif

		else if (code .eq. edt$k_open_output_noseq) then

			length=0
			out_ptr=1

		else if (code .eq. edt$k_close) then

			length=out_ptr-1

		else if (code .eq. edt$k_get) then

			continue			! error

		else if (code .eq. edt$k_open_input) then

			continue			! error

		else if (code .eq. edt$k_open_output_seq) then

			continue			! error

		else if (code .eq. edt$k_open_in_out) then

			continue			! error

		else if (code .eq. edt$k_put) then

			continue			! error

		else if (code .eq. edt$k_close_del) then

			continue			! no action

		endif

	else if (stream .eq. edt$k_write_file) then

		fileio = edt$fileio(code,stream,record,rhb)

	else if (stream .eq. edt$k_command_file) then

		fileio = edt$fileio(code,stream,record,rhb)

	else if (stream .eq. edt$k_include_file) then

		fileio = edt$fileio(code,stream,record,rhb)

	else if (stream .eq. edt$k_journal_file) then

		fileio = edt$fileio(code,stream,record,rhb)

	endif

	return

	end