(FILECREATED "19-Mar-85 10:31:54" {PHYLUM}<TRILLIUM>BIRTHDAY84>SOURCES>TRILLIUM.;4 31525
changes to: (VARS TRILLIUMCOMS TRILLIUM.COLOR.MAP CONTROL.WINDOW.ICON TRILLIUM.BITMAP
TRILLIUM.SPOT.BITMAP)
previous date: "18-Feb-85 12:59:13" {PHYLUM}<TRILLIUM>BIRTHDAY84>SOURCES>TRILLIUM.;3)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TRILLIUMCOMS)
(RPAQQ TRILLIUMCOMS [(DECLARE: DOEVAL@LOAD (LOCALVARS . T))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE FIRST (E (TRILLIUM.SET.VERSION)))
(* Trillium constants and variables)
(VARS [TRILLIUM.BILLBOARD (QUOTE (("Trillium" (TIMESROMAND 72))
("A Design Environment" (TIMESROMAND 36))
("for Operator Interfaces" (TIMESROMAND 36))
("by" (TIMESROMAND 24))
("The Trillium Committee" (TIMESROMAND 36))
("c/o Austin Henderson" (TIMESROMAND 24))
("Palo Alto Research Center" (TIMESROMAND 24))
("XEROX Corporation" (TIMESROMAND 24]
TRILLIUM.FILES TRILLIUM.RELEASE.HOST/DIRECTORY TRILLIUM.VERSION
(ALL.TRILLIUM.FILES (CONS (QUOTE TRILLIUM)
(CONS (QUOTE TRI-TOOLS)
TRILLIUM.FILES)))
TRILLIUM.SOURCE.SUBDIRECTORY TRILLIUM.PTYPE.SUBDIRECTORY TRILLIUM.ITEMTYPE.SUBDIRECTORY
TRILLIUM.FIX.SUBDIRECTORY TRILLIUM.INTERFACE.SUBDIRECTORY)
(INITVARS (INTERFACES)
(ITEM.TYPES)
(PTYPES)
(INITIAL.BITMAPS)
(TRILLIUM.BILLBOARD.SHOWING)
(TRILLIUM.FULL.PRESS.PRINTER)
(AUTO.MAKE.CHANGES.FLG)
(COLOR.AVAILABLE)
(IN.LIVING.COLOR)
(AUDIO.AVAILABLE)
(TRILLIUM.COLOR.MAP))
(* Trillium record declarations)
(RECORDS GRIDREGION LOCATION LOCATION2 POSITION2)
(* Trillium macro declarations)
(MACROS ATOMICALLY CELL.GET.LINK CELL.PUT.LINK CELL.VALUE COMPOSITE? EMPTY.CELL
GET.CURRENT.VALUE GET.FIELD GET.FIELDQ GET.PARAM GET.PARAMQ ITEM.CREATE ITEM.TYPE
ITEM.TYPE.DESCRIPTION NEW.LOCATION NEW.POSITION PTYPE.DESCRIPTION SET.FIELD
SET.FIELDQ SET.PARAM SET.PARAMQ THINKING TRILLIUM.PRINTOUT TYPE.DEFINEDP XCOORD XDIST
XGDIST XGRID XGRIDIFY XGRIDNEAR YCOORD YDIST YGDIST YGRID YGRIDIFY YGRIDNEAR)
(* Trillium function declarations)
(FNS ADD.TO.BACKGROUND.MENU IN.COLOR SET.TRILLIUM.FILES.LOCATION TRILLIUM.BILLBOARD
TRILLIUM.COMPILE.ITEMTYPE.FNS TRILLIUM.COMPILE.PTYPE.FNS TRILLIUM.FILENAME TRILLIUM.INIT
TRILLIUM.ITEMTYPES.FILENAME TRILLIUM.LOAD.COMPILED TRILLIUM.LOAD.FILE
TRILLIUM.LOAD.FILES TRILLIUM.LOAD.OTHER TRILLIUM.LOAD.SOURCE TRILLIUM.LOAD.SOURCES
TRILLIUM.LOAD.TRILLIUM? TRILLIUM.MAKESYS TRILLIUM.PTYPES.FILENAME TRILLIUM.SET.SOURCE
TRILLIUM.SET.VERSION TRILLIUM.SUPPORT.FORM TRILLIUM.LOAD.FIXES)
(* Trillium miscellaneous declarations)
(BITMAPS CONTROL.WINDOW.ICON TRILLIUM.BITMAP TRILLIUM.SPOT.BITMAP)
(CURSORS TRILLIUM.CURSOR)
[P (INTERRUPTCHAR 2 (QUOTE (SPAWN.MOUSE)))
(SET.TRILLIUM.FILES.LOCATION FILE)
(TRILLIUM.SET.SOURCE (QUOTE TRILLIUM))
(TRILLIUM.LOAD.TRILLIUM?)
(* changes during startup don't require refiling!)
(RPLACD (GETPROP (QUOTE TRILLIUM)
(QUOTE FILE]
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
(DECLARE: DOEVAL@LOAD
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS)
)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE FIRST
)
(* Trillium constants and variables)
(RPAQQ TRILLIUM.BILLBOARD (("Trillium" (TIMESROMAND 72))
("A Design Environment" (TIMESROMAND 36))
("for Operator Interfaces" (TIMESROMAND 36))
("by" (TIMESROMAND 24))
("The Trillium Committee" (TIMESROMAND 36))
("c/o Austin Henderson" (TIMESROMAND 24))
("Palo Alto Research Center" (TIMESROMAND 24))
("XEROX Corporation" (TIMESROMAND 24))))
(RPAQQ TRILLIUM.FILES (TRI-ANALYZE TRI-COMPILE TRI-CREATE TRI-EDIT TRI-EDITCLASS TRI-EDITFRAME
TRI-EDITINTERFACE TRI-EDITITEM TRI-EDITITYPE TRI-EDITSUPER
TRI-EVENTS TRI-HARDCOPY TRI-IO TRI-ITEMTYPES TRI-RUN TRI-SAVING
TRI-SHOW TRI-SPLITMERGE TRI-UTIL TRI-WINDOWS))
(RPAQQ TRILLIUM.RELEASE.HOST/DIRECTORY NOBIND)
(RPAQQ TRILLIUM.VERSION "19-Mar-85")
(RPAQ ALL.TRILLIUM.FILES (CONS (QUOTE TRILLIUM)
(CONS (QUOTE TRI-TOOLS)
TRILLIUM.FILES)))
(RPAQQ TRILLIUM.SOURCE.SUBDIRECTORY SOURCES)
(RPAQQ TRILLIUM.PTYPE.SUBDIRECTORY PTYPES)
(RPAQQ TRILLIUM.ITEMTYPE.SUBDIRECTORY ITEMTYPES)
(RPAQQ TRILLIUM.FIX.SUBDIRECTORY FIXES)
(RPAQQ TRILLIUM.INTERFACE.SUBDIRECTORY INTERFACES)
(RPAQ? INTERFACES )
(RPAQ? ITEM.TYPES )
(RPAQ? PTYPES )
(RPAQ? INITIAL.BITMAPS )
(RPAQ? TRILLIUM.BILLBOARD.SHOWING )
(RPAQ? TRILLIUM.FULL.PRESS.PRINTER )
(RPAQ? AUTO.MAKE.CHANGES.FLG )
(RPAQ? COLOR.AVAILABLE )
(RPAQ? IN.LIVING.COLOR )
(RPAQ? AUDIO.AVAILABLE )
(RPAQ? TRILLIUM.COLOR.MAP )
(* Trillium record declarations)
[DECLARE: EVAL@COMPILE
(RECORD GRIDREGION (LEFT BOTTOM WIDTH HEIGHT)
LEFT ← -16383 BOTTOM ← -16383 WIDTH ← 32767 HEIGHT ← 32767
[ACCESSFNS ((TOP (IPLUS (fetch (GRIDREGION BOTTOM) of DATUM)
(fetch (GRIDREGION HEIGHT) of DATUM)
-1))
(RIGHT (IPLUS (fetch (GRIDREGION LEFT) of DATUM)
(fetch (GRIDREGION WIDTH) of DATUM)
-1]
[TYPE? (AND (EQ (LENGTH DATUM)
4)
(EVERY DATUM (FUNCTION FIXP])
(RECORD LOCATION (X . Y)
[TYPE? (AND (LISTP DATUM)
(NUMBERP (CAR DATUM))
(NUMBERP (CDR DATUM])
(RECORD LOCATION2 (X1 Y1 X2 Y2 DUMMY))
(RECORD POSITION2 (XCOORD1 YCOORD1 XCOORD2 YCOORD2 DUMMY))
]
(* Trillium macro declarations)
(DECLARE: EVAL@COMPILE
(PUTPROPS ATOMICALLY MACRO (ATOMICALLY.FORMS (CONS (QUOTE PROGN)
ATOMICALLY.FORMS)))
(PUTPROPS CELL.GET.LINK MACRO (($Cell.Name$ $Label$)
(LISTGET (FIND.CELL $Cell.Name$)
$Label$)))
(PUTPROPS CELL.PUT.LINK MACRO (($Cell.Name$ $Label$ $New.Value$)
(LISTPUT (FIND.CELL $Cell.Name$)
$Label$ $New.Value$)))
(PUTPROPS CELL.VALUE MACRO (($CellName$)
(GET.CURRENT.VALUE (QUOTE $CellName$))))
(PUTPROPS COMPOSITE? MACRO (($Composite?Item$)
(GETPROP (ITEM.TYPE $Composite?Item$)
(QUOTE COMPOSITE?))))
(PUTPROPS EMPTY.CELL MACRO (($CellName$)
(CHANGE.CURRENT.VALUE (QUOTE $CellName$))))
(PUTPROPS GET.CURRENT.VALUE MACRO (($Cell.Name$)
(LISTGET (FIND.CELL $Cell.Name$)
(QUOTE VALUE))))
(PUTPROPS GET.FIELD MACRO ((object field.name expected.type)
(LISTGET object field.name)))
(PUTPROPS GET.FIELDQ MACRO ((object field.name expected.type)
(GET.FIELD object (QUOTE field.name)
(QUOTE expected.type))))
(PUTPROPS GET.PARAM MACRO ((item param.name expected.itype)
(OR (LISTGET item param.name)
(GET.PARAM.DEFAULT item param.name))))
(PUTPROPS GET.PARAMQ MACRO ((item param.name expected.itype)
(GET.PARAM item (QUOTE param.name)
(QUOTE expected.itype))))
(PUTPROPS ITEM.CREATE MACRO [$specs$ (APPEND (QUOTE (LIST (QUOTE \TYPE)))
(CONS (KWOTE (CAR $specs$))
(for ELEM in (CDR $specs$)
join (LIST (KWOTE (CAR ELEM))
(CADR ELEM])
(PUTPROPS ITEM.TYPE DMACRO (= . CADR))
(PUTPROPS ITEM.TYPE.DESCRIPTION MACRO (($Item.Type$)
(GETPROP $Item.Type$ (QUOTE TYPE.DESCRIPTION))))
(PUTPROPS NEW.LOCATION MACRO (($xval$ $yval$)
(create LOCATION
X ← $xval$
Y ← $yval$)))
(PUTPROPS NEW.POSITION MACRO (($xcoord$ $ycoord$)
(create POSITION
XCOORD ← $xcoord$
YCOORD ← $ycoord$)))
(PUTPROPS PTYPE.DESCRIPTION MACRO (($PType$)
(GETPROP $PType$ (QUOTE PTYPE.DESCRIPTION))))
(PUTPROPS SET.FIELD MACRO ((object field.name new.value expected.type)
(LISTPUT object field.name new.value)))
(PUTPROPS SET.FIELDQ MACRO ((object field.name new.value expected.type)
(SET.FIELD object (QUOTE field.name)
new.value
(QUOTE expected.type))))
(PUTPROPS SET.PARAM MACRO ((item param.name new.value expected.itype)
(LISTPUT item param.name new.value)))
(PUTPROPS SET.PARAMQ MACRO ((item param.name new.value expected.itype)
(SET.PARAM item (QUOTE param.name)
new.value
(QUOTE expected.itype))))
(PUTPROPS THINKING MACRO (THINKING.FORMS (CONS (QUOTE RESETFORM)
(CONS (LIST (QUOTE SWAP.CURSOR.AUX)
NIL
(QUOTE TRILLIUM.CURSOR))
THINKING.FORMS))))
(PUTPROPS TRILLIUM.PRINTOUT MACRO [SPECS (PROG ((WINDOWSPEC (QUOTE PROMPTWINDOW))
(BREAKSPEC (QUOTE NEW.BLOCK)))
(do (SELECTQ (CAR SPECS)
(NEW.BLOCK (SETQ BREAKSPEC (QUOTE
NEW.BLOCK))
(SETQ SPECS (CDR SPECS)))
(SAME.BLOCK (SETQ BREAKSPEC (QUOTE
SAME.BLOCK))
(SETQ SPECS (CDR SPECS)))
(SAME.LINE (SETQ BREAKSPEC (QUOTE
SAME.LINE))
(SETQ SPECS (CDR SPECS)))
(ON (SETQ WINDOWSPEC (CADR SPECS))
(SETQ SPECS (CDDR SPECS)))
(RETURN)))
(RETURN (CONS (QUOTE printout)
(CONS (LIST (QUOTE
GET.TRILLIUM.PRINTOUT.WINDOW)
(KWOTE WINDOWSPEC)
(KWOTE BREAKSPEC))
SPECS])
(PUTPROPS TYPE.DEFINEDP MACRO (($Item$)
(ITEM.TYPE.DESCRIPTION (ITEM.TYPE $Item$))))
(PUTPROPS XCOORD DMACRO (($GRIDX$)
(IPLUS TRILLIUM.GRID.X0 (XDIST $GRIDX$))))
(PUTPROPS XDIST MACRO (($GRIDDX$)
(ITIMES $GRIDDX$ TRILLIUM.GRID.DX)))
(PUTPROPS XGDIST MACRO (($Xspacing$)
(IQUOTIENT $Xspacing$ TRILLIUM.GRID.DX)))
(PUTPROPS XGRID MACRO (($Xcoord$)
(XGDIST (IDIFFERENCE $Xcoord$ TRILLIUM.GRID.X0))))
(PUTPROPS XGRIDIFY MACRO (($Xcoord$)
(XCOORD (XGRIDNEAR $Xcoord$))))
(PUTPROPS XGRIDNEAR MACRO (($Xcoord$)
(XGRID (IPLUS $Xcoord$ TRILLIUM.GRID.HALF.DX))))
(PUTPROPS YCOORD DMACRO (($GRIDY$)
(IPLUS TRILLIUM.GRID.Y0 (YDIST $GRIDY$))))
(PUTPROPS YDIST MACRO (($GRIDDY$)
(ITIMES $GRIDDY$ TRILLIUM.GRID.DY)))
(PUTPROPS YGDIST MACRO (($Yspacing$)
(IQUOTIENT $Yspacing$ TRILLIUM.GRID.DY)))
(PUTPROPS YGRID MACRO (($Ycoord$)
(YGDIST (IDIFFERENCE $Ycoord$ TRILLIUM.GRID.Y0))))
(PUTPROPS YGRIDIFY MACRO (($Ycoord$)
(YCOORD (YGRIDNEAR $Ycoord$))))
(PUTPROPS YGRIDNEAR MACRO (($Ycoord$)
(YGRID (IPLUS $Ycoord$ TRILLIUM.GRID.HALF.DY))))
)
(* Trillium function declarations)
(DEFINEQ
(ADD.TO.BACKGROUND.MENU
[LAMBDA (ITEM) (* edited: "15-APR-83 17:00")
(* adds an item to the background menu.)
(DECLARE (GLOBALVARS BackgroundMenu BackgroundMenuCommands))
(COND
((FASSOC (CAR ITEM)
BackgroundMenuCommands))
(T (SETQ BackgroundMenuCommands (NCONC1 BackgroundMenuCommands ITEM))
(SETQ BackgroundMenu])
(IN.COLOR
[LAMBDA (ON) (* edited: "10-JAN-83 08:56")
(DECLARE (GLOBALVARS IN.LIVING.COLOR TRILLIUM.COLOR.MAP))
(COND
(ON (COLORDISPLAY TRILLIUM.COLOR.MAP)
(SETQ IN.LIVING.COLOR T))
(T (COLORDISPLAY)
(SETQ IN.LIVING.COLOR])
(SET.TRILLIUM.FILES.LOCATION
[LAMBDA (FILE)
(DECLARE (GLOBALVARS TRILLIUM.DIRECTORY TRILLIUM.HOST TRILLIUM.SOURCE.SUBDIRECTORY))
(* NHB "17-Dec-84 13:38")
(PROG ((UPFN (UNPACKFILENAME FILE))
SOURCEDIR? SOURCEDIRLENGTH)
(SETQ TRILLIUM.HOST (LISTGET UPFN (QUOTE HOST)))
(SETQ TRILLIUM.DIRECTORY (LISTGET UPFN (QUOTE DIRECTORY)))
(SETQ SOURCEDIRLENGTH (LENGTH (UNPACK TRILLIUM.SOURCE.SUBDIRECTORY)))
(SETQ SOURCEDIR? (SUBSTRING TRILLIUM.DIRECTORY (MINUS SOURCEDIRLENGTH)))
(COND
((EQ (MKATOM SOURCEDIR?)
TRILLIUM.SOURCE.SUBDIRECTORY)
(SETQ TRILLIUM.DIRECTORY (MKATOM (SUBSTRING TRILLIUM.DIRECTORY 1 (DIFFERENCE -1
SOURCEDIRLENGTH])
(TRILLIUM.BILLBOARD
[LAMBDA (ALIGNMENT SEPARATION POSITION) (* edited: " 6-May-84 14:52")
(DECLARE (GLOBALVARS TRILLIUM.BILLBOARD))
(BILLBOARD TRILLIUM.BILLBOARD (OR ALIGNMENT (QUOTE CENTER))
(OR SEPARATION 30)
(OR POSITION (create POSITION
XCOORD ← 350
YCOORD ← 700])
(TRILLIUM.COMPILE.ITEMTYPE.FNS
[LAMBDA NIL (* HaKo "13-SEP-83 22:15")
(DECLARE (GLOBALVARS ITEM.TYPES))
(for ITYPE in ITEM.TYPES bind (FN FNS) do (for SPEC in (LISTGET (GET.FIELDQ (ITEM.TYPE.DESCRIPTION
ITYPE)
OTHER ITEM.TYPE)
(QUOTE FNS))
when [LISTP (GETD (SETQ FN (CADR SPEC]
do (SETQ FNS (CONS FN FNS)))
finally (AND FNS (QCOMPILE! FNS))
(RETURN FNS])
(TRILLIUM.COMPILE.PTYPE.FNS
[LAMBDA NIL (* HaKo "13-SEP-83 22:24")
(DECLARE (GLOBALVARS PTYPES))
(for PTYPE in PTYPES bind (FN FNS) do (for SPEC in (LISTGET (GET.FIELDQ (PTYPE.DESCRIPTION PTYPE)
OTHER)
(QUOTE FNS))
when [LISTP (GETD (SETQ FN (CADR SPEC]
do (SETQ FNS (CONS FN FNS)))
finally (AND FNS (QCOMPILE! FNS))
(RETURN FNS])
(TRILLIUM.FILENAME
[LAMBDA (FILE COMPILED SUBDIRECTORY) (* NHB "17-Dec-84 13:20")
(DECLARE (GLOBALVARS COMPILE.EXT TRILLIUM.DIRECTORY TRILLIUM.HOST TRILLIUM.SOURCE.SUBDIRECTORY))
(PROG [(DIRECTORY (COND
(SUBDIRECTORY (CONCAT TRILLIUM.DIRECTORY SUBDIRECTORY))
(T (CONCAT TRILLIUM.DIRECTORY TRILLIUM.SOURCE.SUBDIRECTORY]
(RETURN (COND
(COMPILED (PACKFILENAME (QUOTE HOST)
TRILLIUM.HOST
(QUOTE DIRECTORY)
DIRECTORY
(QUOTE NAME)
FILE
(QUOTE EXTENSION)
COMPILE.EXT))
(T (PACKFILENAME (QUOTE HOST)
TRILLIUM.HOST
(QUOTE DIRECTORY)
DIRECTORY
(QUOTE NAME)
FILE])
(TRILLIUM.INIT
[LAMBDA NIL (* PH " 7-Sep-84 13:30")
(* DAHJr "31-Mar-84 16:37")
(DECLARE (GLOBALVARS LAFITEFORMSMENU LAFITESPECIALFORMS TRILLIUM.DESCRIPTIONS.WINDOW
TRILLIUM.OLD.CURSOR TRILLIUM.SUPPORT.FORM USERNAME))
(SETQ TRILLIUM.OLD.CURSOR (CURSORCREATE))
(SETQ TRILLIUM.DESCRIPTIONS.WINDOW (CREATEW (QUOTE (315 678 333 115))
(QUOTE TRILLIUM.DESCRIPTIONS)))
(DSPSCROLL (QUOTE ON)
(WINDOWPROP TRILLIUM.DESCRIPTIONS.WINDOW (QUOTE DSP)))
(* * OLD WAY: (SETQ TRILLIUM.PRINTOUT.WINDOWS (LIST (QUOTE PROMPTWINDOW) PROMPTWINDOW)))
(COND
([AND (BOUNDP (QUOTE LAFITESPECIALFORMS))
(NOT (BOUNDP (QUOTE TRILLIUM.SUPPORT.FORM]
(SETQ TRILLIUM.SUPPORT.FORM (QUOTE ("Trillium Report" (FUNCTION TRILLIUM.SUPPORT.FORM)
"A form to report a Trillium bug or suggestion")))
(SETQ LAFITESPECIALFORMS (CONS TRILLIUM.SUPPORT.FORM LAFITESPECIALFORMS))
(SETQ LAFITEFORMSMENU)))
(COND
((FMEMB USERNAME (QUOTE (AHENDERSON AHENDERSON.PA)))
(* * This loads fonts only required for the Billboard, which is only used by Austin Henderson! Otherwise get
error: can't find TIMESROMAND 72)
(TRILLIUM.LOAD.OTHER)))
(ADD.TO.BACKGROUND.MENU (QUOTE (Trillium (TRILLIUM)
"Opens a Trillium Control Window")))
(TRILLIUM.GRID.SETUP 0 0 17 17)
(PROFILE.INIT)
NIL])
(TRILLIUM.ITEMTYPES.FILENAME
[LAMBDA (FILE COMPILED) (* kkm "26-Nov-84 11:42")
(DECLARE (GLOBALVARS COMPILE.EXT TRILLIUM.DIRECTORY TRILLIUM.HOST))
(PROG (DIRECTORY.STR)
(RETURN (PACKFILENAME (QUOTE HOST)
TRILLIUM.HOST
(QUOTE DIRECTORY)
(COND
((STREQUAL (SUBSTRING (SETQ DIRECTORY.STR (MKSTRING
TRILLIUM.DIRECTORY))
-7)
"SOURCES")
(CONCAT (SUBSTRING DIRECTORY.STR 1 -8)
"ITEMTYPES"))
(T TRILLIUM.DIRECTORY))
(QUOTE NAME)
FILE])
(TRILLIUM.LOAD.COMPILED
[LAMBDA (FILE) (* DAHJr "21-APR-83 16:16")
(LOAD (TRILLIUM.FILENAME FILE T])
(TRILLIUM.LOAD.FILE
[LAMBDA (FILE SOURCEFILE.ALSO) (* DAHJr "20-DEC-82 20:14")
(TRILLIUM.LOAD.COMPILED FILE)
[COND
(SOURCEFILE.ALSO (TRILLIUM.LOAD.SOURCE FILE (QUOTE ALLPROP]
(TRILLIUM.SET.SOURCE FILE])
(TRILLIUM.LOAD.FILES
[LAMBDA (SOURCESFILES.ALSO) (* edited: "18-SEP-82 10:00")
(DECLARE (GLOBALVARS TRILLIUM.FILES))
(printout NIL T "Loading Trillium files: ")
(for FILE in TRILLIUM.FILES do (printout NIL T 2 FILE))
(TERPRI)
(for FILE in TRILLIUM.FILES do (TRILLIUM.LOAD.FILE FILE SOURCESFILES.ALSO])
(TRILLIUM.LOAD.OTHER
[LAMBDA NIL (* DAHJr "11-MAY-83 11:50")
(* FOR READNUMBER)
(FONTCREATE (QUOTE (GACHA 12 BOLD)))
(FONTCREATE (QUOTE (TIMESROMAND 72)))
(FONTCREATE (QUOTE (TIMESROMAND 36)))
(FONTCREATE (QUOTE (TIMESROMAND 24])
(TRILLIUM.LOAD.SOURCE
[LAMBDA (FILE DEF/PROP) (* DAHJr "21-JUN-83 18:05")
(SELECTQ DEF/PROP
((T NIL)
(LOAD (TRILLIUM.FILENAME FILE)
(QUOTE PROP)))
(DEF (LOAD (TRILLIUM.FILENAME FILE)))
(LOAD (TRILLIUM.FILENAME FILE)
DEF/PROP])
(TRILLIUM.LOAD.SOURCES
[LAMBDA (DEF/PROP) (* DAHJr "23-JUN-83 09:01")
(DECLARE (GLOBALVARS TRILLIUM.FILES))
(PROG (FILES)
(SETQ FILES (CONS (QUOTE TRILLIUM)
TRILLIUM.FILES))
(printout NIL T "Loading sources for Trillium files: ")
(for FILE in FILES do (printout NIL T 2 FILE))
(TERPRI)
(for FILE in FILES do (TRILLIUM.LOAD.SOURCE FILE DEF/PROP])
(TRILLIUM.LOAD.TRILLIUM?
[LAMBDA NIL (* N.H.Briggs "18-Jan-85 14:58")
(* DAHJr " 5-DEC-83 09:17")
(* Load the Trillium system unless TRILLIUM.LOADED has
a value.)
(DECLARE (GLOBALVARS TRILLIUM.FILES TRILLIUM.LOADED TRILLIUM.ITEMTYPE.SUBDIRECTORY
TRILLIUM.PTYPE.SUBDIRECTORY TRILLIUM.INTERFACE.SUBDIRECTORY))
(COND
((NOT (BOUNDP (QUOTE TRILLIUM.LOADED)))
(PROG (SOURCES? SOURCEONLY? SYSONLY? STANDARD? DEMO? (TRIFILES (REMOVE (QUOTE TRI-ITEMTYPES)
TRILLIUM.FILES)))
(SETQ TRILLIUM.LOADED T) (* So we can recursively load sources of TRILLIUM
file.)
(printout T T "Loading the TRILLIUM system ..." T)
(SETQ SYSONLY? (EQ (ASKUSER NIL NIL " Small loadup? ")
(QUOTE Y)))
[COND
((NOT SYSONLY?)
(SETQ TRIFILES (CONS (QUOTE TRI-TOOLS)
TRIFILES))
(SETQ SOURCES? (EQ (ASKUSER NIL NIL " Load sources? ")
(QUOTE Y)))
(COND
(SOURCES? (SETQ SOURCEONLY? (EQ (ASKUSER NIL NIL " Load sources only? ")
(QUOTE Y]
(SETQ STANDARD? (EQ (ASKUSER NIL NIL " Load standard set of item types? ")
(QUOTE Y)))
(SETQ DEMO? (EQ (ASKUSER NIL NIL " Load DEMO interface? ")
(QUOTE Y)))
(printout NIL T "Loading Trillium files: ")
(for FILE in (SETQ TRIFILES (SORT (COPY TRIFILES))) do (printout NIL T 3 FILE))
(printout NIL T T "Go ahead and have some coffee!" T)
(printout NIL 3 "(Don't forget to hit the SPACE bar a few times!)" T)
[COND
((AND SOURCES? (NOT SOURCEONLY?))
(LOAD (TRILLIUM.FILENAME (QUOTE TRILLIUM))
(QUOTE ALLPROP]
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
COMPILEBANG EDITBITMAP GRAPHER HEADLINE MAKEGRAPH READNUMBER TEDIT
TRAJECTORY-FOLLOWER PIECE-MENUS)
(for F in TRIFILES
do [COND
(SOURCEONLY? (LOAD (TRILLIUM.FILENAME F)))
(T (LOAD (TRILLIUM.FILENAME F T)
(AND SYSONLY? (QUOTE SYSLOAD)))
(COND
(SOURCES? (LOAD (TRILLIUM.FILENAME F)
(QUOTE ALLPROP]
(TRILLIUM.SET.SOURCE F))
(LOAD (TRILLIUM.FILENAME (QUOTE TRI-ITEMTYPES))
(AND SYSONLY? (QUOTE SYSLOAD)))
(TRILLIUM.SET.SOURCE (QUOTE TRI-ITEMTYPES))
(TRILLIUM.INIT)
(TRILLIUM (create POSITION
XCOORD ← 730
YCOORD ← 330))
[COND
(STANDARD? (for F in (QUOTE (PRIMITIVE-ITEMTYPES COMPOSITE-ITEMTYPES))
do (LOAD (TRILLIUM.FILENAME F NIL TRILLIUM.ITEMTYPE.SUBDIRECTORY)
(AND SYSONLY? (QUOTE SYSLOAD)))
(TRILLIUM.SET.SOURCE F TRILLIUM.ITEMTYPE.SUBDIRECTORY)
(MARK.OBJECT.FILE F))
(LOAD (TRILLIUM.FILENAME (QUOTE BASIC-PTYPES)
NIL TRILLIUM.PTYPE.SUBDIRECTORY)
(AND SYSONLY? (QUOTE SYSLOAD)))
(TRILLIUM.SET.SOURCE (QUOTE BASIC-PTYPES)
TRILLIUM.PTYPE.SUBDIRECTORY)
(MARK.OBJECT.FILE (QUOTE BASIC-PTYPES]
[COND
(DEMO? (LOAD (TRILLIUM.FILENAME (QUOTE DEMO-INTERFACE)
NIL TRILLIUM.INTERFACE.SUBDIRECTORY)
(AND SYSONLY? (QUOTE SYSLOAD)))
(TRILLIUM.SET.SOURCE (QUOTE DEMO-INTERFACE)
TRILLIUM.INTERFACE.SUBDIRECTORY)
(MARK.OBJECT.FILE (QUOTE DEMO-INTERFACE]
(COMPILE.INTERNAL.FNS.IF.NECESSARY)
(RETURN T])
(TRILLIUM.MAKESYS
[LAMBDA (BIGSYSFLG SYSFILESPEC) (* NHB "17-Dec-84 17:31")
(* Fixed by NHB to handle null connected directory)
(DECLARE (GLOBALVARS ADVISEDFNS POSTGREETFORMS CHANGESARRAY FILELST INTERFACES NOTCOMPILEDFILES
NOTLISTEDFILES \CONNECTED.DIR \CONNECTED.HOST))
(PROG [(MAKESYSFILE (PACKFILENAME (QUOTE HOST)
(OR (FILENAMEFIELD SYSFILESPEC (QUOTE HOST))
\CONNECTED.HOST)
(QUOTE DIRECTORY)
(OR (FILENAMEFIELD SYSFILESPEC (QUOTE DIRECTORY))
(AND (NOT (STREQUAL \CONNECTED.DIR ""))
\CONNECTED.DIR))
(QUOTE NAME)
(COND
((FILENAMEFIELD SYSFILESPEC (QUOTE NAME)))
(BIGSYSFLG (QUOTE BIGTRILLIUM))
(T (QUOTE TRILLIUM)))
(QUOTE EXTENSION)
(OR (FILENAMEFIELD SYSFILESPEC (QUOTE EXTENSION))
(QUOTE SYSOUT))
(QUOTE VERSION)
(OR (FILENAMEFIELD SYSFILESPEC (QUOTE VERSION))
1]
(OR (TTYCONFIRM (CONCAT "Makesys into " MAKESYSFILE " [confirm] "))
(RETURN))
(FILES?)
[COND
([OR NOTCOMPILEDFILES (FILEPKGCHANGES)
(for F in FILELST thereis (CDR (GETPROP F (QUOTE FILE]
(OR (TTYCONFIRM "You have made changes which have not been filed! Continue makesys? ")
(RETURN]
[COND
((TTYCONFIRM "Reset interfaces? ")
(for INTERFACE.NAME in INTERFACES do (RESET.INTERFACE (FIND.INTERFACE INTERFACE.NAME)
T]
[COND
[(AND (NOT BIGSYSFLG)
(TTYCONFIRM "Gain space? ")
(TTYCONFIRM "For sure? "))
(%. ERASE)
[for F in FILELST do (RPLACD (GETPROP F (QUOTE FILE]
(CLEARFILEPKG (QUOTE E))
(CLRHASH CHANGESARRAY)
(CLRHASH)
(SETQ ADVISEDFNS)
(MAPATOMS (FUNCTION (LAMBDA (X)
(REMPROPLIST X
(QUOTE (VALUE EXPR CODE SUBR FILEMAP ADVISED ADVICE READVICE
EDIT-SAVE *HISTORY*]
(T (MAPATOMS (FUNCTION (LAMBDA (X)
(REMPROPLIST X (QUOTE (VALUE CODE SUBR EDIT-SAVE *HISTORY*]
(* * Let MAKESYS worry about this: (SETQ GREETHIST))
(SETQ NOTLISTEDFILES)
(PURGEHISTORY (QUOTE E))
(REMPROP (QUOTE EDIT)
(QUOTE LASTVALUE))
(RESETDEDIT)
[OR (FASSOC (QUOTE TRILLIUM.LOAD.FIXES)
POSTGREETFORMS)
(NCONC1 POSTGREETFORMS (QUOTE (TRILLIUM.LOAD.FIXES]
[OR (FASSOC (QUOTE PROFILE.INIT)
POSTGREETFORMS)
(NCONC1 POSTGREETFORMS (QUOTE (PROFILE.INIT]
(RECLAIM)
(MAKESYS MAKESYSFILE])
(TRILLIUM.PTYPES.FILENAME
[LAMBDA (FILE COMPILED) (* kkm "26-Nov-84 11:44")
(DECLARE (GLOBALVARS COMPILE.EXT TRILLIUM.DIRECTORY TRILLIUM.HOST))
(PROG (DIRECTORY.STR)
(RETURN (PACKFILENAME (QUOTE HOST)
TRILLIUM.HOST
(QUOTE DIRECTORY)
(COND
((STREQUAL (SUBSTRING (SETQ DIRECTORY.STR (MKSTRING
TRILLIUM.DIRECTORY))
-7)
"SOURCES")
(CONCAT (SUBSTRING DIRECTORY.STR 1 -8)
"PTYPES"))
(T TRILLIUM.DIRECTORY))
(QUOTE NAME)
FILE])
(TRILLIUM.SET.SOURCE
[LAMBDA (FILE SUBDIRECTORY) (* edited: "18-Jan-85 13:45")
(DECLARE (GLOBALVARS TRILLIUM.DIRECTORY TRILLIUM.HOST))
(CDR (RPLACD (CAR (GETPROP FILE (QUOTE FILEDATES)))
(PACKFILENAME (QUOTE HOST)
TRILLIUM.HOST
(QUOTE DIRECTORY)
(CONCAT TRILLIUM.DIRECTORY (OR SUBDIRECTORY
TRILLIUM.SOURCE.SUBDIRECTORY))
(QUOTE NAME)
FILE])
(TRILLIUM.SET.VERSION
[LAMBDA NIL (* DAHJr "19-JUL-83 00:48")
(DECLARE (GLOBALVARS TRILLIUM.VERSION))
(PROG (SPACE FIRST LAST DATE)
(SETQ DATE (DATE))
(SETQ SPACE (STRPOS " " DATE))
(SETQ FIRST (COND
((EQ SPACE 1)
2)
(T 1)))
(SETQ SPACE (STRPOS " " DATE FIRST))
(SETQ LAST (SUB1 SPACE))
(SETQ TRILLIUM.VERSION (SUBSTRING (DATE)
FIRST LAST))
(RETURN TRILLIUM.VERSION])
(TRILLIUM.SUPPORT.FORM
[LAMBDA NIL (* kkm "19-Nov-84 14:18")
(PROG (OUTSTREAM)
(DECLARE (GLOBALVARS TRILLIUM.VERSION))
(SETQ OUTSTREAM (OPENTEXTSTREAM ""))
(printout OUTSTREAM "Subject: Trillium: >>Subject<<" T)
(printout OUTSTREAM "To: TrilliumSupport↑.pa" T)
(printout OUTSTREAM "Status: >>Status<<" T)
(printout OUTSTREAM "cc: " (USERNAME)
T)
(printout OUTSTREAM "Reply-to: TrilliumSupport↑.pa" T)
(printout OUTSTREAM "Trillium-System-Date: " TRILLIUM.VERSION T)
(printout OUTSTREAM "Lisp-System-Date: " MAKESYSDATE T)
(printout OUTSTREAM "Machine-Type: " (MACHINETYPE)
T)
(printout OUTSTREAM T ">>Message<<" T)
(RETURN OUTSTREAM])
(TRILLIUM.LOAD.FIXES
[LAMBDA NIL (* edited: "19-Dec-84 15:36")
(* NHB "17-Dec-84 17:12")
(* load all the fix files we can find from the fixes
subdirectory)
(DECLARE (GLOBALVARS TRILLIUM.FIX.SUBDIRECTORY))
(PROG (FIX-FILES)
(SETQ FIX-FILES (DIRECTORY (TRILLIUM.FILENAME (QUOTE *)
T TRILLIUM.FIX.SUBDIRECTORY)))
[MAPC FIX-FILES (FUNCTION (LAMBDA (FILE)
(COND
((INFILEP FILE)
(LOAD FILE]
(COND
((GETPROP (QUOTE TRILLIUM.INIT)
(QUOTE EXPR))
(SETQ FIX-FILES (DIRECTORY (TRILLIUM.FILENAME (QUOTE *.;)
NIL TRILLIUM.FIX.SUBDIRECTORY)))
(MAPC FIX-FILES (FUNCTION (LAMBDA (FILE)
(COND
((INFILEP FILE)
(LOAD FILE (QUOTE ALLPROP])
)
(* Trillium miscellaneous declarations)
(RPAQ CONTROL.WINDOW.ICON (READBITMAP))
(37 50
"OOOOOOOOOH@@"
"OOOOOOOOOH@@"
"L@@@@@@@AH@@"
"L@@@@@@@AH@@"
"L@N@@@@@AH@@"
"LCK@@@F@AH@@"
"LLAO@@OLAH@@"
"LH@ALOONAH@@"
"LKL@FOONAH@@"
"LLG@COO@AH@@"
"LG@LCON@AH@@"
"LAHCAN@@AH@@"
"L@O@HOL@AH@@"
"L@ONAHC@AH@@"
"LCOOI@@LAH@@"
"LGOONO@FAH@@"
"LGOLA@LCAH@@"
"LOOAK@CAAH@@"
"LNFCCLAHIH@@"
"L@DFCN@NIH@@"
"L@LLEMLAAH@@"
"LAIHELCOAH@@"
"LCC@DL@@AH@@"
"LBB@DO@@AH@@"
"LBF@ION@AH@@"
"LBDACMN@AH@@"
"LBDFGIO@AH@@"
"LB@HOKO@AH@@"
"LCACOCO@AH@@"
"LAOGLGO@AH@@"
"L@@GION@AH@@"
"L@@GCOL@AH@@"
"L@@CGO@@AH@@"
"L@@CON@@AH@@"
"L@@GOL@@AH@@"
"L@@GIL@@AH@@"
"L@@NAH@@AH@@"
"L@@LAH@@AH@@"
"L@@@CH@@AH@@"
"L@@@CH@@AH@@"
"L@@@G@@@AH@@"
"L@@@F@@@AH@@"
"L@@@F@@@AH@@"
"L@@@N@@@AH@@"
"L@@@L@@@AH@@"
"L@@AL@@@AH@@"
"L@@@@@@@AH@@"
"L@@@@@@@AH@@"
"OOOOOOOOOH@@"
"OOOOOOOOOH@@")
(RPAQ TRILLIUM.BITMAP (READBITMAP))
(29 42
"@N@@@@@@"
"CK@@@F@@"
"LAO@@OL@"
"H@ALOON@"
"KL@FOON@"
"LG@COO@@"
"G@LCON@@"
"AHCAN@@@"
"@O@HOL@@"
"@ONAHC@@"
"COOI@@L@"
"GOONO@F@"
"GOLA@LC@"
"OOAK@CA@"
"NFCCLAHH"
"@DFCN@NH"
"@LLEMLA@"
"AIHELCO@"
"CC@DL@@@"
"BB@DO@@@"
"BF@ION@@"
"BDACMN@@"
"BDFGIO@@"
"B@HOKO@@"
"CACOCO@@"
"AOGLGO@@"
"@@GION@@"
"@@GCOL@@"
"@@CGO@@@"
"@@CON@@@"
"@@GOL@@@"
"@@GIL@@@"
"@@NAH@@@"
"@@LAH@@@"
"@@@CH@@@"
"@@@CH@@@"
"@@@G@@@@"
"@@@F@@@@"
"@@@F@@@@"
"@@@N@@@@"
"@@@L@@@@"
"@@AL@@@@")
(RPAQ TRILLIUM.SPOT.BITMAP (READBITMAP))
(16 16
"@@@@"
"@GL@"
"AMG@"
"CAAH"
"FA@L"
"DA@D"
"LA@F"
"HA@B"
"OOON"
"HA@B"
"LA@F"
"DA@D"
"FA@L"
"CAAH"
"AMG@"
"@GL@")
(RPAQ TRILLIUM.CURSOR (CURSORCREATE (READBITMAP) 8 8))
(16 16
"@@@@"
"@@AN"
"O@FA"
"LLLE"
"JFII"
"IKKC"
"DADN"
"COOH"
"@FN@"
"@DJ@"
"@ME@"
"@JEH"
"AJDL"
"ADDF"
"AKHB"
"@N@B")(INTERRUPTCHAR 2 (QUOTE (SPAWN.MOUSE)))
(SET.TRILLIUM.FILES.LOCATION FILE)
(TRILLIUM.SET.SOURCE (QUOTE TRILLIUM))
(TRILLIUM.LOAD.TRILLIUM?)
(* changes during startup don't require refiling!)
(RPLACD (GETPROP (QUOTE TRILLIUM)
(QUOTE FILE)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PUTPROPS TRILLIUM COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (11014 29376 (ADD.TO.BACKGROUND.MENU 11024 . 11491) (IN.COLOR 11493 . 11804) (
SET.TRILLIUM.FILES.LOCATION 11806 . 12687) (TRILLIUM.BILLBOARD 12689 . 13034) (
TRILLIUM.COMPILE.ITEMTYPE.FNS 13036 . 13559) (TRILLIUM.COMPILE.PTYPE.FNS 13561 . 14052) (
TRILLIUM.FILENAME 14054 . 14855) (TRILLIUM.INIT 14857 . 16368) (TRILLIUM.ITEMTYPES.FILENAME 16370 .
16946) (TRILLIUM.LOAD.COMPILED 16948 . 17110) (TRILLIUM.LOAD.FILE 17112 . 17382) (TRILLIUM.LOAD.FILES
17384 . 17786) (TRILLIUM.LOAD.OTHER 17788 . 18155) (TRILLIUM.LOAD.SOURCE 18157 . 18482) (
TRILLIUM.LOAD.SOURCES 18484 . 18984) (TRILLIUM.LOAD.TRILLIUM? 18986 . 22860) (TRILLIUM.MAKESYS 22862
. 25847) (TRILLIUM.PTYPES.FILENAME 25849 . 26419) (TRILLIUM.SET.SOURCE 26421 . 26929) (
TRILLIUM.SET.VERSION 26931 . 27462) (TRILLIUM.SUPPORT.FORM 27464 . 28331) (TRILLIUM.LOAD.FIXES 28333
. 29374)))))
STOP