(FILECREATED "19-Nov-84 17:41:08" {AZTEC}<TRILLIUM>BIRTHDAY84>RERELEASE>TRI-IO.;2 27772
changes to: (FNS INSTALL.ITEM.TYPE MAKE.ITEMTYPES.COMS INSTALL.PTYPE MAKE.PTYPES.COMS
UPDATE.INTERFACE UPDATE.ITEM)
previous date: "22-Aug-84 11:26:38" {AZTEC}<TRILLIUM>BIRTHDAY84>RERELEASE>TRI-IO.;1)
(* Copyright (c) 1984 by Xerox Corporation)
(PRETTYCOMPRINT TRI-IOCOMS)
(RPAQQ TRI-IOCOMS [(VARS TRILLIUM.INTERFACE.REPRESENTATION.VERSION
TRILLIUM.ITEMTYPE.REPRESENTATION.VERSION
TRILLIUM.PTYPE.REPRESENTATION.VERSION)
(FNS CONVERT.DIALOG.RECORDS.TO.PROPLISTS CONVERT.FRAME.RECORD.TO.PROPLIST
CONVERT.GRIDDED.OFFSET CONVERT.GRIDDED.OFFSETS CONVERT.ITEM.GRID.VALUES DELDEF.DIALOG
DELDEF.INTERFACE DELDEF.ITEMTYPE DELDEF.PTYPE DUMP.DIALOG DUMP.INTERFACE DUMP.ITEMTYPE
DUMP.PTYPE GETDEF.DIALOG GETDEF.INTERFACE GETDEF.ITEMTYPE GETDEF.PTYPE
INSERT.ITEM.VERSIONS INSTALL.ITEM.TYPE INSTALL.ITEM.TYPE.DEFAULTS INSTALL.PTYPE
ITEMTYPE.FNS MAKE.ITEMTYPES.COMS MAKE.PTYPES.COMS MARKASCHANGEDP PUTDEF.DIALOG
PUTDEF.INTERFACE PUTDEF.ITEMTYPE PUTDEF.PTYPE READ.BITMAPS READ.DIALOG READ.INTERFACE
READ.INTERFACEQ READ.ITEMTYPE READ.PTYPE REGISTER.ITEM.TYPE REGISTER.PTYPE
SET.ITEM.TYPE.DESCRIPTION SET.PTYPE.DESCRIPTION TRILLIUM.ITEMTYPE.FNS
UNINSTALL.ITEM.TYPE UNINSTALL.PTYPE UNREGISTER.ITEM.TYPE UNREGISTER.PTYPE
UPDATE.INTERFACE UPDATE.ITEM)
(MACROS CONVERT.GRIDDED.OFFSETSQ)
(FILEPKGCOMS DIALOGS INTERFACES ITEMTYPES PTYPES)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML READ.PTYPE READ.ITEMTYPE READ.INTERFACEQ READ.DIALOG
MAKE.PTYPES.COMS MAKE.ITEMTYPES.COMS)
(LAMA])
(RPAQQ TRILLIUM.INTERFACE.REPRESENTATION.VERSION 3)
(RPAQQ TRILLIUM.ITEMTYPE.REPRESENTATION.VERSION 5)
(RPAQQ TRILLIUM.PTYPE.REPRESENTATION.VERSION 1)
(DEFINEQ
(CONVERT.DIALOG.RECORDS.TO.PROPLISTS
[LAMBDA (DIALOG) (* DAHJr " 5-DEC-83 16:40")
(* edited: "23-JUN-82 14:18")
(* ITEM.CREATE DIALOG (NAME (fetch (DIALOG NAME) of DIALOG)) (FRAMES (for FRAME in (fetch
(DIALOG FRAMES) of DIALOG) collect (CONVERT.FRAME.RECORD.TO.PROPLIST FRAME))) (FIRST.FRAME
(fetch (DIALOG FIRST.FRAME) of DIALOG)) (REGION (fetch (DIALOG REGION) of DIALOG)))
(OBS "Missing DIALOG record definition!"])
(CONVERT.FRAME.RECORD.TO.PROPLIST
[LAMBDA (FRAME) (* DAHJr " 5-DEC-83 16:46")
(* ITEM.CREATE FRAME (NAME (fetch
(FRAME NAME) of FRAME)) (ITEMS
(fetch (FRAME ITEMS) of FRAME)))
(OBS "Missing FRAME record definition!"])
(CONVERT.GRIDDED.OFFSET
[LAMBDA (ITEM PARAM) (* PH "22-Aug-84 10:58")
(PROG (VALUE)
(AND (SETQ VALUE (GET.FIELD ITEM PARAM))
(SET.PARAM ITEM PARAM (XCOORD VALUE])
(CONVERT.GRIDDED.OFFSETS
[LAMBDA (ITEM X.PARAM Y.PARAM NEW.PARAM) (* PH "22-Aug-84 11:00")
(PROG ((X (GET.FIELD ITEM X.PARAM))
(Y (GET.FIELD ITEM Y.PARAM))
DEFAULT.OFFSET)
(COND
((OR X Y)
(SETQ DEFAULT.OFFSET (GET.PARAM.DEFAULT ITEM NEW.PARAM))
(SET.PARAM ITEM X.PARAM)
(SET.PARAM ITEM Y.PARAM)
[SET.PARAM ITEM NEW.PARAM (NEW.POSITION (COND
(X (XCOORD X))
(T (fetch (POSITION XCOORD) of DEFAULT.OFFSET)
))
(COND
(Y (YCOORD Y))
(T (fetch (POSITION YCOORD) of DEFAULT.OFFSET]
(COMPRESS.PROPLIST ITEM])
(CONVERT.ITEM.GRID.VALUES
[LAMBDA (ITEM) (* HaKo "27-Jul-84 17:07")
(PROG (ITYPE DESCRIPTION GTYPE PNAME VALUE)
(SETQ ITYPE (ITEM.TYPE ITEM))
(SETQ DESCRIPTION (ITEM.TYPE.DESCRIPTION ITYPE))
(for PARAMETER in (GET.FIELDQ DESCRIPTION PARAMETERS)
do (SETQ GTYPE (GET.FIELDQ PARAMETER GRID.TYPE))
(COND
(GTYPE (SETQ PNAME (GET.FIELDQ PARAMETER NAME))
(SETQ VALUE (LISTGET ITEM PNAME))
(COND
(VALUE (SET.PARAM ITEM PNAME (COORDS VALUE])
(DELDEF.DIALOG
[LAMBDA (NAME TYPE)
(SET NAME (QUOTE NOBIND])
(DELDEF.INTERFACE
[LAMBDA (NAME TYPE) (* edited: "15-APR-83 17:13")
(REMPROP NAME (QUOTE INTERFACE.DESCRIPTION])
(DELDEF.ITEMTYPE
[LAMBDA (NAME TYPE) (* edited: " 6-MAY-82 19:42")
(UNREGISTER.ITEM.TYPE NAME])
(DELDEF.PTYPE
[LAMBDA (NAME TYPE) (* DAHJr "13-JUN-83 16:50")
(UNREGISTER.PTYPE NAME])
(DUMP.DIALOG
[LAMBDA (NAME) (* DAHJr "20-JAN-83 09:19")
(DUMP.INTERFACE NAME])
(DUMP.INTERFACE
[LAMBDA (NAME) (* HaKo "10-Aug-84 11:18")
(DECLARE (GLOBALVARS TRILLIUM.INTERFACE.REPRESENTATION.VERSION))
(PROG ((INTERFACE (FIND.INTERFACE NAME)))
(if (NULL INTERFACE)
then (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "No definition as an INTERFACES for " NAME)
(RETURN))
(RESET.INTERFACE INTERFACE T)
(INSERT.ITEM.VERSIONS INTERFACE)
(PRINT (LIST (QUOTE READ.INTERFACEQ)
NAME TRILLIUM.INTERFACE.REPRESENTATION.VERSION))
(HPRINT INTERFACE NIL T])
(DUMP.ITEMTYPE
[LAMBDA (ITYPE) (* DAHJr " 5-DEC-83 16:34")
(DECLARE (GLOBALVARS TRILLIUM.ITEMTYPE.REPRESENTATION.VERSION))
(PROG (DESCRIPTION)
(SETQ DESCRIPTION (ITEM.TYPE.DESCRIPTION ITYPE))
(COND
(DESCRIPTION (RESET.ITEM.TYPE.DESCRIPTION DESCRIPTION)
(PRINT (LIST (QUOTE READ.ITEMTYPE)
ITYPE TRILLIUM.ITEMTYPE.REPRESENTATION.VERSION))
(HPRINT DESCRIPTION NIL T))
(T (printout T T ITYPE " unprintable as an ITEMTYPE")
(* VERSION 1: AS RECORD)
(* VERSION 2: WITH BITMAPS " 6-JUL-82")
(* VERSION 3: AS PROPERTY LIST " 7-APR-83")
(* VERSION 4: AS PROPERTY LIST WITH PARAMETERS AS
PROPERTY LISTS "23-JUN-83")
(* VERSION 5: CONVERT THE GRID PTYPES: LEAVE THE OLD
PTYPE IN THE GRID.TYPE PROPERTY)
))
(RETURN])
(DUMP.PTYPE
[LAMBDA (PTYPE) (* DAHJr "13-JUN-83 17:04")
(DECLARE (GLOBALVARS TRILLIUM.PTYPE.REPRESENTATION.VERSION))
(PROG (DESCRIPTION)
(SETQ DESCRIPTION (PTYPE.DESCRIPTION PTYPE))
(COND
(DESCRIPTION (PRINT (LIST (QUOTE READ.PTYPE)
PTYPE TRILLIUM.PTYPE.REPRESENTATION.VERSION))
(HPRINT DESCRIPTION NIL T))
(T (printout T T PTYPE " unprintable as a PTYPE")
(* VERSION 1: AS PROPERTY LIST "13-JUN-83 16:59:51")
))
(RETURN])
(GETDEF.DIALOG
[LAMBDA (NAME TYPE) (* DAHJr " 5-May-84 17:14")
(PROG (DIALOG BITMAP.NAME)
(SETQ DIALOG (EVALV NAME))
(COND
((EQ DIALOG (QUOTE NOBIND))
(RETURN)))
(COND
((NLISTP DIALOG)
(RETURN)))
(COND
((NEQ (ITEM.TYPE DIALOG)
(QUOTE DIALOG))
(RETURN)))
(RESET.INTERFACE DIALOG)
(RETURN DIALOG])
(GETDEF.INTERFACE
[LAMBDA (NAME TYPE) (* edited: "15-APR-83 17:11")
(GETPROP NAME (QUOTE INTERFACE.DESCRIPTION])
(GETDEF.ITEMTYPE
[LAMBDA (NAME TYPE) (* edited: " 6-MAY-82 18:56")
(ITEM.TYPE.DESCRIPTION NAME])
(GETDEF.PTYPE
[LAMBDA (NAME TYPE) (* DAHJr "21-JUN-83 19:09")
(PTYPE.DESCRIPTION NAME])
(INSERT.ITEM.VERSIONS
[LAMBDA (INTERFACE) (* HaKo "10-Aug-84 11:34")
(for FRAME in (GET.FIELDQ INTERFACE FRAMES) do (for ITEM in (DEFINING.ITEMS.OF.FRAME FRAME)
bind (ITEM.VERSION ITYPE.VERSION)
do (SETQ ITEM.VERSION (OR (GET.FIELDQ ITEM
VERSION)
0))
(SETQ ITYPE.VERSION
(OR (GETPROP (ITEM.TYPE ITEM)
(QUOTE VERSION))
0))
(if (IGREATERP ITEM.VERSION ITYPE.VERSION)
then (TRILLIUM.PRINTOUT ON
TRILLIUM.WARNINGS
"Item of type "
(ITEM.TYPE
ITEM)
" encountered has a more recent version ("
ITEM.VERSION
") than loaded itemtype ("
ITYPE.VERSION
").")
elseif (ILESSP ITEM.VERSION ITYPE.VERSION)
then
(* * No need to update. The item was either created during this session or updated when loaded.
Only case to worry about is loaded and updated or created before loading in older version of itemtype.
Only thing we could do then is to undo updates. Forget it!)
(SET.FIELDQ ITEM VERSION
ITYPE.VERSION])
(INSTALL.ITEM.TYPE
[LAMBDA (ITYPE) (* HaKo "16-Aug-84 16:20")
(DECLARE (GLOBALVARS INITIAL.BITMAPS ITEM.TYPES))
(PROG (OTHER (DESCRIPTION (ITEM.TYPE.DESCRIPTION ITYPE)))
(SETQ OTHER (GET.FIELDQ DESCRIPTION OTHER ITEM.TYPE))
(SETQ ITEM.TYPES (CONS ITYPE ITEM.TYPES))
(SETQ ITEM.TYPES (SORT (INTERSECTION ITEM.TYPES ITEM.TYPES)))
(PUTPROP ITYPE (QUOTE COMPOSITE?)
(EQ (GET.FIELDQ DESCRIPTION KIND ITEM.TYPE)
(QUOTE COMPOSITE)))
(for FNSPEC in (LISTGET OTHER (QUOTE FNS)) bind (ACTION FNNAME)
do (SETQ ACTION (CAR FNSPEC))
(SETQ FNNAME (CADR FNSPEC))
(COND
(ACTION (PUTPROP ITYPE ACTION FNNAME)))
(NOTE.INTERNAL.FN FNNAME))
[for BITMAPSPEC in (LISTGET OTHER (QUOTE BITMAPS))
do (for SPEC in INITIAL.BITMAPS bind (NAME ←(CAR BITMAPSPEC))
when (EQ NAME (CAR SPEC))
do (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Redefining bitmap: " NAME)
(RPLACA (CDR SPEC)
(BITMAPCOPY (CADR BITMAPSPEC)))
(RETURN)
finally (SET NAME (CADR BITMAPSPEC))
(SETQ INITIAL.BITMAPS (SORT (CONS (COPYALL BITMAPSPEC)
INITIAL.BITMAPS)
T]
[OR (GET.FIELDQ DESCRIPTION CLASSES)
(SET.FIELDQ DESCRIPTION CLASSES (LIST (GET.FIELDQ DESCRIPTION KIND]
(INSTALL.ITEM.TYPE.DEFAULTS ITYPE DESCRIPTION)
(PUTPROP ITYPE (QUOTE VERSION)
(GET.FIELDQ DESCRIPTION VERSION))
(COMPILE.ITEM.TYPE ITYPE])
(INSTALL.ITEM.TYPE.DEFAULTS
[LAMBDA (ITYPE DESCRIPTION) (* HaKo "26-Jul-84 12:13")
(PUTPROP ITYPE (QUOTE DEFAULTS)
(for PARAMETER in (GET.FIELDQ DESCRIPTION PARAMETERS) collect (CONS (GET.FIELDQ
PARAMETER
NAME)
(GET.FIELDQ
PARAMETER
DEFAULT])
(INSTALL.PTYPE
[LAMBDA (PTYPE) (* HaKo " 7-Aug-84 12:50")
(DECLARE (GLOBALVARS PTYPES))
(PROG ((DESCRIPTION (PTYPE.DESCRIPTION PTYPE)))
(SETQ PTYPES (CONS PTYPE PTYPES))
(SETQ PTYPES (SORT (INTERSECTION PTYPES PTYPES)))
(for FNSPEC in (LISTGET (GET.FIELDQ DESCRIPTION OTHER)
(QUOTE FNS))
bind (ACTION FNNAME)
do (SETQ ACTION (CAR FNSPEC))
(SETQ FNNAME (CADR FNSPEC))
(COND
(ACTION (PUTPROP PTYPE ACTION FNNAME)))
(NOTE.INTERNAL.FN FNNAME])
(ITEMTYPE.FNS
[LAMBDA NIL (* DAHJr " 7-APR-83 20:52")
(DECLARE (GLOBALVARS ITEM.TYPES))
(for ITYPE in ITEM.TYPES join (for SPEC in (LISTGET (GET.FIELDQ (ITEM.TYPE.DESCRIPTION ITYPE)
OTHER ITEM.TYPE)
(QUOTE FNS))
collect (CADR SPEC])
(MAKE.ITEMTYPES.COMS
[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.PTYPES.COMS
[NLAMBDA (PTYPES) (* DAHJr "13-JUN-83 17:04")
(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])
(MARKASCHANGEDP
[LAMBDA (NAME TYPE) (* edited: "23-DEC-82 09:59")
(DECLARE (GLOBALVARS FILELST))
(OR (MEMBER NAME (FILEPKGCHANGES TYPE))
(for FILE in FILELST thereis (MEMBER NAME (ASSOC TYPE (CDR (GETPROP FILE (QUOTE FILE])
(PUTDEF.DIALOG
[LAMBDA (NAME TYPE DIALOG) (* edited: "25-MAR-82 12:44")
(PROG NIL
(SET NAME DIALOG)
(REGISTER.DIALOG.NAME NAME])
(PUTDEF.INTERFACE
[LAMBDA (NAME TYPE INTERFACE) (* edited: "15-APR-83 17:12")
(PUTPROP NAME (QUOTE INTERFACE.DESCRIPTION)
INTERFACE)
(REGISTER.INTERFACE.NAME NAME])
(PUTDEF.ITEMTYPE
[LAMBDA (NAME TYPE DESCRIPTION) (* edited: " 6-MAY-82 19:43")
(REGISTER.ITEM.TYPE NAME DESCRIPTION])
(PUTDEF.PTYPE
[LAMBDA (NAME TYPE DESCRIPTION) (* DAHJr "13-JUN-83 17:14")
(REGISTER.PTYPE NAME DESCRIPTION])
(READ.BITMAPS
[LAMBDA (CHAR LOW HIGH) (* HK "21-JUL-82 15:42")
(DECLARE (GLOBALVARS GENNUM))
(RESETVAR GENNUM (IPLUS 10000 LOW -1)
(for I from LOW to HIGH do (SET (GENSYM CHAR)
(READBITMAP])
(READ.DIALOG
[NLAMBDA (NAME VERSION) (* edited: "15-APR-83 17:42")
(* LEAVE THIS IN THE SYSTEM TO PICK UP OLD INTERFACES)
(READ.INTERFACE NAME VERSION])
(READ.INTERFACE
[LAMBDA (NAME VERSION) (* HaKo "10-Aug-84 11:34")
(DECLARE (SPECVARS FILE))
(PROG (INTERFACE PROFILE CLASS FRAME ITYPE DESCRIPTION GTYPE FIELD.NAME VALUE)
[COND
((LISTP VERSION)
(PROG ((OLD.FORM VERSION))
(* * BEFORE VERSION NUMBERS: ITEMS REPRESENTED AS TYPERECORDS)
(SETQ INTERFACE (CONVERT.DIALOG.RECORDS.TO.PROPLISTS OLD.FORM))
[for FRAME in (GET.FIELDQ INTERFACE FRAMES)
do (for ITEM in (GET.FIELDQ FRAME ITEMS) when (EQ (ITEM.TYPE ITEM)
(QUOTE BITMAP))
do (SET.PARAMQ ITEM BITMAP (EVALV (GET.FIELDQ ITEM \BITMAP.NAME]
(SETQ VERSION 2)))
((OR (NULL VERSION)
(IEQP VERSION 1))
(PROG ((OLD.FORM (HREAD)))
(* * NIL: SAME AS 1, BUT UNMARKED)
(* * 1: ITEMS AS PROPLISTS; INTERFACES, FRAMES AS TYPERECORDS 82/4/15?)
(SETQ INTERFACE (CONVERT.DIALOG.RECORDS.TO.PROPLISTS OLD.FORM))
(SETQ VERSION 2)))
(T (SETQ INTERFACE (HREAD]
(UPDATE.INTERFACE INTERFACE VERSION)
(PUTDEF.INTERFACE NAME (QUOTE INTERFACES)
INTERFACE)
(REGISTER.INTERFACE.NAME NAME)
(ADD.OBJECT.TO.FILE NAME (QUOTE INTERFACE.NAMES)
(LISTGET (UNPACKFILENAME FILE)
(QUOTE NAME)))
(RETURN])
(READ.INTERFACEQ
[NLAMBDA (NAME VERSION) (* edited: "19-JAN-83 12:11")
(READ.INTERFACE NAME VERSION])
(READ.ITEMTYPE
[NLAMBDA (NAME VERSION) (* DAHJr " 5-DEC-83 16:48")
(DECLARE (SPECVARS FILE))
(PROG (DESCRIPTION PARAMETERS NEW.PARAMETERS PTYPE CHANGED)
(SETQ DESCRIPTION (HREAD))
(COND
((OR (EQ VERSION 1)
(EQ VERSION 2)) (* VERSION 1: THE ORIGINAL: AS RECORD)
(* VERSION 2: WITH BITMAPS " 6-JUL-82")
[SETQ DESCRIPTION (ITEM.CREATE ITEM.TYPE (NAME (CADR DESCRIPTION))
(COMMENT (CADDR DESCRIPTION))
(KIND (CADDDR DESCRIPTION))
(PARAMETERS (CAR (CDDDDR DESCRIPTION)))
(SUBITEM.SPECS (CADR (CDDDDR DESCRIPTION)))
(OTHER (CADDR (CDDDDR DESCRIPTION]
(* VERSION 3: AS PROPERTY LIST " 7-APR-83")
(SETQ VERSION 3)))
(COND
((EQ VERSION 3) (* VERSION 3: AS PROPERTY LIST " 7-APR-83")
(* VERSION 4: AS PROPERTY LIST WITH PARAMETERS AS
PROPERTY LISTS "23-JUN-83")
(SETQ PARAMETERS (GET.FIELDQ DESCRIPTION PARAMETERS))
[SETQ NEW.PARAMETERS (for PARAMETER in PARAMETERS collect (ITEM.CREATE
PARAMETER
(NAME (CAR PARAMETER))
(TYPE (CADR PARAMETER))
(DEFAULT (CADDDR PARAMETER))
(COMMENT (CADDR PARAMETER]
(SET.FIELDQ DESCRIPTION PARAMETERS NEW.PARAMETERS)
(SETQ VERSION 4)))
(COND
((EQ VERSION 4) (* VERSION 4: AS PROPERTY LIST WITH PARAMETERS AS
PROPERTY LISTS "23-JUN-83")
(* IF ITEMTYPE IS NOT A MEMBER OF ANY CLASS, PUT IT IN
THE KIND CLASS)
[COND
((GET.FIELDQ DESCRIPTION CLASSES))
(T (SET.FIELDQ DESCRIPTION CLASSES (LIST (GET.FIELDQ DESCRIPTION KIND]
(* VERSION 5: CONVERT THE GRID PTYPES;
LEAVE THE OLD PTYPE IN THE GRID.TYPE PROPERTY
" 9-AUG-83")
(SETQ PARAMETERS (GET.FIELDQ DESCRIPTION PARAMETERS))
(SETQ CHANGED)
[for PARAMETER in PARAMETERS
do (SETQ PTYPE (GET.FIELDQ PARAMETER TYPE))
(COND
([AND (LISTP PTYPE)
(FMEMB (CAR PTYPE)
(QUOTE (LOCATION GRIDREGION LOCATION2]
(SET.FIELDQ PARAMETER GRID.TYPE PTYPE)
[SET.FIELDQ PARAMETER TYPE (LIST (SELECTQ (CAR PTYPE)
(LOCATION (QUOTE POSITION))
(GRIDREGION (QUOTE REGION))
(LOCATION2 (QUOTE POSITION2))
(TROUBLE.WITH.TRILLIUM
"Unrecognized GRID PType"
(CAR PTYPE]
(SET.FIELDQ PARAMETER DEFAULT (COORDS (GET.FIELDQ PARAMETER DEFAULT)))
(COND
((NULL CHANGED)
(SETQ CHANGED T)
(printout T T "In " (GET.FIELDQ DESCRIPTION NAME)
", changed PTYPES in characteristics: ")))
(printout T (GET.FIELDQ PARAMETER NAME)
" "]
(SETQ VERSION 5)))
(COND
((NEQ VERSION 5)
(TROUBLE.WITH.TRILLIUM "Unrecognized version number" VERSION)))
(REGISTER.ITEM.TYPE NAME DESCRIPTION)
(ADD.OBJECT.TO.FILE NAME (QUOTE ITEMTYPE.NAMES)
(LISTGET (UNPACKFILENAME FILE)
(QUOTE NAME)))
(RETURN])
(READ.PTYPE
[NLAMBDA (NAME VERSION) (* DAHJr "13-JUN-83 17:04")
(PROG (OLD.DESCRIPTION DESCRIPTION)
(SELECTQ VERSION
(1 (* VERSION 1: AS PROPERTY LIST "13-JUN-83 17:00:30")
(SETQ DESCRIPTION (HREAD)))
(TROUBLE.WITH.TRILLIUM "Unrecognized version number" VERSION))
(REGISTER.PTYPE NAME DESCRIPTION)
(RETURN])
(REGISTER.ITEM.TYPE
[LAMBDA (ITYPE DESCRIPTION) (* DAHJr " 5-DEC-83 12:59")
(DECLARE (GLOBALVARS ITEM.TYPE.MENU))
(SET.ITEM.TYPE.DESCRIPTION ITYPE DESCRIPTION)
(SETQ ITEM.TYPE.MENU)
(INSTALL.ITEM.TYPE ITYPE])
(REGISTER.PTYPE
[LAMBDA (PTYPE DESCRIPTION) (* DAHJr "13-JUN-83 17:02")
(SET.PTYPE.DESCRIPTION PTYPE DESCRIPTION)
(INSTALL.PTYPE PTYPE])
(SET.ITEM.TYPE.DESCRIPTION
[LAMBDA (ITEM.TYPE DESCRIPTION) (* edited: " 6-JUL-82 20:14")
(COND
(DESCRIPTION (PUTPROP ITEM.TYPE (QUOTE TYPE.DESCRIPTION)
DESCRIPTION))
(T (REMPROP ITEM.TYPE (QUOTE TYPE.DESCRIPTION])
(SET.PTYPE.DESCRIPTION
[LAMBDA (ITEM.TYPE DESCRIPTION) (* DAHJr "13-JUN-83 19:01")
(COND
(DESCRIPTION (PUTPROP ITEM.TYPE (QUOTE PTYPE.DESCRIPTION)
DESCRIPTION))
(T (REMPROP ITEM.TYPE (QUOTE PTYPE.DESCRIPTION])
(TRILLIUM.ITEMTYPE.FNS
[LAMBDA NIL (* DAHJr " 7-APR-83 20:53")
(DECLARE (GLOBALVARS TRILLIUM.ITEM.TYPES))
(for ITYPE in TRILLIUM.ITEM.TYPES join (for SPEC in (LISTGET (GET.FIELDQ (ITEM.TYPE.DESCRIPTION
ITYPE)
OTHER ITEM.TYPE)
(QUOTE FNS))
collect (CADR SPEC])
(UNINSTALL.ITEM.TYPE
[LAMBDA (ITYPE) (* DAHJr " 7-APR-83 21:02")
(DECLARE (GLOBALVARS ITEM.TYPES))
(PROG ((OTHER (GET.FIELDQ (ITEM.TYPE.DESCRIPTION ITYPE)
OTHER ITEM.TYPE)))
(SETQ ITEM.TYPES (DREMOVE ITYPE ITEM.TYPES))
(for FNSPEC in (LISTGET OTHER (QUOTE FNS)) do (REMPROP ITYPE (CAR FNSPEC)))
(REMPROP ITYPE (QUOTE COMPOSITE?))
(SET.ANALYSISFN ITYPE NIL])
(UNINSTALL.PTYPE
[LAMBDA (PTYPE) (* DAHJr "13-JUN-83 16:49")
(DECLARE (GLOBALVARS PTYPES))
(PROG ((OTHER (GET.FIELDQ (PTYPE.DESCRIPTION PTYPE)
OTHER ITEM.TYPE)))
(SETQ PTYPES (DREMOVE PTYPE PTYPES))
(for FNSPEC in (LISTGET OTHER (QUOTE FNS)) do (REMPROP PTYPE (CAR FNSPEC])
(UNREGISTER.ITEM.TYPE
[LAMBDA (ITYPE) (* DAHJr " 2-AUG-83 20:31")
(DECLARE (GLOBALVARS ITEM.TYPE.MENU))
(UNINSTALL.ITEM.TYPE ITYPE)
(SET.ITEM.TYPE.DESCRIPTION ITYPE NIL)
(SETQ ITEM.TYPE.MENU])
(UNREGISTER.PTYPE
[LAMBDA (PTYPE) (* DAHJr "13-JUN-83 16:50")
(UNINSTALL.PTYPE PTYPE)
(SET.PTYPE.DESCRIPTION PTYPE NIL])
(UPDATE.INTERFACE
[LAMBDA (INTERFACE INTERFACE.VERSION) (* HaKo "17-Aug-84 16:49")
[COND
((IEQP INTERFACE.VERSION 2)
(PROG (PROFILE CLASS FRAME ITYPE DESCRIPTION GTYPE PNAME PVAL)
(* * DIALOG => INTERFACE)
(RPLACA (CDR INTERFACE)
(QUOTE INTERFACE))
(* * IF PROFILE IS PRESENT, DELETE IT, AND PUT FRAME CLASS INFO WHERE NEEDED)
(COND
((SETQ PROFILE (GET.FIELDQ INTERFACE PROFILE))
[for ELEM on (GET.FIELDQ PROFILE FRAME.CLASSES) by (CDDR ELEM)
do (SETQ CLASS (CAR ELEM))
(for FRAME.NAME in (CADR ELEM) do (COND
((SETQ FRAME (FIND.FRAME INTERFACE
FRAME.NAME))
(ADD.FRAME.CLASS FRAME CLASS]
(SET.FIELDQ INTERFACE PROFILE NIL)))
(* * 3; CONVERT ALL VALUES OF GRID PTYPES " 9-AUG-83")
[for FRAME in (GET.FIELDQ INTERFACE FRAMES)
do (for ITEM in (DEFINING.ITEMS.OF.FRAME FRAME)
do (SETQ ITYPE (ITEM.TYPE ITEM))
(SETQ DESCRIPTION (ITEM.TYPE.DESCRIPTION ITYPE))
(for PARAMETER in (GET.FIELDQ DESCRIPTION PARAMETERS)
do (if (SETQ GTYPE (GET.FIELDQ PARAMETER GRID.TYPE))
then (SETQ PNAME (GET.FIELDQ PARAMETER NAME))
(if (SETQ PVAL (LISTGET ITEM PNAME))
then (SET.PARAM ITEM PNAME (COORDS PVAL]
(SETQ INTERFACE.VERSION 3]
(COND
((NOT (IEQP INTERFACE.VERSION 3))
(SHOULDNT "Unrecognized interface version number" INTERFACE.VERSION)))
(OR (GET.FIELDQ INTERFACE COLOR.MAP)
(SET.FIELDQ INTERFACE COLOR.MAP NIL))
(OR (GET.FIELDQ INTERFACE BACKGROUND.COLOR)
(SET.FIELDQ INTERFACE BACKGROUND.COLOR (QUOTE WHITE)))
(WALK.INTERFACE INTERFACE NIL (FUNCTION (LAMBDA (OBJECT)
(COND
((ITEMP OBJECT)
(UPDATE.ITEM OBJECT)))
NIL])
(UPDATE.ITEM
[LAMBDA (ITEM) (* HaKo "17-Aug-84 16:36")
(bind (ITEM.VERSION ITYPE ITYPE.VERSION UPDATE.FN)
first (SETQ ITEM.VERSION (GET.FIELDQ ITEM VERSION))
(COND
((NULL ITEM.VERSION)
(SETQ ITEM.VERSION 0)))
(SETQ ITYPE (ITEM.TYPE ITEM))
(SETQ ITYPE.VERSION (GETPROP ITYPE (QUOTE VERSION)))
(COND
((NULL ITYPE.VERSION)
(SETQ ITYPE.VERSION 0)))
(COND
((IGREATERP ITEM.VERSION ITYPE.VERSION)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Item of type " ITYPE
" encountered has a more recent version ("
ITEM.VERSION ") than loaded itemtype (" ITYPE.VERSION ").")
(RETURN)))
while (ILESSP ITEM.VERSION ITYPE.VERSION)
do (SETQ ITEM.VERSION (ADD1 ITEM.VERSION))
(COND
((SETQ UPDATE.FN (GETPROP ITYPE ITEM.VERSION))
(APPLY* UPDATE.FN ITEM])
)
(DECLARE: EVAL@COMPILE
(PUTPROPS CONVERT.GRIDDED.OFFSETSQ MACRO ((item x.param y.param new.param)
(CONVERT.GRIDDED.OFFSETS item (QUOTE x.param)
(QUOTE y.param)
(QUOTE new.param))))
)
(PUTDEF (QUOTE DIALOGS) (QUOTE FILEPKGCOMS) (QUOTE
([COM MACRO
(X (E (MAPC (QUOTE X)
(FUNCTION DUMP.DIALOG]
(TYPE DESCRIPTION "TRILLIUM dialogs" GETDEF
GETDEF.DIALOG PUTDEF PUTDEF.DIALOG DELDEF
DELDEF.DIALOG))))
(PUTDEF (QUOTE INTERFACES) (QUOTE FILEPKGCOMS) (QUOTE
([COM MACRO
(X (E (MAPC (QUOTE X)
(FUNCTION DUMP.INTERFACE]
(TYPE DESCRIPTION "Trillium interfaces" GETDEF
GETDEF.INTERFACE PUTDEF PUTDEF.INTERFACE
DELDEF DELDEF.INTERFACE))))
(PUTDEF (QUOTE ITEMTYPES) (QUOTE FILEPKGCOMS) (QUOTE ([COM MACRO (X (COMS * (MAKE.ITEMTYPES.COMS
X]
(TYPE DESCRIPTION "TRILLIUM item types" GETDEF
GETDEF.ITEMTYPE PUTDEF PUTDEF.ITEMTYPE
DELDEF DELDEF.ITEMTYPE))))
(PUTDEF (QUOTE PTYPES) (QUOTE FILEPKGCOMS) (QUOTE ([COM MACRO (X (COMS * (MAKE.PTYPES.COMS X]
(TYPE DESCRIPTION "TRILLIUM parameter types"
GETDEF GETDEF.PTYPE PUTDEF PUTDEF.PTYPE
DELDEF DELDEF.PTYPE))))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML READ.PTYPE READ.ITEMTYPE READ.INTERFACEQ READ.DIALOG MAKE.PTYPES.COMS
MAKE.ITEMTYPES.COMS)
(ADDTOVAR LAMA )
)
(PUTPROPS TRI-IO COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1894 26195 (CONVERT.DIALOG.RECORDS.TO.PROPLISTS 1904 . 2477) (
CONVERT.FRAME.RECORD.TO.PROPLIST 2479 . 2852) (CONVERT.GRIDDED.OFFSET 2854 . 3086) (
CONVERT.GRIDDED.OFFSETS 3088 . 3743) (CONVERT.ITEM.GRID.VALUES 3745 . 4303) (DELDEF.DIALOG 4305 . 4375
) (DELDEF.INTERFACE 4377 . 4542) (DELDEF.ITEMTYPE 4544 . 4696) (DELDEF.PTYPE 4698 . 4841) (DUMP.DIALOG
4843 . 4983) (DUMP.INTERFACE 4985 . 5593) (DUMP.ITEMTYPE 5595 . 6793) (DUMP.PTYPE 6795 . 7413) (
GETDEF.DIALOG 7415 . 7863) (GETDEF.INTERFACE 7865 . 8030) (GETDEF.ITEMTYPE 8032 . 8181) (GETDEF.PTYPE
8183 . 8323) (INSERT.ITEM.VERSIONS 8325 . 9651) (INSTALL.ITEM.TYPE 9653 . 11236) (
INSTALL.ITEM.TYPE.DEFAULTS 11238 . 11609) (INSTALL.PTYPE 11611 . 12189) (ITEMTYPE.FNS 12191 . 12544) (
MAKE.ITEMTYPES.COMS 12546 . 13076) (MAKE.PTYPES.COMS 13078 . 13588) (MARKASCHANGEDP 13590 . 13887) (
PUTDEF.DIALOG 13889 . 14083) (PUTDEF.INTERFACE 14085 . 14302) (PUTDEF.ITEMTYPE 14304 . 14466) (
PUTDEF.PTYPE 14468 . 14621) (READ.BITMAPS 14623 . 14902) (READ.DIALOG 14904 . 15174) (READ.INTERFACE
15176 . 16571) (READ.INTERFACEQ 16573 . 16727) (READ.ITEMTYPE 16729 . 20184) (READ.PTYPE 20186 . 20637
) (REGISTER.ITEM.TYPE 20639 . 20916) (REGISTER.PTYPE 20918 . 21111) (SET.ITEM.TYPE.DESCRIPTION 21113
. 21386) (SET.PTYPE.DESCRIPTION 21388 . 21657) (TRILLIUM.ITEMTYPE.FNS 21659 . 22061) (
UNINSTALL.ITEM.TYPE 22063 . 22546) (UNINSTALL.PTYPE 22548 . 22927) (UNREGISTER.ITEM.TYPE 22929 . 23202
) (UNREGISTER.PTYPE 23204 . 23393) (UPDATE.INTERFACE 23395 . 25269) (UPDATE.ITEM 25271 . 26193)))))
STOP