(FILECREATED "19-Nov-84 17:24:49" {AZTEC}<TRILLIUM>BIRTHDAY84>RERELEASE>TRI-SAVING.;2 30108
changes to: (FNS LOADING.FILE)
previous date: "17-Aug-84 23:24:10" {AZTEC}<TRILLIUM>BIRTHDAY84>RERELEASE>TRI-SAVING.;1)
(* Copyright (c) 1984 by Xerox Corporation)
(PRETTYCOMPRINT TRI-SAVINGCOMS)
(RPAQQ TRI-SAVINGCOMS ((VARS (CLEANUP.CONFIRM.MENU)
(FILE.OBJECT.TYPE.MENU)
(LOADING.&.SAVING.COMMAND.MENU)
(TRILLIUM.OBJECT.FILES))
(FNS ACQUIRE.FILE.OBJECT.NAME ACQUIRE.FILE.OBJECT.TYPE ACQUIRE.OBJECT.FILE.ENTRY
ACQUIRE.OBJECT.FILE.NAME ADD.INTERFACE.TO.FILE ADD.ITEMTYPE.TO.FILE ADD.OBJECT.TO.FILE
CLEANUP.OBJECT.FILES CLEANUP.OBJECT.FILES.GIVE.REASON CLEANUP.OBJECT.FILES.SELECTIVELY
COPY.OBJECT.FILE DEFINE.NEW.FILE DEFINE.OBJECT.FILE DELETE.FROM.FILE DELETE.OBJECT.FILE
DELETE.OBJECT.FROM.FILE FILE.NEW.OBJECTS FILED.OBJECTS.ON FILES.WITH.MARKED.OBJECTS
FORGET.OBJECT.CHANGES GET.CLEANUP.CONFIRM.MENU GET.LOADING.&.SAVING.COMMAND.MENU
INTERACT&DELETE.OBJECT.FILE INTERACT&FILE.NEW.OBJECTS INTERACT&LIST.OBJECTS.ON.FILE
INTERACT&MAKE.OBJECT.FILE INTERACT&SHOW.OBJECTS.ON.FILE LIST.OBJECTS.ON.FILE
LOADING.&.SAVING LOADING.FILE MAKE.OBJECT.FILE MARK.OBJECT.FILE OBJECT.FILE.NAMES
SHOW.OBJECT.FILES SHOW.OBJECTS.ON.FILE TRILLIUM.CONN? TRILLIUM.CONNECT
WHERE.IS.OBJECT.FILED?)))
(RPAQQ CLEANUP.CONFIRM.MENU NIL)
(RPAQQ FILE.OBJECT.TYPE.MENU NIL)
(RPAQQ LOADING.&.SAVING.COMMAND.MENU NIL)
(RPAQQ TRILLIUM.OBJECT.FILES NIL)
(DEFINEQ
(ACQUIRE.FILE.OBJECT.NAME
[LAMBDA (FILENAME) (* DAHJr "23-JAN-83 14:33")
(DECLARE (GLOBALVARS ITEMTYPE.NAMES))
(PROG (INTERFACE.NAMES ITEMS FILE.OBJECT.MENU)
(SETQ ITEMS (CONS))
(SETQ INTERFACE.NAMES (FILED.OBJECTS.ON (QUOTE INTERFACE.NAMES)
FILENAME))
[COND
(INTERFACE.NAMES (TCONC ITEMS (LIST "--Interfaces--" NIL))
(for INTERFACE.NAME in INTERFACE.NAMES
do (TCONC ITEMS (LIST INTERFACE.NAME (KWOTE (CONS (QUOTE
INTERFACE.NAMES)
INTERFACE.NAME]
(SETQ ITEMTYPE.NAMES (FILED.OBJECTS.ON (QUOTE ITEMTYPE.NAMES)
FILENAME))
[COND
(ITEMTYPE.NAMES (TCONC ITEMS (LIST "--Item types--" NIL))
(for ITYPE in ITEMTYPE.NAMES
do (TCONC ITEMS (LIST ITYPE (KWOTE (CONS (QUOTE ITEMTYPE.NAMES)
ITYPE]
(SETQ FILE.OBJECT.MENU (create MENU
ITEMS ←(CAR ITEMS)
TITLE ←(CONCAT "Objects on file " FILENAME)
CENTERFLG ← T
CHANGEOFFSETFLG ← T))
(RETURN (MENU FILE.OBJECT.MENU])
(ACQUIRE.FILE.OBJECT.TYPE
[LAMBDA NIL (* DAHJr "23-JAN-83 19:18")
(* EVAL THIS WHEN THE MENU IS CHANGED
(SETQ FILE.OBJECT.TYPE.MENU))
(DECLARE (GLOBALVARS FILE.OBJECT.TYPE.MENU))
(MENU (OR FILE.OBJECT.TYPE.MENU (SETQ FILE.OBJECT.TYPE.MENU (create MENU
TITLE ← "What kind of object"
ITEMS ←[QUOTE
((Interface (QUOTE
INTERFACE.NAMES))
(Itemtype (QUOTE
ITEMTYPE.NAMES]
CENTERFLG ← T
CHANGEOFFSETFLG ← T])
(ACQUIRE.OBJECT.FILE.ENTRY
[LAMBDA (MESSAGE) (* HaKo "25-Jul-84 17:06")
(DECLARE (GLOBALVARS TRILLIUM.OBJECT.FILES))
(PROG (NAME.MENU)
(COND
(MESSAGE (TRILLIUM.PRINTOUT ON PROMPTWINDOW MESSAGE)))
(SETQ NAME.MENU (create MENU
ITEMS ←(for ENTRY in TRILLIUM.OBJECT.FILES
collect (LIST (CAR ENTRY)
(KWOTE ENTRY)))
TITLE ← "Trillium object files"
CENTERFLG ← T
CHANGEOFFSETFLG ← T))
(RETURN (MENU NAME.MENU])
(ACQUIRE.OBJECT.FILE.NAME
[LAMBDA (MESSAGE) (* DAHJr "24-JAN-83 10:12")
(CAR (ACQUIRE.OBJECT.FILE.ENTRY MESSAGE])
(ADD.INTERFACE.TO.FILE
[LAMBDA NIL (* DAHJr "23-JAN-83 13:48")
(PROG (ENTRY INTERFACE.NAME CONTENTS INTERFACE.NAMES)
(SETQ ENTRY (ACQUIRE.OBJECT.FILE.ENTRY))
(COND
(ENTRY (SETQ INTERFACE.NAME (ACQUIRE.INTERFACE.NAME))
(COND
(INTERFACE.NAME (ADD.OBJECT.TO.FILE INTERFACE.NAME (QUOTE INTERFACE.NAMES)
(CAR ENTRY])
(ADD.ITEMTYPE.TO.FILE
[LAMBDA NIL (* DAHJr "23-JAN-83 13:50")
(PROG (ENTRY ITEMTYPE.NAME CONTENTS ITEMTYPE.NAMES)
(SETQ ENTRY (ACQUIRE.OBJECT.FILE.ENTRY))
(COND
(ENTRY (SETQ ITEMTYPE.NAME (ACQUIRE.ITEM.TYPE))
(COND
(ITEMTYPE.NAME (ADD.OBJECT.TO.FILE ITEMTYPE.NAME (QUOTE ITEMTYPE.NAMES)
(CAR ENTRY])
(ADD.OBJECT.TO.FILE
[LAMBDA (OBJECT TYPE FILENAME) (* DAHJr "24-JAN-83 10:14")
(DECLARE (GLOBALVARS TRILLIUM.OBJECT.FILES))
(PROG (ENTRY CONTENTS OBJECTS)
(SETQ ENTRY (FASSOC FILENAME TRILLIUM.OBJECT.FILES))
[COND
((NULL ENTRY)
(DEFINE.NEW.FILE FILENAME NIL)
(SETQ ENTRY (FASSOC FILENAME TRILLIUM.OBJECT.FILES]
(SETQ CONTENTS (CDR ENTRY))
[COND
(CONTENTS (SETQ OBJECTS (LISTGET CONTENTS TYPE))
(SETQ OBJECTS (CONS OBJECT OBJECTS))
(SETQ OBJECTS (INTERSECTION OBJECTS OBJECTS))
(SETQ OBJECTS (SORT OBJECTS))
(LISTPUT CONTENTS TYPE OBJECTS))
(T (RPLACD ENTRY (LIST TYPE (LIST OBJECT]
(MARK.OBJECT.FILE FILENAME T])
(CLEANUP.OBJECT.FILES
[LAMBDA NIL (* HaKo "16-Aug-84 16:23")
(PROG (TO.BE.DUMPED.FILES)
(INTERACT&FILE.NEW.OBJECTS)
(SETQ TO.BE.DUMPED.FILES (FILES.WITH.MARKED.OBJECTS))
(COND
(TO.BE.DUMPED.FILES (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS "Files to be made:")
(for FILENAME in TO.BE.DUMPED.FILES
do (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS SAME.LINE 1
FILENAME))
(SELECTQ (MENU (GET.CLEANUP.CONFIRM.MENU))
((NIL DON'T.MAKE.ANY.FILES.NOW)
NIL)
[MAKE.ALL.WITHOUT.CONFIRMATION (THINKING
(for FILENAME in
TO.BE.DUMPED.FILES
do (MAKE.OBJECT.FILE
FILENAME]
(MAKE.SELECTIVELY.WITH.CONFIRMATION (
CLEANUP.OBJECT.FILES.SELECTIVELY TO.BE.DUMPED.FILES))
(SHOULDNT)))
(T (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS "No files need making"])
(CLEANUP.OBJECT.FILES.GIVE.REASON
[LAMBDA (FILENAME) (* HaKo "16-Aug-84 16:25")
(PROG (MEMBERSHIP.CHANGES INTERFACE.NAMES ITYPES)
(SETQ MEMBERSHIP.CHANGES (FILED.OBJECTS.ON (QUOTE CHANGED)
FILENAME))
(SETQ INTERFACE.NAMES (for INTERFACE.NAME in (FILED.OBJECTS.ON (QUOTE INTERFACE.NAMES)
FILENAME)
when (MARKASCHANGEDP INTERFACE.NAME (QUOTE DIALOGS)) collect
INTERFACE.NAME))
(SETQ ITYPES (for ITYPE in (FILED.OBJECTS.ON (QUOTE ITEMTYPE.NAMES)
FILENAME)
when (MARKASCHANGEDP ITYPE (QUOTE ITEMTYPES)) collect ITYPE))
(COND
[(OR MEMBERSHIP.CHANGES INTERFACE.NAMES ITYPES)
(TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS "The file " FILENAME
" needs to be made because")
(COND
(MEMBERSHIP.CHANGES (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS SAME.BLOCK 2
"its membership has changed")))
[COND
(INTERFACE.NAMES (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS SAME.BLOCK 2
"these interfaces have changed:")
(for INTERFACE.NAME in INTERFACE.NAMES
do (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS SAME.LINE 1
INTERFACE.NAME]
(COND
(ITYPES (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS SAME.BLOCK 2
"these itemtypes have changed:")
(for ITYPE in ITYPES do (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS SAME.LINE
1 ITYPE]
(T (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS "The file " FILENAME
" does not need making"])
(CLEANUP.OBJECT.FILES.SELECTIVELY
[LAMBDA (FILENAMES) (* DAHJr "24-JAN-83 12:37")
(PROG (CONFIRM.SUBMENU DONE)
(for FILENAME in FILENAMES
do (SETQ CONFIRM.SUBMENU (create MENU
TITLE ←(CONCAT "Make file " FILENAME " now?")
ITEMS ←(QUOTE (YES NOT.NOW (" " NIL)
WHY.DOES.IT.NEED.MAKING?
SHOW.MEMBERSHIP
FORGET.MEMBERSHIP.CHANGES
FORGET.CHANGES.TO.OBJECTS))
CENTERFLG ← T
CHANGEOFFSETFLG ← T))
(SETQ DONE)
(until DONE do (SELECTQ (MENU CONFIRM.SUBMENU)
(NIL NIL)
(YES (SETQ DONE T)
(MAKE.OBJECT.FILE FILENAME))
(NOT.NOW (SETQ DONE T))
(WHY.DOES.IT.NEED.MAKING? (CLEANUP.OBJECT.FILES.GIVE.REASON
FILENAME))
(SHOW.MEMBERSHIP (SHOW.OBJECTS.ON.FILE FILENAME))
(FORGET.MEMBERSHIP.CHANGES (MARK.OBJECT.FILE FILENAME NIL))
(FORGET.CHANGES.TO.OBJECTS (FORGET.OBJECT.CHANGES FILENAME))
(SHOULDNT])
(COPY.OBJECT.FILE
[LAMBDA NIL (* HaKo "16-Aug-84 16:25")
(PROG (ENTRY FILENAME CONTENTS)
(SETQ ENTRY (ACQUIRE.OBJECT.FILE.ENTRY "Indicate file to be copied"))
(COND
(ENTRY (TRILLIUM.PRINTOUT ON PROMPTWINDOW "Name of the copy: ")
(SETQ FILENAME (PROMPT.READ))
(COND
(FILENAME (SETQ CONTENTS (COPYALL (CDR ENTRY)))
(DEFINE.NEW.FILE FILENAME CONTENTS)
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "File " FILENAME " defined"])
(DEFINE.NEW.FILE
[LAMBDA (FILENAME CONTENTS) (* DAHJr "24-JAN-83 10:09")
(DECLARE (GLOBALVARS TRILLIUM.OBJECT.FILES))
[COND
(TRILLIUM.OBJECT.FILES (PUTASSOC FILENAME CONTENTS TRILLIUM.OBJECT.FILES))
(T (SETQ TRILLIUM.OBJECT.FILES (LIST (CONS FILENAME CONTENTS]
(MARK.OBJECT.FILE FILENAME T])
(DEFINE.OBJECT.FILE
[LAMBDA NIL (* HaKo "16-Aug-84 16:26")
(PROG (FILENAME)
(TRILLIUM.PRINTOUT ON PROMPTWINDOW "Name of file to hold Trillium objects: ")
(SETQ FILENAME (PROMPT.READ))
(COND
(FILENAME (DEFINE.NEW.FILE FILENAME NIL)
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE SAME.BLOCK "File " FILENAME
" defined containing no objects"])
(DELETE.FROM.FILE
[LAMBDA NIL (* HaKo "16-Aug-84 16:27")
(PROG (ENTRY CONTENTS FILENAME OBJECT.NAME INTERFACE.NAMES)
(SETQ ENTRY (ACQUIRE.OBJECT.FILE.ENTRY))
(COND
(ENTRY (SETQ FILENAME (CAR ENTRY))
(SETQ CONTENTS (CDR ENTRY))
(COND
[CONTENTS (SETQ OBJECT.NAME (ACQUIRE.FILE.OBJECT.NAME FILENAME))
(COND
([AND OBJECT.NAME (CONFIRM (CONCAT "Delete " (SELECTQ (CAR
OBJECT.NAME)
(
INTERFACE.NAMES "interface")
(ITEMTYPE.NAMES
"itemtype")
(SHOULDNT))
" "
(CDR OBJECT.NAME]
(DELETE.OBJECT.FROM.FILE (CDR OBJECT.NAME)
(CAR OBJECT.NAME)
FILENAME]
(T (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "There are no entries on file " FILENAME
" to delete"])
(DELETE.OBJECT.FILE
[LAMBDA (FILENAME) (* DAHJr "24-JAN-83 10:41")
(DECLARE (GLOBALVARS TRILLIUM.OBJECT.FILES))
(SETQ TRILLIUM.OBJECT.FILES (DREMOVE (FASSOC FILENAME TRILLIUM.OBJECT.FILES)
TRILLIUM.OBJECT.FILES])
(DELETE.OBJECT.FROM.FILE
[LAMBDA (OBJECT TYPE FILENAME) (* DAHJr "24-JAN-83 10:16")
(DECLARE (GLOBALVARS TRILLIUM.OBJECT.FILES))
(PROG (ENTRY CONTENTS OBJECTS)
(SETQ ENTRY (FASSOC FILENAME TRILLIUM.OBJECT.FILES))
(OR ENTRY (SHOULDNT))
(SETQ CONTENTS (CDR ENTRY))
[COND
(CONTENTS (LISTPUT CONTENTS TYPE (DREMOVE OBJECT (LISTGET CONTENTS TYPE]
(MARK.OBJECT.FILE FILENAME T])
(FILE.NEW.OBJECTS
[LAMBDA (INTERFACE.NAMES ITYPES) (* HaKo "25-Jul-84 17:10")
(PROG (FILED.INTERFACES FILED.ITEMTYPES ENTRY)
[for INTERFACE.NAME in INTERFACE.NAMES
do (TRILLIUM.PRINTOUT ON PROMPTWINDOW "Indicate where to file interface " INTERFACE.NAME)
(SETQ ENTRY (ACQUIRE.OBJECT.FILE.ENTRY))
(COND
(ENTRY (ADD.OBJECT.TO.FILE INTERFACE.NAME (QUOTE INTERFACE.NAMES)
(CAR ENTRY]
(for ITYPE in ITYPES
do (TRILLIUM.PRINTOUT ON PROMPTWINDOW "Indicate where to file itemtype " ITYPE)
(SETQ ENTRY (ACQUIRE.OBJECT.FILE.ENTRY))
(COND
(ENTRY (ADD.OBJECT.TO.FILE ITYPE (QUOTE ITEMTYPE.NAMES)
(CAR ENTRY])
(FILED.OBJECTS.ON
[LAMBDA (TYPE OBJECT.FILES) (* DAHJr "23-JAN-83 17:10")
(DECLARE (GLOBALVARS TRILLIUM.OBJECT.FILES))
(COND
((AND OBJECT.FILES (LITATOM OBJECT.FILES))
(LISTGET (CDR (FASSOC OBJECT.FILES TRILLIUM.OBJECT.FILES))
TYPE))
(T (PROG (FILES OBJECTS ENTRY)
(SETQ FILES (OR OBJECT.FILES (OBJECT.FILE.NAMES)))
[SETQ OBJECTS (for FILE in FILES
join (SETQ ENTRY (FASSOC FILE TRILLIUM.OBJECT.FILES))
(COPY (LISTGET (CDR ENTRY)
TYPE]
(SETQ OBJECTS (INTERSECTION OBJECTS OBJECTS))
(RETURN (SORT OBJECTS])
(FILES.WITH.MARKED.OBJECTS
[LAMBDA NIL (* DAHJr "24-JAN-83 10:28")
(for FILENAME in (OBJECT.FILE.NAMES) unless [AND (NULL (FILED.OBJECTS.ON (QUOTE CHANGED)
FILENAME))
(for INTERFACE.NAME in (FILED.OBJECTS.ON
(QUOTE INTERFACE.NAMES)
FILENAME)
never (MARKASCHANGEDP INTERFACE.NAME
(QUOTE DIALOGS)))
(for ITYPE in (FILED.OBJECTS.ON (QUOTE
ITEMTYPE.NAMES)
FILENAME)
never (MARKASCHANGEDP ITYPE (QUOTE ITEMTYPES]
collect FILENAME])
(FORGET.OBJECT.CHANGES
[LAMBDA (FILENAME) (* DAHJr "24-JAN-83 12:18")
(PROG (INTERFACE.NAMES ITYPES)
[for INTERFACE.NAME in (FILED.OBJECTS.ON (QUOTE INTERFACE.NAMES)
FILENAME)
do (COND
((AND (MARKASCHANGEDP INTERFACE.NAME (QUOTE DIALOGS))
(CONFIRM (CONCAT "Forget changes to interface " INTERFACE.NAME "?")))
(UNMARK.INTERFACE (FIND.INTERFACE INTERFACE.NAME]
(for ITYPE in (FILED.OBJECTS.ON (QUOTE ITEMTYPE.NAMES)
FILENAME)
do (COND
((AND (MARKASCHANGEDP ITYPE (QUOTE ITEMTYPES))
(CONFIRM (CONCAT "Forget changes to itemtype " ITYPE "?")))
(UNMARK.ITEM.TYPE ITYPE])
(GET.CLEANUP.CONFIRM.MENU
[LAMBDA NIL (* DAHJr "24-JAN-83 11:15")
(* EVAL THIS WHEN CHANGING THE MENU
(SETQ CLEANUP.CONFIRM.MENU))
(DECLARE (GLOBALVARS CLEANUP.CONFIRM.MENU))
(OR CLEANUP.CONFIRM.MENU (SETQ CLEANUP.CONFIRM.MENU (create MENU
TITLE ← "Make these files now?"
ITEMS ←(QUOTE (
MAKE.ALL.WITHOUT.CONFIRMATION MAKE.SELECTIVELY.WITH.CONFIRMATION DON'T.MAKE.ANY.FILES.NOW))
CENTERFLG ← T
CHANGEOFFSETFLG ← T])
(GET.LOADING.&.SAVING.COMMAND.MENU
[LAMBDA NIL (* DAHJr "22-MAR-83 12:31")
(* WHEN MENU CHANGES EVAL: (SETQ
LOADING.&.SAVING.COMMAND.MENU NIL))
(DECLARE (GLOBALVARS LOADING.&.SAVING.COMMAND.MENU))
(OR LOADING.&.SAVING.COMMAND.MENU (SETQ LOADING.&.SAVING.COMMAND.MENU
(create MENU
ITEMS ←(QUOTE (CONNECTED.TO.? CONNECT.TO.HOST/DIRECTORY ("" NIL)
LOAD.FILE
("" NIL)
CREATE.NEW.FILE COPY.FILE DELETE.FILE SHOW.FILES
("" NIL)
ADD.INTERFACE.TO.FILE ADD.ITEMTYPE.TO.FILE
DELETE.OBJECT.FROM.FILE SHOW.OBJECTS.ON.FILE
LIST.OBJECTS.ON.FILE WHERE.IS.OBJECT.FILED?
("" NIL)
FILE.NEW.OBJECTS MAKE.FILE CLEANUP.ALL.CHANGES QUIT))
TITLE ← "Loading and Saving"
CENTERFLG ← T
CHANGEOFFSETFLG ← T])
(INTERACT&DELETE.OBJECT.FILE
[LAMBDA NIL (* DAHJr "24-JAN-83 10:41")
(PROG (FILENAME)
(SETQ FILENAME (ACQUIRE.OBJECT.FILE.NAME))
(COND
((AND FILENAME (CONFIRM (CONCAT "Delete Trillium file " FILENAME)))
(DELETE.OBJECT.FILE FILENAME])
(INTERACT&FILE.NEW.OBJECTS
[LAMBDA NIL (* HaKo "16-Aug-84 16:28")
(DECLARE (GLOBALVARS INTERFACES ITEM.TYPES))
(PROG (FILED.INTERFACES FILED.ITEMTYPES TO.BE.FILED.INTERFACES TO.BE.FILED.ITEMTYPES
TO.BE.DUMPED.FILES)
(SETQ FILED.INTERFACES (FILED.OBJECTS.ON (QUOTE INTERFACE.NAMES)
NIL))
(SETQ TO.BE.FILED.INTERFACES (LDIFFERENCE INTERFACES FILED.INTERFACES))
(SETQ FILED.ITEMTYPES (FILED.OBJECTS.ON (QUOTE ITEMTYPE.NAMES)
NIL))
(SETQ TO.BE.FILED.ITEMTYPES (LDIFFERENCE ITEM.TYPES FILED.ITEMTYPES))
(COND
[(OR TO.BE.FILED.INTERFACES TO.BE.FILED.ITEMTYPES)
(TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS "Not yet filed:")
[COND
(TO.BE.FILED.INTERFACES (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS 2 "Interfaces:")
(for INTERFACE.NAME in TO.BE.FILED.INTERFACES
do (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS 1
INTERFACE.NAME]
[COND
(TO.BE.FILED.ITEMTYPES (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS 2 "Itemtypes:")
(for ITYPE in TO.BE.FILED.ITEMTYPES
do (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS 1 ITYPE]
(COND
((CONFIRM "Files these before making files?")
(FILE.NEW.OBJECTS TO.BE.FILED.INTERFACES TO.BE.FILED.ITEMTYPES]
(T (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "All objects have already been filed"])
(INTERACT&LIST.OBJECTS.ON.FILE
[LAMBDA NIL (* DAHJr "17-FEB-83 11:09")
(PROG (FILENAME)
(SETQ FILENAME (ACQUIRE.OBJECT.FILE.NAME))
(COND
(FILENAME (THINKING (LIST.OBJECTS.ON.FILE FILENAME])
(INTERACT&MAKE.OBJECT.FILE
[LAMBDA NIL (* DAHJr "24-JAN-83 10:55")
(PROG (NAME)
(SETQ NAME (ACQUIRE.OBJECT.FILE.NAME))
(COND
(NAME (THINKING (MAKE.OBJECT.FILE NAME])
(INTERACT&SHOW.OBJECTS.ON.FILE
[LAMBDA NIL (* DAHJr "24-JAN-83 12:24")
(PROG (FILENAME)
(SETQ FILENAME (ACQUIRE.OBJECT.FILE.NAME))
(COND
(FILENAME (SHOW.OBJECTS.ON.FILE FILENAME])
(LIST.OBJECTS.ON.FILE
[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])
(LOADING.&.SAVING
[LAMBDA (INTERFACE) (* HaKo "16-Aug-84 16:30")
(* "Top level of the editor")
(PROG (COMMAND.MENU COMMAND HOST DIRECTORY DONE)
(SETQ COMMAND.MENU (GET.LOADING.&.SAVING.COMMAND.MENU))
(until DONE
do (SETQ COMMAND (MENU COMMAND.MENU))
(TRILLIUM.CLEAR.ALL.PROMPTING)
(SELECTQ COMMAND
(NIL)
(QUIT (SETQ DONE T))
(CONNECTED.TO.? (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS
"Now connected to: "
(TRILLIUM.CONN?)))
(CONNECT.TO.HOST/DIRECTORY (TRILLIUM.CONNECT))
(LOAD.FILE (LOADING.FILE))
(CHECK.OBJECTS (DEFINE.OBJECT.FILE))
(CREATE.NEW.FILE (DEFINE.OBJECT.FILE))
(COPY.FILE (COPY.OBJECT.FILE))
(DELETE.FILE (INTERACT&DELETE.OBJECT.FILE))
(SHOW.FILES (SHOW.OBJECT.FILES))
(ADD.INTERFACE.TO.FILE (ADD.INTERFACE.TO.FILE))
(ADD.ITEMTYPE.TO.FILE (ADD.ITEMTYPE.TO.FILE))
(DELETE.OBJECT.FROM.FILE (DELETE.FROM.FILE))
(SHOW.OBJECTS.ON.FILE (INTERACT&SHOW.OBJECTS.ON.FILE))
(LIST.OBJECTS.ON.FILE (INTERACT&LIST.OBJECTS.ON.FILE))
(WHERE.IS.OBJECT.FILED? (WHERE.IS.OBJECT.FILED?))
(FILE.NEW.OBJECTS (INTERACT&FILE.NEW.OBJECTS))
(MAKE.FILE (INTERACT&MAKE.OBJECT.FILE))
(CLEANUP.ALL.CHANGES (CLEANUP.OBJECT.FILES))
(SHOULDNT])
(LOADING.FILE
[LAMBDA NIL (* kkm "19-Nov-84 15:58")
(* HaKo "16-Aug-84 16:31")
(PROG (FILENAME)
(TRILLIUM.PRINTOUT ON PROMPTWINDOW "Name of the file to be loaded: ")
(SETQ FILENAME (PROMPT.READ))
(COND
(FILENAME (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Loading file " FILENAME)
(LOAD FILENAME)
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE SAME.BLOCK "File " FILENAME " loaded")
(MARK.OBJECT.FILE FILENAME NIL])
(MAKE.OBJECT.FILE
[LAMBDA (FILENAME) (* HaKo "16-Aug-84 16:58")
(DECLARE (GLOBALVARS NOTCOMPILEDFILES NOTLISTEDFILES))
(PROG (INTERFACE.NAMES ITEMTYPE.NAMES FILECOMS FILECOMSVAR FULL.FILE.NAME)
(SETQ INTERFACE.NAMES (FILED.OBJECTS.ON (QUOTE INTERFACE.NAMES)
FILENAME))
[COND
(INTERFACE.NAMES (SETQ FILECOMS (CONS (CONS (QUOTE DIALOGS)
INTERFACE.NAMES)
FILECOMS]
(SETQ ITEMTYPE.NAMES (FILED.OBJECTS.ON (QUOTE ITEMTYPE.NAMES)
FILENAME))
[COND
(ITEMTYPE.NAMES (SETQ FILECOMS (CONS (CONS (QUOTE ITEMTYPES)
ITEMTYPE.NAMES)
FILECOMS]
[SETQ FILECOMSVAR (MKATOM (CONCAT FILENAME (QUOTE COMS]
(SET FILECOMSVAR FILECOMS)
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Trillium object file " FILENAME " => ")
[SETQ FULL.FILE.NAME (MAKEFILE FILENAME (QUOTE (FAST]
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE SAME.LINE FULL.FILE.NAME)
(MARK.OBJECT.FILE FILENAME NIL)
(RPLACD (GETPROP FILENAME (QUOTE FILE)))
(SETQ NOTCOMPILEDFILES (DREMOVE FILENAME NOTCOMPILEDFILES))
(SETQ NOTLISTEDFILES (DREMOVE FILENAME NOTLISTEDFILES])
(MARK.OBJECT.FILE
[LAMBDA (FILENAME CHANGED) (* HaKo "30-SEP-83 22:13")
(* edited: "15-APR-83 16:50")
(DECLARE (GLOBALVARS TRILLIUM.OBJECT.FILES))
(PROG (ENTRY CONTENTS)
(SETQ ENTRY (FASSOC FILENAME TRILLIUM.OBJECT.FILES))
(COND
[ENTRY (SETQ CONTENTS (CDR ENTRY))
(COND
(CONTENTS (LISTPUT CONTENTS (QUOTE CHANGED)
CHANGED))
(T (RPLACD ENTRY (LIST (QUOTE CHANGED)
CHANGED]
(CHANGED (SHOULDNT "File is undefined"))
(T (SETQ TRILLIUM.OBJECT.FILES (CONS (LIST FILENAME)
TRILLIUM.OBJECT.FILES])
(OBJECT.FILE.NAMES
[LAMBDA NIL
(DECLARE (GLOBALVARS TRILLIUM.OBJECT.FILES))
(for ENTRY in TRILLIUM.OBJECT.FILES collect (CAR ENTRY])
(SHOW.OBJECT.FILES
[LAMBDA NIL (* HaKo "16-Aug-84 16:32")
(DECLARE (GLOBALVARS TRILLIUM.OBJECT.FILES))
(COND
(TRILLIUM.OBJECT.FILES (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS "Trillium object files: ")
(for FILE in (OBJECT.FILE.NAMES) do (TRILLIUM.PRINTOUT ON
TRILLIUM.DESCRIPTIONS
SAME.BLOCK 3 FILE)
))
(T (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS "There are no Trillium object files yet defined"]
)
(SHOW.OBJECTS.ON.FILE
[LAMBDA (FILENAME) (* HaKo "16-Aug-84 16:32")
(DECLARE (GLOBALVARS TRILLIUM.OBJECT.FILES))
(PROG (ENTRY CONTENTS INTERFACE.NAMES ITEMTYPE.NAMES)
(SETQ ENTRY (FASSOC FILENAME TRILLIUM.OBJECT.FILES))
(COND
(ENTRY (SETQ CONTENTS (CDR ENTRY))
(COND
[CONTENTS (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS "The file " FILENAME
" now has objects:")
(TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS SAME.BLOCK 3 "Interfaces:")
(SETQ INTERFACE.NAMES (LISTGET CONTENTS (QUOTE INTERFACE.NAMES)))
(COND
(INTERFACE.NAMES (for INTERFACE.NAME in INTERFACE.NAMES
do (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS
SAME.LINE 1 INTERFACE.NAME)
))
(T (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS SAME.LINE 1 "none")))
(TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS SAME.BLOCK 3 "Itemtypes:")
(SETQ ITEMTYPE.NAMES (LISTGET CONTENTS (QUOTE ITEMTYPE.NAMES)))
(COND
(ITEMTYPE.NAMES (for ITEMTYPE.NAME in ITEMTYPE.NAMES
do (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS
SAME.LINE 1 ITEMTYPE.NAME)))
(T (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS SAME.LINE 1 "none"]
(T (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS "The file " (CAR ENTRY)
"has no objects on it now"])
(TRILLIUM.CONN?
[LAMBDA NIL (* DAHJr "22-JAN-83 16:12")
(DECLARE (GLOBALVARS \CONNECTED.DIR \CONNECTED.HOST))
(PACKFILENAME (QUOTE HOST)
\CONNECTED.HOST
(QUOTE DIRECTORY)
\CONNECTED.DIR])
(TRILLIUM.CONNECT
[LAMBDA NIL (* HaKo "16-Aug-84 16:32")
(DECLARE (GLOBALVARS LOGINHOST/DIR))
(PROG (HOST DIRECTORY HOST/DIR)
(TRILLIUM.PRINTOUT ON PROMPTWINDOW "Host to connect to (%")%" means no change): ")
(SETQ HOST (PROMPT.READ))
(TRILLIUM.PRINTOUT ON PROMPTWINDOW SAME.BLOCK
"Directory (name>name>...>name) to connect to: ")
(SETQ DIRECTORY (PROMPT.READ))
(SETQ HOST/DIR (COND
((OR HOST DIRECTORY)
(PACKFILENAME (QUOTE HOST)
HOST
(QUOTE DIRECTORY)
DIRECTORY))
(T LOGINHOST/DIR)))
(CNDIR HOST/DIR)
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "You are now connected to " (TRILLIUM.CONN?])
(WHERE.IS.OBJECT.FILED?
[LAMBDA NIL (* HaKo "16-Aug-84 16:33")
(PROG (TYPE.MENU TYPE OBJECT.NAME FILENAMES)
(SETQ TYPE (ACQUIRE.FILE.OBJECT.TYPE))
(SETQ OBJECT.NAME (SELECTQ TYPE
(NIL NIL)
(INTERFACE.NAMES (ACQUIRE.INTERFACE.NAME))
(ITEMTYPE.NAMES (ACQUIRE.ITEM.TYPE))
(SHOULDNT)))
(COND
(OBJECT.NAME (SETQ FILENAMES (for FILENAME in (OBJECT.FILE.NAMES)
when (FMEMB OBJECT.NAME (FILED.OBJECTS.ON TYPE FILENAME))
collect FILENAME))
(TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS (COND
((EQ TYPE (QUOTE INTERFACE.NAMES))
"Interface")
(T "Itemtype"))
1 OBJECT.NAME)
(SELECTQ (LENGTH FILENAMES)
(0 (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS SAME.LINE
" is not filed on any file"))
(1 (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS SAME.LINE
" is filed on file "
(CAR FILENAMES)))
(PROGN (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS SAME.LINE
" is filed on files")
(for FILENAME in FILENAMES
do (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS SAME.BLOCK
1 FILENAME])
)
(PUTPROPS TRI-SAVING COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1556 30027 (ACQUIRE.FILE.OBJECT.NAME 1566 . 2697) (ACQUIRE.FILE.OBJECT.TYPE 2699 . 3342
) (ACQUIRE.OBJECT.FILE.ENTRY 3344 . 3903) (ACQUIRE.OBJECT.FILE.NAME 3905 . 4077) (
ADD.INTERFACE.TO.FILE 4079 . 4504) (ADD.ITEMTYPE.TO.FILE 4506 . 4918) (ADD.OBJECT.TO.FILE 4920 . 5701)
(CLEANUP.OBJECT.FILES 5703 . 6689) (CLEANUP.OBJECT.FILES.GIVE.REASON 6691 . 8344) (
CLEANUP.OBJECT.FILES.SELECTIVELY 8346 . 9392) (COPY.OBJECT.FILE 9394 . 9940) (DEFINE.NEW.FILE 9942 .
10306) (DEFINE.OBJECT.FILE 10308 . 10753) (DELETE.FROM.FILE 10755 . 11669) (DELETE.OBJECT.FILE 11671
. 11951) (DELETE.OBJECT.FROM.FILE 11953 . 12434) (FILE.NEW.OBJECTS 12436 . 13179) (FILED.OBJECTS.ON
13181 . 13826) (FILES.WITH.MARKED.OBJECTS 13828 . 14502) (FORGET.OBJECT.CHANGES 14504 . 15229) (
GET.CLEANUP.CONFIRM.MENU 15231 . 15833) (GET.LOADING.&.SAVING.COMMAND.MENU 15835 . 16746) (
INTERACT&DELETE.OBJECT.FILE 16748 . 17082) (INTERACT&FILE.NEW.OBJECTS 17084 . 18548) (
INTERACT&LIST.OBJECTS.ON.FILE 18550 . 18833) (INTERACT&MAKE.OBJECT.FILE 18835 . 19094) (
INTERACT&SHOW.OBJECTS.ON.FILE 19096 . 19369) (LIST.OBJECTS.ON.FILE 19371 . 21542) (LOADING.&.SAVING
21544 . 23028) (LOADING.FILE 23030 . 23618) (MAKE.OBJECT.FILE 23620 . 24878) (MARK.OBJECT.FILE 24880
. 25563) (OBJECT.FILE.NAMES 25565 . 25727) (SHOW.OBJECT.FILES 25729 . 26272) (SHOW.OBJECTS.ON.FILE
26274 . 27706) (TRILLIUM.CONN? 27708 . 27976) (TRILLIUM.CONNECT 27978 . 28758) (WHERE.IS.OBJECT.FILED?
28760 . 30025)))))
STOP