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