Category : Modula II Source Code
Archive   : FLXCPY10.ZIP
Filename : SUBDIRS.MOD

IMPLEMENTATION MODULE SubDirS;

FROM OtherMSD IMPORT GetCurDir, ChangeCurDir, GetCurDisk, ChangeCurDisk;

FROM Strings IMPORT String, StoS, Concat, Length, PosLast,
Pos, Copy, Delete, StrLower;

FROM Terminal IMPORT WriteString, WriteLn;

CONST
CurrentDrive = 0;
DirStackSize = 6;
VAR
SaveDirStack : ARRAY [0..(DirStackSize-1)] OF String;
SaveDirCount : CARDINAL;
DiskString : String;
CurDisk : CARDINAL;


PROCEDURE PushDir() : BOOLEAN;
VAR
SaveDir : String;
BEGIN (* PushDir *)
IF (SaveDirCount < DirStackSize) THEN (* Still space on directory stack *)
IF GetCurDir( CurrentDrive, SaveDir) THEN
SaveDirStack[ SaveDirCount] := SaveDir;
INC( SaveDirCount);
RETURN( TRUE);
ELSE
RETURN( FALSE);
END; (* IF GetCurDir *)
ELSE
RETURN( FALSE); (* Stack overflow *)
END; (* IF SaveDirCount *)
END PushDir;

PROCEDURE PopDir() : BOOLEAN;
VAR
SaveDir : String;
BEGIN (* PopDir *)
IF SaveDirCount > 0 THEN
DEC( SaveDirCount);
RETURN( ChangeCurDir( SaveDirStack[SaveDirCount]));
ELSE
RETURN( FALSE); (* Stack underflow *)
END; (* IF SaveDirCount > 0 *)
END PopDir;

(* Test a path/file specification to see if it is a subdirectory. Is so,
return TRUE, else return FALSE. *)
PROCEDURE IsSubdir(spec : ARRAY OF CHAR) : BOOLEAN;
VAR
b, IsDir, ChangeDrive : BOOLEAN;
JunkNum : CARDINAL;
BEGIN (* IsSubdir *)
b := PushDir();
IF spec[1]=':' THEN
ChangeDrive := TRUE;
JunkNum := ChangeCurDisk( ORD( CAP( spec[0])) - 64);
IF NOT PushDir() THEN RETURN FALSE; END;
ELSE
ChangeDrive := FALSE;
END; (* IF spec[1] *)
IsDir := ChangeCurDir( spec);
IF ChangeDrive THEN b := PopDir(); END;
b := PopDir();
RETURN IsDir;
END IsSubdir;


(* Accept FileSpec or PathSpec as argument, convert to fully qualified
file/path name (starting at drive and root dir). Return TRUE if
successful, false otherwise. *)
PROCEDURE FullyQualify(VAR Spec : ARRAY OF CHAR) : BOOLEAN;
VAR
JunkBool,
ChangeDrive : BOOLEAN;
FileName,
FullSpec : String;
JunkNum,
LastSlash : CARDINAL;

(* Internal proc for FQ. -- reappend file name to path spec after
successful creation of FQ'd path. *)
PROCEDURE RestoreFileName;
BEGIN (* RestoreFileName *)
IF FileName <> '' THEN
StrLower( FileName);
IF Length( Spec) > 3 (* if not root dir, need separating \ *)
THEN Concat( Spec, '\', Spec); END
Concat( Spec, FileName, Spec);
END; (* IF FileName *)
END RestoreFileName;

BEGIN (* FullyQualify *)
(* Save current directory on default drive, clear FileName variable *)
IF NOT PushDir() THEN
(* WriteString('fq: first pushdir failed'); WriteLn; *)
RETURN FALSE;
END;
FileName := '';

(* Test for drive spec. If drive spec, change drive and save current
dir on new drive. *)
IF Spec[1]=':' THEN
ChangeDrive := TRUE;
JunkNum := ChangeCurDisk( ORD( CAP( Spec[0])) - ORD( 'A')+1);
IF NOT PushDir() THEN
(* WriteString('fq: pushdir on change drive failed');WriteLn; *)
RETURN FALSE;
END;
ELSE
ChangeDrive := FALSE;
END; (* IF Spec[1] *)

(* Assume the easy case first: Spec is a valid path with no filename on it. *)
IF (ChangeCurDir( Spec)) THEN (* success on easy case *)
JunkBool := GetCurDir( CurrentDrive, FullSpec);
JunkNum := StoS( FullSpec, Spec, FALSE);
IF ChangeDrive THEN JunkBool := PopDir(); END;
IF (PopDir()) THEN
RETURN TRUE;
ELSE
(* WriteString('fq: popdir failed');WriteLn; *)
RETURN FALSE;
END;

(* If this fails, we've either got a filename on the end or an invalid
path, so we've got to experiment and try to puzzle it out. *)

ELSIF Pos('\', Spec, 0) = (HIGH(Spec) +1) THEN

(* No \'s, therefore we've almost certainly got a simple filename or
drive and filename as input. We've already accounted for drive changes
so save filename if needed and get the current directory. *)
IF (Length( Spec) > 2) AND (Spec[1] = ':') THEN
Copy( Spec, 2, Length( Spec) - 2, FileName);
ELSE
JunkNum := StoS( Spec, FileName, FALSE);
END; (* IF Length( Spec)... *)

JunkBool := GetCurDir( CurrentDrive, FullSpec);
JunkNum := StoS( FullSpec, Spec, FALSE);
RestoreFileName;

IF ChangeDrive THEN JunkBool := PopDir(); END;
IF (PopDir()) THEN
RETURN TRUE;
ELSE
(* WriteString('fq: popdir failed');WriteLn; *)
RETURN FALSE;
END;

ELSE (* We've got some form of pathspec plus filename, or an invalid
path. Try to validate, and return error if fails. *)

(* First save the filename, and delete from spec. *)
LastSlash := PosLast( '\', Spec, HIGH( Spec));
Copy( Spec, LastSlash, HIGH( Spec), FileName);

(* If we've got a root spec, we need to leave the \, else we don't
want a final slash, so check for root spec. *)
IF LastSlash = 0
THEN Delete( Spec, LastSlash+1, HIGH( Spec));
ELSIF (Spec[1]=':') AND (LastSlash = 2)
THEN Delete( Spec, LastSlash+1, HIGH( Spec));
ELSE Delete( Spec, LastSlash, HIGH( Spec));
END; (* IF LastSlash = 0 *)
Delete( FileName, 0, 1); (* delete leading \ from filename *)

IF ChangeCurDir( Spec) THEN (* success! *)
JunkBool := GetCurDir( CurrentDrive, FullSpec);
JunkNum := StoS( FullSpec, Spec, FALSE);
RestoreFileName;
IF ChangeDrive THEN JunkBool := PopDir(); END;
IF (PopDir()) THEN
RETURN TRUE;
ELSE
(* WriteString('fq: popdir failed');WriteLn; *)
RETURN FALSE;
END;
ELSE (* Failed again, restore directories and return error. *)
IF ChangeDrive THEN JunkBool := PopDir(); END;
JunkBool := PopDir();
(* WriteString('fq: qualify failed');WriteLn; *)
RETURN FALSE;
END; (* IF ChangeCurDir (2) *)
END; (* IF ChangeCurDir *)
END FullyQualify;

BEGIN (* SubDirS *)
SaveDirCount := 0;
END SubDirS.