(***********************************************************************

Name:		MakeAbs.Pas
Version:	1.0

     This software has been placed into the public domain by Digital
			 Equipment Corporation.


DISCLAIMER:

The information herein is subject to change without  notice  and  should
not be construed as a commitment by Digital Equipment Corporation.

Digital Equipment Corporation assumes no responsibility for the  use  or
reliability  of  this  software.   This  software  is  provided "as is,"
without any warranty of any kind, express or implied.  Digital Equipment
Corporation  will  not	be liable in any event for any damages including
any loss of data, profit, or savings, claims against  the  user  by  any
other  party,  or  any other incidental or consequential damages arising
out of the use of, or inability to use, this software, even  if  Digital
Equipment Corporation is advised of the possibility of such damage.

DEFECT REPORTING AND SUGGESTIONS:

Please send reports of defects or suggestions for  improvement	directly
to the author:

	Brian Hetrick
	Digital Equipment Corporation
	110 Spit Brook Road  ZKO1-3/J10
	Nashua NH  03062-2698

Do NOT file a Software Performance Report on  this  software,  call  the
Telephone  Support  Center regarding this software, contact your Digital
Field Office  regarding  this  software,  or  use  any	other  mechanism
provided for Digital's supported and warranted software.


FACILITY:

    TURBO Pascal MS-DOS support routines

ABSTRACT:

    Translates a relative  path  specification	into  an  absolute  path
    specification  (one that does not depend upon current directories or
    relative directory specifiers)

ENVIRONMENT:

    MS-DOS V2.0 or later, compiled with  Borland  International's  TURBO
    Pascal V3.0 or later.

AUTHOR: Brian Hetrick, CREATION DATE: 1 December 1986.

MODIFIED BY:

	Brian Hetrick, 01-Dec-86: Version 1.0
  000 - Original creation of module.

***********************************************************************)
{.PA}
(*
 *  INCLUDE FILES:
 *)

(*
 *  LABEL DECLARATIONS:
 *)

(*
 *  CONSTANT DECLARATIONS:
 *)

(*
 *  TYPE DECLARATIONS:
 *)

TYPE

    MakeAbsPath = STRING [255];

(*
 *  OWN STORAGE:
 *)

(*
 *  TABLE OF CONTENTS:
 *)
{.PA}
PROCEDURE MakePathAbsolute
   (VAR RelativePath : MakeAbsPath);

(***********************************************************************

FUNCTIONAL DESCRIPTION:

    Finds the absolute path specification  for	a  given  relative  path
    specification.  In the absolute path specification, the drive letter
    and a root-relative path specification name the file.  In a relative
    path specification, the drive letter need not appear (it defaults to
    the current drive), and the path specification may	be  relative  to
    the current path on the drive.

FORMAL PARAMETERS:

    Path.mt.r - The possibly relative path specification which is set to
	be the corresponding absolute path specification.

RETURN VALUE:

    None.

IMPLICIT INPUTS:

    None.

IMPLICIT OUTPUTS:

    None.

SIDE EFFECTS:

    May obtain the current directory on the current drive, or  the  cur-
    rent  directory on some other drive.  For some reason, MS-DOS acces-
    es the drive when the current directory is requested,  so  this  may
    generate  an  MS-DOS  level  error if the drive does not exist or if
    there is no volume in the drive.

***********************************************************************)

    VAR

	AbsolutePath	   : MakeAbsPath;
	DriveIndex	   : INTEGER;
	LastDeletePosition : INTEGER;
	ScanPtr 	   : INTEGER;
	ThisChar	   : CHAR;

    BEGIN

    (*
     *	Get drive index and current directory for drive
     *)

    IF (Length (RelativePath) >= 2) AND (RelativePath [2] = ':')
    THEN
	BEGIN

	DriveIndex := Ord (UpCase (RelativePath [1])) - 64;
	Delete (RelativePath, 1, 2)

	END
    ELSE

	DriveIndex := 0;

    GetDir (DriveIndex, AbsolutePath);

    (*
     *	Construct the absolute path name
     *)

    IF Length (RelativePath) > 0
    THEN
	BEGIN

	IF (RelativePath [1] = '/') OR (RelativePath [1] = '\')
	THEN

	    Delete (AbsolutePath, 3, Length (AbsolutePath) - 2)

	ELSE IF (AbsolutePath [Length (AbsolutePath)] <> '\') AND
		(AbsolutePath [Length (AbsolutePath)] <> '/')
	THEN

	    Insert ('\', AbsolutePath, Length (AbsolutePath) + 1)

	END;

    Insert (RelativePath, AbsolutePath, Length (AbsolutePath) + 1);

    (*
     *	Fix lowercase and directory separators
     *)

    FOR ScanPtr := 1 TO Length (AbsolutePath)
    DO
	BEGIN

	ThisChar := UpCase (AbsolutePath [ScanPtr]);
	IF ThisChar = '/'
	THEN
	    ThisChar := '\';
	AbsolutePath [ScanPtr] := ThisChar

	END;

    (*
     *	Fix up '.' and '..' references
     *)

    ScanPtr := 1;
    WHILE ScanPtr <= Length (AbsolutePath)
    DO
	BEGIN

	IF AbsolutePath [ScanPtr] = '\'
	THEN
	    BEGIN

	    (*
	     *	Check next character for '.'
	     *)

	    IF (Length (AbsolutePath) > ScanPtr) AND
	       (AbsolutePath [ScanPtr + 1] = '.')
	    THEN
		BEGIN

		(*
		 *  Check next character also for '..'
		 *)

		IF (Length (AbsolutePath) > ScanPtr + 1) AND
		   (AbsolutePath [ScanPtr + 2] = '.')
		THEN
		    BEGIN

		    (*
		     *	Have reference to parent directory.  Delete both
		     *	'..' and previous directory
		     *)

		    LastDeletePosition := ScanPtr + 2;
		    REPEAT
			ScanPtr := ScanPtr - 1
		    UNTIL (AbsolutePath [ScanPtr] = '\') OR
			  (AbsolutePath [ScanPtr] = ':');

		    IF AbsolutePath [ScanPtr] = ':'
		    THEN
			ScanPtr := ScanPtr + 1

		    END
		ELSE

		    (*
		     *	Have reference to current directory.  Delete '.'
		     *	only
		     *)

		    LastDeletePosition := ScanPtr + 1;

		(*
		 *  Delete directory references
		 *)

		Delete (AbsolutePath, ScanPtr,
		    LastDeletePosition - ScanPtr + 1)

		END
	    ELSE

		(*
		 *  Next character is not '.'
		 *)

		ScanPtr := ScanPtr + 1

	    END
	ELSE

	    (*
	     *	Current character is not '\'
	     *)

	    ScanPtr := ScanPtr + 1

	END;

    (*
     *	Specification of the root directory through .. may leave only
     *	the drive letter and colon
     *)

    IF Length (AbsolutePath) = 2
    THEN
	Insert ('\', AbsolutePath, 3);

    (*
     *	Return the absolute path
     *)

    RelativePath := AbsolutePath

    END;