Viewing contents of file '../idllib/astron/contrib/landsman/allpro/idl5to4.pro'
	PRO IDL5TO4, K_FILENAME, OUTDIR, ECHO=ECHO, PATH=K_PATH,	$
		MOD_ONLY=MOD_ONLY, ERRMSG=ERRMSG
;+
; Project     :	SOHO - CDS
;
; Name        :	IDL5TO4
;
; Purpose     :	Convert IDL/v5 array[] syntax to IDL/v4 array() syntax.
;
; Category    :	Utility
;
; Explanation :	In IDL version 5, square brackets were introduced as an
;		alternate way of referencing an array, to avoid confusion
;		between arrays and functions.  In prior versions of IDL, the
;		syntax FRED(3) could be interpreted as either the third element
;		of the array FRED, or as a call to the function FRED.  This
;		syntax is still supported in IDL/v5, but the new syntax FRED[3]
;		can be used to show that it is the third element of the array
;		FRED which is desired, and not a function call.
;
;		One of the problems that the new syntax resolves is that of
;		routines where FRED(3) was intended to be used as an array
;		subscripting, and was developed in an environment where there
;		was no FRED function which could cause confusion.  If this
;		routine was then moved to an environment where there was a FRED
;		function, then the routine would no longer work correctly.
;		Using FRED[3] solves this problem.
;
;		Unfortunately, the syntax FRED[3] is not supported in earlier
;		versions of IDL.  However, it may be that many routines would
;		actually work in the earlier IDLs if the FRED[3] syntax was
;		changed to FRED(3).  The routine IDL5TO4 makes this conversion.
;		The modified routine should then work in earlier versions of
;		IDL, assuming that there are no other version-specific aspects
;		to the code.
;
; Syntax      :	IDL5TO4, FILENAME  [, OUTDIR ]
;
; Examples    :	IDL5TO4, '*.pro'		;Converts all procedure files
;						;in current directory
;
;		IDL5TO4, '*.pro', 'idlv4'	;Converted files written to
;						;idlv4 subdirectory.
;
; Inputs      :	FILENAME = The name of the file(s) to process.  May be an array
;			   of filenames, and may also contain wildcard
;			   characters.
;
; Opt. Inputs :	OUTDIR = The name of a directory to write the converted files
;			 to.  The directory must aleady exist--the routine will
;			 not try to create it.  If not passed, then the files
;			 will be replaced with the converted version at their
;			 present location.
;
; Outputs     :	None.
;
; Opt. Outputs:	None.
;
; Keywords    :	ECHO   = If set, the a message line is printed for every file
;			 processed.
;
;		MOD_ONLY = If set, then only those files which require
;			 changes will be processed.  Use this when not passing
;			 the OUTDIR parameter, and you don't want the timestamp
;			 of unaffected files changed.
;
;		PATH   = If set, then contains a list of directories to process
;			 in turn.  A plus sign before any directory will
;			 translate into the entire directory tree.  For
;			 example, the following command will process all .pro
;			 files in the /cs/idl directory tree.
;
;				IDL5TO4, '*.pro', PATH='+/cs/idl', /MOD_ONLY
;
;		ERRMSG = If defined and passed, then any error messages will be
;			 returned to the user in this parameter rather than
;			 depending on the MESSAGE routine in IDL.  If no errors
;			 are encountered, then a null string is returned.  In
;			 order to use this feature, ERRMSG must be defined
;			 first, e.g.
;
;				ERRMSG = ''
;				IDL5TO4, ERRMSG=ERRMSG, ...
;				IF ERRMSG NE '' THEN ...
;
; Calls       :	DATATYPE, FIND_ALL_DIR, FIND_FILES, FIND_FILE, FILE_EXIST,
;		BREAK_FILE, CONCAT_DIR
;
; Common      :	None.
;
; Restrictions:	Although most situations should be accounted for, there may
;		still be situations which are not adequately addressed by this
;		routine.  One possible failure scenario is when a structure
;		contains a tag name which exactly matches an IDL operator,
;		e.g. "AND", "OR", "MOD", "EQ", etc.
;
;		This routine may not work correctly in Windows or MacOS, if it
;		needs to overwrite a file which already exists.  However, it
;		should work okay if the output files are directed to an empty
;		subdirectory.
;
; Side effects:	None.
;
; Prev. Hist. :	Partially based on IDLV5_TO_V4 by Wayne Landsman
;
; History     :	Version 1, 22-Jul-1998, William Thompson, GSFC
;		Version 2, 04-Aug-1998, WIlliam Thompson, GSFC
;			Fixed bug involving keywords.
;			Added keywords PATH, MOD_ONLY
;
; Contact     :	WTHOMPSON
;-
;
;
	ON_ERROR, 2
;
;  Check the number of parameters.  Make sure that FILENAME and OUTDIR are
;  strings, and that OUTDIR is a scalar.
;
	IF N_PARAMS() LT 1 THEN BEGIN
	    MESSAGE = 'Syntax:  IDL5TO4, FILENAME  [, OUTDIR ]'
	    GOTO, HANDLE_ERROR
	ENDIF
;
	IF N_ELEMENTS(K_FILENAME) GE 1 THEN FILENAME = K_FILENAME
	IF DATATYPE(FILENAME,1) NE 'String' THEN BEGIN
	    MESSAGE = 'FILENAME must be a string'
	    GOTO, HANDLE_ERROR
	ENDIF
;
	IF N_ELEMENTS(OUTDIR) GE 1 THEN BEGIN
	    IF DATATYPE(OUTDIR,1) NE 'String' THEN BEGIN
		MESSAGE = 'OUTDIR must be a string'
		GOTO, HANDLE_ERROR
	    ENDIF
;
	    IF N_ELEMENTS(OUTDIR) GT 1 THEN BEGIN
		MESSAGE = 'OUTDIR must be a scalar'
		GOTO, HANDLE_ERROR
	    ENDIF
	ENDIF
;
;  If PATH is an array, then call this routine for each element.
;
	IF N_ELEMENTS(K_PATH) GE 1 THEN BEGIN
	    PATH = K_PATH
	    IF DATATYPE(PATH,1) NE 'String' THEN BEGIN
		MESSAGE = 'PATH must be a string'
		GOTO, HANDLE_ERROR
	    ENDIF
	ENDIF
;
	IF N_ELEMENTS(PATH) GT 1 THEN BEGIN
	    FOR I=0,N_ELEMENTS(PATH)-1 DO BEGIN
		MESSAGE = ''
		IDL5TO4, FILENAME, OUTDIR, ECHO=ECHO, PATH=PATH(I),	$
			MOD_ONLY=MOD_ONLY, ERRMSG=MESSAGE
		IF MESSAGE NE '' THEN GOTO, HANDLE_ERROR
	    ENDFOR
	    RETURN
	ENDIF
;
;  If FILENAME is an array, then call this routine for each element.
;
	IF N_ELEMENTS(FILENAME) GT 1 THEN BEGIN
	    FOR I=0,N_ELEMENTS(FILENAME)-1 DO BEGIN
		MESSAGE = ''
		IDL5TO4, FILENAME(I), OUTDIR, ECHO=ECHO, PATH=PATH,	$
			MOD_ONLY=MOD_ONLY, ERRMSG=MESSAGE
		IF MESSAGE NE '' THEN GOTO, HANDLE_ERROR
	    ENDFOR
	    RETURN
	ENDIF
;
;  If FILENAME contains a wildcard character, then expand the wildcards, and
;  call this routine for each filename derived.
;
	IF N_ELEMENTS(PATH) EQ 1 THEN BEGIN
	    PATH = FIND_ALL_DIR(PATH, /PLUS_REQUIRED, /PATH)
	    FILES = FIND_FILES(FILENAME, PATH)
	END ELSE FILES = FIND_FILE(FILENAME)
;
	IF N_ELEMENTS(FILES) GT 1 THEN BEGIN
	    FOR I=0,N_ELEMENTS(FILES)-1 DO BEGIN
		MESSAGE = ''
		IDL5TO4, FILES(I), OUTDIR, ECHO=ECHO, PATH=PATH,	$
			MOD_ONLY=MOD_ONLY, ERRMSG=MESSAGE
		IF MESSAGE NE '' THEN GOTO, HANDLE_ERROR
	    ENDFOR
	    RETURN
	ENDIF
;
;  Determine the byte equivalences of various characters to be used in the
;  program.
;
	TAB    = 9B
	BLANK  = (BYTE(' '))(0)
	SQUOTE = (BYTE("'"))(0)
	DQUOTE = (BYTE('"'))(0)
	ZERO   = (BYTE('0'))(0)
	NINE   = (BYTE('9'))(0)
	DOLLAR = (BYTE('$'))(0)
	SLEFT  = (BYTE('['))(0)
	RLEFT  = (BYTE('('))(0)
	SRIGHT = (BYTE(']'))(0)
	RRIGHT = (BYTE(')'))(0)
	CHARA  = (BYTE('A'))(0)
	CHARZ  = (BYTE('Z'))(0)
	PLUS   = (BYTE('+'))(0)
	ATSIGN = (BYTE('@'))(0)
	PERIOD = (BYTE('.'))(0)
	SEMICOLON  = (BYTE(';'))(0)
	UNDERSCORE = (BYTE('_'))(0)
;
;  Determine the commands for moving, depending on the operating system.
;
	CASE OS_FAMILY() OF
	    'vms': BEGIN
		RENAME = 'RENAME'
		DELETE = 'DELETE'
		CURDIR = '[]'
		END
	    ELSE: BEGIN
		RENAME = 'mv'
		DELETE = 'rm'
		CURDIR = '.'
		END
	ENDCASE
;
;  Check the input filename.  If OUTDIR was passed, then 
;
	IF NOT FILE_EXIST(FILENAME) THEN BEGIN
	    MESSAGE = 'Input file "' + FILENAME + '" does not exist'
	    GOTO, HANDLE_ERROR
	ENDIF
;
;  Determine the name of the input file, and the ultimate output file.  If the
;  output file already exists, then write to a temporary file.
;
	TEMPFILE = 'TEMPFILE.TEMPFILE'
	IF N_ELEMENTS(OUTDIR) EQ 0 THEN OUTFILE = FILENAME ELSE BEGIN
	    TEMPFILE = CONCAT_DIR(OUTDIR, TEMPFILE)
	    BREAK_FILE, FILENAME, DISK, DIR, NAME, EXT
	    OUTFILE = CONCAT_DIR(OUTDIR, NAME+EXT)
	    IF NOT FILE_EXIST(OUTFILE) THEN TEMPFILE = OUTFILE
	ENDELSE
;
;  Open up the input file and the temporary output file.
;
	MESSAGE = 'Unable to open input file "' + FILENAME + '"'
	CHANGED = 0
	ON_IOERROR, HANDLE_ERROR
	OPENR, IN, FILENAME, /GET_LUN
	IF KEYWORD_SET(ECHO) THEN PRINT, 'Processing file ' + FILENAME
;
	MESSAGE = 'Unable to open output file "' + TEMPFILE + '"'
	ON_IOERROR, HANDLE_ERROR
	OPENW, OUT, TEMPFILE, /GET_LUN
;
	MESSAGE = 'Read/write error encountered'
	ON_IOERROR, HANDLE_ERROR
;
;  Step through all the lines in the file.
;
	WHILE NOT EOF(IN) DO BEGIN
	    N_LINES = 0
	    LASTCHAR = DOLLAR
	    TEMP = ''
	    WHILE (NOT EOF(IN)) AND ((LASTCHAR EQ DOLLAR) OR	$
		    (STRLEN(TEMP) EQ 0)) DO BEGIN
		READF, IN, TEMP
;
;  Convert the line to uppercase, and then to a byte array.
;
		BTEMP = BYTE(STRUPCASE(TEMP))
;
;  Convert all tabs to blanks.
;
		W = WHERE(BTEMP EQ TAB, COUNT)
		IF COUNT GT 0 THEN BTEMP(W) = BLANK
;
;  Ignore all strings delimited by either single or double quotes.  Start with
;  whichever character is first in the string.
;
		WS = [WHERE(BTEMP EQ SQUOTE, SCOUNT), STRLEN(TEMP)-1]
		WD = [WHERE(BTEMP EQ DQUOTE, DCOUNT), STRLEN(TEMP)-1]
		IF (WS(0) LT WD(0)) OR (DCOUNT EQ 0) THEN QUOTE = SQUOTE ELSE $
			QUOTE = DQUOTE
		FOR IQUOTE = 0,1 DO BEGIN
;
;  Ignore all strings delimited by single quotes.
;
		    IF QUOTE EQ SQUOTE THEN BEGIN
			FOR I = 0, SCOUNT-1, 2 DO BEGIN
			    I1 = WS(I) + 1
			    I2 = WS(I+1) - 1
			    IF I1 LE I2 THEN BTEMP(I1:I2) = BLANK
			ENDFOR
			QUOTE = DQUOTE
;
;  Ignore all strings delimited by double quotes.  However, first check to see
;  if the character immediately following the first quote is a numeral.  If it
;  is, then it's an octal constant instead.
;
		    END ELSE BEGIN
			FOR I = 0, DCOUNT-1, 2 DO BEGIN
			    IF (WD(I)+1) LT STRLEN(TEMP) THEN	$
				    TEST = BTEMP(WD(I)+1) ELSE TEST = 0B
			    IF (TEST GE ZERO) AND (TEST LE NINE) THEN I=I-1 $
				    ELSE BEGIN
				I1 = WD(I) + 1
				I2 = WD(I+1) - 1
				IF I1 LE I2 THEN BTEMP(I1:I2) = BLANK
			    ENDELSE
			ENDFOR
			QUOTE = SQUOTE
		    ENDELSE
		ENDFOR
;
;  Ignore any characters after (and including) the comment character.
;
		W = WHERE(BTEMP EQ SEMICOLON, COUNT)
		IF (W(0) LT N_ELEMENTS(BTEMP)) AND (COUNT GT 0) THEN	$
			BTEMP(W(0):*) = BLANK
;
;  Find out if the last character is a continuation character.  If it is, then
;  remove it from the byte array.
;
		W = WHERE(BTEMP NE BLANK, COUNT)
		IF COUNT GT 0 THEN LASTCHAR = BTEMP(W(COUNT-1)) ELSE	$
			LASTCHAR = BLANK
		IF LASTCHAR EQ DOLLAR THEN BTEMP(W(COUNT-1)) = BLANK
;
;  Store the line in the concatenated LINE and BLINE arrays.
;
		IF N_LINES EQ 0 THEN BEGIN
		    LINE = TEMP
		    BLINE = BTEMP
		    N_CHAR = STRLEN(TEMP)
		END ELSE BEGIN
		    LINE = LINE + TEMP
		    BLINE = [BLINE, BTEMP]
		    N_CHAR = [N_CHAR, STRLEN(TEMP)]
		ENDELSE
		N_LINES = N_LINES + 1
	    ENDWHILE
;
;  Make sure that any null characters, introduced by zero-length lines, are
;  removed from the byte array.
;
	    W = WHERE(BLINE NE 0B, COUNT)
	    IF COUNT GT 0 THEN BLINE = BLINE(W)
;
;  If the first character in the line is an @ sign, or a period, then the line
;  is an IDL directive, and shouldn't be changed.
;
	    IF (BLINE(0) EQ ATSIGN) THEN GOTO, WRITE_LINE
	    W = WHERE(BLINE NE BLANK, COUNT)
	    IF COUNT GT 0 THEN IF BLINE(W(0)) EQ PERIOD THEN GOTO, WRITE_LINE
;
;  Remove all words that are actually IDL operators.
;
	    OPS = ['EQ','NE','LE','LT','GE','GT','AND','OR','XOR','MOD']
	    OPS = ' ' + OPS + ' '
	    BTEMP = BLINE
	    W = WHERE(((BLINE LT CHARA) OR (BLINE GT CHARZ)) AND	$
		    ((BLINE LT ZERO) OR (BLINE GT NINE)) AND	$
		    (BLINE NE UNDERSCORE), COUNT)
	    IF COUNT GT 0 THEN BTEMP(W) = BLANK
	    TEMP = ' ' + STRING(BTEMP) + ' '
	    FOR I = 0,N_ELEMENTS(OPS)-1 DO BEGIN
	        W = -1
		REPEAT BEGIN
		    W = STRPOS(TEMP,OPS(I),W+1)
		    IF W GE 0 THEN FOR J=0,STRLEN(OPS(I))-3 DO	$
			    BLINE(W+J) = PLUS
		ENDREP UNTIL W LT 0
	    ENDFOR
;
;  Find all [] pairs.  Work from the innermost outward.
;
	    REPEAT BEGIN
		WRIGHT = WHERE(BLINE EQ SRIGHT, RCOUNT)
		IF RCOUNT GT 0 THEN BEGIN
		    WRIGHT = WRIGHT(0)
		    BLINE(WRIGHT) = RRIGHT
		    WLEFT = WHERE(BLINE(0:WRIGHT(0)) EQ SLEFT, LCOUNT)
		    IF LCOUNT GT 0 THEN BEGIN
			WLEFT = WLEFT(LCOUNT-1)
			BLINE(WLEFT) = RLEFT
;
;  Find the first nonblank character to the left of the left bracket.  If it's
;  alphanumeric, an underscore, or the round right bracket, then change the
;  brackets from square to round.
;
			I = WLEFT - 1
			WHILE (I GT 0) AND (BLINE(I) EQ BLANK) DO I = I - 1
			IF ((BLINE(I) GE CHARA) AND (BLINE(I) LE CHARZ)) OR $
				((BLINE(I) GE ZERO) AND (BLINE(I) LE NINE)) $
				OR (BLINE(I) EQ RRIGHT) OR	$
				(BLINE(I) EQ UNDERSCORE) THEN BEGIN
			    CHANGED = 1
			    STRPUT, LINE, '(', WLEFT
			    STRPUT, LINE, ')', WRIGHT
			ENDIF
		    ENDIF
		ENDIF
	    ENDREP UNTIL RCOUNT EQ 0
;
;  Write the modified line to the output file.
;
WRITE_LINE:
	    FOR I = 0,N_LINES-1 DO BEGIN
		PRINTF, OUT, STRMID(LINE,0,N_CHAR(I))
		IF N_CHAR(I) LT STRLEN(LINE) THEN LINE =	$
			STRMID(LINE,N_CHAR(I),STRLEN(LINE)-N_CHAR(I))
	    ENDFOR
	ENDWHILE
;
;  Close the input and output files.  If necessary, then rename the temporary
;  file to the final filename.
;
	FLUSH, IN, OUT
	FREE_LUN, IN, OUT
	IF TEMPFILE NE OUTFILE THEN BEGIN
	    IF CHANGED OR (NOT KEYWORD_SET(MOD_ONLY)) THEN BEGIN
		SPAWN, RENAME + ' ' + TEMPFILE + ' ' + OUTFILE
	    END ELSE BEGIN
		SPAWN, DELETE + ' ' + TEMPFILE
	    ENDELSE
	ENDIF
;
;  If the ERRMSG keyword was passed, then set it to the null string to signal
;  success.
;
	IF N_ELEMENTS(ERRMSG) NE 0 THEN ERRMSG = ''
	RETURN
;
;  Error handling point.
;
HANDLE_ERROR:
	IF N_ELEMENTS(ERRMSG) NE 0 THEN ERRMSG = 'IDL5TO4: ' + MESSAGE $
		ELSE MESSAGE, MESSAGE
	END