(FILECREATED " 6-Jun-85 19:46:12" {PHYLUM}<TRILLIUM>BIRTHDAY84>FIXES>JUN-6-85-FIXES-COMPLETE.;1 56334
changes to: (FNS LoadPatches TRILLIUM.LOAD.FIXES PROFILE.EDITOR.TITLECOMMANDFN)
(VARS JUN-6-85-FIXES-COMPLETECOMS)
previous date: " 6-Jun-85 19:15:31"
{PHYLUM}<TRILLIUM>BIRTHDAY84>FIXES>JUN-6-85-FIXES-COMPLETE.;1)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT JUN-6-85-FIXES-COMPLETECOMS)
(RPAQQ JUN-6-85-FIXES-COMPLETECOMS [(* * Useful fn - the patch loader from <lispusers> modified to do
right thing for PROP/ALLPROP)
(FNS LoadPatches)
(* * 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)
(* * add itemtype and ptype to the list of objects included in a
LISTFILE index)
(ADDVARS (INDEXEDTYPESLST (ITEMTYPE READ.ITEMTYPE)
(PTYPE READ.PTYPE)))
(* * MAKE.ITEMTYPES.COMS and MAKE.PTYPES.COMS now add a comment
giving name of object)
(FNS MAKE.ITEMTYPES.COMS.Original MAKE.ITEMTYPES.COMS
MAKE.PTYPES.COMS.Original MAKE.PTYPES.COMS)
(* * don't use \CONNECTED.xxx, use (DIRECTORYNAME T T))
(FNS PROFILE.EDITOR.TITLECOMMANDFN
PROFILE.EDITOR.TITLECOMMANDFN.Original TRILLIUM.CONN?
TRILLIUM.CONN?.Original)
(* * LIST.OBJECTS.ON.FILE mustn't delete file before LISTFILES is
finished)
(FNS LIST.OBJECTS.ON.FILE.Original LIST.OBJECTS.ON.FILE)
(* * fix DELETE.INTERFACE to do a more thorough job of deleting
an interface)
(FNS DELETE.INTERFACE)
(* * fixes to Trillium Itemtypes and Ptypes)
(* * LABELLED.BUTTON Changed default LABEL value to be "1"
instead of 1)
(ITEMTYPES LABELLED.BUTTON)
(* * INVERTING.CASCADE.LIGHT alignment values were inadvertently
quoted: D.Ingalls)
(ITEMTYPES INVERTING.CASCADE.LIGHT)
(* * 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))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML MAKE.PTYPES.COMS
MAKE.PTYPES.COMS.Original
MAKE.ITEMTYPES.COMS
MAKE.ITEMTYPES.COMS.Original)
(LAMA])
(* * Useful fn - the patch loader from <lispusers> modified to do right thing for PROP/ALLPROP)
(DEFINEQ
(LoadPatches
[LAMBDA (directory ldflg afterDate) (* smL "29-May-85 14:17")
(* * Load all DCOM files from the directory)
(DECLARE (GLOBALVARS COMPILE.EXT))
(LET [(afterIDate (if afterDate
then (OR (IDATE afterDate)
0)
else 0))
(files (NCONC (for file in (FILDIR (CONCAT directory "*." COMPILE.EXT))
collect (FILENAMEFIELD file (QUOTE NAME)))
(for file in (FILDIR (CONCAT directory "*.")) collect (FILENAMEFIELD
file
(QUOTE NAME]
(* Remove duplications)
(SETQ files (INTERSECTION files files)) (* Prefer the compiled over uncompiled unless user
specified a ldflg of PROP or ALLPROP)
[if (MEMB ldflg (QUOTE (PROP ALLPROP)))
then [SETQ files (for file in files collect (OR (INFILEP (CONCAT directory file))
(INFILEP (CONCAT directory file "."
COMPILE.EXT]
else (SETQ files (for file in files collect (OR (INFILEP (CONCAT directory file "."
COMPILE.EXT))
(INFILEP (CONCAT directory file]
[SETQ files (for file in files collect (OR (INFILEP (CONCAT directory file "." COMPILE.EXT))
(INFILEP (CONCAT directory file]
(* We could have picked up files that existed in a
subdirectory -- but they got turned into NIL in the
INFILEP)
(SETQ files (DREMOVE NIL files)) (* Now sort the files by date)
[SETQ files (for file in files collect (CONS file (GETFILEINFO file (QUOTE ICREATIONDATE]
[SETQ files (SORT files (FUNCTION (LAMBDA (X Y)
(LESSP (CDR X)
(CDR Y] (* Finally, load the files made after the given date)
(for file in files when (GREATERP (CDR file)
afterIDate)
do (SELECTQ ldflg
(HIDDEN (* Load the file, but don't put it on FILELST)
(LOAD? (CAR file)
T)
(SETQ FILELST (DREMOVE (FILENAMEFIELD (CAR file)
(QUOTE NAME))
FILELST)))
(LOAD? (CAR file)
ldflg)))
files])
)
(* * 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 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.MAKESYS
[LAMBDA (BIGSYSFLG SYSFILESPEC) (* TBigham "10-Apr-85 23:21")
(* Fixed by NHB to handle null connected directory)
(DECLARE (GLOBALVARS ADVISEDFNS POSTGREETFORMS CHANGESARRAY FILELST INTERFACES NOTCOMPILEDFILES
NOTLISTEDFILES))
(PROG [(MAKESYSFILE (PACKFILENAME (QUOTE HOST)
(OR (FILENAMEFIELD SYSFILESPEC (QUOTE HOST))
(FILENAMEFIELD (DIRECTORYNAME T T)
(QUOTE HOST)))
(QUOTE DIRECTORY)
(OR (FILENAMEFIELD SYSFILESPEC (QUOTE DIRECTORY))
(FILENAMEFIELD (DIRECTORYNAME T T)
(QUOTE DIRECTORY)))
(QUOTE NAME)
(if (FILENAMEFIELD SYSFILESPEC (QUOTE NAME))
elseif BIGSYSFLG
then (QUOTE BIGTRILLIUM)
else (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 PROFILE.INIT)
POSTGREETFORMS)
(NCONC1 POSTGREETFORMS (QUOTE (PROFILE.INIT]
[OR (FASSOC (QUOTE TRILLIUM.LOAD.FIXES)
POSTGREETFORMS)
(NCONC1 POSTGREETFORMS (QUOTE (TRILLIUM.LOAD.FIXES]
(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 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.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))
(LoadPatches (TRILLIUM.FILENAME "" NIL TRILLIUM.FIX.SUBDIRECTORY)
(if (GETPROP (QUOTE TRILLIUM.INIT)
(QUOTE EXPR))
then (QUOTE ALLPROP))
MAKESYSDATE])
)
(* * 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 (* 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.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)
(* * add itemtype and ptype to the list of objects included in a LISTFILE index)
(ADDTOVAR INDEXEDTYPESLST (ITEMTYPE READ.ITEMTYPE)
(PTYPE READ.PTYPE))
(* * MAKE.ITEMTYPES.COMS and MAKE.PTYPES.COMS now add a comment giving name of object)
(DEFINEQ
(MAKE.ITEMTYPES.COMS.Original
[NLAMBDA (ITYPES) (* DAHJr "14-APR-83 21:22")
(for ITYPE in ITYPES bind (DESCRIPTION OTHER FNS)
join (SETQ DESCRIPTION (ITEM.TYPE.DESCRIPTION ITYPE))
(SETQ OTHER (GET.FIELDQ DESCRIPTION OTHER ITEM.TYPE))
(SETQ FNS (for FN in (LISTGET OTHER (QUOTE FNS)) collect (CADR FN)))
(CONS (LIST (QUOTE E)
(LIST (QUOTE DUMP.ITEMTYPE)
(KWOTE ITYPE)))
(AND FNS (LIST (CONS (QUOTE FNS)
FNS])
(MAKE.ITEMTYPES.COMS
[NLAMBDA (ITYPES) (* edited: " 7-Jan-85 15:45")
(for ITYPE in ITYPES bind (DESCRIPTION OTHER FNS)
join (SETQ DESCRIPTION (ITEM.TYPE.DESCRIPTION ITYPE))
(SETQ OTHER (GET.FIELDQ DESCRIPTION OTHER ITEM.TYPES))
(SETQ FNS (for FN in (LISTGET OTHER (QUOTE FNS)) collect (CADR FN)))
(CONS (LIST (QUOTE *)
ITYPE)
(CONS (LIST (QUOTE E)
(LIST (QUOTE DUMP.ITEMTYPE)
(KWOTE ITYPE)))
(AND FNS (LIST (CONS (QUOTE FNS)
FNS])
(MAKE.PTYPES.COMS.Original
[NLAMBDA (PTYPES) (* N.H.Briggs "18-Jan-85 15:12")
(for PTYPE in PTYPES bind (DESCRIPTION OTHER FNS)
join (SETQ DESCRIPTION (PTYPE.DESCRIPTION PTYPE))
(SETQ OTHER (GET.FIELDQ DESCRIPTION OTHER))
(SETQ FNS (for FN in (LISTGET OTHER (QUOTE FNS)) collect (CADR FN)))
(CONS (LIST (QUOTE E)
(LIST (QUOTE DUMP.PTYPE)
(KWOTE PTYPE)))
(AND FNS (LIST (CONS (QUOTE FNS)
FNS])
(MAKE.PTYPES.COMS
[NLAMBDA (PTYPES) (* N.H.Briggs "18-Jan-85 15:05")
(for PTYPE in PTYPES bind (DESCRIPTION OTHER FNS)
join (SETQ DESCRIPTION (PTYPE.DESCRIPTION PTYPE))
(SETQ OTHER (GET.FIELDQ DESCRIPTION OTHER))
(SETQ FNS (for FN in (LISTGET OTHER (QUOTE FNS)) collect (CADR FN)))
(CONS (LIST (QUOTE *)
PTYPE)
(CONS (LIST (QUOTE E)
(LIST (QUOTE DUMP.PTYPE)
(KWOTE PTYPE)))
(AND FNS (LIST (CONS (QUOTE FNS)
FNS])
)
(* * don't use \CONNECTED.xxx, use (DIRECTORYNAME T T))
(DEFINEQ
(PROFILE.EDITOR.TITLECOMMANDFN
[LAMBDA (WINDOW ITEM) (* TBigham "10-Apr-85 23:01")
(DECLARE (GLOBALVARS TRILLIUM.PROFILE))
(PROG (COMMAND.MENU FFN)
(TRILLIUM.CLEAR.ALL.PROMPTING)
(SETQ COMMAND.MENU (GET.PROFILE.EDITOR.TITLECOMMANDFN.MENU))
(SELECTQ (MENU COMMAND.MENU)
(NIL NIL)
(MAKE.CHANGES (PROFILE.EDITOR.MAKE.CHANGES WINDOW))
[SAVE.PROFILE (THINKING (PROFILE.EDITOR.MAKE.CHANGES WINDOW)
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Saving profile ... ")
[SET (FILECOMS (QUOTE TRILLIUM-PROFILE))
(QUOTE ((VARS TRILLIUM.PROFILE)
(P (COND
((AND (BOUNDP (QUOTE
TRILLIUM.PROFILE.EDITOR.WINDOW))
(WINDOWP
TRILLIUM.PROFILE.EDITOR.WINDOW))
(CLOSEW
TRILLIUM.PROFILE.EDITOR.WINDOW)))
(SETQ TRILLIUM.PROFILE.EDITOR.WINDOW]
(SETQ FFN (PACK* (DIRECTORYNAME NIL T)
(QUOTE TRILLIUM-PROFILE)))
(COND
((CONFIRM (CONCAT "Save PROFILE as " FFN " ?"))
(MAKEFILE FFN)
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE SAME.LINE "as "
FFN))
(T (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE SAME.LINE
" aborted. "]
(SHOULDNT "Unrecognized keyword in PROFILE.EDITOR.TITLECOMMANDFN"])
(PROFILE.EDITOR.TITLECOMMANDFN.Original
[LAMBDA (WINDOW ITEM) (* kkm "19-Nov-84 16:16")
(DECLARE (GLOBALVARS TRILLIUM.PROFILE))
(PROG (COMMAND.MENU FFN)
(TRILLIUM.CLEAR.ALL.PROMPTING)
(SETQ COMMAND.MENU (GET.PROFILE.EDITOR.TITLECOMMANDFN.MENU))
(SELECTQ (MENU COMMAND.MENU)
(NIL NIL)
(MAKE.CHANGES (PROFILE.EDITOR.MAKE.CHANGES WINDOW))
[SAVE.PROFILE (THINKING (PROFILE.EDITOR.MAKE.CHANGES WINDOW)
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Saving profile ... ")
[SET (FILECOMS (QUOTE TRILLIUM-PROFILE))
(QUOTE ((VARS TRILLIUM.PROFILE)
(P (COND
((AND (BOUNDP (QUOTE
TRILLIUM.PROFILE.EDITOR.WINDOW))
(WINDOWP
TRILLIUM.PROFILE.EDITOR.WINDOW))
(CLOSEW
TRILLIUM.PROFILE.EDITOR.WINDOW)))
(SETQ TRILLIUM.PROFILE.EDITOR.WINDOW]
(SETQ FFN (PACKFILENAME (QUOTE HOST)
\CONNECTED.HOST
(QUOTE DIRECTORY)
\CONNECTED.DIR
(QUOTE NAME)
(QUOTE TRILLIUM-PROFILE)))
(COND
((CONFIRM (CONCAT "Save PROFILE as " FFN " ?"))
(MAKEFILE FFN)
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE SAME.LINE "as "
FFN))
(T (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE SAME.LINE
" aborted. "]
(SHOULDNT "Unrecognized keyword in PROFILE.EDITOR.TITLECOMMANDFN"])
(TRILLIUM.CONN?
[LAMBDA NIL (* TBigham "10-Apr-85 22:48")
(DIRECTORYNAME T T])
(TRILLIUM.CONN?.Original
[LAMBDA NIL (* DAHJr "22-JAN-83 16:12")
(DECLARE (GLOBALVARS \CONNECTED.DIR \CONNECTED.HOST))
(PACKFILENAME (QUOTE HOST)
\CONNECTED.HOST
(QUOTE DIRECTORY)
\CONNECTED.DIR])
)
(* * LIST.OBJECTS.ON.FILE mustn't delete file before LISTFILES is finished)
(DEFINEQ
(LIST.OBJECTS.ON.FILE.Original
[LAMBDA (FILENAME) (* HaKo "16-Aug-84 16:29")
(DECLARE (GLOBALVARS TRILLIUM.OBJECT.FILES))
(PROG (ENTRY CONTENTS INTERFACE.NAMES ITEMTYPE.NAMES FN INTERFACE)
(SETQ ENTRY (FASSOC FILENAME TRILLIUM.OBJECT.FILES))
(SETQ CONTENTS (CDR ENTRY))
(SETQ FN (PACKFILENAME (QUOTE HOST)
(QUOTE CORE)
(QUOTE NAME)
FILENAME
(QUOTE EXTENSION)
(QUOTE TXT)
(QUOTE VERSION)
1))
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Making the file ...")
(OPENFILE FN (QUOTE OUTPUT))
(printout FN "A printout of " FILENAME ", a file of Trillium objects." T "As of " (DATE)
", has contents as follows:")
(printout FN T)
(printout FN T)
(printout FN "Interfaces:")
(SETQ INTERFACE.NAMES (LISTGET CONTENTS (QUOTE INTERFACE.NAMES)))
(COND
(INTERFACE.NAMES (for INTERFACE.NAME in INTERFACE.NAMES do (printout FN " "
INTERFACE.NAME)))
(T (printout FN " none")))
(printout FN T)
(printout FN T)
(printout FN "Itemtypes:")
(SETQ ITEMTYPE.NAMES (LISTGET CONTENTS (QUOTE ITEMTYPE.NAMES)))
(COND
(ITEMTYPE.NAMES (for ITEMTYPE.NAME in ITEMTYPE.NAMES do (printout FN " " ITEMTYPE.NAME)))
(T (printout FN " none")))
(printout FN T)
(printout FN T)
(for INTERFACE.NAME in INTERFACE.NAMES
do (SETQ INTERFACE (FIND.INTERFACE INTERFACE.NAME))
(RESET.INTERFACE INTERFACE T)
(PRINTDEF INTERFACE NIL NIL NIL NIL FN)
(printout FN T)
(printout FN T))
(for ITEMTYPE.NAME in ITEMTYPE.NAMES
do (PRINTDEF (ITEM.TYPE.DESCRIPTION ITEMTYPE.NAME)
NIL NIL NIL NIL FN)
(printout FN T)
(printout FN T))
(CLOSEF FN)
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE SAME.LINE "listing the file ...")
(APPLY* (QUOTE LISTFILES)
FN)
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE SAME.LINE "done")
(DELFILE FN])
(LIST.OBJECTS.ON.FILE
[LAMBDA (FILENAME) (* N.H.Briggs "18-Jan-85 17:59")
(* * fixed to spawn a process with \SINGLEFILEINDEX.DONTSPAWN bound to T to avoid deleting listing file before
LISTFILES process has finished)
(DECLARE (GLOBALVARS TRILLIUM.OBJECT.FILES))
(PROG (ENTRY CONTENTS INTERFACE.NAMES ITEMTYPE.NAMES FN INTERFACE)
(SETQ ENTRY (FASSOC FILENAME TRILLIUM.OBJECT.FILES))
(SETQ CONTENTS (CDR ENTRY))
(SETQ FN (PACKFILENAME (QUOTE HOST)
(QUOTE CORE)
(QUOTE NAME)
FILENAME
(QUOTE EXTENSION)
(QUOTE TXT)
(QUOTE VERSION)
1))
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Making the file ...")
(OPENFILE FN (QUOTE OUTPUT))
(printout FN "A printout of " FILENAME ", a file of Trillium objects." T "As of " (DATE)
", has contents as follows:")
(printout FN T)
(printout FN T)
(printout FN "Interfaces:")
(SETQ INTERFACE.NAMES (LISTGET CONTENTS (QUOTE INTERFACE.NAMES)))
(COND
(INTERFACE.NAMES (for INTERFACE.NAME in INTERFACE.NAMES do (printout FN " "
INTERFACE.NAME)))
(T (printout FN " none")))
(printout FN T)
(printout FN T)
(printout FN "Itemtypes:")
(SETQ ITEMTYPE.NAMES (LISTGET CONTENTS (QUOTE ITEMTYPE.NAMES)))
(COND
(ITEMTYPE.NAMES (for ITEMTYPE.NAME in ITEMTYPE.NAMES do (printout FN " " ITEMTYPE.NAME)))
(T (printout FN " none")))
(printout FN T)
(printout FN T)
(for INTERFACE.NAME in INTERFACE.NAMES
do (SETQ INTERFACE (FIND.INTERFACE INTERFACE.NAME))
(RESET.INTERFACE INTERFACE T)
(PRINTDEF INTERFACE NIL NIL NIL NIL FN)
(printout FN T)
(printout FN T))
(for ITEMTYPE.NAME in ITEMTYPE.NAMES
do (PRINTDEF (ITEM.TYPE.DESCRIPTION ITEMTYPE.NAME)
NIL NIL NIL NIL FN)
(printout FN T)
(printout FN T))
(CLOSEF FN)
(ADD.PROCESS (BQUOTE (PROGN (RESETVAR \SINGLEFILEINDEX.DONTSPAWN T (LISTFILES , FN))
(DELFILE (QUOTE , FN))
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Listing of "
(QUOTE , FILENAME)
" complete.")))
(QUOTE NAME)
(QUOTE Trillium% Listing))
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE SAME.LINE " spawned listing process."])
)
(* * fix DELETE.INTERFACE to do a more thorough job of deleting an interface)
(DEFINEQ
(DELETE.INTERFACE
[LAMBDA (INTERFACE.NAME) (* N.H.Briggs "25-Feb-85 16:48")
(COND
((EQ (GET.FIELDQ CURRENT.INTERFACE NAME INTERFACE)
INTERFACE.NAME)
(COND
((OPENWP CURRENT.INTERFACE.WINDOW)
(CLOSEW CURRENT.INTERFACE.WINDOW)))
(SETQ CURRENT.INTERFACE)
(SETQ CURRENT.INTERFACE.WINDOW)))
(UNREGISTER.INTERFACE.NAME INTERFACE.NAME)
(UNMARKASCHANGED INTERFACE.NAME (QUOTE INTERFACES))
(DELDEF.INTERFACE INTERFACE.NAME (QUOTE INTERFACES])
)
(* * fixes to Trillium Itemtypes and Ptypes)
(* * LABELLED.BUTTON Changed default LABEL value to be "1" instead of 1)
(* LABELLED.BUTTON)
(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))
(* * INVERTING.CASCADE.LIGHT alignment values were inadvertently quoted: D.Ingalls)
(* INVERTING.CASCADE.LIGHT)
(READ.ITEMTYPE INVERTING.CASCADE.LIGHT 5)
(\TYPE ITEM.TYPE NAME INVERTING.CASCADE.LIGHT COMMENT "An indicator with associated text" KIND
COMPOSITE PARAMETERS ((\TYPE PARAMETER NAME PLACEMENT TYPE (POSITION) DEFAULT (170 . 170) COMMENT
"A reference grid position" GRID.TYPE (LOCATION)) (\TYPE PARAMETER NAME TEXT TYPE (LIST (STRING))
DEFAULT (Label for Light) COMMENT "The text associated with the light") (\TYPE PARAMETER NAME FONT
TYPE (FONT) DEFAULT (HELVETICA 10) COMMENT "The font in which to print the information") (\TYPE
PARAMETER NAME TEXT.OFFSET TYPE (OFFSET.VECTOR (PLACEMENT)) DEFAULT (51 . 17) COMMENT
"The offset of the words form the lower left corner of the button") (\TYPE PARAMETER NAME
HORIZONTAL.ALIGNMENT TYPE (ONEOF (LEFT CENTER RIGHT)) DEFAULT (QUOTE LEFT) COMMENT
"Horizontal alignment of text about reference point") (\TYPE PARAMETER NAME VERTICAL.ALIGNMENT TYPE
(ONEOF (TOP CENTER BOTTOM)) DEFAULT (QUOTE CENTER) COMMENT
"Vertical alignment of text about the reference point") (\TYPE PARAMETER NAME CELL TYPE (CELL)
DEFAULT CELL.1 COMMENT "The cell to affect and display") (\TYPE PARAMETER NAME VALUE TYPE (CONSTANT
) DEFAULT VALUE.1 COMMENT "The value to be set and reflected")) SUBITEM.SPECS ((LABEL WORDS (ITEM
BLOCK.OF.TEXT (PLACEMENT (PTRANSLATE PLACEMENT TEXT.OFFSET)) (LIST.OF.LINES TEXT) (FONT FONT) (
XALIGNMENT HORIZONTAL.ALIGNMENT) (YALIGNMENT VERTICAL.ALIGNMENT))) (ITEM LIGHT (PLACEMENT (
BOUNDING.BOX WORDS)) (CELL CELL) (REFERENCE.VALUE VALUE))) OTHER (FNS ((1
CONVERT.INVERTING.CASCADE.LIGHT.OFFSETS))) CLASSES (COMPOSITE) VERSION 1)
(DEFINEQ
(CONVERT.INVERTING.CASCADE.LIGHT.OFFSETS
[LAMBDA (ITEM) (* edited: "16-Aug-84 10:07")
(CONVERT.GRIDDED.OFFSETSQ ITEM HORIZONTAL.OFFSET VERTICAL.OFFSET TEXT.OFFSET])
)
(* * 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])
)
(* BITMAP.NAME)
(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)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML MAKE.PTYPES.COMS MAKE.PTYPES.COMS.Original MAKE.ITEMTYPES.COMS
MAKE.ITEMTYPES.COMS.Original)
(ADDTOVAR LAMA )
)
(PUTPROPS JUN-6-85-FIXES-COMPLETE COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5004 7611 (LoadPatches 5014 . 7609)) (7816 8817 (FONTS.IN.CORE.Original 7826 . 8324) (
FONTS.IN.CORE 8326 . 8815)) (8885 10961 (FORGET.FRAME.CLASS.Original 8895 . 9912) (FORGET.FRAME.CLASS
9914 . 10959)) (11055 12957 (MOVE.ITEM.Original 11065 . 11979) (MOVE.ITEM 11981 . 12955)) (13040 16303
(COPY.INTERFACE.Original 13050 . 14705) (COPY.INTERFACE 14707 . 16301)) (16445 17218 (
ACQUIRE.INTERFACE.NAME.Original 16455 . 16753) (ACQUIRE.INTERFACE.NAME 16755 . 17216)) (17373 18594 (
SET.TRILLIUM.FILES.LOCATION.Original 17383 . 17709) (SET.TRILLIUM.FILES.LOCATION 17711 . 18592)) (
18684 24782 (TRILLIUM.MAKESYS.Original 18694 . 21720) (TRILLIUM.MAKESYS 21722 . 24780)) (24876 25833 (
TRILLIUM.SET.SOURCE.Original 24886 . 25321) (TRILLIUM.SET.SOURCE 25323 . 25831)) (25915 26556 (
TRILLIUM.LOAD.FIXES 25925 . 26554)) (26644 33907 (TRILLIUM.LOAD.TRILLIUM?.Original 26654 . 30009) (
TRILLIUM.LOAD.TRILLIUM? 30011 . 33905)) (34028 35458 (TRILLIUM.FILENAME.Original 34038 . 34653) (
TRILLIUM.FILENAME 34655 . 35456)) (36224 38711 (MAKE.ITEMTYPES.COMS.Original 36234 . 36837) (
MAKE.ITEMTYPES.COMS 36839 . 37487) (MAKE.PTYPES.COMS.Original 37489 . 38077) (MAKE.PTYPES.COMS 38079
. 38709)) (38774 42289 (PROFILE.EDITOR.TITLECOMMANDFN 38784 . 40256) (
PROFILE.EDITOR.TITLECOMMANDFN.Original 40258 . 41847) (TRILLIUM.CONN? 41849 . 41992) (
TRILLIUM.CONN?.Original 41994 . 42287)) (42372 47382 (LIST.OBJECTS.ON.FILE.Original 42382 . 44698) (
LIST.OBJECTS.ON.FILE 44700 . 47380)) (47467 48040 (DELETE.INTERFACE 47477 . 48038)) (51206 51440 (
CONVERT.INVERTING.CASCADE.LIGHT.OFFSETS 51216 . 51438)) (51584 53692 (BITMAP.NAME/CREATE.Original
51594 . 53690)) (53844 55975 (BITMAP.NAME/CREATE 53854 . 55973)))))
STOP