(FILECREATED "18-Mar-85 15:47:08"
{PHYLUM}<TRILLIUM>BIRTHDAY84>ENHANCEMENTS>RECORDS-NHB>TRI-RECORD-RUN.;7 17670
changes to: (FNS CACHE.SUPERFRAMES ACTIVATE.INITIALIZATIONS CACHE.SUPERFRAMES.COLLECT
CACHE.SUPERFRAMES.IF.NECESSARY)
(VARS TRI-RECORD-RUNCOMS)
previous date: " 6-Mar-85 13:51:15"
{PHYLUM}<TRILLIUM>BIRTHDAY84>ENHANCEMENTS>RECORDS-NHB>TRI-RECORD-RUN.;4)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TRI-RECORD-RUNCOMS)
(RPAQQ TRI-RECORD-RUNCOMS ((FNS CACHE.SUPERFRAMES CACHE.SUPERFRAMES.COLLECT ACTIVATE.DISPLAYERS*
CACHE.SUPERFRAMES.IF.NECESSARY DO.FRAME.CHANGE FRAME.DO.PUSH
GRAPH.ITEMS PRINT.SUPERFRAMES START.FRAME FRAME.DO.GOTO FRAME.DO.POP
RESTORE.INTERFACE.CONTEXT SET.FRAME.CONTEXT ACTIVATE.DISPLAYERS
ACTIVATE.IMPLICATIONS ACTIVATE.INHIBITORS ACTIVATE.INITIALIZATIONS
ACTIVATE.INITIALIZATIONS* ACTIVATE.SENSORS ACTIVATE.SENSORS*
ADD.TO.FRAME.CONTEXT*)))
(DEFINEQ
(CACHE.SUPERFRAMES
[LAMBDA (FRAME) (* N.H.Briggs "18-Mar-85 12:17")
(DECLARE (GLOBALVARS CURRENT.INTERFACE))
(* * collect all superframes in back to front order and cache for later use)
(PROG ((SUPERFRAMES (LIST FRAME)))
(for SUPERFRAME.NAME in (fetch.frame.fieldq FRAME SUPERFRAMES) bind SUPERFRAME
do (if (SETQ SUPERFRAME (FIND.FRAME CURRENT.INTERFACE SUPERFRAME.NAME))
then (CACHE.SUPERFRAMES.COLLECT SUPERFRAME)))
(replace.frame.fieldq FRAME SUPERFRAMES.CACHE SUPERFRAMES)
(replace.frame.fieldq FRAME SUPERFRAMES.CACHED? T])
(CACHE.SUPERFRAMES.COLLECT
[LAMBDA (FRAME) (* N.H.Briggs "18-Mar-85 12:15")
(DECLARE (SPECVARS SUPERFRAMES)
(GLOBALVARS CURRENT.INTERFACE))
(push SUPERFRAMES FRAME)
(for SUPERFRAME.NAME in (fetch.frame.fieldq FRAME SUPERFRAMES) bind SUPERFRAME
do (if (SETQ SUPERFRAME (FIND.FRAME CURRENT.INTERFACE SUPERFRAME.NAME))
then (CACHE.SUPERFRAMES.COLLECT SUPERFRAME])
(ACTIVATE.DISPLAYERS*
[LAMBDA (FRAME CELL.NAME DONT.TRACE) (* N.H.Briggs "18-Mar-85 10:50")
(DECLARE (GLOBALVARS TRILLIUM.TRACE))
(CACHE.SUPERFRAMES.IF.NECESSARY FRAME)
(COND
[CELL.NAME (for SUPERFRAME in (fetch.frame.fieldq FRAME SUPERFRAMES.CACHE)
do (for DISPLAYER in (fetch.frame.fieldq SUPERFRAME DISPLAYERS)
when [OR (EQ CELL.NAME (CAR DISPLAYER))
(AND (LISTP (CAR DISPLAYER))
(MEMBER CELL.NAME (CAR DISPLAYER]
do (* Since INDICATORS can be more than just EQ, let
INVERTing them deal with the overlapping problem for
now)
(AND TRILLIUM.TRACE (NULL DONT.TRACE)
(SHOW.TRACE.FROM.CELL CELL.NAME (CADR DISPLAYER)))
(DISPLAY.ITEM (CADR DISPLAYER)
FRAME]
(T (for SUPERFRAME in (fetch.frame.fieldq FRAME SUPERFRAMES.CACHE)
do (for DISPLAYER in (fetch.frame.fieldq SUPERFRAME DISPLAYERS)
do (* Since INDICATORS can be more than just EQ, let
INVERTing them deal with the overlapping problem for
now)
(AND TRILLIUM.TRACE (NULL DONT.TRACE)
(SHOW.TRACE.FROM.CELL CELL.NAME (CADR DISPLAYER)))
(DISPLAY.ITEM (CADR DISPLAYER)
FRAME])
(CACHE.SUPERFRAMES.IF.NECESSARY
[LAMBDA (FRAME) (* N.H.Briggs "15-Mar-85 16:32")
(if (NOT (fetch.frame.fieldq FRAME SUPERFRAMES.CACHED?))
then (CACHE.SUPERFRAMES FRAME])
(DO.FRAME.CHANGE
[LAMBDA NIL (* N.H.Briggs "22-Feb-85 09:29")
(DECLARE (GLOBALVARS CHANGE.FRAME.SPECIFICATIONS CURRENT.INTERFACE))
(PROG ((SPECS CHANGE.FRAME.SPECIFICATIONS)
FRAME.NAME FRAME OPERATION)
(SETQ CHANGE.FRAME.SPECIFICATIONS)
(SETQ FRAME (LISTGET SPECS (QUOTE FRAME)))
(SETQ OPERATION (LISTGET SPECS (QUOTE OPERATION)))
[COND
((NULL FRAME)
(SETQ FRAME.NAME (LISTGET SPECS (QUOTE FRAME.NAME)))
(COND
(FRAME.NAME (SETQ FRAME (FIND.FRAME CURRENT.INTERFACE FRAME.NAME))
(COND
((NULL FRAME)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Frame " FRAME.NAME
" not found in interface "
(fetch.interface.fieldq CURRENT.INTERFACE NAME))
(RETURN]
(COND
((SETQ FRAME (SELECTQ OPERATION
(PUSH (FRAME.DO.PUSH FRAME))
(POP (FRAME.DO.POP FRAME))
(NO.CHANGE (FRAME.DO.GOTO FRAME))
(TROUBLE.WITH.TRILLIUM ON TRILLIUM.WARNINGS
"Unrecognized OPERATION"
OPERATION)))
(BEGIN.EVENT (QUOTE $FrameChangeEvent$))
(START.FRAME FRAME (LISTGET SPECS (QUOTE INITIALIZE)))
(END.EVENT])
(FRAME.DO.PUSH
[LAMBDA (FRAME) (* HaKo "15-Aug-84 15:40")
(COND
(FRAME (TRILLIUM.STACK (CONS (fetch.frame.fieldq FRAME NAME)
(TRILLIUM.STACK)))
FRAME)
(T (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Can't push to unspecified frame!")
NIL])
(GRAPH.ITEMS
[LAMBDA (FRAME) (* N.H.Briggs " 1-Mar-85 14:23")
(DECLARE (GLOBALVARS CURRENT.INTERFACE.WINDOW GRAPH.ITEMS.GRAPH.SPEC))
(PROG (ITEMS GRAPH.SPEC INTERESTING.ITEMS CELL.NAMES REAL.ROOTS TITLE GRAPH.FRAME.WINDOW)
(THINKING (SETQ ITEMS (fetch.frame.fieldq FRAME ITEMS))
(SETQ GRAPH.SPEC GRAPH.ITEMS.GRAPH.SPEC)
(SETQ INTERESTING.ITEMS (DEFINING.ITEMS.OF.FRAME FRAME))
(SETQ CELL.NAMES (DEFINING.PTYPES.OF.FRAME (QUOTE (CELL))
FRAME))
[SETQ REAL.ROOTS (for ITEM in INTERESTING.ITEMS collect (CONS ITEM (QUOTE ITEM]
(SETQ TITLE (CONCAT "Item graph for frame " (fetch.frame.fieldq FRAME NAME)))
(SETQ GRAPH.FRAME.WINDOW (MAKE.GRAPH NIL TITLE GRAPH.SPEC REAL.ROOTS FRAME
(QUOTE GRAPH.ITEMS.LEFTBUTTONFN)
(QUOTE GRAPH.ITEMS.MIDDLEBUTTONFN)))
(WINDOWPROP CURRENT.INTERFACE.WINDOW (QUOTE FRAME)
FRAME))
(RETURN GRAPH.FRAME.WINDOW])
(PRINT.SUPERFRAMES
[LAMBDA (FRAME) (* N.H.Briggs " 1-Mar-85 14:25")
(* DAHJr "19-JAN-83 16:16")
(PROG (FRAME.NAME SUPERFRAMES)
(SETQ FRAME.NAME (fetch.frame.fieldq FRAME NAME))
(SETQ SUPERFRAMES (fetch.frame.fieldq FRAME SUPERFRAMES))
(COND
(SUPERFRAMES (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS "Superframes of frame "
FRAME.NAME ": ")
(for FR in SUPERFRAMES do (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS 3 FR)))
(T (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS FRAME.NAME " has no superframes")))
(RETURN])
(START.FRAME
[LAMBDA (FRAME INITIALIZE?) (* HaKo "16-Aug-84 16:23")
(DECLARE (GLOBALVARS CURRENT.FRAME CURRENT.INTERFACE.WINDOW REPORT.FRAMES))
(FORGET.EDIT.WINDOWS)
(WINDOWPROP CURRENT.INTERFACE.WINDOW (QUOTE CURRENT.FRAME)
FRAME)
(SETQ CURRENT.FRAME FRAME)
(ANALYZE.FRAME.IF.NECESSARY* FRAME)
(MARK.FRAME.CONTEXT.OBSOLETE FRAME)
(DISPLAY.FRAME FRAME INITIALIZE?)
(INTERFACE.WINDOW.CHANGE.TITLE)
(AND REPORT.FRAMES (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Running frame " (fetch.frame.fieldq
CURRENT.FRAME NAME])
(FRAME.DO.GOTO
[LAMBDA (FRAME) (* N.H.Briggs " 1-Mar-85 14:28")
(COND
[FRAME (TRILLIUM.STACK (CONS (fetch.frame.fieldq FRAME NAME)
(CDR (TRILLIUM.STACK]
(T (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Can't go to unspecified frame!")))
FRAME])
(FRAME.DO.POP
[LAMBDA (FRAME) (* N.H.Briggs " 1-Mar-85 14:28")
(DECLARE (GLOBALVARS CURRENT.INTERFACE))
(PROG [(STACK (CDR (TRILLIUM.STACK]
(COND
((NULL STACK)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "At the bottom of the stack; can't pop further")
)
[(NULL FRAME)
(SETQ FRAME (FIND.FRAME CURRENT.INTERFACE (CAR STACK]
((NULL (SETQ STACK (FMEMB (fetch.frame.fieldq FRAME NAME)
STACK)))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "The frame " (fetch.frame.fieldq FRAME NAME)
" is not on the stack; can't return to it")))
(COND
(STACK (TRILLIUM.STACK STACK)
(RETURN FRAME])
(RESTORE.INTERFACE.CONTEXT
[LAMBDA (WINDOW) (* N.H.Briggs " 1-Mar-85 14:29")
(DECLARE (GLOBALVARS CURRENT.BITMAP.FRAMES CURRENT.DSP CURRENT.FRAME CURRENT.FRAME.NAMES
CURRENT.INTERFACE CURRENT.INTERFACE.WINDOW CURRENT.MACHINE.STATE
IN.LIVING.COLOR FRAME.NAME.MENU))
(SETQ CURRENT.INTERFACE.WINDOW WINDOW)
(SETQ CURRENT.DSP (WINDOWPROP WINDOW (QUOTE DSP)))
(SETQ CURRENT.MACHINE.STATE (WINDOWPROP WINDOW (QUOTE MACHINE.STATE)))
(SETQ CURRENT.INTERFACE (WINDOWPROP WINDOW (QUOTE INTERFACE)))
(SETQ CURRENT.FRAME (WINDOWPROP WINDOW (QUOTE CURRENT.FRAME)))
(SETQ CURRENT.FRAME.NAMES (for FRAME in (fetch.interface.fieldq CURRENT.INTERFACE FRAMES)
collect (fetch.frame.fieldq FRAME NAME)))
(SETQ CURRENT.BITMAP.FRAMES)
(SETQ FRAME.NAME.MENU)
(COND
(IN.LIVING.COLOR (INSTALL.COLOR.MAP CURRENT.INTERFACE)))
(SET.FRAME.CONTEXT CURRENT.FRAME])
(SET.FRAME.CONTEXT
[LAMBDA (FRAME) (* N.H.Briggs " 1-Mar-85 14:30")
(* SETS UP GLOBAL VARIABLES SO RUNNING OF THE FRAME
GOES FASTER)
(DECLARE (GLOBALVARS CURRENT.INTERFACE FRAME.ALL.ARTWORK FRAME.ALL.DISPLAYERS
FRAME.ALL.IMPLICATIONS FRAME.ALL.INHIBITORS FRAME.ALL.INITIALIZATION
FRAME.ALL.OBSOLETE FRAME.ALL.SENSORS))
(SETQ FRAME.ALL.INITIALIZATION (APPEND (fetch.frame.fieldq FRAME INITIALIZATION)))
(SETQ FRAME.ALL.ARTWORK (APPEND (fetch.frame.fieldq FRAME ARTWORK)))
(SETQ FRAME.ALL.SENSORS NIL)
(SETQ FRAME.ALL.INHIBITORS NIL)
(SETQ FRAME.ALL.DISPLAYERS (APPEND (fetch.frame.fieldq FRAME DISPLAYERS)))
(SETQ FRAME.ALL.IMPLICATIONS (APPEND (fetch.frame.fieldq FRAME IMPLICATIONS)))
[for SUPERFRAME.NAME bind SUPERFRAME in (fetch.frame.fieldq FRAME SUPERFRAMES)
do (COND
((SETQ SUPERFRAME (FIND.FRAME CURRENT.INTERFACE SUPERFRAME.NAME))
(ADD.TO.FRAME.CONTEXT* SUPERFRAME]
(SETQ FRAME.ALL.INHIBITORS (NCONC (REVERSE (fetch.frame.fieldq FRAME INHIBITORS))
FRAME.ALL.INHIBITORS))
(SETQ FRAME.ALL.SENSORS (NCONC (REVERSE (fetch.frame.fieldq FRAME SENSORS))
FRAME.ALL.SENSORS))
(SETQ FRAME.ALL.OBSOLETE])
(ACTIVATE.DISPLAYERS
[LAMBDA (FRAME CELL.NAME) (* HaKo "27-Jul-84 16:34")
(PROG (T1 T2 DISPLAYERS.TO.ON DISPLAYERS.TO.OFF ITEM)
(SETQ DISPLAYERS.TO.ON (LIST NIL))
(SETQ DISPLAYERS.TO.OFF (LIST NIL))
[for DISPLAYER in (fetch.frame.fieldq FRAME DISPLAYERS)
when [OR (NULL CELL.NAME)
(EQ CELL.NAME (CAR DISPLAYER))
(AND (LISTP (CAR DISPLAYER))
(MEMBER CELL.NAME (CAR DISPLAYER]
do (COND
[(EQUAL (GET.FIELDQ (CADR DISPLAYER)
\TYPE)
(QUOTE INDICATOR))
(SETQ ITEM (CADR DISPLAYER))
[SETQ T1 (EQP (GET.PARAMQ ITEM REFERENCE.VALUE)
(GET.CURRENT.VALUE (GET.PARAMQ ITEM CELL]
(SETQ T2 (EQ (GET.PARAMQ ITEM ON/OFF)
(QUOTE ON)))
(COND
((AND T1 (NOT T2))
(TCONC DISPLAYERS.TO.ON ITEM))
((AND (NOT T1)
T2)
(TCONC DISPLAYERS.TO.OFF ITEM]
(T (DISPLAY.ITEM (CADR DISPLAYER)
FRAME]
[for DISPLAYER in (CAR DISPLAYERS.TO.OFF) do (COND
(DISPLAYER (DISPLAY.ITEM DISPLAYER FRAME]
(for DISPLAYER in (CAR DISPLAYERS.TO.ON) do (COND
(DISPLAYER (DISPLAY.ITEM DISPLAYER FRAME])
(ACTIVATE.IMPLICATIONS
[LAMBDA (FRAME CELL.NAME OLD.VALUE NEW.VALUE DONT.TRACE) (* edited: " 1-NOV-82 11:34")
(for IMPLICATION in (fetch.frame.fieldq FRAME IMPLICATIONS)
when [OR (EQ CELL.NAME (CAR IMPLICATION))
(AND (LISTP (CAR IMPLICATION))
(MEMBER CELL.NAME (CAR IMPLICATION]
do (IMPLY.ITEM (CADR IMPLICATION)
OLD.VALUE NEW.VALUE DONT.TRACE])
(ACTIVATE.INHIBITORS
[LAMBDA (FRAME CELL.NAME OLD.VALUE NEW.VALUE DONT.TRACE) (* edited: " 1-NOV-82 11:31")
(OR (EQ OLD.VALUE (QUOTE UNINITIALIZED))
(for INHIBITOR in (fetch.frame.fieldq FRAME INHIBITORS)
when [OR (EQ CELL.NAME (CAR INHIBITOR))
(AND (LISTP (CAR INHIBITOR))
(MEMBER CELL.NAME (CAR INHIBITOR]
never (INHIBIT.ITEM (CADR INHIBITOR)
OLD.VALUE NEW.VALUE DONT.TRACE])
(ACTIVATE.INITIALIZATIONS
[LAMBDA (FRAME) (* N.H.Briggs "18-Mar-85 13:22")
(for INITIALIZATION in (fetch.frame.fieldq FRAME INITIALIZATIONS) do (INITIALIZE.ITEM
INITIALIZATION
FRAME])
(ACTIVATE.INITIALIZATIONS*
[LAMBDA (FRAME) (* DAHJr "16-FEB-83 10:01")
(* (for SUPERFRAME.NAME bind SUPERFRAME in (fetch.frame.fieldq FRAME SUPERFRAMES) do (COND ((SETQ SUPERFRAME
(FIND.FRAME CURRENT.INTERFACE SUPERFRAME.NAME)) (ACTIVATE.INITIALIZATIONS* SUPERFRAME)) (T (TRILLIUM.PRINTOUT
"Frame " (GET.FIELDQ FRAME NAME) " has superframe " SUPERFRAME.NAME " which doesn't exist" " (initialization)"))))
(ACTIVATE.INITIALIZATIONS FRAME))
(DECLARE (GLOBALVARS FRAME.ALL.INITIALIZATIONS))
(SET.FRAME.CONTEXT.IF.NECESSARY FRAME)
(for INITIALIZATION in FRAME.ALL.INITIALIZATIONS do (INITIALIZE.ITEM INITIALIZATION FRAME])
(ACTIVATE.SENSORS
[LAMBDA (FRAME TOUCH XCOORD YCOORD) (* HK "22-JUL-82 11:33")
(for SENSOR in (fetch.frame.fieldq FRAME SENSORS) thereis (SENSE.ITEM SENSOR TOUCH XCOORD YCOORD
FRAME])
(ACTIVATE.SENSORS*
[LAMBDA (FRAME TOUCH XCOORD YCOORD) (* DAHJr "16-FEB-83 10:04")
(* (OR (ACTIVATE.SENSORS FRAME TOUCH XCOORD YCOORD) (for SUPERFRAME.NAME bind SUPERFRAME in
(fetch.frame.fieldq FRAME SUPERFRAMES) thereis (COND ((SETQ SUPERFRAME (FIND.FRAME CURRENT.INTERFACE
SUPERFRAME.NAME)) (ACTIVATE.SENSORS* SUPERFRAME TOUCH XCOORD YCOORD)) (T (TRILLIUM.PRINTOUT "Frame "
(GET.FIELDQ FRAME NAME) " has superframe " SUPERFRAME.NAME " which doesn't exist" " (sensors)") NIL)))))
(DECLARE (GLOBALVARS FRAME.ALL.SENSORS))
(SET.FRAME.CONTEXT.IF.NECESSARY FRAME)
(for SENSOR in FRAME.ALL.SENSORS thereis (SENSE.ITEM SENSOR TOUCH XCOORD YCOORD FRAME])
(ADD.TO.FRAME.CONTEXT*
[LAMBDA (FRAME) (* N.H.Briggs " 1-Mar-85 14:27")
(* SETS UP GLOBAL VARIABLES SO RUNNING OF THE FRAME
GOES FASTER)
(* BACK TO FRONT)
(DECLARE (GLOBALVARS CURRENT.INTERFACE FRAME.ALL.ARTWORK FRAME.ALL.DISPLAYERS
FRAME.ALL.IMPLICATIONS FRAME.ALL.INHIBITORS FRAME.ALL.INITIALIZATION
FRAME.ALL.SENSORS))
(SETQ FRAME.ALL.INITIALIZATION (APPEND (fetch.frame.fieldq FRAME INITIALIZATION)
FRAME.ALL.INITIALIZATION))
(SETQ FRAME.ALL.ARTWORK (APPEND (fetch.frame.fieldq FRAME ARTWORK)
FRAME.ALL.ARTWORK))
(SETQ FRAME.ALL.DISPLAYERS (APPEND (fetch.frame.fieldq FRAME DISPLAYERS)
FRAME.ALL.DISPLAYERS))
(SETQ FRAME.ALL.IMPLICATIONS (APPEND (fetch.frame.fieldq FRAME IMPLICATIONS)
FRAME.ALL.IMPLICATIONS))
[for SUPERFRAME.NAME bind SUPERFRAME in (fetch.frame.fieldq FRAME SUPERFRAMES)
do (COND
((SETQ SUPERFRAME (FIND.FRAME CURRENT.INTERFACE SUPERFRAME.NAME))
(ADD.TO.FRAME.CONTEXT* SUPERFRAME] (* FRONT TO BACK)
(SETQ FRAME.ALL.INHIBITORS (APPEND (fetch.frame.fieldq FRAME INHIBITORS)
FRAME.ALL.INHIBITORS))
(SETQ FRAME.ALL.SENSORS (APPEND (fetch.frame.fieldq FRAME SENSORS)
FRAME.ALL.SENSORS])
)
(PUTPROPS TRI-RECORD-RUN COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (983 17585 (CACHE.SUPERFRAMES 993 . 1693) (CACHE.SUPERFRAMES.COLLECT 1695 . 2192) (
ACTIVATE.DISPLAYERS* 2194 . 3663) (CACHE.SUPERFRAMES.IF.NECESSARY 3665 . 3908) (DO.FRAME.CHANGE 3910
. 5260) (FRAME.DO.PUSH 5262 . 5597) (GRAPH.ITEMS 5599 . 6689) (PRINT.SUPERFRAMES 6691 . 7422) (
START.FRAME 7424 . 8066) (FRAME.DO.GOTO 8068 . 8407) (FRAME.DO.POP 8409 . 9194) (
RESTORE.INTERFACE.CONTEXT 9196 . 10242) (SET.FRAME.CONTEXT 10244 . 11679) (ACTIVATE.DISPLAYERS 11681
. 13070) (ACTIVATE.IMPLICATIONS 13072 . 13520) (ACTIVATE.INHIBITORS 13522 . 14012) (
ACTIVATE.INITIALIZATIONS 14014 . 14298) (ACTIVATE.INITIALIZATIONS* 14300 . 15045) (ACTIVATE.SENSORS
15047 . 15295) (ACTIVATE.SENSORS* 15297 . 16060) (ADD.TO.FRAME.CONTEXT* 16062 . 17583)))))
STOP