(FILECREATED "17-Aug-84 21:36:58" {ICE}<TRILLIUM><BIRTHDAY84>BETA>TRI-TOOLS.;1 45698
previous date: "16-Aug-84 17:44:06" {ICE}<TRILLIUM>BIRTHDAY84>PRE-BETA>TRI-TOOLS.;9)
(PRETTYCOMPRINT TRI-TOOLSCOMS)
(RPAQQ TRI-TOOLSCOMS [(FNS ADD.NV.PAIR CHECK.FREEVARS CLEAR.ALTERNATE.SCREEN COMPARE.TRILLIUMS
COMPAREFILES COMPAREFNS COPY.FROM.ALTERNATE.SCREEN
COPY.TO.ALTERNATE.SCREEN COUNT.ITEMS COUNT.ITEMS1 COUNT.RATIO
LOAD.TRILLIUM MAKE.ALTERNATE.SCREEN OLD.EDIT.FRAME OLD.GET.FIELD
OLD.TRILLIUM.PRINTOUT SWITCHSCREENS TF TRILLIUM.ADD.DECLARATIONS
TRILLIUM.ADD.TIMESTAMP TRILLIUM.FIX TRILLIUM.FNS TRILLIUM.INDEX
TRILLIUM.INDEX.ADD.FIELD TRILLIUM.INDEX.FIND.ENTRY
TRILLIUM.LOADING.INSTRUCTIONS TRILLIUM.LIST TRILLIUM.LOG
TRILLIUM.MOVE.FILE TRILLIUM.MOVE.FILE.REMOTE TRILLIUM.MOVE.FILES
TRILLIUM.MOVE.FILES.REMOTE TRILLIUM.MOVE.FILES.REMOTELY
TRILLIUM.MOVE.FILES.REMOTELY.REMOTE TRILLIUM.RELEASE TRILLIUM.WHEREIS
WALK.ITEMS.OF.ITEM WALK.OBJECTS.OF.FRAME WALK.OBJECTS.OF.INTERFACE
WALK.OBJECTS.OF.OBJECT WALK.TRILLIUM.FNS WALK.TRILLIUM.FNS.DESCEND)
(VARS (LEN)
(ALTERNATE.SCREEN))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA TRILLIUM.LOG TRILLIUM.LIST OLD.TRILLIUM.PRINTOUT CHECK.FREEVARS)
(NLAML)
(LAMA])
(DEFINEQ
(ADD.NV.PAIR
[LAMBDA (NVSET NAME VALUE) (* HaKo "29-AUG-83 12:55")
(* Inserts (NAME VALUE) into NVSET. If NAME already present, adds VALUE at end of value list of NAME.
Note that NVSET is a TCONC cell! Returns NAME if addition was made.)
(PROG [DONE (NVENTRY (FASSOC NAME (CAR NVSET]
(COND
((NULL NVENTRY)
(TCONC NVSET (SETQ NVENTRY (LIST NAME)))
(SETQ DONE NAME)))
(COND
([AND VALUE (NOT (MEMBER VALUE (CDR NVENTRY]
(NCONC1 NVENTRY VALUE)
(SETQ DONE NAME)))
(RETURN DONE])
(CHECK.FREEVARS
[NLAMBDA FILES (* HaKo "11-Jun-84 16:27")
(DECLARE (GLOBALVARS TRILLIUM.FILES))
(for FILE in (OR FILES (APPEND (QUOTE (TRILLIUM BASIC-PTYPES PRIMITIVE-ITEMTYPES
COMPOSITE-ITEMTYPES))
TRILLIUM.FILES))
bind (ALLFREEVARS) when (BOUNDP (FILECOMS FILE))
do (printout T T T FILE " : ")
[for FN in (FILEFNSLST FILE) bind (FNCALLS FREEVARS)
when (PROGN (SETQ FNCALLS (CALLS FN))
(SETQ FREEVARS (for V in (CADDR FNCALLS)
unless [OR (FMEMB V (CADR FNCALLS))
(FMEMB V (QUOTE (RESETVARSLST]
collect V)))
do (printout T T FN 20 " uses: " FREEVARS)
(for V in FREEVARS unless (MEMB V ALLFREEVARS) do (SETQ ALLFREEVARS (CONS V
ALLFREEVARS]
finally (printout T T T)
(RETURN (SORT ALLFREEVARS])
(CLEAR.ALTERNATE.SCREEN
[LAMBDA NIL (* HaKo "15-Aug-84 16:45")
(* DAHJr "12-JUN-81 16:31")
(DECLARE (GLOBALVARS ALTERNATE.SCREEN SCREENHEIGHT SCREENWIDTH))
(OBS)
(BITBLT NIL NIL NIL ALTERNATE.SCREEN 0 0 SCREENWIDTH SCREENHEIGHT (QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE NIL])
(COMPARE.TRILLIUMS
[LAMBDA (DIRECTORY1 DIRECTORY2 DRIBBLEFILE) (* HaKo "26-Jul-84 11:19")
(DECLARE (SPECVARS FILENAME1 FILENAME2)
(GLOBALVARS ALL.TRILLIUM.FILES))
(PROG ((FILENAME1 (UNPACKFILENAME DIRECTORY1))
(FILENAME2 (UNPACKFILENAME DIRECTORY2)))
(if DRIBBLEFILE
then (DRIBBLE DRIBBLEFILE))
[for FILENAME in ALL.TRILLIUM.FILES
do (LISTPUT FILENAME1 (QUOTE NAME)
FILENAME)
(LISTPUT FILENAME2 (QUOTE NAME)
FILENAME)
(NLSETQ (COMPAREFILES (PACKFILENAME FILENAME1)
(PACKFILENAME FILENAME2]
(if DRIBBLEFILE
then (EMPRESS (DRIBBLE])
(COMPAREFILES
[LAMBDA (FILE1 FILE2) (* HaKo " 7-Aug-84 12:45")
(* edited: " 4-DEC-83 13:52")
(PROG (FILE FILENAME NAME COMS1 COMS2 FNS1 FNS2 FNS)
(SETQ FILE1 (INFILEP FILE1))
(SETQ FILE2 (INFILEP FILE2))
(printout NIL T "Comparison of files " FILE1 " and " FILE2 T)
(SETQ FILE (LOADFROM FILE1))
(SETQ FILENAME (UNPACKFILENAME FILE))
(SETQ NAME (LISTGET FILENAME (QUOTE NAME)))
[SETQ COMS1 (COPY (EVAL (FILECOMS NAME]
(SETQ FNS1 (FILEFNSLST NAME))
(SETQ FILE (LOADFROM FILE2))
(SETQ FILENAME (UNPACKFILENAME FILE))
(SETQ NAME (LISTGET FILENAME (QUOTE NAME)))
[SETQ COMS2 (COPY (EVAL (FILECOMS NAME]
(SETQ FNS2 (FILEFNSLST NAME))
(printout NIL T "COMS: " T)
(COMPARELISTS COMS1 COMS2)
(printout NIL T "----------------------------------")
(COND
((SETQ FNS (LDIFFERENCE FNS1 FNS2))
(printout NIL T "Fns on " FILE1 " not on " FILE2 T FNS T
"----------------------------------")))
(COND
((SETQ FNS (LDIFFERENCE FNS2 FNS1))
(printout NIL T "Fns on " FILE2 " not on " FILE1 T FNS T
"----------------------------------")))
(SETQ FNS (NCONC FNS1 FNS2))
(SETQ FNS (SORT (INTERSECTION FNS FNS)))
(for FN in FNS bind (SOURCES ←(LIST FILE1 FILE2))
do (printout NIL T FN ":" T)
(COMPAREDEFS FN (QUOTE FNS)
SOURCES)
(printout NIL T "----------------------------------"])
(COMPAREFNS
[LAMBDA (FNS SOURCES) (* DAHJr " 5-DEC-83 09:34")
(for FN in FNS
do (printout NIL T "--------" T FN ": " T)
(COMPAREDEFS FN (QUOTE FNS)
SOURCES])
(COPY.FROM.ALTERNATE.SCREEN
[LAMBDA (DESTINATION) (* HaKo "15-Aug-84 16:46")
(* DAHJr "24-JUN-83 11:28")
(DECLARE (GLOBALVARS ALTERNATE.SCREEN SCREENHEIGHT SCREENWIDTH))
(OBS)
(DSPFILL NIL WHITESHADE (QUOTE REPLACE)
DESTINATION)
(BITBLT ALTERNATE.SCREEN 0 0 DESTINATION 0 0 SCREENWIDTH SCREENHEIGHT (QUOTE INPUT)
(QUOTE REPLACE])
(COPY.TO.ALTERNATE.SCREEN
[LAMBDA (SOURCE) (* HaKo "15-Aug-84 16:47")
(* DAHJr "27-OCT-81 20:28")
(DECLARE (GLOBALVARS ALTERNATE.SCREEN SCREENHEIGHT SCREENWIDTH))
(OBS)
(BITBLT (DSPDESTINATION NIL SOURCE)
0 0 ALTERNATE.SCREEN 0 0 SCREENWIDTH SCREENHEIGHT (QUOTE INPUT)
(QUOTE REPLACE])
(COUNT.ITEMS
[LAMBDA (ALL) (* DAHJr " 6-DEC-83 16:19")
(DECLARE (SPECVARS LEN)
(GLOBALVARS CURRENT.FRAME))
(SETQ LEN)
(for ITEM in (GET.FIELDQ CURRENT.FRAME ITEMS) do (COUNT.ITEMS1 ITEM ALL])
(COUNT.ITEMS1
[LAMBDA (ITEM ALL) (* DAHJr " 6-DEC-83 16:19")
(DECLARE (SPECVARS LEN))
(SETQ LEN (CONS (LIST (IDIFFERENCE (IQUOTIENT (LENGTH ITEM)
2)
3)
(LENGTH (GET.FIELDQ (ITEM.TYPE.DESCRIPTION (ITEM.TYPE ITEM))
PARAMETERS)))
LEN))
(COND
(ALL (for SUB.ITEM in (GET.FIELDQ ITEM SUBITEMS) do (COUNT.ITEMS1 SUB.ITEM ALL])
(COUNT.RATIO
[LAMBDA NIL (* DAHJr " 6-DEC-83 16:27")
(DECLARE (SPECVARS LEN))
(PROG ((N 0)
(SUM 0.0))
[for ELEMENT in LEN
do (SETQ N (ADD1 N))
(SETQ SUM (FPLUS SUM (FQUOTIENT (CAR ELEMENT)
(CADR ELEMENT]
(RETURN (FTIMES (FQUOTIENT SUM N)
100])
(LOAD.TRILLIUM
[LAMBDA (WITH.SOURCES) (* DAHJr "10-OCT-83 09:59")
(LOAD (QUOTE TRILLIUM.DCOM))
(COND
(WITH.SOURCES (TRILLIUM.LOAD.SOURCES)))
(LOAD (QUOTE BASIC-PTYPES))
(LOAD (QUOTE PRIMITIVE-ITEMTYPES))
(LOAD (QUOTE COMPOSITE-ITEMTYPES))
(LOAD (QUOTE DEMO-INTERFACE])
(MAKE.ALTERNATE.SCREEN
[LAMBDA NIL (* HaKo "15-Aug-84 16:42")
(* DAHJr "27-OCT-81 18:51")
(DECLARE (GLOBALVARS ALTERNATE.DSP ALTERNATE.SCREEN))
(OBS)
(COND
(ALTERNATE.SCREEN)
(T (SETQ ALTERNATE.SCREEN (BITMAPCOPY (SCREENBITMAP)))
(SETQ ALTERNATE.DSP (DSPCREATE))
(DSPDESTINATION ALTERNATE.SCREEN ALTERNATE.DSP])
(OLD.EDIT.FRAME
[LAMBDA (FRAME) (* edited: "24-Jun-84 13:13")
(* "Top level of the editor")
(SELECTQ (MENU (GET.FRAME.EDITOR.COMMAND.MENU))
(NIL NIL)
(CREATE.NEW.ITEM (CREATE.NEW.ITEM FRAME))
(COPY.ITEM (INTERACT©.ITEM FRAME))
(MOVE.ITEM (MOVE.ITEM FRAME))
(SHAPE.ITEM (SHAPE.ITEM FRAME))
(NAME.ITEM (NAME.ITEM FRAME))
(EDIT.ITEM (TOP.EDIT.ITEM FRAME))
(PRINT.ITEMS (PRINT.ITEMS FRAME))
(GRAPH.ITEMS (GRAPH.ITEMS FRAME))
(EXPAND.ITEM (EXPAND.ITEM FRAME))
(DELETE.ITEM (DELETE.ITEM FRAME))
(BURY.ITEM (BURY.ITEM FRAME))
(FREEZE.ITEM (INTERACT&FREEZE.ITEM FRAME))
(THAW.ITEM (INTERACT&THAW.ITEM FRAME))
(GROUP.ITEMS (GROUP.ITEMS FRAME))
(MODIFY.ITEMS (MODIFY.ITEMS FRAME))
(SAVE.ITEM (SAVE.ITEM FRAME))
(RETRIEVE.SAVED.ITEM (RETRIEVE.SAVED.ITEM FRAME))
(INSTALL.GRID (INSTALL.GRID FRAME))
(MANIPULATE.SUPERFRAMES (MANIPULATE.SUPERFRAMES FRAME))
(ADD.SUPERFRAME (TOP.ADD.SUPERFRAME FRAME))
(FORGET.SUPERFRAME (TOP.FORGET.SUPERFRAMES FRAME))
(PRINT.SUPERFRAMES (PRINT.SUPERFRAMES FRAME))
(ADD.FRAME.CLASS (ADD.FRAME.CLASS FRAME))
(FORGET.FRAME.CLASS (FORGET.FRAME.CLASS FRAME))
(PRINT.FRAME.CLASSES (PRINT.FRAME.CLASSES FRAME))
(EXPOSE.ITEM.EDITORS (EXPOSE.ITEM.EDITORS))
(FORGET.ITEM.EDITORS (THINKING (FORGET.EDIT.WINDOWS)
NIL))
(DEFINE.ITEM.TYPE (DEFINE.ITEM.TYPE))
(MANIPULATE.FRAMES (MANIPULATE.FRAMES))
(MANIPULATE.INTERFACE (MANIPULATE.INTERFACE))
(ANALYZE.FRAME (TOP.ANALYZE.FRAME FRAME))
(INITIALIZE.FRAME (TOP.INITIALIZE.FRAME FRAME))
(DISPLAY.FRAME (TOP.DISPLAY.FRAME FRAME))
(HARDCOPY (TOP.HARDCOPY))
(INSPECT.FRAME (INSPECT/PLIST FRAME))
(SHOULDNT "Unrecognized command in EDIT.FRAME"])
(OLD.GET.FIELD
[LAMBDA (ITEM FIELD.NAME EXPECTED.ITEM.TYPE) (* DAHJr "31-Mar-84 17:08")
(* This function assumes that ITEM is a proper PROPLIST!
Does an in-line equivalent of a non-checking LISTGET.)
(* * OLD WAY (COND ((NULL ITEM) NIL) ((NLISTP ITEM) (ERROR "Non-list item in GET.FIELD: " ITEM))
((NOT (LITATOM FIELD.NAME)) (ERROR "Non-atomic field name in GET.FIELD: " FIELD.NAME)) ((AND EXPECTED.ITEM.TYPE
(NEQ EXPECTED.ITEM.TYPE (ITEM.TYPE ITEM))) (ERROR "Type mismatch in GET.FIELD: " (LIST EXPECTED.ITEM.TYPE
FIELD.NAME ITEM))) (T (PROG ((PREV ITEM) (TAIL ITEM)) LOOP (COND ((NULL TAIL) (SETQ TAIL (GET.FIELD.DEFAULT ITEM
FIELD.NAME)) (* CACHEING DISABLED: (RPLACD (CDR PREV) (LIST FIELD.NAME TAIL))) (RETURN TAIL))
((EQ FIELD.NAME (CAR TAIL)) (RETURN (CADR TAIL))) (T (SETQ TAIL (CDDR (SETQ PREV TAIL))) (GO LOOP)))))))
(* * OPEN.CODE (PROG ((PREV ITEM) (TAIL ITEM)) LOOP (COND ((NULL TAIL) (RETURN (GET.FIELD.DEFAULT ITEM FIELD.NAME)
)) ((EQ FIELD.NAME (CAR TAIL)) (RETURN (CADR TAIL))) (T (SETQ TAIL (CDDR (SETQ PREV TAIL))) (GO LOOP)))))
(* * (OR (LISTGET ITEM FIELD.NAME) (GET.FIELD.DEFAULT ITEM FIELD.NAME)))
(* * COUNTING (PROG ((PREV (CDDR ITEM)) TAIL (X 0)) (SETQ TAIL PREV) LOOP (SETQ X (ADD1 X))
(COND ((NULL TAIL) (SETQ LEN (CONS (LIST X (IQUOTIENT (LENGTH ITEM) 2)) LEN)) (RETURN (GET.FIELD.DEFAULT ITEM
FIELD.NAME))) ((EQ FIELD.NAME (CAR TAIL)) (SETQ LEN (CONS (LIST X (IQUOTIENT (LENGTH ITEM) 2)) LEN))
(RETURN (CADR TAIL))) (T (SETQ TAIL (CDDR (SETQ PREV TAIL))) (GO LOOP)))))
(PROG ((PREV ITEM)
(TAIL ITEM))
LOOP(COND
((NULL TAIL)
(RETURN (GET.FIELD.DEFAULT ITEM FIELD.NAME)))
[(EQ FIELD.NAME (CAR TAIL))
(RETURN (OR (CADR TAIL)
(GET.FIELD.DEFAULT ITEM FIELD.NAME]
(T (SETQ TAIL (CDDR (SETQ PREV TAIL)))
(GO LOOP])
(OLD.TRILLIUM.PRINTOUT
[NLAMBDA SPECS (* DAHJr "23-JAN-83 16:17")
(* ACTS LIKE PRINTOUT FOR SOME CASES; IF TRILLIUM.CLEARPROMPT IS T THEN CLEARS THE WINDOW, OTHERWISE PUTS IN AN
AUTOMATIC CR; FIRST SPEC MAY BE A KEYWORD: SAME.LINE -
NO INITIAL CR; SAME.BLOCK -
NEVER CLEARS THE WINDOW;)
(DECLARE (GLOBALVARS PROMPTWINDOW TRILLIUM.CLEARPROMPT TRILLIUM.HAVE.PROMPTED))
(PROG (SPCS)
(SETQ SPCS (COND
((LISTP SPECS)
(SELECTQ (CAR SPECS)
(SAME.LINE (CDR SPECS))
(SAME.BLOCK (TERPRI PROMPTWINDOW)
(CDR SPECS))
(PROGN (COND
(TRILLIUM.CLEARPROMPT (CLEARW PROMPTWINDOW))
(T (TERPRI PROMPTWINDOW)))
SPECS)))
(T (COND
(TRILLIUM.CLEARPROMPT (CLEARW PROMPTWINDOW))
(T (TERPRI PROMPTWINDOW)))
SPECS)))
[for SPEC in SPCS do (COND
((EQ SPEC T)
(TERPRI PROMPTWINDOW))
((STRINGP SPEC)
(TRILLIUM.PRINTOUT.STRING SPEC))
((NUMBERP SPEC)
(SPACES SPEC PROMPTWINDOW))
(T (PRIN1 (EVAL SPEC)
PROMPTWINDOW]
(SETQ TRILLIUM.HAVE.PROMPTED T])
(SWITCHSCREENS
[LAMBDA (DSP) (* HaKo "15-Aug-84 16:40")
(* DAHJr "27-OCT-81 19:09")
(DECLARE (GLOBALVARS CURRENT.DSP))
(OBS "Superseded by SWITCH.DSP")
(PROG1 CURRENT.DSP (SETQ CURRENT.DSP DSP])
(TF
[LAMBDA (OBJ FPTYPE SRC) (* HaKo " 8-Jun-84 15:59")
(TRILLIUM.FIX OBJ FPTYPE SRC)
(COND
((GETDEF OBJ FPTYPE SRC (QUOTE (NOERROR NOCOPY NODWIM)))
(EDITDEF OBJ FPTYPE])
(TRILLIUM.ADD.DECLARATIONS
[LAMBDA (FILES) (* HaKo "16-Aug-84 17:15")
(DECLARE (GLOBALVARS GLOBALVARS TRILLIUM.FILES))
(for FILE in [OR (MKLIST FILES)
(APPEND TRILLIUM.FILES (QUOTE (TRILLIUM TRI-TOOLS BASIC-PTYPES
PRIMITIVE-ITEMTYPES COMPOSITE-ITEMTYPES]
bind (globalvars specvars def callsfn callsdef vars declptr decls globdecl origglobdecl
specdecl origspecdecl)
first (SETQ globalvars (COPY GLOBALVARS)) when (BOUNDP (FILECOMS FILE))
do (for FN in (FILEFNSLST FILE)
do (SETQ def (GETDEF FN))
(SETQ callsfn (CALLS FN))
(SETQ callsdef (CALLS def))
[SETQ vars (INTERSECTION (LDIFFERENCE (UNION (CADDR callsfn)
(CADDDR callsfn))
(CADR callsfn))
(LDIFFERENCE (UNION (CADDR callsdef)
(CADDDR callsdef))
(CADR callsdef]
(SETQ declptr (CDDR def))
(while (AND declptr (EQ (CAAR declptr)
(QUOTE *)))
do (SETQ declptr (CDR declptr)))
(SETQ decls (CAR declptr))
[SETQ origglobdecl (AND (EQ (CAR decls)
(QUOTE DECLARE))
(FASSOC (QUOTE GLOBALVARS)
(CDR decls]
[SETQ origspecdecl (AND (EQ (CAR decls)
(QUOTE DECLARE))
(FASSOC (QUOTE SPECVARS)
(CDR decls]
(for var in (SETQ globdecl (CDR origglobdecl)) unless (FMEMB var globalvars)
do (SETQ globalvars (CONS var globalvars)))
(SETQ globdecl)
(for var in (SETQ specdecl (CDR origspecdecl)) unless (FMEMB var specvars)
do (SETQ specvars (CONS var specvars)))
(SETQ specdecl)
[for var in vars do (if (FMEMB var globdecl)
then NIL
elseif (FMEMB var specdecl)
then NIL
elseif (FMEMB var globalvars)
then (SETQ globdecl (CONS var globdecl))
elseif (FMEMB var specvars)
then (SETQ specdecl (CONS var specdecl))
elseif (PROGN (printout T T var " (in " FN ")")
(TTYCONFIRM " is a globalvar? "))
then (SETQ globdecl (CONS var globdecl))
(SETQ globalvars (CONS var globalvars))
else (SETQ specdecl (CONS var specdecl))
(SETQ specvars (CONS var specvars]
(SETQ globdecl (SORT (INTERSECTION globdecl globdecl)))
(SETQ specdecl (SORT (INTERSECTION specdecl specdecl)))
(if [OR (NOT (EQUAL globdecl (CDR origglobdecl)))
(NOT (EQUAL specdecl (CDR origspecdecl]
then [if (NEQ (CAR decls)
(QUOTE DECLARE))
then [SETQ decls (NCONC (LIST (QUOTE DECLARE))
(if specdecl
then (LIST (CONS (QUOTE SPECVARS)
specdecl)))
(if globdecl
then (LIST (CONS (QUOTE GLOBALVARS)
globdecl]
(RPLNODE declptr decls (CONS (CAR declptr)
(CDR declptr)))
else (if globdecl
then [if origglobdecl
then (RPLACD origglobdecl globdecl)
else (RPLACD decls (CONS (CONS (QUOTE GLOBALVARS)
globdecl)
(CDR decls]
else (if origglobdecl
then (DREMOVE globdecl origglobdecl)))
(if specdecl
then [if origspecdecl
then (RPLACD origspecdecl specdecl)
else (RPLACD decls (CONS (CONS (QUOTE SPECVARS)
specdecl)
(CDR decls]
else (if origspecdecl
then (DREMOVE specdecl origspecdecl]
(printout T FN " : " 5 decls T)
(PUTDEF FN (QUOTE FNS)
def)
(PUTD FN def])
(TRILLIUM.ADD.TIMESTAMP
[LAMBDA (FN) (* HaKo "15-SEP-83 14:26")
(* PO "15-SEP-83 14:11")
(* Adds a new timestamp to the definition of FN, unless
the initials of the current timestamp are the same as
the current INITIALS)
(DECLARE (GLOBALVARS INITIALS))
(PROG (TIMESTAMP (CURDEF (GETDEF FN)))
(SETQ TIMESTAMP (CADDR CURDEF))
(COND
((OR (NEQ (CAR TIMESTAMP)
(QUOTE *))
(NEQ (CADR TIMESTAMP)
INITIALS))
[PUTDEF FN (QUOTE FNS)
(CONS (CAR CURDEF)
(CONS (CADR CURDEF)
(CONS (LIST (QUOTE *)
INITIALS
(SUBSTRING (DATE)
1 -4))
(CDDR CURDEF]
(RETURN FN])
(TRILLIUM.FIX
[LAMBDA (OBJ FPTYPE SRC) (* HaKo "11-Jun-84 10:54")
(DECLARE (GLOBALVARS FILELST USERNAME))
(PROG [ORIGOBJ (FIXFILE (FILENAMEFIELD (MKATOM (CONCAT "TRI-FIX-" USERNAME))
(QUOTE NAME]
(COND
((NOT (LITATOM OBJ))
(RETURN (ERROR "Can't fix " OBJ)))
((NOT (BOUNDP (FILECOMS FIXFILE)))
(printout T T "Creating file " FIXFILE " ... ")
(for VAR in (QUOTE (TRI.CHANGELOG))
do (OR (BOUNDP VAR)
(SET VAR NIL))
(ADDTOFILE VAR (QUOTE VARS)
FIXFILE)))
((MEMB OBJ (FILECOMSLST FIXFILE FPTYPE))
(RETURN OBJ)))
(COND
((GETDEF OBJ FPTYPE SRC (QUOTE (NOERROR NOCOPY NODWIM)))
(SETQ ORIGOBJ (MKATOM (CONCAT OBJ "!Original")))
(COPYDEF OBJ ORIGOBJ FPTYPE SRC)
(COND
((OR (NULL FPTYPE)
(EQ FPTYPE (QUOTE FNS)))
(TRILLIUM.ADD.TIMESTAMP OBJ)))
(ADDTOFILE ORIGOBJ FPTYPE FIXFILE))
((NOT (TTYCONFIRM "New object? "))
(RETURN)))
(ADDTOFILE OBJ FPTYPE FIXFILE)
(SETQ FILELST (NCONC1 (DREMOVE FIXFILE FILELST)
FIXFILE))
(* So that CLEANUP will first write out the Trillium .DCOM files. Filepkg gets confused sometimes when the same
changed function is in more than one file.)
(RETURN OBJ])
(TRILLIUM.FNS
[LAMBDA NIL (* HaKo "26-Jul-84 11:17")
(* DAHJr "16-FEB-83 12:41")
(DECLARE (GLOBALVARS ALL.TRILLIUM.FILES))
(PROG (FNS FNSSET)
[SETQ FNS (for FILE in ALL.TRILLIUM.FILES join (COPY (FILEFNSLST FILE]
(SETQ FNSSET (INTERSECTION FNS FNS))
(RETURN (COND
((IGREATERP (LENGTH FNS)
(LENGTH FNSSET))
(printout NIL T "There are duplicates" T)
(SORT FNS))
(T (SORT FNSSET])
(TRILLIUM.INDEX
[LAMBDA (INDEXFILE QUIETFLG) (* HaKo "16-Aug-84 13:58")
(DECLARE (GLOBALVARS TRILLIUM.FILES TRILLIUM.INDEX TRILLIUM.INDEX.ROOTFNS
TRILLIUM.INDEX.UNFILED.OBJECTS))
(PROG (LISTING? ENTRY CNT FNSLST (INDEX (CONS (HARRAY 1024)
2))
(TRIFILES (APPEND (QUOTE (TRILLIUM TRI-TOOLS PRIMITIVE-ITEMTYPES
COMPOSITE-ITEMTYPES BASIC-PTYPES))
TRILLIUM.FILES)))
[COND
((BOUNDP (QUOTE TRILLIUM.INDEX))
(OR QUIETFLG (TTYCONFIRM "TRILLIUM.INDEX already bound. Recompute? ")
(RETURN)))
(T (OR QUIETFLG (TTYCONFIRM "Building TRILLIUM.INDEX... [confirm] ")
(RETURN]
(OR QUIETFLG INDEXFILE (SETQ INDEXFILE (QUOTE {DSK}TRI-INDEX.;1)))
(COND
(QUIETFLG (SETQ LISTING? INDEXFILE))
((NOT (TTYCONFIRM (CONCAT "File index on " INDEXFILE "? ")))
(SETQ INDEXFILE))
((TTYCONFIRM "Listing? ")
(SETQ LISTING? INDEXFILE)))
(OR QUIETFLG (printout T T "Collecting:" T))
[for FPTYPE
in (QUOTE (ADVICE ALISTS EXPRESSIONS FIELDS FILEPKGCOMS GLOBALRESOURCES I.S.OPRS
ITEMTYPES MACROS PTYPES RECORDS TEMPLATES USERMACROS VARS INTERFACES
DIALOGS))
do (COND
((NOT QUIETFLG)
(SETQ CNT 0)
(printout T 5 FPTYPE " ...")))
[for TRIFILE in TRIFILES when (BOUNDP (FILECOMS TRIFILE))
do (for OBJ in (FILECOMSLST TRIFILE FPTYPE)
do (OR QUIETFLG (SETQ CNT (ADD1 CNT)))
(COND
[[AND (LISTP OBJ)
(MEMB (CAR OBJ)
(QUOTE (SETQ SETQQ RPAQQ RPAQ?]
(SETQ ENTRY (TRILLIUM.INDEX.FIND.ENTRY INDEX (CADR OBJ)
(QUOTE VARS)))
(TRILLIUM.INDEX.ADD.FIELD ENTRY (QUOTE filed-on)
TRIFILE)
(TRILLIUM.INDEX.ADD.FIELD ENTRY (QUOTE initial-value)
(OR (CADDR OBJ)
(QUOTE NILL]
(T (SETQ ENTRY (TRILLIUM.INDEX.FIND.ENTRY INDEX OBJ FPTYPE))
(TRILLIUM.INDEX.ADD.FIELD ENTRY (QUOTE filed-on)
TRIFILE]
(COND
((NOT QUIETFLG)
(printout T 30 .I4 CNT T]
(COND
((NOT QUIETFLG)
(SETQ CNT 0)
(printout T 5 "FNS ...")))
[for TRIFILE in TRIFILES when (BOUNDP (FILECOMS TRIFILE))
bind (ENTRY CALLSFN CALLEES LVARS FVARS GVARS DONTVARS USES)
first (SETQ DONTVARS
(QUOTE (%%BITMAPTYPE# %%MENUTYPE# ADVISEDFNS BackgroundMenu
BackgroundMenuCommands CHANGESARRAY COMPILE.EXT COUTFILE
FILELST FILEPKGTYPES FULLPRESSPRINTER GREETHIST INITIALS
LASTMOUSEBUTTONS LASTMOUSEX LASTMOUSEY LOGINHOST/DIR
NOTCOMPILEDFILES NOTLISTEDFILES PROMPTWINDOW
RESETVARSLST SCREENHEIGHT SCREENWIDTH ScreenBitMap
USERNAME WHOLECOLORDISPLAY \CONNECTED.DIR
\CONNECTED.HOST \EM.KBDAD2 \FONTSINCORE)))
do (for FN in (FILEFNSLST TRIFILE)
do (OR QUIETFLG (SETQ CNT (ADD1 CNT)))
(SETQ FNSLST (CONS FN FNSLST))
(SETQ ENTRY (TRILLIUM.INDEX.FIND.ENTRY INDEX FN (QUOTE FNS)))
(TRILLIUM.INDEX.ADD.FIELD ENTRY (QUOTE filed-on)
TRIFILE)
(SETQ CALLSFN (CALLS FN))
(SETQ CALLEES (CAR CALLSFN))
(SETQ LVARS (CADR CALLSFN))
(SETQ FVARS (CADDR CALLSFN))
(SETQ GVARS (CADDDR CALLSFN))
(for CALLEE in CALLEES do (TRILLIUM.INDEX.ADD.FIELD ENTRY (QUOTE calls)
CALLEE))
(for FREEVAR in FVARS unless (OR (FMEMB FREEVAR LVARS)
(FMEMB FREEVAR DONTVARS))
do (TRILLIUM.INDEX.ADD.FIELD ENTRY (QUOTE uses-freely)
FREEVAR))
(for GLOBALVAR in GVARS unless (FMEMB GLOBALVAR DONTVARS)
do (TRILLIUM.INDEX.ADD.FIELD ENTRY (QUOTE uses-globally)
GLOBALVAR]
(COND
((NOT QUIETFLG)
(printout T 30 .I4 CNT T)))
(OR QUIETFLG (printout T T "Cross-indexing FNS and VARS ..."))
[MAPHASH INDEX (FUNCTION (LAMBDA (ENTRYLST NAME)
(for TYPEENTRYPAIR in ENTRYLST bind (ENTRY CALLEES)
when (EQ (CAR TYPEENTRYPAIR)
(QUOTE FNS))
do (SETQ ENTRY (CDR TYPEENTRYPAIR))
[COND
([CDR (SETQ CALLEES (FASSOC (QUOTE calls)
(CDR ENTRY]
[RPLACD CALLEES (SORT (INTERSECTION FNSLST (CDR CALLEES]
(for FN in (CDR CALLEES) do (TRILLIUM.INDEX.ADD.FIELD
(TRILLIUM.INDEX.FIND.ENTRY
INDEX FN (QUOTE FNS))
(QUOTE called-by)
NAME]
(for VAR in (CDR (FASSOC (QUOTE uses-freely)
ENTRY))
do (TRILLIUM.INDEX.ADD.FIELD (TRILLIUM.INDEX.FIND.ENTRY INDEX VAR
(QUOTE VARS))
(QUOTE used-freely-by)
NAME))
(for VAR in (CDR (FASSOC (QUOTE uses-globally)
ENTRY))
do (TRILLIUM.INDEX.ADD.FIELD (TRILLIUM.INDEX.FIND.ENTRY INDEX VAR
(QUOTE VARS))
(QUOTE used-globally-by)
NAME]
(OR QUIETFLG (printout T " done." T T "Sorting index ..."))
(SETQ TRILLIUM.INDEX)
[MAPHASH INDEX (FUNCTION (LAMBDA (ENTRYLST NAME)
(SETQ TRILLIUM.INDEX (CONS (CONS NAME ENTRYLST)
TRILLIUM.INDEX]
(SORT TRILLIUM.INDEX T)
(SETQ TRILLIUM.INDEX.ROOTFNS)
(SETQ TRILLIUM.INDEX.UNFILED.OBJECTS)
(SETQ TRILLIUM.INDEX (for NAMEENTRYLSTPAIR in TRILLIUM.INDEX bind (NAME ENTRYLST)
join (SETQ NAME (CAR NAMEENTRYLSTPAIR))
(SETQ ENTRYLST (CDR NAMEENTRYLSTPAIR))
(for TYPEENTRYPAIR in ENTRYLST bind (TYPE ENTRY)
collect (SETQ TYPE (CAR TYPEENTRYPAIR))
(SETQ ENTRY (CDR TYPEENTRYPAIR))
[COND
([AND (EQ TYPE (QUOTE FNS))
(NULL (CDR (FASSOC (QUOTE called-by)
(CDR ENTRY]
(SETQ TRILLIUM.INDEX.ROOTFNS (CONS ENTRY
TRILLIUM.INDEX.ROOTFNS]
[COND
([NULL (CDR (FASSOC (QUOTE filed-on)
(CDR ENTRY]
(SETQ TRILLIUM.INDEX.UNFILED.OBJECTS
(CONS ENTRY TRILLIUM.INDEX.UNFILED.OBJECTS]
ENTRY)))
(SETQ TRILLIUM.INDEX.ROOTFNS (DREVERSE TRILLIUM.INDEX.ROOTFNS))
(SETQ TRILLIUM.INDEX.UNFILED.OBJECTS (DREVERSE TRILLIUM.INDEX.UNFILED.OBJECTS))
(OR QUIETFLG (printout T " done." T T "=> Index stored on TRILLIUM.INDEX" T))
[COND
(INDEXFILE (OR QUIETFLG (printout T T "Creating " INDEXFILE " ... "))
[SET (FILECOMS INDEXFILE)
(COPYALL (QUOTE ((VARS TRILLIUM.INDEX TRILLIUM.INDEX.ROOTFNS
TRILLIUM.INDEX.UNFILED.OBJECTS]
(MAKEFILE INDEXFILE)
(OR QUIETFLG (printout T " done." T))
(COND
(LISTING? (OR QUIETFLG (printout T T "Listing " INDEXFILE " ... "))
(APPLY* (FUNCTION LISTFILES)
INDEXFILE)
(OR QUIETFLG (printout T " done." T]
(OR QUIETFLG (printout T T "Trillium index complete!" T])
(TRILLIUM.INDEX.ADD.FIELD
[LAMBDA (ENTRY FIELDNAME NEWMEMBER) (* HaKo "16-Aug-84 13:57")
(PROG (FIELD)
[COND
((NULL NEWMEMBER)
(RETURN ENTRY))
[(NULL (SETQ FIELD (FASSOC FIELDNAME ENTRY)))
(NCONC1 ENTRY (SETQ FIELD (LIST FIELDNAME NEWMEMBER]
(T (RPLACD FIELD (MERGEINSERT NEWMEMBER (CDR FIELD)
T]
(RETURN ENTRY])
(TRILLIUM.INDEX.FIND.ENTRY
[LAMBDA (INDEX OBJ FPTYPE) (* HaKo " 8-Jun-84 16:34")
(PROG (ENTRY (ENTRYLST (GETHASH OBJ INDEX)))
(COND
([NULL (SETQ ENTRY (CDR (FASSOC FPTYPE ENTRYLST]
(SETQ ENTRY (LIST OBJ (LIST (QUOTE type)
FPTYPE)))
(PUTHASH OBJ (NCONC1 ENTRYLST (CONS FPTYPE ENTRY))
INDEX)))
(RETURN ENTRY])
(TRILLIUM.LOADING.INSTRUCTIONS
[LAMBDA NIL (* DAHJr "24-JAN-83 13:32")
(PROG (WINDOW INSTRUCTIONS (WIDTH 450)
(HEIGHT 430))
[SETQ INSTRUCTIONS (QUOTE (("Load bootstrap file (possibly already done):"
"LOAD({fileserver}<directories>TRILLIUM.DCOM)"
"<Directories> has the form: <name>name> ... >name>."
"{Fileserver} and <directories> may be omitted"
" if they are the same as where you are connected.")
("Load the Trillium systems files:" "(TRILLIUM.LOAD.FILES)")
("Initialize Trillium:" "(TRILLIUM.INIT)")
("Open a Trillium command window:" "either type (TRILLIUM)"
"or select TRILLIUM on the background menu")
("Load files containing itemtypes and interfaces:"
"select LOADING.&.MAKING.FILES in the command window"
"connect by selecting CONNECT.TO.HOST/DIRECTORY"
"load files by selecting LOAD.FILE"
" eg. PRIMITIVE-ITEMTYPES"
" eg. COMPOSITE-ITEMTYPES"
" eg. DEMO-INTERFACE"
"select QUIT when finished loading files")
("Compile some functions to gain efficiency"
"(TRILLIUM.COMPILE.ITEMTYPE.FNS)")
("Run Trillium; good luck!"]
(SETQ WINDOW (CREATEW (LIST 100 100 WIDTH HEIGHT)
"Trillium loading instructions"))
(DSPFONT (FONTCREATE (QUOTE HELVETICA)
12
(QUOTE BOLD))
WINDOW)
(for INSTRUCTION in INSTRUCTIONS
do (SPACES 1 WINDOW)
(PRIN3 (CAR INSTRUCTION)
WINDOW)
(TERPRI WINDOW)
(for DETAIL in (CDR INSTRUCTION)
do (SPACES 4 WINDOW)
(PRIN3 DETAIL WINDOW)
(TERPRI WINDOW))
(TERPRI WINDOW))
(WINDOWPROP WINDOW (QUOTE RESHAPEFN)
(QUOTE DON'T))
(MOVEW WINDOW)
(RETURN])
(TRILLIUM.LIST
[NLAMBDA FILELST.OR.ALLFLG (* HK "21-JUN-82 13:03")
(* If called without args, lists all Trillium files that have changed since the last listing was made.
If called with file names, lists those, or if called with T, lists all Trillium files)
(DECLARE (GLOBALVARS TRI.LISTING.DATE TRILLIUM.FILES))
(PROG ((TRIFILES (CONS (QUOTE TRILLIUM)
TRILLIUM.FILES))
(PREVLISTIDATE (COND
((BOUNDP (QUOTE TRI.LISTING.DATE))
(IDATE TRI.LISTING.DATE))
(T 0)))
FDPROP)
(COND
[(NULL FILELST.OR.ALLFLG)
(SETQ TRIFILES (for F in TRIFILES
join (AND [ILESSP PREVLISTIDATE
(IDATE (CAR (SETQ FDPROP
(CAR (GETPROP F (QUOTE FILEDATES]
(LIST (CDR FDPROP]
((NEQ (CAR FILELST.OR.ALLFLG)
T)
(SETQ TRIFILES FILELST.OR.ALLFLG)))
(COND
((NULL TRIFILES)
(printout T "No Trillium files changed since the last listing on " TRI.LISTING.DATE T)
NIL)
((EQ (QUOTE Y)
(ASKUSER 8 (QUOTE N)
(CONS "Listing of files: " TRIFILES)))
(APPLY (FUNCTION LISTFILES)
TRIFILES)
(SETQ TRI.LISTING.DATE (DATE))
(MARKASCHANGED (QUOTE TRI.LISTING.DATE)
(QUOTE VARS))
(RETURN TRI.LISTING.DATE])
(TRILLIUM.LOG
[NLAMBDA MODS (* HK "23-JUN-82 09:46")
(* To maintain a log of changes made to Trillium.
Records initials, date and comment from arg or prompt.)
(DECLARE (GLOBALVARS INITIALS TRI.CHANGELOG))
(PROG ((MODLST MODS))
(OR MODLST (RETURN))
(SETQ MODLST (NCONC (LIST (QUOTE *)
INITIALS
(DATE))
MODLST))
(SETQ TRI.CHANGELOG (CONS MODLST TRI.CHANGELOG))
(MARKASCHANGED (QUOTE TRI.CHANGELOG)
(QUOTE VARS))
(RETURN MODLST])
(TRILLIUM.MOVE.FILE
[LAMBDA (FILE FROM.HOST/DIRECTORY TO.HOST/DIRECTORY MOVE.ONLY.IF.NEWER NO.CONFIRMATION.REQUIRED)
(* HaKo " 8-SEP-83 12:25")
(PROG (FILE.FIELDS FILE.NAME FILE.EXTENSION FROM.FIELDS FROM.HOST FROM.DIRECTORY TO.FIELDS
TO.HOST TO.DIRECTORY FROM.FILE TO.FILE FROM.FILE.FULL.NAME TO.FILE.FULL.NAME
COPY.FILE.NAME)
(SETQ FILE.FIELDS (UNPACKFILENAME FILE))
(SETQ FILE.NAME (LISTGET FILE.FIELDS (QUOTE NAME)))
(SETQ FILE.EXTENSION (LISTGET FILE.FIELDS (QUOTE EXTENSION)))
(SETQ FROM.FIELDS (UNPACKFILENAME FROM.HOST/DIRECTORY))
(SETQ FROM.HOST (LISTGET FROM.FIELDS (QUOTE HOST)))
(SETQ FROM.DIRECTORY (LISTGET FROM.FIELDS (QUOTE DIRECTORY)))
(SETQ TO.FIELDS (UNPACKFILENAME TO.HOST/DIRECTORY))
(SETQ TO.HOST (LISTGET TO.FIELDS (QUOTE HOST)))
(SETQ TO.DIRECTORY (LISTGET TO.FIELDS (QUOTE DIRECTORY)))
(SETQ FROM.FILE (PACKFILENAME (QUOTE HOST)
FROM.HOST
(QUOTE DIRECTORY)
FROM.DIRECTORY
(QUOTE NAME)
FILE.NAME
(QUOTE EXTENSION)
FILE.EXTENSION))
(SETQ TO.FILE (PACKFILENAME (QUOTE HOST)
TO.HOST
(QUOTE DIRECTORY)
TO.DIRECTORY
(QUOTE NAME)
FILE.NAME
(QUOTE EXTENSION)
FILE.EXTENSION))
(SETQ FROM.FILE.FULL.NAME (INFILEP FROM.FILE))
(RETURN (COND
((NULL FROM.FILE.FULL.NAME)
(printout NIL T "Cannot find file " FROM.FILE ": ignoring request")
(LIST (QUOTE COULDNT.FIND)
FROM.FILE))
([AND MOVE.ONLY.IF.NEWER (NOT (GREATERP (GETFILEINFO FROM.FILE.FULL.NAME
(QUOTE ICREATIONDATE))
(GETFILEINFO TO.FILE (QUOTE ICREATIONDATE]
(LIST (QUOTE ALREADY.CURRENT)
FROM.FILE))
((OR NO.CONFIRMATION.REQUIRED (TTYCONFIRM (CONCAT "Move " FROM.FILE.FULL.NAME
" to "
TO.FILE "? ")))
(printout NIL T " " FROM.FILE.FULL.NAME " => ")
(SETQ COPY.FILE.NAME (COPYFILE FROM.FILE.FULL.NAME TO.FILE))
(printout NIL COPY.FILE.NAME)
(LIST (QUOTE MOVED)
FROM.FILE COPY.FILE.NAME))
(T (LIST (QUOTE DIDNT.MOVE)
FROM.FILE])
(TRILLIUM.MOVE.FILE.REMOTE
[LAMBDA (FILE FROM.HOST/DIRECTORY TO.HOST/DIRECTORY MOVE.ONLY.IF.NEWER REPORT.IN.WINDOW)
(* edited: "17-FEB-83 15:43")
(PROG (PROC WINDOW)
[COND
(REPORT.IN.WINDOW (SETQ WINDOW (CREATEW NIL (CONCAT "Remote copy of " FILE " from "
FROM.HOST/DIRECTORY " to "
TO.HOST/DIRECTORY]
(RETURN (ADD.PROCESS (BQUOTE (TRILLIUM.MOVE.FILE , (KWOTE FILE)
,
(KWOTE FROM.HOST/DIRECTORY)
,
(KWOTE TO.HOST/DIRECTORY)
,
(KWOTE MOVE.ONLY.IF.NEWER)
T))
FILE NIL (BQUOTE (REMOTEORLOCAL (REMOTECONTEXT (FILES
<AHENDERSON>LISP>TRILLIUM.DCOM))
(TTY , WINDOW])
(TRILLIUM.MOVE.FILES
[LAMBDA (FROM.HOST/DIRECTORY TO.HOST/DIRECTORY MOVE.ONLY.IF.NEWER NO.CONFIRMATION.REQUIRED)
(* edited: "17-FEB-83 16:33")
(DECLARE (GLOBALVARS COMPILE.EXT TRILLIUM.FILES))
(PROG (RESULTS)
(SETQ RESULTS (CONS))
(for FILE in (CONS (QUOTE TRILLIUM)
TRILLIUM.FILES)
do (TCONC RESULTS (TRILLIUM.MOVE.FILE FILE FROM.HOST/DIRECTORY TO.HOST/DIRECTORY
MOVE.ONLY.IF.NEWER NO.CONFIRMATION.REQUIRED))
(TCONC RESULTS (TRILLIUM.MOVE.FILE (PACKFILENAME (QUOTE NAME)
FILE
(QUOTE EXTENSION)
COMPILE.EXT)
FROM.HOST/DIRECTORY TO.HOST/DIRECTORY
MOVE.ONLY.IF.NEWER NO.CONFIRMATION.REQUIRED)))
(for FILE in (QUOTE (PRIMITIVE-ITEMTYPES COMPOSITE-ITEMTYPES DEMO-INTERFACE))
do (TCONC RESULTS (TRILLIUM.MOVE.FILE FILE FROM.HOST/DIRECTORY TO.HOST/DIRECTORY
MOVE.ONLY.IF.NEWER NO.CONFIRMATION.REQUIRED)))
(RETURN (CAR RESULTS])
(TRILLIUM.MOVE.FILES.REMOTE
[LAMBDA (FROM.HOST/DIRECTORY TO.HOST/DIRECTORY MOVE.ONLY.IF.NEWER REPORT.IN.WINDOW)
(* edited: "17-FEB-83 15:44")
(PROG (PROC WINDOW)
[COND
(REPORT.IN.WINDOW (SETQ WINDOW (CREATEW NIL (CONCAT
"Remote copy of all Trillium files from "
FROM.HOST/DIRECTORY " to "
TO.HOST/DIRECTORY]
(RETURN (ADD.PROCESS (BQUOTE (TRILLIUM.MOVE.FILES , (KWOTE FROM.HOST/DIRECTORY)
,
(KWOTE TO.HOST/DIRECTORY)
,
(KWOTE MOVE.ONLY.IF.NEWER)
T))
(QUOTE ALL.FILES)
NIL
(BQUOTE (REMOTEORLOCAL (REMOTECONTEXT (FILES
<AHENDERSON>LISP>TRILLIUM.DCOM))
(TTY , WINDOW])
(TRILLIUM.MOVE.FILES.REMOTELY
[LAMBDA (FROM.HOST/DIRECTORY TO.HOST/DIRECTORY MOVE.ONLY.IF.NEWER REPORT.IN.WINDOWS)
(* edited: "17-FEB-83 16:33")
(DECLARE (GLOBALVARS COMPILE.EXT TRILLIUM.FILES))
(PROG (PROCESSES RESULTS RESULT)
(SETQ PROCESSES (CONS))
(for FILE in (CONS (QUOTE TRILLIUM)
TRILLIUM.FILES)
do (TCONC PROCESSES (TRILLIUM.MOVE.FILE.REMOTE FILE FROM.HOST/DIRECTORY
TO.HOST/DIRECTORY MOVE.ONLY.IF.NEWER
REPORT.IN.WINDOWS))
(BLOCK)
(TCONC PROCESSES (TRILLIUM.MOVE.FILE.REMOTE (PACKFILENAME (QUOTE NAME)
FILE
(QUOTE EXTENSION)
COMPILE.EXT)
FROM.HOST/DIRECTORY TO.HOST/DIRECTORY
MOVE.ONLY.IF.NEWER REPORT.IN.WINDOWS))
(BLOCK))
(for FILE in (QUOTE (PRIMITIVE-ITEMTYPES COMPOSITE-ITEMTYPES DEMO-INTERFACE))
do (TCONC PROCESSES (TRILLIUM.MOVE.FILE.REMOTE FILE FROM.HOST/DIRECTORY
TO.HOST/DIRECTORY MOVE.ONLY.IF.NEWER
REPORT.IN.WINDOWS))
(BLOCK))
(SETQ PROCESSES (CAR PROCESSES))
(SETQ RESULTS (CONS))
(while PROCESSES do (for PROCESS in PROCESSES
do [COND
((PROCESS.FINISHEDP PROCESS)
(SETQ RESULT (PROCESS.RESULT PROCESS))
(printout NIL T RESULT)
(TCONC RESULTS RESULT)
(SETQ PROCESSES (DREMOVE PROCESS PROCESSES]
(BLOCK)))
(RETURN (CAR RESULTS])
(TRILLIUM.MOVE.FILES.REMOTELY.REMOTE
[LAMBDA (FROM.HOST/DIRECTORY TO.HOST/DIRECTORY MOVE.ONLY.IF.NEWER REPORT.IN.WINDOW)
(* edited: "17-FEB-83 15:46")
(PROG (PROC WINDOW)
[COND
(REPORT.IN.WINDOW (SETQ WINDOW (CREATEW NIL (CONCAT
"Remote copy of all Trillium files from "
FROM.HOST/DIRECTORY " to "
TO.HOST/DIRECTORY]
(RETURN (ADD.PROCESS (BQUOTE (TRILLIUM.MOVE.FILES.REMOTELY , (KWOTE FROM.HOST/DIRECTORY)
,
(KWOTE TO.HOST/DIRECTORY)
,
(KWOTE MOVE.ONLY.IF.NEWER)))
(QUOTE ALL.FILES)
NIL
(BQUOTE (REMOTEORLOCAL (REMOTECONTEXT (FILES
<AHENDERSON>LISP>TRILLIUM.DCOM))
(TTY , WINDOW])
(TRILLIUM.RELEASE
[LAMBDA (ALL.REMOTE INDIVIDUALLY.REMOTE REPORT.IN.WINDOW MOVE.ONLY.IF.NEWER FROM.HOST/DIRECTORY
TO.HOST/DIRECTORY CONFIRMATION.REQUIRED)
(* edited: "17-FEB-83 16:19")
(DECLARE (GLOBALVARS TRILLIUM.RELEASE.HOST/DIRECTORY))
(PROG (FH TH)
(SETQ FH (OR FROM.HOST/DIRECTORY (QUOTE <AHENDERSON>LISP>)))
(SETQ TH (OR TO.HOST/DIRECTORY TRILLIUM.RELEASE.HOST/DIRECTORY))
(RETURN (COND
[ALL.REMOTE (COND
(INDIVIDUALLY.REMOTE (TRILLIUM.MOVE.FILES.REMOTELY.REMOTE FH TH
MOVE.ONLY.IF.NEWER
REPORT.IN.WINDOW))
(T (TRILLIUM.MOVE.FILES.REMOTE FH TH MOVE.ONLY.IF.NEWER
REPORT.IN.WINDOW]
(T (COND
(INDIVIDUALLY.REMOTE (TRILLIUM.MOVE.FILES.REMOTELY FH TH MOVE.ONLY.IF.NEWER
REPORT.IN.WINDOW))
(T (TRILLIUM.MOVE.FILES FH TH MOVE.ONLY.IF.NEWER (NOT CONFIRMATION.REQUIRED])
(TRILLIUM.WHEREIS
[LAMBDA (FNS) (* DAHJr "16-FEB-83 12:45")
(for FN in FNS collect (LIST FN (WHEREIS FN])
(WALK.ITEMS.OF.ITEM
[LAMBDA (ITEM ACTIONFN CONTEXT) (* HaKo "15-Aug-84 15:03")
(OBS "Superseded by WALK.ITEM")
(PROG (ITYPE PARAMETERS SUBITEMS VALUE)
(APPLY* ACTIONFN ITEM CONTEXT)
(SETQ ITYPE (ITEM.TYPE ITEM))
(SETQ PARAMETERS (GET.FIELDQ (ITEM.TYPE.DESCRIPTION ITYPE)
PARAMETERS ITEM.TYPE))
(SETQ SUBITEMS (for PARAMETER in PARAMETERS when (SETQ VALUE (GET.FIELD ITEM
(GET.FIELDQ
PARAMETER
NAME)))
do (WALK.ITEMS.OF.VALUE/PTYPE VALUE (GET.FIELDQ PARAMETER TYPE)
ACTIONFN CONTEXT)))
(RETURN])
(WALK.OBJECTS.OF.FRAME
[LAMBDA (FRAME ACTIONFN CONTEXT) (* HaKo "15-Aug-84 14:11")
(* edited: "20-May-84 13:19")
(OBS "Superseded by WALK.FRAME")
(for ITEM in (GET.FIELDQ FRAME ITEMS) thereis (WALK.OBJECTS.OF.OBJECT ITEM (QUOTE (ITEM))
NIL ACTIONFN CONTEXT])
(WALK.OBJECTS.OF.INTERFACE
[LAMBDA (INTERFACE ACTIONFN CONTEXT) (* HaKo "15-Aug-84 14:10")
(* edited: "20-May-84 12:44")
(OBS "Superseded by WALK.INTERFACE")
(for FRAME in (GET.FIELDQ INTERFACE FRAMES) THEREIS (WALK.OBJECTS.OF.FRAME FRAME ACTIONFN CONTEXT]
)
(WALK.OBJECTS.OF.OBJECT
[LAMBDA (OBJECT PTYPE HOLDER ACTIONFN CONTEXT) (* HaKo "15-Aug-84 15:03")
(OBS "Superseded by WALK.OBJECT")
(PROG (ITYPE PARAMETERS PNAME ENTRY SUB.TYPE)
(RETURN (COND
((APPLY* ACTIONFN OBJECT PTYPE HOLDER CONTEXT))
(T (COND
[(OR (NLISTP PTYPE)
(EQ (CAR PTYPE)
(QUOTE ITEM))) (* THE OBJECT IS AN ITEM)
(SETQ ITYPE (ITEM.TYPE OBJECT))
(SETQ PARAMETERS (GET.FIELDQ (ITEM.TYPE.DESCRIPTION ITYPE)
PARAMETERS ITEM.TYPE))
(for PARAMETER in PARAMETERS
thereis (SETQ PNAME (GET.FIELDQ PARAMETER NAME))
(AND (SETQ ENTRY (for ENT on OBJECT by (CDDR ENT)
thereis (EQ (CAR ENT)
PNAME)))
(WALK.OBJECTS.OF.OBJECT (CADR ENTRY)
(GET.FIELDQ PARAMETER TYPE)
(CDR ENTRY)
ACTIONFN CONTEXT]
(T (* THE OBJECT IS AN INSTANCE OF A PTYPE)
(SELECTQ (CAR PTYPE)
(LIST (SETQ SUB.TYPE (CADR PTYPE))
(for SUB.ENT on OBJECT thereis (WALK.OBJECTS.OF.OBJECT
(CAR SUB.ENT)
SUB.TYPE SUB.ENT ACTIONFN
CONTEXT)))
(STRUCTURE (for FIELD in (CADR PTYPE) as SUB.ENT on OBJECT
thereis (WALK.OBJECTS.OF.OBJECT (CAR SUB.ENT)
(CADR FIELD)
SUB.ENT ACTIONFN
CONTEXT)))
NIL])
(WALK.TRILLIUM.FNS
[LAMBDA (LOOK.FOR.FORM APPLYFN FILES) (* HaKo "16-Aug-84 17:14")
(DECLARE (GLOBALVARS TRILLIUM.FILES))
(for FILE in [OR (MKLIST FILES)
(APPEND TRILLIUM.FILES (QUOTE (TRILLIUM TRI-TOOLS BASIC-PTYPES
PRIMITIVE-ITEMTYPES COMPOSITE-ITEMTYPES]
bind [EDITCOMS ←(BQUOTE ((EXAM , LOOK.FOR.FORM] when (BOUNDP (FILECOMS FILE))
do (for FN in (FILEFNSLST FILE) do (WALK.TRILLIUM.FNS.DESCEND LOOK.FOR.FORM FN APPLYFN
EDITCOMS (GETDEF FN])
(WALK.TRILLIUM.FNS.DESCEND
[LAMBDA (LOOK.FOR.FORM FN APPLYFN EDITCOMS FORM) (* HaKo "27-Jul-84 15:10")
(if (MEMBER LOOK.FOR.FORM FORM)
then (if APPLYFN
then (APPLY* APPLYFN FORM FN)
NIL
else (EDITDEF FN NIL NIL EDITCOMS)
T)
else (for SUBFORM in FORM when (LISTP SUBFORM) when (WALK.TRILLIUM.FNS.DESCEND LOOK.FOR.FORM FN
APPLYFN EDITCOMS
SUBFORM)
do (RETURN T])
)
(RPAQQ LEN NIL)
(RPAQQ ALTERNATE.SCREEN NIL)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA TRILLIUM.LOG TRILLIUM.LIST OLD.TRILLIUM.PRINTOUT CHECK.FREEVARS)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (1356 45426 (ADD.NV.PAIR 1366 . 1977) (CHECK.FREEVARS 1979 . 2940) (
CLEAR.ALTERNATE.SCREEN 2942 . 3366) (COMPARE.TRILLIUMS 3368 . 4049) (COMPAREFILES 4051 . 5726) (
COMPAREFNS 5728 . 5971) (COPY.FROM.ALTERNATE.SCREEN 5973 . 6445) (COPY.TO.ALTERNATE.SCREEN 6447 . 6875
) (COUNT.ITEMS 6877 . 7161) (COUNT.ITEMS1 7163 . 7611) (COUNT.RATIO 7613 . 7984) (LOAD.TRILLIUM 7986
. 8330) (MAKE.ALTERNATE.SCREEN 8332 . 8797) (OLD.EDIT.FRAME 8799 . 10751) (OLD.GET.FIELD 10753 .
12783) (OLD.TRILLIUM.PRINTOUT 12785 . 13959) (SWITCHSCREENS 13961 . 14291) (TF 14293 . 14526) (
TRILLIUM.ADD.DECLARATIONS 14528 . 18129) (TRILLIUM.ADD.TIMESTAMP 18131 . 19021) (TRILLIUM.FIX 19023 .
20382) (TRILLIUM.FNS 20384 . 20973) (TRILLIUM.INDEX 20975 . 28066) (TRILLIUM.INDEX.ADD.FIELD 28068 .
28473) (TRILLIUM.INDEX.FIND.ENTRY 28475 . 28883) (TRILLIUM.LOADING.INSTRUCTIONS 28885 . 30920) (
TRILLIUM.LIST 30922 . 32254) (TRILLIUM.LOG 32256 . 32909) (TRILLIUM.MOVE.FILE 32911 . 35209) (
TRILLIUM.MOVE.FILE.REMOTE 35211 . 35998) (TRILLIUM.MOVE.FILES 36000 . 37068) (
TRILLIUM.MOVE.FILES.REMOTE 37070 . 37872) (TRILLIUM.MOVE.FILES.REMOTELY 37874 . 39413) (
TRILLIUM.MOVE.FILES.REMOTELY.REMOTE 39415 . 40230) (TRILLIUM.RELEASE 40232 . 41224) (TRILLIUM.WHEREIS
41226 . 41402) (WALK.ITEMS.OF.ITEM 41404 . 42077) (WALK.OBJECTS.OF.FRAME 42079 . 42473) (
WALK.OBJECTS.OF.INTERFACE 42475 . 42854) (WALK.OBJECTS.OF.OBJECT 42856 . 44346) (WALK.TRILLIUM.FNS
44348 . 44919) (WALK.TRILLIUM.FNS.DESCEND 44921 . 45424)))))
STOP