(FILECREATED "13-Feb-86 18:12:19" {DSK}<LISPFILES2>IMPROVEDDCOMS>ENV.;2
 2593   

      changes to:  (VARS ENVCOMS)
		   (FNS QP.CANNONICAL.FILE.NAME)

      previous date: " 8-Feb-86 15:21:29" {DSK}<LISPFILES2>IMPROVEDDCOMS>ENV.;1)


(* Copyright (c) 1986 by Quintus Computer Systems, Inc. All rights reserved.)

(PRETTYCOMPRINT ENVCOMS)

(RPAQQ ENVCOMS
 ((FNS QP.ABSOLUTE.PATH QP.ADD.FILE.TO.PATH QP.CANNONICAL.FILE.NAME QP.FILE.EXISTS 
		       QP.GETENV QP.HOST.VERSION REMLISTPROP)))
(DEFINEQ

(QP.ABSOLUTE.PATH

  (LAMBDA (PATH)
    (
COND

      ((
SYMBOLP
 PATH)
	(LET ((PATH.HOST (
FILENAMEFIELD
 PATH (
QUOTE
 HOST)))
	      (CONN.HOST (
FILENAMEFIELD
 \CONNECTED.DIRECTORY (
QUOTE
 HOST))))
	     (
COND

	       ((
OR
 (
EQ
 PATH.HOST CONN.HOST)
		      (
NULL
 PATH.HOST))
		 (
PACKFILENAME
 (
QUOTE
 BODY)
				 PATH
				 (
QUOTE
 BODY)
				 \CONNECTED.DIRECTORY))
	       (T PATH))))
      (T PATH))))

(QP.ADD.FILE.TO.PATH

  (LAMBDA (PATH PARTSLIST)
    (
COND

      ((
AND
 (
NEQ
 (
NTHCHARCODE
 PATH -1)
		     (
CHARCODE
 >))
	      (
OR
 (
STRPOS
 "<" PATH)
		    (
STRPOS
 ">" PATH)
		    (
NEQ
 (
CHCON1
 PATH)
			   (
CHARCODE
 {))))
	(
SETQ
 PARTSLIST (
CONS
 ">" PARTSLIST))))
    (
SETQ
 PARTSLIST (
CONS
 PATH PARTSLIST))
    (
COND

      ((
AND
 (
NEQ
 (
CHCON1
 PATH)
		     (
CHARCODE
 {))
	      (
NOT
 (
STRPOS
 "<" PATH)))
	(
SETQ
 PARTSLIST (
CONS
 "<" PARTSLIST))))
    (
PACK
 PARTSLIST)))

(QP.CANNONICAL.FILE.NAME

  (LAMBDA (FL)                                               (* If FL can be found, returns full name of FL, sans 

							     version number, otherwise just returns FL)

    (LET ((FULL (
FULLNAME
 FL (
QUOTE
 OLD))))
         (if
 FULL
	     then
 (
PACKFILENAME
 (
QUOTE
 VERSION)
				    NIL
				    (
QUOTE
 BODY)
				    FULL)
	   else
 FL))))

(QP.FILE.EXISTS

  (LAMBDA (PATH)
    (
COND

      ((
INFILEP
 PATH)
	1)
      (T 0))))

(QP.GETENV

  (LAMBDA (TYPE)
    (
SELECTQ
 TYPE
	       (HOME LOGINHOST/DIR)
	       (
SHOULDNT
 (
QUOTE
 GETENV)))))

(QP.HOST.VERSION

  (LAMBDA NIL
    (VALUES 79 4 1 5)))

(REMLISTPROP

  (LAMBDA (
LIST
 ITEM)
    (CL:DO (RESULT (LIST1 LIST (
CDDR
 LIST1)))
	   ((
NULL
 LIST1)
	    RESULT)
	   (
COND

	     ((
EQ
 (
CAR
 LIST1)
		    ITEM))
	     (T (
SETQ
 RESULT (
APPEND
 (
LIST
 (
CAR
 LIST1)
						 (
CADR
 LIST1))
					 RESULT)))))))
)
(PUTPROPS ENV COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (497 2507 (QP.ABSOLUTE.PATH 507 . 952) (QP.ADD.FILE.TO.PATH 954 . 1517) (
QP.CANNONICAL.FILE.NAME 1519 . 1923) (QP.FILE.EXISTS 1925 . 2020) (QP.GETENV 2022 . 2149) (
QP.HOST.VERSION 2151 . 2209) (REMLISTPROP 2211 . 2505)))))
STOP