-- File: RedirectDFDriver.mesa
-- Shoup, July 25, 1986 11:46:00 am PDT

DIRECTORY
	Commander USING [CommandProc, Handle, Register],
	CommandTool USING [ArgN, NumArgs],
	Rope USING [ROPE, Equal, Substr, Fetch, Length, Cat, FromChar],
	IO USING [STREAM, GetLineRope, EndOf, PutF, rope, Close],
	FS USING [AccessOptions, Error, StreamOpen, Delete, Rename]
	;
	

RedirectDFDriver: CEDAR PROGRAM
	IMPORTS Commander, CommandTool, Rope, IO, FS = {
	
OPEN Commander, CommandTool, Rope, IO, FS;

Abort: ERROR = CODE;


Main: CommandProc = {
	ENABLE Abort => GOTO Quit;

	sourceDF: ROPE;
	targetGiven: BOOL;
	targetPrefix: ROPE;
	topSuffix: ROPE;
	docSuffix: ROPE;
	impSuffix: ROPE;
	
	
		
	[sourceDF, targetGiven, targetPrefix, topSuffix, docSuffix, impSuffix] _
		ProcessCommandLine[cmd];
	
	IF targetGiven THEN
		ProcessSourceWithTarget[cmd, sourceDF, targetPrefix, topSuffix, docSuffix, impSuffix]
	ELSE
		ProcessSourceWithoutTarget[cmd, sourceDF];
		
		
	EXITS
		Quit => NULL;
};





ProcessCommandLine: PROC [cmd: Handle] 
						  RETURNS [sourceDF: ROPE,
					  	  			   targetGiven: BOOL,
						  			   targetPrefix: ROPE,
						    		   topSuffix: ROPE,
	     				  			   docSuffix: ROPE,
						  			   impSuffix: ROPE] = {
						  			   
						  			   
	IF NumArgs[cmd] < 2 THEN CommandLineError[cmd];
	sourceDF _ ArgN[cmd, 1];
	
	IF Length[sourceDF] < 3 OR NOT Equal[Substr[sourceDF, Length[sourceDF]-3, 3], ".df", FALSE] THEN
		sourceDF _ Cat[sourceDF, ".df"];

	targetGiven _ FALSE;
	IF NumArgs[cmd] = 2 THEN RETURN;
	targetGiven _ TRUE;
	targetPrefix _ ArgN[cmd, 2];
	topSuffix _ NIL;
	docSuffix _ NIL;
	impSuffix _ NIL;
	
	FOR i: INT IN [3..NumArgs[cmd]) DO
		IF Equal[s1: Substr[base: ArgN[cmd, i], start: 0, len: 2], 
			s2: "t=", case: FALSE] THEN 
			topSuffix _ Substr[base: ArgN[cmd, i], start: 2]
		ELSE IF Equal[s1: Substr[base: ArgN[cmd, i], start: 0, len: 2], 
			s2: "d=", case: FALSE] THEN 
			docSuffix _ Substr[base: ArgN[cmd, i], start: 2]
		ELSE IF Equal[s1: Substr[base: ArgN[cmd, i], start: 0, len: 2], 
			s2: "i=", case: FALSE] THEN 
			impSuffix _ Substr[base: ArgN[cmd, i], start: 2]
		ELSE 
			CommandLineError[cmd];
	ENDLOOP;
	
	};



CommandLineError: PROC [cmd: Handle] = {
	PutF[cmd.out, 
			"Usage: RedirectDF sourceDF [targetPrefix [t=Top>] [d=Documentation>] [i=sourceDF>]\n"];
	ERROR Abort;
};


ProcessSourceWithTarget: PROC [cmd: Handle,
									  sourceDF: ROPE,
									  targetPrefix: ROPE,
									  topSuffix:  ROPE,
									  docSuffix: ROPE,
									  impSuffix: ROPE] = {
									  
									 
	topTarget, docTarget, impTarget: ROPE;
	topSource, docSource, impSource: ROPE;
	line, sourceRoot, sourcePrefix: ROPE;
	input, output: STREAM;
	args: LIST OF ROPE;
	tempFile: ROPE;
	
	
	
	sourceRoot _ExtractRoot[sourceDF];
	sourcePrefix _ NIL;
		
	topTarget _ MakeDirectory[targetPrefix, topSuffix, "Top>"];
	docTarget _ MakeDirectory[targetPrefix, docSuffix, "Documentation>"];
	impTarget _ MakeDirectory[targetPrefix, impSuffix, Cat[sourceRoot, ">"]];
	
	tempFile _ Cat["RedirectDF$", sourceRoot];
	
	input _ OpenFile[cmd, sourceDF, $read];
	output _ OpenFile[cmd, tempFile, $create ! Abort => {Close[input]; ERROR Abort}];
	
	WHILE NOT EndOf[input] DO
		line _ GetLineRope[input];
		
		args _ GetArgs[line];
		IF ListLength[args] = 2 AND (Equal[args.first, "Directory"] OR Equal[args.first, "Exports"]) THEN {
			
			keyword: ROPE _ args.first;
			sourceDir: ROPE _ args.rest.first;
			targetDir: ROPE;
			
			IF sourcePrefix = NIL THEN {
				sourcePrefix _ GetPrefix[sourceDir];
				topSource _ Cat[sourcePrefix, "Top>"];
				docSource _ Cat[sourcePrefix, "Documentation>"];
				impSource _ Cat[sourcePrefix, sourceRoot, ">"];
			};
			
			IF Equal[sourceDir, topSource, FALSE] THEN targetDir _ topTarget
			ELSE IF Equal[sourceDir, docSource, FALSE] THEN targetDir _  docTarget
			ELSE IF Equal[sourceDir, impSource, FALSE] THEN targetDir _ impTarget
			ELSE {
				PutF[cmd.out, "inconsistent directory: %g\n", rope[sourceDir]];
				BadCleanUp[input, output, tempFile];
				ERROR Abort;
			};
			
			PutF[output, "%g %g\n", rope[keyword], rope[targetDir]];
			PutF[output, "--Was %g\n", rope[sourceDir]];
			
		}
		ELSE IF NOT IsWasLine[line] THEN
			PutF[output, "%g\n", rope[line]];
	ENDLOOP;
	
	GoodCleanUp[input, output, tempFile, sourceDF, cmd];
};

BadCleanUp: PROC [input, output: STREAM, tempFile: ROPE] = {

	Close[input];
	Close[output];
	Delete[tempFile];
};

GoodCleanUp: PROC [input, output: STREAM, tempFile, sourceDF: ROPE, cmd: Handle] = {
	
	Close[input];
	Close[output];
	Rename[from: tempFile, to: sourceDF 
				! Error => {
					PutF[cmd.out, "could not create %g\n", rope[sourceDF]];
					Delete[tempFile];
					ERROR Abort;
				}];
			
};

ProcessSourceWithoutTarget: PROC [cmd: Handle, sourceDF: ROPE] = {
	sourceRoot, tempFile, line: ROPE;
	input, output: STREAM;
	args: LIST OF ROPE;
	
	
	sourceRoot _ ExtractRoot[sourceDF];
		
	tempFile _ Cat["RedirectDF$", sourceRoot];
	
	input _ OpenFile[cmd, sourceDF, $read];
	output _ OpenFile[cmd, tempFile, $create ! Abort => {Close[input]; ERROR Abort}];
	
	WHILE NOT EndOf[input] DO
		line _ GetLineRope[input];
		
		args _ GetArgs[line];
		IF ListLength[args] = 2 AND  (Equal[args.first, "Directory"] OR Equal[args.first, "Exports"]) THEN {
			
			keyword: ROPE _ args.first;
			sourceDir: ROPE _ args.rest.first;
			targetDir: ROPE;
			
			IF EndOf[input] THEN {
				PutF[cmd.out, "CameFrom line missing\n"];
				BadCleanUp[input, output, tempFile];
				ERROR Abort;
			};
			
			line _ GetLineRope[input];
			args _ GetArgs[line];
			IF ListLength[args] # 2 OR NOT Equal[args.first, "--Was"] THEN {
				PutF[cmd.out, "--Was line missing\n"];
				BadCleanUp[input, output, tempFile];
				ERROR Abort;
			};
			
			
			
			targetDir _ args.rest.first;
			
			PutF[output, "%g %g\n", rope[keyword], rope[targetDir]];
			PutF[output, "--Was %g\n", rope[sourceDir]];
			
		}
		ELSE IF NOT IsWasLine[line] THEN
			PutF[output, "%g\n", rope[line]];
	ENDLOOP;
	
	GoodCleanUp[input, output, tempFile, sourceDF, cmd];
			
};


IsWasLine: PROC [line: ROPE] RETURNS [BOOLEAN] = {

	args: LIST OF ROPE;
	
	args _ GetArgs[line];
	RETURN [ListLength[args] = 2 AND Equal[args.first, "--Was"]];
}; 



ExtractRoot: PROC [sourceDF: ROPE] RETURNS [ROPE] = {

	i : INT;
	
	
	i _ Length[sourceDF] - 4;
	WHILE i >= 0 AND Fetch[sourceDF, i] # '> AND Fetch[sourceDF, i] # '/ DO
		i _ i - 1;
	ENDLOOP;
	
	RETURN [Substr[sourceDF, i+1, Length[sourceDF]-4-i]];
};

	


ListLength: PROC [list: LIST OF ROPE] RETURNS [INT] = {
	IF list = NIL THEN
		RETURN [0]
	ELSE
		RETURN [ListLength[list.rest]+1];
};


GetArgs: PROC[from: ROPE] RETURNS [LIST OF ROPE] = {
	
	pos: INT _ 0;
	len: INT _ Length[from];
	
	
	GetOneArg: PROC [] RETURNS [result: ROPE] = {
		WHILE (pos < len) AND ((Fetch[from, pos] = ' ) OR (Fetch[from, pos] = '\t))  DO
			pos _ pos + 1;
		ENDLOOP;
		
		IF pos >= len THEN
			RETURN [NIL];
			
		result _ "";
		WHILE (pos < len) AND (Fetch[from, pos] # ' ) AND (Fetch[from, pos] # '\t)  DO
			result _ Cat[result, FromChar[Fetch[from, pos]]];
			pos _ pos + 1;
		ENDLOOP;
	};
	
	RGetArgs: PROC [] RETURNS [LIST OF ROPE] = {
		arg: ROPE;
		
		arg _ GetOneArg[];
		IF arg = NIL THEN
			RETURN [NIL]
		ELSE
			RETURN [CONS[arg, RGetArgs[]]];
	};
	
	
	RETURN [RGetArgs[]];
};
		

OpenFile: PROC [cmd: Handle, fname: ROPE, mode: AccessOptions] RETURNS [STREAM] = {

	ENABLE Error => {
							  IF error.group = user THEN PutF[cmd.out, "%g\n", rope[error.explanation]]
							  ELSE PutF[cmd.out, "can't open %g\n", rope[fname]];
							  ERROR Abort};
							  
	RETURN [StreamOpen[fname, mode]];
};


GetPrefix: PROC [s: ROPE] RETURNS [ROPE] = {

	i: INT;
	
	i _ Length[s]-2;
	WHILE (i >= 0) AND (Fetch[s, i] # '>)  AND (Fetch[s, i] # '/) DO
		i _ i - 1;
	ENDLOOP;
	
	RETURN [Substr[s, 0, i+1]];
};

MakeDirectory: PROC [prefix, suffix, default: ROPE] RETURNS [res: ROPE] = {

		
	IF suffix = NIL THEN
		suffix _ default;
	
	res _ Cat[prefix, suffix];
};	


-- start code

Register["///Commands/RedirectDF", Main];
}.