(FILECREATED "17-Jan-85 09:27:06" {PHYLUM}<TRILLIUM>BIRTHDAY84>FIXES>TRI-FIX-FNS-NHB.;5 6527   

      changes to:  (VARS TRI-FIX-FNS-NHBCOMS)
		   (FNS LIST.OBJECTS.ON.FILE.Original LIST.OBJECTS.ON.FILE)

      previous date: " 9-Jan-85 16:31:42" {PHYLUM}<TRILLIUM>BIRTHDAY84>FIXES>TRI-FIX-FNS-NHB.;4)


(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT TRI-FIX-FNS-NHBCOMS)

(RPAQQ TRI-FIX-FNS-NHBCOMS [(FNS MAKE.ITEMTYPES.COMS LIST.OBJECTS.ON.FILE.Original 
				 LIST.OBJECTS.ON.FILE)
			    (ADDVARS (INDEXEDTYPESLST (ITEMTYPE READ.ITEMTYPE)))
			    (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
				      (ADDVARS (NLAMA)
					       (NLAML MAKE.ITEMTYPES.COMS)
					       (LAMA])
(DEFINEQ

(MAKE.ITEMTYPES.COMS
  [NLAMBDA (ITYPES)                                          (* edited: " 7-Jan-85 15:45")
    (for ITYPE in ITYPES bind (DESCRIPTION OTHER FNS)
       join (SETQ DESCRIPTION (ITEM.TYPE.DESCRIPTION ITYPE))
	    (SETQ OTHER (GET.FIELDQ DESCRIPTION OTHER ITEM.TYPES))
	    (SETQ FNS (for FN in (LISTGET OTHER (QUOTE FNS)) collect (CADR FN)))
	    (CONS (LIST (QUOTE *)
			ITYPE)
		  (CONS (LIST (QUOTE E)
			      (LIST (QUOTE DUMP.ITEMTYPE)
				    (KWOTE ITYPE)))
			(AND FNS (LIST (CONS (QUOTE FNS)
					     FNS])

(LIST.OBJECTS.ON.FILE.Original
  [LAMBDA (FILENAME)                                         (* HaKo "16-Aug-84 16:29")
    (DECLARE (GLOBALVARS TRILLIUM.OBJECT.FILES))
    (PROG (ENTRY CONTENTS INTERFACE.NAMES ITEMTYPE.NAMES FN INTERFACE)
          (SETQ ENTRY (FASSOC FILENAME TRILLIUM.OBJECT.FILES))
          (SETQ CONTENTS (CDR ENTRY))
          (SETQ FN (PACKFILENAME (QUOTE HOST)
				 (QUOTE CORE)
				 (QUOTE NAME)
				 FILENAME
				 (QUOTE EXTENSION)
				 (QUOTE TXT)
				 (QUOTE VERSION)
				 1))
          (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Making the file ...")
          (OPENFILE FN (QUOTE OUTPUT))
          (printout FN "A printout of " FILENAME ", a file of Trillium objects." T "As of " (DATE)
		    ", has contents as follows:")
          (printout FN T)
          (printout FN T)
          (printout FN "Interfaces:")
          (SETQ INTERFACE.NAMES (LISTGET CONTENTS (QUOTE INTERFACE.NAMES)))
          (COND
	    (INTERFACE.NAMES (for INTERFACE.NAME in INTERFACE.NAMES do (printout FN " " 
										 INTERFACE.NAME)))
	    (T (printout FN " none")))
          (printout FN T)
          (printout FN T)
          (printout FN "Itemtypes:")
          (SETQ ITEMTYPE.NAMES (LISTGET CONTENTS (QUOTE ITEMTYPE.NAMES)))
          (COND
	    (ITEMTYPE.NAMES (for ITEMTYPE.NAME in ITEMTYPE.NAMES do (printout FN " " ITEMTYPE.NAME)))
	    (T (printout FN " none")))
          (printout FN T)
          (printout FN T)
          (for INTERFACE.NAME in INTERFACE.NAMES
	     do (SETQ INTERFACE (FIND.INTERFACE INTERFACE.NAME))
		(RESET.INTERFACE INTERFACE T)
		(PRINTDEF INTERFACE NIL NIL NIL NIL FN)
		(printout FN T)
		(printout FN T))
          (for ITEMTYPE.NAME in ITEMTYPE.NAMES
	     do (PRINTDEF (ITEM.TYPE.DESCRIPTION ITEMTYPE.NAME)
			  NIL NIL NIL NIL FN)
		(printout FN T)
		(printout FN T))
          (CLOSEF FN)
          (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE SAME.LINE "listing the file ...")
          (APPLY* (QUOTE LISTFILES)
		  FN)
          (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE SAME.LINE "done")
          (DELFILE FN])

(LIST.OBJECTS.ON.FILE
  [LAMBDA (FILENAME)                                         (* N.H.Briggs "17-Jan-85 09:25")

          (* * fixed to bind \SINGLEFILEINDEX.DONTSPAWN to T to avoid deleting listing file before LISTFILES process has 
	  finished)


    (DECLARE (GLOBALVARS TRILLIUM.OBJECT.FILES))
    (PROG (ENTRY CONTENTS INTERFACE.NAMES ITEMTYPE.NAMES FN INTERFACE)
          (SETQ ENTRY (FASSOC FILENAME TRILLIUM.OBJECT.FILES))
          (SETQ CONTENTS (CDR ENTRY))
          (SETQ FN (PACKFILENAME (QUOTE HOST)
				 (QUOTE CORE)
				 (QUOTE NAME)
				 FILENAME
				 (QUOTE EXTENSION)
				 (QUOTE TXT)
				 (QUOTE VERSION)
				 1))
          (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Making the file ...")
          (OPENFILE FN (QUOTE OUTPUT))
          (printout FN "A printout of " FILENAME ", a file of Trillium objects." T "As of " (DATE)
		    ", has contents as follows:")
          (printout FN T)
          (printout FN T)
          (printout FN "Interfaces:")
          (SETQ INTERFACE.NAMES (LISTGET CONTENTS (QUOTE INTERFACE.NAMES)))
          (COND
	    (INTERFACE.NAMES (for INTERFACE.NAME in INTERFACE.NAMES do (printout FN " " 
										 INTERFACE.NAME)))
	    (T (printout FN " none")))
          (printout FN T)
          (printout FN T)
          (printout FN "Itemtypes:")
          (SETQ ITEMTYPE.NAMES (LISTGET CONTENTS (QUOTE ITEMTYPE.NAMES)))
          (COND
	    (ITEMTYPE.NAMES (for ITEMTYPE.NAME in ITEMTYPE.NAMES do (printout FN " " ITEMTYPE.NAME)))
	    (T (printout FN " none")))
          (printout FN T)
          (printout FN T)
          (for INTERFACE.NAME in INTERFACE.NAMES
	     do (SETQ INTERFACE (FIND.INTERFACE INTERFACE.NAME))
		(RESET.INTERFACE INTERFACE T)
		(PRINTDEF INTERFACE NIL NIL NIL NIL FN)
		(printout FN T)
		(printout FN T))
          (for ITEMTYPE.NAME in ITEMTYPE.NAMES
	     do (PRINTDEF (ITEM.TYPE.DESCRIPTION ITEMTYPE.NAME)
			  NIL NIL NIL NIL FN)
		(printout FN T)
		(printout FN T))
          (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE SAME.LINE "listing the file ...")
          (CLOSEF FN)
          (RESETVAR \SINGLEFILEINDEX.DONTSPAWN T (APPLY* (QUOTE LISTFILES)
							 FN))
          (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE SAME.LINE "done")
          (DELFILE FN])
)

(ADDTOVAR INDEXEDTYPESLST (ITEMTYPE READ.ITEMTYPE))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML MAKE.ITEMTYPES.COMS)

(ADDTOVAR LAMA )
)
(PUTPROPS TRI-FIX-FNS-NHB COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (746 6233 (MAKE.ITEMTYPES.COMS 756 . 1404) (LIST.OBJECTS.ON.FILE.Original 1406 . 3722) (
LIST.OBJECTS.ON.FILE 3724 . 6231)))))
STOP