(FILECREATED " 7-Jan-85 15:06:28" {PHYLUM}<TRILLIUM>BIRTHDAY84>FIXES>JAN-7-85-FIXES-COMPLETE.;2 37093
changes to: (VARS JAN-7-85-FIXES-COMPLETECOMS)
(FNS FONTS.IN.CORE))
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT JAN-7-85-FIXES-COMPLETECOMS)
(RPAQQ JAN-7-85-FIXES-COMPLETECOMS ((* * Henrietta fixes to Trillium source)
(* * FONTS.IN.CORE: Didn't search list by device type. If the
DISPLAY font type was not first in the list, it wouldn't be
included in the font menu.)
(FNS FONTS.IN.CORE.Original FONTS.IN.CORE)
(* * FORGET.FRAME.CLASS: Didn't reset CURRENT.BITMAP.FRAMES)
(FNS FORGET.FRAME.CLASS.Original FORGET.FRAME.CLASS)
(* * MOVE.ITEM: Flips all items in the frame while prompting for
item's new placement)
(FNS MOVE.ITEM.Original MOVE.ITEM)
(* * COPY.INTERFACE: Modified to copy the color map of the
interface, also)
(FNS COPY.INTERFACE.Original COPY.INTERFACE)
(* * Webster fixes to Trillium source)
(* * ACQUIRE.INTERFACE.NAME; Modified to inform user when no
interfaces have been loaded)
(FNS ACQUIRE.INTERFACE.NAME.Original ACQUIRE.INTERFACE.NAME)
(* * PARC fixes to Trillium source)
(* * SET.TRILLIUM.FILES.LOCATION modified to include only host
and release directory, and to end with >)
(FNS SET.TRILLIUM.FILES.LOCATION.Original
SET.TRILLIUM.FILES.LOCATION)
(* * TRILLIUM.MAKESYS modified to cause fix file loading when
sysout is restarted)
(FNS TRILLIUM.MAKESYS.Original TRILLIUM.MAKESYS)
(* * TRILLIUM.SET.SOURCE modified to make use of new var
TRILLIUM.SOURCE.SUBDIRECTORY)
(FNS TRILLIUM.SET.SOURCE.Original TRILLIUM.SET.SOURCE)
(* * TRILLIUM.LOAD.FIXES new function to do work of loading all
fix files)
(FNS TRILLIUM.LOAD.FIXES)
(* * TRILLIUM.LOAD.TRILLIUM? modified to make use of modified
TRILLIUM.FILENAME)
(FNS TRILLIUM.LOAD.TRILLIUM?.Original TRILLIUM.LOAD.TRILLIUM?)
(* * TRILLIUM.FILENAME modified to take argument indicating which
subdirectory of the release to take file from)
(FNS TRILLIUM.FILENAME.Original TRILLIUM.FILENAME)
(* * TRILLIUM.RELEASE.HOST/DIRECTORY Obsolete variable, set to
NOBIND)
(VARS TRILLIUM.RELEASE.HOST/DIRECTORY)
(* * *.SUBDIRECTORY new (global)
variables locating the subdirectories wherein various parts of
Trillium are kept)
(VARS TRILLIUM.SOURCE.SUBDIRECTORY TRILLIUM.PTYPE.SUBDIRECTORY
TRILLIUM.ITEMTYPE.SUBDIRECTORY TRILLIUM.FIX.SUBDIRECTORY
TRILLIUM.INTERFACE.SUBDIRECTORY)
(* * Henrietta fixes to Trillium Itemtypes and Ptypes)
(* LABELLED.BUTTON Changed default LABEL value to be "1" instead
of 1)
(ITEMTYPES LABELLED.BUTTON)
(* Submitted by PatH: BITMAP.NAME/CREATE used
(LISTGET CURRENT.FRAME.CLASSES (QUOTE BITMAP.FRAMES))
instead of CURRENT.BITMAP.FRAMES)
(FNS BITMAP.NAME/CREATE.Original)
(PTYPES BITMAP.NAME)
(P (COMPILE.INTERNAL.FNS.IF.NECESSARY))))
(* * Henrietta fixes to Trillium source)
(* * FONTS.IN.CORE: Didn't search list by device type. If the DISPLAY font type was not first
in the list, it wouldn't be included in the font menu.)
(DEFINEQ
(FONTS.IN.CORE.Original
[LAMBDA NIL (* edited: " 4-DEC-82 15:28")
(DECLARE (GLOBALVARS \FONTSINCORE))
(for FAMILY in \FONTSINCORE join (for SIZE in (CDR FAMILY)
join (for FACE in (CDR SIZE)
when (EQ (CAR (CADR (CADR FACE)))
(QUOTE DISPLAY))
collect (LIST (CAR FAMILY)
(CAR SIZE)
(CAR FACE])
(FONTS.IN.CORE
[LAMBDA NIL (* edited: " 4-DEC-82 15:28")
(DECLARE (GLOBALVARS \FONTSINCORE))
(for FAMILY in \FONTSINCORE join (for SIZE in (CDR FAMILY)
join (for FACE in (CDR SIZE)
when (EQ (CAR (CADR (CADR FACE)))
(QUOTE DISPLAY))
collect (LIST (CAR FAMILY)
(CAR SIZE)
(CAR FACE])
)
(* * FORGET.FRAME.CLASS: Didn't reset CURRENT.BITMAP.FRAMES)
(DEFINEQ
(FORGET.FRAME.CLASS.Original
[LAMBDA (FRAME) (* HaKo "25-Jul-84 16:28")
(DECLARE (GLOBALVARS CURRENT.INTERFACE FRAME.NAME.MENU))
(PROG (FRAME.NAME CLASSES CLASS.NAME)
(SETQ FRAME.NAME (GET.FIELDQ FRAME NAME FRAME))
(SETQ CLASSES (GET.FIELDQ FRAME CLASSES))
(COND
((NULL CLASSES)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "This frame has no classes; can't forget one"))
(T (SETQ CLASS.NAME
(MENU (create MENU
ITEMS ← CLASSES
TITLE ← "Classes"
CENTERFLG ← T
CHANGEOFFSETFLG ← T)))
(COND
((AND CLASS.NAME (CONFIRM (CONCAT "Forget class" CLASS.NAME "?")))
(SET.FIELDQ FRAME CLASSES (REMOVE CLASS.NAME CLASSES))
(MARK.INTERFACE CURRENT.INTERFACE)
(SETQ FRAME.NAME.MENU)
(RETURN T))
(T (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "FORGET.FRAME.CLASS command aborted"])
(FORGET.FRAME.CLASS
[LAMBDA (FRAME) (* kkm "29-Nov-84 15:41")
(DECLARE (GLOBALVARS CURRENT.INTERFACE FRAME.NAME.MENU))
(PROG (FRAME.NAME CLASSES CLASS.NAME)
(SETQ FRAME.NAME (GET.FIELDQ FRAME NAME FRAME))
(SETQ CLASSES (GET.FIELDQ FRAME CLASSES))
(COND
((NULL CLASSES)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "This frame has no classes; can't forget one"))
(T (SETQ CLASS.NAME
(MENU (create MENU
ITEMS ← CLASSES
TITLE ← "Classes"
CENTERFLG ← T
CHANGEOFFSETFLG ← T)))
(COND
((AND CLASS.NAME (CONFIRM (CONCAT "Forget class" CLASS.NAME "?")))
(SET.FIELDQ FRAME CLASSES (REMOVE CLASS.NAME CLASSES))
(MARK.INTERFACE CURRENT.INTERFACE)
(SETQ FRAME.NAME.MENU)
(SETQ CURRENT.BITMAP.FRAMES)
(RETURN T))
(T (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "FORGET.FRAME.CLASS command aborted"])
)
(* * MOVE.ITEM: Flips all items in the frame while prompting for item's new placement)
(DEFINEQ
(MOVE.ITEM.Original
[LAMBDA (FRAME) (* HaKo "25-Jul-84 16:52")
(PROG (ITEM DELTA.POSITION OLD.POSITION)
(SETQ ITEM (ACQUIRE.ITEM FRAME "Point out the item to be moved"))
(COND
((NULL ITEM)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot find any item where you pointed: move command aborted"))
((NOT (TYPE.DEFINEDP ITEM))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Can't move that item, as its type is undefined"))
(T (SETQ OLD.POSITION (BOUNDING.BOX ITEM))
(SETQ DELTA.POSITION (ACQUIRE.MOVED.PLACEMENT ITEM
"Indicate a new placement for the item"))
(THINKING (TRANSLATE.PLACEMENT ITEM DELTA.POSITION)
(ANALYZE&COMPLETE.ITEM ITEM FRAME)
(UPDATE&DISPLAY.FRAME FRAME ITEM OLD.POSITION))
(RETURN ITEM])
(MOVE.ITEM
[LAMBDA (FRAME) (* kkm "29-Nov-84 19:48")
(PROG (ITEM DELTA.POSITION OLD.POSITION)
(SETQ ITEM (ACQUIRE.ITEM FRAME "Point out the item to be moved"))
(COND
((NULL ITEM)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot find any item where you pointed: move command aborted"))
((NOT (TYPE.DEFINEDP ITEM))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Can't move that item, as its type is undefined"))
(T (SETQ OLD.POSITION (BOUNDING.BOX ITEM))
(FLIP.ALL.ITEMS FRAME)
(SETQ DELTA.POSITION (ACQUIRE.MOVED.PLACEMENT ITEM
"Indicate a new placement for the item"))
(FLIP.ALL.ITEMS FRAME)
(THINKING (TRANSLATE.PLACEMENT ITEM DELTA.POSITION)
(ANALYZE&COMPLETE.ITEM ITEM FRAME)
(UPDATE&DISPLAY.FRAME FRAME ITEM OLD.POSITION))
(RETURN ITEM])
)
(* * COPY.INTERFACE: Modified to copy the color map of the interface, also)
(DEFINEQ
(COPY.INTERFACE.Original
[LAMBDA (INTERFACE) (* kkm " 2-Jan-85 17:03")
(PROG (NAME NEW.NAME NEW.INTERFACE FRAMES FIRST.FRAME REGION PROFILE BACKGROUND.COLOR)
(SETQ NAME (GET.FIELDQ INTERFACE NAME INTERFACE))
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Copying interface " NAME)
(TRILLIUM.PRINTOUT ON PROMPTWINDOW "Name of copy: ")
(SETQ NEW.NAME (PROMPT.READ))
(COND
((NULL NEW.NAME)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Copy command aborted"))
((NOT (ATOM NEW.NAME))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Name must be one word")
(RETURN))
((FIND.INTERFACE NEW.NAME)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "The name " NEW.NAME " is already in use")
(RETURN))
(T (SETQ FRAMES (for FRAME in (GET.FIELDQ INTERFACE FRAMES) collect (COPY.FRAME FRAME)))
(SETQ FIRST.FRAME (GET.FIELDQ INTERFACE FIRST.FRAME))
(SETQ REGION (COPY (GET.FIELDQ INTERFACE REGION)))
(SETQ PROFILE (COPYALL (GET.FIELDQ INTERFACE PROFILE)))
(SETQ BACKGROUND.COLOR (COPYALL (GET.FIELDQ INTERFACE BACKGROUND.COLOR)))
(SETQ NEW.INTERFACE (ITEM.CREATE INTERFACE (NAME NEW.NAME)
(FRAMES FRAMES)
(FIRST.FRAME FIRST.FRAME)
(REGION REGION)
(PROFILE PROFILE)
(BACKGROUND.COLOR BACKGROUND.COLOR)
(COLOR.MAP.INTENSITIES COLOR.MAP.INTENSITIES)))
(ADD.NEW.INTERFACE NEW.INTERFACE)
(MARK.INTERFACE NEW.INTERFACE T)
(RETURN NEW.NAME])
(COPY.INTERFACE
[LAMBDA (INTERFACE) (* kkm "19-Nov-84 12:50")
(PROG (NAME NEW.NAME NEW.INTERFACE FRAMES FIRST.FRAME REGION PROFILE BACKGROUND.COLOR)
(SETQ NAME (GET.FIELDQ INTERFACE NAME INTERFACE))
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Copying interface " NAME)
(TRILLIUM.PRINTOUT ON PROMPTWINDOW "Name of copy: ")
(SETQ NEW.NAME (PROMPT.READ))
(COND
((NULL NEW.NAME)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Copy command aborted"))
((NOT (ATOM NEW.NAME))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Name must be one word")
(RETURN))
((FIND.INTERFACE NEW.NAME)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "The name " NEW.NAME " is already in use")
(RETURN))
(T (SETQ FRAMES (for FRAME in (GET.FIELDQ INTERFACE FRAMES) collect (COPY.FRAME FRAME)))
(SETQ FIRST.FRAME (GET.FIELDQ INTERFACE FIRST.FRAME))
(SETQ REGION (COPY (GET.FIELDQ INTERFACE REGION)))
(SETQ PROFILE (COPYALL (GET.FIELDQ INTERFACE PROFILE)))
(SETQ BACKGROUND.COLOR (COPYALL (GET.FIELDQ INTERFACE BACKGROUND.COLOR)))
(SETQ NEW.INTERFACE (ITEM.CREATE INTERFACE (NAME NEW.NAME)
(FRAMES FRAMES)
(FIRST.FRAME FIRST.FRAME)
(REGION REGION)
(PROFILE PROFILE)
(BACKGROUND.COLOR BACKGROUND.COLOR)))
(ADD.NEW.INTERFACE NEW.INTERFACE)
(MARK.INTERFACE NEW.INTERFACE T)
(RETURN NEW.NAME])
)
(* * Webster fixes to Trillium source)
(* * ACQUIRE.INTERFACE.NAME; Modified to inform user when no interfaces have been loaded)
(DEFINEQ
(ACQUIRE.INTERFACE.NAME.Original
[LAMBDA NIL (* DAHJr "18-JAN-83 14:46")
(DECLARE (GLOBALVARS INTERFACES))
(MENU (create MENU
ITEMS ← INTERFACES
TITLE ← "Interfaces"
CENTERFLG ← T
CHANGEOFFSETFLG ← T])
(ACQUIRE.INTERFACE.NAME
[LAMBDA NIL (* PH "18-Dec-84 16:23")
(* * Changed to print out a message if there are no interfaces in the system)
(DECLARE (GLOBALVARS INTERFACES))
(COND
(INTERFACES (MENU (create MENU
ITEMS ← INTERFACES
TITLE ← "Interfaces"
CENTERFLG ← T
CHANGEOFFSETFLG ← T)))
(T (TRILLIUM.PRINTOUT T "No interfaces!" T])
)
(* * PARC fixes to Trillium source)
(* * SET.TRILLIUM.FILES.LOCATION modified to include only host and release directory, and to
end with >)
(DEFINEQ
(SET.TRILLIUM.FILES.LOCATION.Original
[LAMBDA (FILE)
(DECLARE (GLOBALVARS TRILLIUM.DIRECTORY TRILLIUM.HOST))
(PROG ((UPFN (UNPACKFILENAME FILE)))
(SETQ TRILLIUM.HOST (LISTGET UPFN (QUOTE HOST)))
(SETQ TRILLIUM.DIRECTORY (LISTGET UPFN (QUOTE DIRECTORY])
(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.MAKESYS modified to cause fix file loading when sysout is restarted)
(DEFINEQ
(TRILLIUM.MAKESYS.Original
[LAMBDA (BIGSYSFLG SYSFILESPEC) (* NHB "17-Dec-84 13:29")
(DECLARE (GLOBALVARS ADVISEDFNS AFTERSYSOUTFORMS 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))
\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.INIT)
AFTERSYSOUTFORMS)
(NCONC1 AFTERSYSOUTFORMS (QUOTE (TRILLIUM.INIT]
(RECLAIM)
(MAKESYS MAKESYSFILE])
(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.SET.SOURCE modified to make use of new var TRILLIUM.SOURCE.SUBDIRECTORY)
(DEFINEQ
(TRILLIUM.SET.SOURCE.Original
[LAMBDA (FILE) (* NHB "17-Dec-84 12:26")
(DECLARE (GLOBALVARS TRILLIUM.DIRECTORY TRILLIUM.HOST))
(CDR (RPLACD (CAR (GETPROP FILE (QUOTE FILEDATES)))
(PACKFILENAME (QUOTE HOST)
TRILLIUM.HOST
(QUOTE DIRECTORY)
TRILLIUM.DIRECTORY
(QUOTE NAME)
FILE])
(TRILLIUM.SET.SOURCE
[LAMBDA (FILE) (* NHB "17-Dec-84 15:21")
(DECLARE (GLOBALVARS TRILLIUM.DIRECTORY TRILLIUM.HOST))
(CDR (RPLACD (CAR (GETPROP FILE (QUOTE FILEDATES)))
(PACKFILENAME (QUOTE HOST)
TRILLIUM.HOST
(QUOTE DIRECTORY)
(CONCAT TRILLIUM.DIRECTORY TRILLIUM.SOURCE.SUBDIRECTORY)
(QUOTE NAME)
FILE])
)
(* * TRILLIUM.LOAD.FIXES new function to do work of loading all fix files)
(DEFINEQ
(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.LOAD.TRILLIUM? modified to make use of modified TRILLIUM.FILENAME)
(DEFINEQ
(TRILLIUM.LOAD.TRILLIUM?.Original
[LAMBDA NIL (* kkm "26-Nov-84 11:44")
(* DAHJr " 5-DEC-83 09:17")
(* Load the Trillium system unless TRILLIUM.LOADED has
a value.)
(DECLARE (GLOBALVARS TRILLIUM.FILES TRILLIUM.LOADED))
(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]
(LOAD (TRILLIUM.FILENAME (QUOTE TRI-ITEMTYPES))
(AND SYSONLY? (QUOTE SYSLOAD)))
(TRILLIUM.INIT)
(TRILLIUM (create POSITION
XCOORD ← 730
YCOORD ← 330))
[COND
(STANDARD? (for F in (QUOTE (PRIMITIVE-ITEMTYPES COMPOSITE-ITEMTYPES))
do (LOAD (TRILLIUM.ITEMTYPES.FILENAME F)
(AND SYSONLY? (QUOTE SYSLOAD)))
(MARK.OBJECT.FILE F))
(LOAD (TRILLIUM.PTYPES.FILENAME (QUOTE BASIC-PTYPES))
(AND SYSONLY? (QUOTE SYSLOAD)))
(MARK.OBJECT.FILE (QUOTE BASIC-PTYPES]
[COND
(DEMO? (LOAD (TRILLIUM.FILENAME (QUOTE DEMO-INTERFACE))
(AND SYSONLY? (QUOTE SYSLOAD)))
(MARK.OBJECT.FILE (QUOTE DEMO-INTERFACE]
(COMPILE.INTERNAL.FNS.IF.NECESSARY)
(RETURN T])
(TRILLIUM.LOAD.TRILLIUM?
[LAMBDA NIL (* NHB "17-Dec-84 15:29")
(* 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]
(LOAD (TRILLIUM.FILENAME (QUOTE TRI-ITEMTYPES))
(AND SYSONLY? (QUOTE SYSLOAD)))
(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)))
(MARK.OBJECT.FILE F))
(LOAD (TRILLIUM.FILENAME (QUOTE BASIC-PTYPES)
NIL TRILLIUM.PTYPE.SUBDIRECTORY)
(AND SYSONLY? (QUOTE SYSLOAD)))
(MARK.OBJECT.FILE (QUOTE BASIC-PTYPES]
[COND
(DEMO? (LOAD (TRILLIUM.FILENAME (QUOTE DEMO-INTERFACE)
NIL TRILLIUM.INTERFACE.SUBDIRECTORY)
(AND SYSONLY? (QUOTE SYSLOAD)))
(MARK.OBJECT.FILE (QUOTE DEMO-INTERFACE]
(COMPILE.INTERNAL.FNS.IF.NECESSARY)
(RETURN T])
)
(* * TRILLIUM.FILENAME modified to take argument indicating which subdirectory of the release
to take file from)
(DEFINEQ
(TRILLIUM.FILENAME.Original
[LAMBDA (FILE COMPILED) (* edited: "18-SEP-82 09:52")
(DECLARE (GLOBALVARS COMPILE.EXT TRILLIUM.DIRECTORY TRILLIUM.HOST))
(COND
(COMPILED (PACKFILENAME (QUOTE HOST)
TRILLIUM.HOST
(QUOTE DIRECTORY)
TRILLIUM.DIRECTORY
(QUOTE NAME)
FILE
(QUOTE EXTENSION)
COMPILE.EXT))
(T (PACKFILENAME (QUOTE HOST)
TRILLIUM.HOST
(QUOTE DIRECTORY)
TRILLIUM.DIRECTORY
(QUOTE NAME)
FILE])
(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.RELEASE.HOST/DIRECTORY Obsolete variable, set to NOBIND)
(RPAQQ TRILLIUM.RELEASE.HOST/DIRECTORY NOBIND)
(* * *.SUBDIRECTORY new (global) variables locating the subdirectories wherein various parts of
Trillium are kept)
(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)
(* * Henrietta fixes to Trillium Itemtypes and Ptypes)
(* LABELLED.BUTTON Changed default LABEL value to be "1" instead of 1)
(READ.ITEMTYPE LABELLED.BUTTON 5)
(\TYPE ITEM.TYPE NAME LABELLED.BUTTON COMMENT
"A button, with a label centered on it, which flashes when pushed, and performs an action" KIND
COMPOSITE PARAMETERS ((\TYPE PARAMETER NAME PLACEMENT TYPE (POSITION) DEFAULT (170 . 170) COMMENT
"The grid position of the lower left corner of the button" GRID.TYPE (LOCATION)) (\TYPE PARAMETER
NAME LABEL TYPE (STRING) DEFAULT "1" COMMENT "The words on the button") (\TYPE PARAMETER NAME FONT
TYPE (FONT) DEFAULT NIL COMMENT "The font for the button label") (\TYPE PARAMETER NAME ACTION.FORM
TYPE (FORM) DEFAULT (ACTION.PRINT "This action brought to you by a LABELLED.BUTTON") COMMENT
"The action caused by this button") (\TYPE PARAMETER NAME PICTURE TYPE (BITMAP.NAME) DEFAULT
SIMPLE.BUTTON.BITMAP COMMENT "The graphic for the button")) SUBITEM.SPECS ((LABEL BUTTON (ITEM
PICTURE (PLACEMENT (PTRANSLATE PLACEMENT (NEW.POSITION (MINUS BUTTON.BITMAP.EXTRA) 0))) (BITMAP
PICTURE))) (ITEM LINE.OF.TEXT (PLACEMENT (PICTURE.CENTER BUTTON)) (LINE LABEL) (XALIGNMENT (
QUOTE CENTER)) (FONT FONT)) (ITEM FLASHING.SENSITIVE.REGION (PLACEMENT (BOUNDING.BOX BUTTON)) (
ACTION.FORM ACTION.FORM))) CLASSES (COMPOSITE BUTTON))
(* Submitted by PatH: BITMAP.NAME/CREATE used (LISTGET CURRENT.FRAME.CLASSES (QUOTE
BITMAP.FRAMES)) instead of CURRENT.BITMAP.FRAMES)
(DEFINEQ
(BITMAP.NAME/CREATE.Original
[LAMBDA (TYPE) (* kkm "19-Nov-84 12:38")
(DECLARE (GLOBALVARS CURRENT.FRAME CURRENT.FRAME.CLASSES CURRENT.INTERFACE))
(PROG [BITMAPNAMEMENU FRAMENAMEMENU BITMAPNAME FRAMELIST (RETURNTOCLASSMENU
(CONSTANT (MENUNAME.FROM.CLASSNAME (QUOTE RETURN.TO.FRAME.LIST]
(* USING STRUCTURED MENUS (PROG (NAMES) (SETQ NAMES (for ITEM in (GET.FIELDQ (FIND.FRAME CURRENT.DIALOG
(QUOTE BITMAPS)) ITEMS FRAME) when (EQ (ITEM.TYPE ITEM) (QUOTE BITMAP)) collect (GET.FIELDQ ITEM NAME)))
(SETQ NAMES (SORT NAMES)) (COND ((EQUAL (CAR BITMAP.NAME.MENU) NAMES)) (T (SETQ BITMAP.NAME.MENU
(CONS NAMES (STRUCTURED.MENU.CREATE NAMES 20 NIL NIL NIL T NIL NIL NIL NIL T))))) (RETURN (STRUCTURED.MENU.INVOKE
(CDR BITMAP.NAME.MENU)))))
[SETQ FRAMELIST (OR (LISTGET CURRENT.FRAME.CLASSES (QUOTE BITMAP.FRAMES))
(LIST (QUOTE BITMAPS]
(SETQ BITMAPNAMEMENU (SETQ FRAMENAMEMENU (create MENU
TITLE ← "Choose Bitmap Frame: "
ITEMS ←[UNION (LIST (
MENUNAME.FROM.CLASSNAME (GET.FIELDQ CURRENT.FRAME NAME FRAME)))
(SORT (for FRAME
in FRAMELIST
collect
(
MENUNAME.FROM.CLASSNAME FRAME]
CENTERFLG ← T
CHANGEOFFSETFLG ← T)))
[while (MENUCLASSNAMEP (SETQ BITMAPNAME (MENU BITMAPNAMEMENU)))
do (COND
((EQ BITMAPNAME RETURNTOCLASSMENU)
(SETQ BITMAPNAMEMENU FRAMENAMEMENU))
(T (SETQ BITMAPNAMEMENU (GET.BITMAP.NAME.MENU (for ITEM
in (GET.FIELDQ
(FIND.FRAME CURRENT.INTERFACE
(
CLASSNAME.FROM.MENUNAME BITMAPNAME))
ITEMS FRAME)
when (EQ (ITEM.TYPE ITEM)
(QUOTE BITMAP))
collect (GET.PARAMQ ITEM NAME))
RETURNTOCLASSMENU]
(RETURN (OR BITMAPNAME (QUOTE EXAMPLE.BITMAP])
)
(READ.PTYPE BITMAP.NAME 1)
(\TYPE PTYPE NAME BITMAP.NAME COMMENT "A Bitmap name" OTHER (FNS ((CREATE BITMAP.NAME/CREATE))))
(DEFINEQ
(BITMAP.NAME/CREATE
[LAMBDA (TYPE) (* edited: "11-Dec-84 09:43")
(DECLARE (GLOBALVARS CURRENT.FRAME CURRENT.FRAME.CLASSES CURRENT.INTERFACE))
(PROG [BITMAPNAMEMENU FRAMENAMEMENU BITMAPNAME FRAMELIST (RETURNTOCLASSMENU
(CONSTANT (MENUNAME.FROM.CLASSNAME (QUOTE RETURN.TO.FRAME.LIST]
(* USING STRUCTURED MENUS (PROG (NAMES) (SETQ NAMES (for ITEM in (GET.FIELDQ (FIND.FRAME CURRENT.DIALOG
(QUOTE BITMAPS)) ITEMS FRAME) when (EQ (ITEM.TYPE ITEM) (QUOTE BITMAP)) collect (GET.FIELDQ ITEM NAME)))
(SETQ NAMES (SORT NAMES)) (COND ((EQUAL (CAR BITMAP.NAME.MENU) NAMES)) (T (SETQ BITMAP.NAME.MENU
(CONS NAMES (STRUCTURED.MENU.CREATE NAMES 20 NIL NIL NIL T NIL NIL NIL NIL T))))) (RETURN (STRUCTURED.MENU.INVOKE
(CDR BITMAP.NAME.MENU)))))
(SETQ FRAMELIST (FOR FRAME IN (OR CURRENT.BITMAP.FRAMES (SET.CURRENT.BITMAP.FRAMES))
COLLECT (GET.FIELDQ FRAME NAME FRAME)))
(SETQ BITMAPNAMEMENU (SETQ FRAMENAMEMENU (create MENU
TITLE ← "Choose Bitmap Frame: "
ITEMS ←[UNION (LIST (
MENUNAME.FROM.CLASSNAME (GET.FIELDQ CURRENT.FRAME NAME FRAME)))
(SORT (for FRAME
in FRAMELIST
collect
(
MENUNAME.FROM.CLASSNAME FRAME]
CENTERFLG ← T
CHANGEOFFSETFLG ← T)))
[while (MENUCLASSNAMEP (SETQ BITMAPNAME (MENU BITMAPNAMEMENU)))
do (COND
((EQ BITMAPNAME RETURNTOCLASSMENU)
(SETQ BITMAPNAMEMENU FRAMENAMEMENU))
(T (SETQ BITMAPNAMEMENU (GET.BITMAP.NAME.MENU (for ITEM
in (GET.FIELDQ
(FIND.FRAME CURRENT.INTERFACE
(
CLASSNAME.FROM.MENUNAME BITMAPNAME))
ITEMS FRAME)
when (EQ (ITEM.TYPE ITEM)
(QUOTE BITMAP))
collect (GET.PARAMQ ITEM NAME))
RETURNTOCLASSMENU]
(RETURN (OR BITMAPNAME (QUOTE EXAMPLE.BITMAP])
)
(COMPILE.INTERNAL.FNS.IF.NECESSARY)
(PUTPROPS JAN-7-85-FIXES-COMPLETE COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3493 4494 (FONTS.IN.CORE.Original 3503 . 4001) (FONTS.IN.CORE 4003 . 4492)) (4562 6630
(FORGET.FRAME.CLASS.Original 4572 . 5585) (FORGET.FRAME.CLASS 5587 . 6628)) (6724 8570 (
MOVE.ITEM.Original 6734 . 7624) (MOVE.ITEM 7626 . 8568)) (8653 11892 (COPY.INTERFACE.Original 8663 .
10306) (COPY.INTERFACE 10308 . 11890)) (12034 12807 (ACQUIRE.INTERFACE.NAME.Original 12044 . 12342) (
ACQUIRE.INTERFACE.NAME 12344 . 12805)) (12962 14183 (SET.TRILLIUM.FILES.LOCATION.Original 12972 .
13298) (SET.TRILLIUM.FILES.LOCATION 13300 . 14181)) (14273 19987 (TRILLIUM.MAKESYS.Original 14283 .
16974) (TRILLIUM.MAKESYS 16976 . 19985)) (20081 20998 (TRILLIUM.SET.SOURCE.Original 20091 . 20526) (
TRILLIUM.SET.SOURCE 20528 . 20996)) (21080 22133 (TRILLIUM.LOAD.FIXES 21090 . 22131)) (22221 29094 (
TRILLIUM.LOAD.TRILLIUM?.Original 22231 . 25566) (TRILLIUM.LOAD.TRILLIUM? 25568 . 29092)) (29215 30645
(TRILLIUM.FILENAME.Original 29225 . 29840) (TRILLIUM.FILENAME 29842 . 30643)) (32674 34745 (
BITMAP.NAME/CREATE.Original 32684 . 34743)) (34873 36963 (BITMAP.NAME/CREATE 34883 . 36961)))))
STOP