OPT OSVERSION=37
OPT REG=5


->/////////////////////////////////////////////////////////////////////////////
->////////////////////////////////////////////////////// External modules /////
->/////////////////////////////////////////////////////////////////////////////
MODULE 'dos/dos' , 'dos/exall'


->/////////////////////////////////////////////////////////////////////////////
->//////////////////////////////////////////////////// Exception handling /////
->/////////////////////////////////////////////////////////////////////////////
RAISE	"ARGS"	IF	ReadArgs()			=	NIL ,
		"MEM"	IF	String()			=	NIL	,
		"DOS"	IF	Open()				=	NIL	,
		"DOS"	IF	Read()				=	-1	,
		"DOS"	IF	Fwrite()			<>	1	,
		"DOS"	IF	Lock()				=	0	,
		"DOS"	IF	AllocDosObject()	=	NIL	,
		"^C"	IF	CtrlC()				=	TRUE


->/////////////////////////////////////////////////////////////////////////////
->////////////////////////////////////////////////// Constant definitions /////
->/////////////////////////////////////////////////////////////////////////////
ENUM	FIND_STR , REPLACE_STR , FILES , HEX_FIND_STR , HEX_REPLACE_STR , CASE_INSENSITIVE ,
		NUMBER_ARGS

ENUM	WRONG_HEX_STRING = "err"


->/////////////////////////////////////////////////////////////////////////////
->/////////////////////////////////////////// Global variable definitions /////
->/////////////////////////////////////////////////////////////////////////////
DEF	find_str	:	PTR TO CHAR
DEF replace_str	:	PTR TO CHAR


->/////////////////////////////////////////////////////////////////////////////
->//////////////////////////////////////////////////////// Main procedure /////
->/////////////////////////////////////////////////////////////////////////////
PROC main() HANDLE

	DEF rdargs = NIL , args : PTR TO LONG
	DEF files : PTR TO LONG , filename : PTR TO CHAR
	DEF file = NIL , file_start , file_length , file_end
	DEF old_dir_lock = NIL , dir_lock = NIL

	PrintF( '          \c1;33;40\cMultiFR\c0;31;40\c v1.2\n' , $9B , $6D , $9B , $6D )
	PutStr( 'Copyright © 1995, Lionel Vintenat\n' )
	PrintF( '\c1;32;40\c---------------------------------\c0;31;40\c\n' , $9B , $6D , $9B , $6D )

	rdargs := ReadArgs( 'FS=FIND_STR/A,RS=REPLACE_STR/A,FILES/M/A,' +
						'HFS=HEX_FIND_STR/S,HRS=HEX_REPLACE_STR/S,CI=CASE_INSENSITIVE/S' ,
						NEW args[ NUMBER_ARGS ] , NIL )

	find_str := get_str( args[ FIND_STR ] , args[ HEX_FIND_STR ] )
	replace_str := get_str( args[ REPLACE_STR ] , args[ HEX_REPLACE_STR ] )

	files := args[ FILES ]

	WHILE files[]

		filename , dir_lock := get_filenames( files[] )
		old_dir_lock := CurrentDir( dir_lock )

		WHILE filename

			CtrlC()

			file :=  Open( filename , OLDFILE )
			file_length := FileLength( filename )
			file_end := ( file_start := NewR( file_length ) ) + file_length
			Read( file , file_start ,  file_length )
			Close( file ) ; file := NIL

			file := Open( filename , NEWFILE )
			PutStr( filename )
			parse_file( file , file_start , file_end , args[ CASE_INSENSITIVE ] )
			Close( file ) ; file := NIL

			Dispose( file_start )

			filename := Next( filename )

		ENDWHILE

		CurrentDir( old_dir_lock ) ; old_dir_lock := NIL
		UnLock( dir_lock ) ; dir_lock := NIL

		files++

	ENDWHILE

EXCEPT DO

	SELECT exception
		CASE "ARGS"
			PrintFault( IoErr() , NIL )
		CASE "MEM"
			PutStr( 'Out of memory !\n' )
		CASE "DOS"
			PrintFault( IoErr() , NIL )
		CASE "^C"
			PutStr( '***user break***\n' )
		CASE WRONG_HEX_STRING
			PutStr( 'Wrong hex string !\n' )
    ENDSELECT

	IF old_dir_lock THEN CurrentDir( old_dir_lock )
	IF dir_lock THEN UnLock( dir_lock )
	IF file THEN Close( file )
	IF rdargs THEN FreeArgs( rdargs )

ENDPROC


->/////////////////////////////////////////////////////////////////////////////
->//////////////////////////////////////////////////////// Version string /////
->/////////////////////////////////////////////////////////////////////////////
CHAR '$VER: MultiFR 1.2 (18.6.95)'


->/////////////////////////////////////////////////////////////////////////////
->///////////////////////////////// Returns the given find/replace string /////
->/////////////////////////////////////////////////////////////////////////////
PROC get_str( rawstr : PTR TO CHAR , hex )

	DEF str : PTR TO CHAR
	DEF mod , new_len , i , c

	IF hex

		mod , new_len := Mod( StrLen( rawstr ) , 2 )
		IF mod THEN Raise( WRONG_HEX_STRING )
		str := String( new_len )

		FOR i := 1 TO new_len

			SELECT 103 OF ( c := rawstr[]++ )
				CASE "0" TO "9"
					str[ i - 1 ] := Shl( c - "0" , 4 )
				CASE "A" TO "F"
					str[ i - 1 ] := Shl( c - "A" + 10 , 4 )
				CASE "a" TO "f"
					str[ i - 1 ] := Shl( c - "a" + 10 , 4 )
				DEFAULT
					Raise( WRONG_HEX_STRING )
			ENDSELECT

			SELECT 103 OF ( c := rawstr[]++ )
				CASE "0" TO "9"
					str[ i - 1 ] := str[ i - 1 ] + c - "0"
				CASE "A" TO "F"
					str[ i - 1 ] := str[ i - 1 ] + c - "A" + 10
				CASE "a" TO "f"
					str[ i - 1 ] := str[ i - 1 ] + c - "a" + 10
				DEFAULT
					Raise( WRONG_HEX_STRING )
			ENDSELECT

		ENDFOR

		SetStr( str , new_len )

	ELSE

		str := String( StrLen( rawstr ) )
		StrCopy( str , rawstr )

	ENDIF

ENDPROC str


->/////////////////////////////////////////////////////////////////////////////
->//////////////////////////////////////// Parses a file pattern argument /////
->/////////////////////////////////////////////////////////////////////////////
PROC get_filenames( path_pattern ) HANDLE

	DEF pattern , path : PTR TO CHAR , dospattern : PTR TO CHAR
	DEF filenames = NIL , dir_lock
	DEF eac = NIL : PTR TO exallcontrol , ead : PTR TO exalldata
	DEF buffer[ 2048 ] : ARRAY , more , i

	pattern := FilePart( path_pattern )
	NEW path[ pattern - path_pattern + 1 ]
	AstrCopy( path , path_pattern , pattern - path_pattern + 1 )

	dir_lock := Lock( path , ACCESS_READ )
	eac := AllocDosObject( DOS_EXALLCONTROL , NIL )
	NEW dospattern[ StrLen( pattern ) * 2 + 2 ]
	ParsePatternNoCase( pattern , dospattern , StrLen( pattern ) * 2 + 2 )
	eac.lastkey := NIL
	eac.matchstring := dospattern
	eac.matchfunc := NIL

	REPEAT

		more := ExAll( dir_lock , buffer , 2048 , ED_NAME , eac )
		ead := buffer

		FOR i := 1 TO eac.entries

			filenames := Link( String( StrLen( ead.name ) ) , filenames )
			StrCopy( filenames , ead.name )

			ead := ead.next

		ENDFOR

	UNTIL more = FALSE

	IF IoErr() <> ERROR_NO_MORE_ENTRIES THEN Raise( "DOS" )

EXCEPT DO

	IF eac THEN FreeDosObject( DOS_EXALLCONTROL , eac )
	ReThrow()

ENDPROC filenames , dir_lock


->/////////////////////////////////////////////////////////////////////////////
->//////////////////////////////////////// Applies Find/Replace to a file /////
->/////////////////////////////////////////////////////////////////////////////
PROC parse_file( file , file_start , file_end , ci )

	DEF file_ptr1 : PTR TO CHAR , file_ptr2 : PTR TO CHAR

	file_ptr1 := ( file_ptr2 := file_start )

	WHILE file_ptr2 < file_end

		IF ( 	IF ci
				THEN str_cmp_no_case( find_str , file_ptr2 , EstrLen( find_str ) )
				ELSE StrCmp( find_str , file_ptr2 , EstrLen( find_str ) )
		   )

			Fwrite( file , file_ptr1 , file_ptr2 - file_ptr1 , 1 )
			Fwrite( file , replace_str , EstrLen( replace_str ) , 1 )
			file_ptr2 := file_ptr2 + EstrLen( find_str )
			file_ptr1 := file_ptr2

			PutStr( '.' )

		ELSE

			INC file_ptr2

		ENDIF

	ENDWHILE

	PutStr( '\n' )

	Fwrite( file , file_ptr1 , file_ptr2 - file_ptr1 , 1 )

ENDPROC


->/////////////////////////////////////////////////////////////////////////////
->//////////////////////////////////// Like StrCmp() but case insensitive /////
->/////////////////////////////////////////////////////////////////////////////
PROC str_cmp_no_case( str1 : PTR TO CHAR , str2 : PTR TO CHAR , len )

	DEF i = 0

	MOVE.L	str1 , A1
	MOVE.L	str2 , A2
	MOVE.L	len  , D0
loop_while:
	CMP.L	D0 , i
	BEQ.B	end_true
	INC		i
	MOVE.B	(A1)+ , D1
	MOVE.B	(A2)+ , D2
	TST.B	D1
	BNE.B	test2
	TST.B	D2
	BEQ.B	end_true
	RETURN FALSE
test2:
	TST.B	D2
	BEQ.B	end_false
insidewhile:
		CMP.B	D1 , D2
		BEQ.B	loop_while
		CMP.B	#"a" , D1
		BCS.B	char1_ok
		CMP.B	#"z" , D1
		BHI.B	char1_ok
		SUB.B	#32 , D1
char1_ok:
		CMP.B	#"a" , D2
		BCS.B	char2_ok
		CMP.B	#"z" , D2
		BHI.B	char2_ok
		SUB.B	#32 , D2
char2_ok:
		CMP.B	D1 , D2
		BEQ.B	loop_while
end_false:
	RETURN FALSE
end_true:
	RETURN TRUE

ENDPROC