(FILECREATED " 6-Mar-85 13:50:02"
{PHYLUM}<TRILLIUM>BIRTHDAY84>ENHANCEMENTS>RECORDS-NHB>TRI-RECORD-SPLITMERGE.;10 36202
changes to: (FNS SPLIT.SUB.INTERFACE FIND.SAVED.FRAMES CREATE.NEW.INTERFACES
CAUTERIZE.INTERFACE CAUTERIZE.SUPERFRAMES RESOLVE.BITMAP.NAME.CONFLICTS
CHANGE.FRAME.NAME DELETE.OLD.ITEM.IN.INTERFACE GET.BITMAP.NAMES.IN.INTERFACE
GET.BITMAP.FRAME.NAMES GET.NAMES.IN.GRAPH.ONLY GET.ROOT.NAMES GET.SUPERFRAMES
CREATE.SPLIT.INTERFACE GET.FIRST.FRAME.IN.INTERFACE GET.FRAME.NAMES
GRAPH.FRAMES.FOR.SPLIT MY.MERGE.INTERFACE RESOLVE.CELL.NAME.CONFLICTS
CHANGE.CELL.NAME GET.CELL.NAMES.IN.FRAME)
previous date: " 1-Mar-85 16:04:13"
{PHYLUM}<TRILLIUM>BIRTHDAY84>ENHANCEMENTS>RECORDS-NHB>TRI-RECORD-SPLITMERGE.;9)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TRI-RECORD-SPLITMERGECOMS)
(RPAQQ TRI-RECORD-SPLITMERGECOMS ((FNS SPLIT.SUB.INTERFACE FIND.SAVED.FRAMES CREATE.NEW.INTERFACES
CAUTERIZE.INTERFACE CAUTERIZE.SUPERFRAMES
RESOLVE.BITMAP.NAME.CONFLICTS CHANGE.FRAME.NAME
DELETE.OLD.ITEM.IN.INTERFACE GET.BITMAP.NAMES.IN.INTERFACE
GET.BITMAP.FRAME.NAMES GET.NAMES.IN.GRAPH.ONLY GET.ROOT.NAMES
GET.SUPERFRAMES CREATE.SPLIT.INTERFACE
GET.FIRST.FRAME.IN.INTERFACE GET.FRAME.NAMES
GRAPH.FRAMES.FOR.SPLIT MY.MERGE.INTERFACE
RESOLVE.CELL.NAME.CONFLICTS CHANGE.CELL.NAME
GET.CELL.NAMES.IN.FRAME)))
(DEFINEQ
(SPLIT.SUB.INTERFACE
[LAMBDA (NODE WINDOW) (* HaKo "16-Aug-84 16:35")
(* EXECUTIVE FOR SPLITTING OFF A SUBINTERFACE AND
MAKING IT INTO A NEW INTERFACE)
(PROG (FRAME.SAVE.LIST OLD.INTERFACE.FRAMES)
(COND
((CONFIRM (CONCAT "SPLIT INTERFACE " (WINDOWPROP WINDOW (QUOTE INTERFACE.NAME))
" AT NODE "
(fetch.frame.fieldq (CAR (fetch (GRAPHNODE NODEID) of NODE))
NAME)
" ?"))
[SETQ FRAME.SAVE.LIST (FIND.SAVED.FRAMES WINDOW (GET.FIRST.FRAME.IN.INTERFACE
(WINDOWPROP WINDOW (QUOTE INTERFACE.NAME)))
NODE
(WINDOWPROP WINDOW (QUOTE INTERFACE.NAME]
(* FIND FRAMES TO REMAIN IN INTERFACE)
(SETQ OLD.INTERFACE.FRAMES (CAR FRAME.SAVE.LIST))
(SETQ OLD.INTERFACE.FRAMES (INTERSECTION OLD.INTERFACE.FRAMES OLD.INTERFACE.FRAMES))
(CREATE.NEW.INTERFACES (WINDOWPROP WINDOW (QUOTE INTERFACE.NAME))
OLD.INTERFACE.FRAMES
(CADR FRAME.SAVE.LIST)
(fetch.frame.fieldq (CAR (fetch NODEID of NODE))
NAME)
WINDOW)
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Split command complete"))
(T (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Split command aborted"])
(FIND.SAVED.FRAMES
[LAMBDA (WINDOW START.NODE NODE INTERFACE.NAME FRAME.GRAPH.LIST)
(* HaKo "25-Jul-84 17:21")
(* INTERFACE SEARCH PROCEDURE TO FIND FRAMES IN
INTERFACE WHICH REMAIN AFTER SPLIT OR DELETE.BELOW)
(* ARG NODE IS NIL ON RECURSIVE CALL)
(PROG (OPEN (CLOSED (CONS))
[NODEID (COND
((LITATOM NODE)
NODE)
(T (fetch.frame.fieldq (CAR (fetch (GRAPHNODE NODEID) of NODE))
NAME]
CURRENTFRAME SPLIT.OFF.FRAMES AMBIGUOUS.FRAMES ROOTS ROOT.SONS POSSIBLE.ROOTS)
[COND
((NULL FRAME.GRAPH.LIST)
[SETQ FRAME.GRAPH.LIST (GET.NAMES.IN.GRAPH.ONLY (CAR (WINDOWPROP WINDOW (QUOTE GRAPH]
(SETQ FRAME.GRAPH.LIST (INTERSECTION FRAME.GRAPH.LIST FRAME.GRAPH.LIST))
(for FRAME in FRAME.GRAPH.LIST do (COND
((EQUAL (CADR FRAME)
(QUOTE (NIL)))
(RPLACD FRAME NIL]
[COND
[NODE [SETQ POSSIBLE.ROOTS (GET.ROOT.NAMES (WINDOWPROP WINDOW (QUOTE ROOTS]
(SETQ ROOTS (LDIFFERENCE (for ITEM in POSSIBLE.ROOTS collect (CAR ITEM))
(INTERSECTION (SETQ ROOT.SONS (for ITEM in POSSIBLE.ROOTS
join (CADR ITEM)))
ROOT.SONS)))
(SETQ ROOTS (for ROOT in ROOTS collect (CONS ROOT
(LIST (GET.FRAME.SONS
(FIND.FRAME (FIND.INTERFACE
INTERFACE.NAME)
ROOT]
(T (SETQ ROOTS (LIST START.NODE]
[for ROOT in ROOTS
do (push OPEN ROOT)
(while (NOT (NULL OPEN))
do ((SETQ CURRENTFRAME (pop OPEN)) (* DEPTH-FIRST SEARCH LOOP, IGNORING THE SELECTED NODE
AND THUS ITS DESCENDENTS AS WELL.
ASKS USER IF AMBIGUOUS FRAMES SHOULD BE INCLUDED)
(COND
[(NEQ (CAR CURRENTFRAME)
NODEID)
(COND
((NOT (MEMBER CURRENTFRAME (CAR CLOSED)))
[for NODES in (COPY (CADR CURRENTFRAME))
do (COND
((FIND.FRAME (FIND.INTERFACE INTERFACE.NAME)
NODES)
(push OPEN (GET.NODE.REP NODES FRAME.GRAPH.LIST)))
(T (DREMOVE NODES (CADR CURRENTFRAME))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "FRAME " NODES
" SPECIFIED IN INTERFACE BUT NOT FOUND"]
(TCONC CLOSED CURRENTFRAME]
(T (SETQ SPLIT.OFF.FRAMES (APPEND SPLIT.OFF.FRAMES
(FIND.SAVED.FRAMES WINDOW CURRENTFRAME NIL
INTERFACE.NAME
FRAME.GRAPH.LIST]
(RPLACA CLOSED (INTERSECTION (CAR CLOSED)
(CAR CLOSED)))
(COND
(NODE (SETQ AMBIGUOUS.FRAMES (INTERSECTION (CAR CLOSED)
SPLIT.OFF.FRAMES))
(SETQ SPLIT.OFF.FRAMES (AMBIGUOUS.FRAMES.TO.INCLUDE SPLIT.OFF.FRAMES
AMBIGUOUS.FRAMES))
(SETQ SPLIT.OFF.FRAMES (INTERSECTION SPLIT.OFF.FRAMES SPLIT.OFF.FRAMES))
(RETURN (LIST (CAR CLOSED)
SPLIT.OFF.FRAMES)))
(T (RETURN (CAR CLOSED])
(CREATE.NEW.INTERFACES
[LAMBDA (OLD.INTERFACE.NAME OLD.INTERFACE.FRAMES NEW.INTERFACE.FRAMES
FIRST.FRAME.IN.SPLIT.INTERFACE WINDOW)
(* N.H.Briggs " 5-Mar-85 11:13")
(* GIVEN THE FRAME STRUCTURE OF THE ORIGINAL INTERFACE AND THE NODES TO REMAIN IN THE OLD INTERFACE, CREATES A NEW
INTERFACE CONSISTING OF THE SPLIT-OFF SUB-INTERFACE)
(PROG (NEW.INTERFACE.NAME LEGAL.NAME.FLG DELETE.CHANGE.FRAME.ITEM.FLG FRAME.NAME.LIST
NEW.INTERFACE FIRST.FRAME.NAME FRAME.LIST INTERFACE)
(SETQ LEGAL.NAME.FLG) (* GET NAME FOR SPLIT OFF INTERFACE)
[while (NOT LEGAL.NAME.FLG) do ((TRILLIUM.PRINTOUT ON PROMPTWINDOW
"NAME OF NEW INTERFACE: ")
(SETQ NEW.INTERFACE.NAME (PROMPT.READ))
(COND
((NOT (LITATOM NEW.INTERFACE.NAME))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"NAME MUST BE A LITERAL ATOM"))
((FIND.INTERFACE NEW.INTERFACE.NAME)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "THE NAME "
NEW.INTERFACE.NAME
" IS ALREADY IN USE"))
(T (SETQ LEGAL.NAME.FLG T]
(SETQ DELETE.CHANGE.FRAME.ITEM.FLG (MENU (create MENU
ITEMS ←(QUOTE (DELETE.ALL
DELETE.SELECTIVELY
DO.NOT.DELETE))
TITLE ←(CONCAT
"CHOICES FOR DELETING FRAME CHANGE ITEMS IN "
NEW.INTERFACE.NAME)
CENTERFLG ← T)))
(CREATE.SPLIT.INTERFACE NEW.INTERFACE.FRAMES OLD.INTERFACE.NAME NEW.INTERFACE.NAME
FIRST.FRAME.IN.SPLIT.INTERFACE DELETE.CHANGE.FRAME.ITEM.FLG)
(SETQ DELETE.CHANGE.FRAME.ITEM.FLG (MENU (create MENU
ITEMS ←(QUOTE (DELETE.ALL
DELETE.SELECTIVELY
DO.NOT.DELETE))
TITLE ←(CONCAT
"CHOICES FOR DELETING FRAME CHANGE ITEMS IN "
OLD.INTERFACE.NAME)
CENTERFLG ← T)))
[replace.interface.fieldq (SETQ INTERFACE (FIND.INTERFACE OLD.INTERFACE.NAME))
FRAMES
(DREMOVE NIL
(for FRAME
in [UNION [UNION (QUOTE (CELLS COLORS))
(OR (LISTGET (LISTGET (
fetch.interface.fieldq INTERFACE PROFILE)
(QUOTE
FRAME.CLASSES))
(QUOTE BITMAP.FRAMES))
(LIST (QUOTE BITMAPS]
(UNION (GET.SUPERFRAMES INTERFACE)
(for OLD.FRAME in
OLD.INTERFACE.FRAMES
collect (CAR OLD.FRAME]
collect (FIND.FRAME (FIND.INTERFACE
OLD.INTERFACE.NAME)
FRAME]
(COND
((NOT (EQ DELETE.CHANGE.FRAME.ITEM.FLG (QUOTE DO.NOT.DELETE)))
(CAUTERIZE.INTERFACE OLD.INTERFACE.FRAMES (fetch.interface.fieldq OLD.INTERFACE
FIRST.FRAME)
INTERFACE DELETE.CHANGE.FRAME.ITEM.FLG)))
(SETQ FRAME.NAME.LIST (for FRAME in OLD.INTERFACE.FRAMES collect (CAR FRAME)))
(COND
((NOT (EQ DELETE.CHANGE.FRAME.ITEM.FLG (QUOTE DO.NOT.DELETE)))
(for FRAME in (fetch.interface.fieldq INTERFACE FRAMES)
do (CAUTERIZE.SUPERFRAMES OLD.INTERFACE.NAME OLD.INTERFACE.NAME INTERFACE
(GET.FIELD FRAME (QUOTE NAME)
(QUOTE FRAME))
FRAME.NAME.LIST
(COND
((EQUAL (GET.FIELD FRAME (QUOTE NAME)
(QUOTE FRAME))
(fetch.interface.fieldq INTERFACE FIRST.FRAME))
T)
(T NIL))
DELETE.CHANGE.FRAME.ITEM.FLG])
(CAUTERIZE.INTERFACE
[LAMBDA (FRAME.LIST FIRST.FRAME.NAME INTERFACE DELETE.CHANGE.FRAME.ITEM.FLG)
(* N.H.Briggs " 1-Mar-85 14:31")
(* SEARCHES THROUGH THE FRAME LIST CONSISTING OF PAIRS <FRAME NAME><DESCENDENTS>. WHEN A DESCENDENT IS FOUND WHICH
IS NOT A FRAME IN THE FRAME LIST, THE CONNECTION BETWEEN THE FRAMES IS BROKEN)
(PROG ((FRAME.NAMES (for PAIR in FRAME.LIST collect (CAR PAIR)))
FRAME PARAMETERS) (* FOR ALL REGULAR FRAMES; NOT SUPERFRAMES)
(for PAIR in FRAME.LIST
do (for SONS in [COPY (REMOVE NIL (UNION (CADR PAIR)
(DEFINING.PTYPES.OF.FRAME
(QUOTE (FRAME))
(SETQ FRAME (FIND.FRAME INTERFACE
(CAR PAIR]
do (COND
((NOT (FMEMB SONS FRAME.NAMES))
(for ITEM in (fetch.frame.fieldq FRAME ITEMS)
do ((SETQ PARAMETERS (GET.FIELDQ (ITEM.TYPE.DESCRIPTION (ITEM.TYPE
ITEM))
PARAMETERS))
(for PARAMETER in PARAMETERS
do (COND
([AND (EQUAL (GET.FIELDQ PARAMETER TYPE)
(QUOTE (FRAME)))
(EQUAL (LISTGET ITEM (QUOTE FRAME))
SONS)
(OR (EQ DELETE.CHANGE.FRAME.ITEM.FLG (QUOTE DELETE.ALL)
)
(CONFIRM (CONCAT "DELETE ITEM IN FRAME "
(CAR PAIR)
" CHANGING TO FRAME " SONS "?"]
(DELETE.OLD.ITEM.IN.INTERFACE FRAME ITEM INTERFACE)
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE
(CONCAT "ITEM POINTING TO FRAME " SONS
" DELETED FROM FRAME "
(CAR PAIR])
(CAUTERIZE.SUPERFRAMES
[LAMBDA (OLD.INTERFACE.NAME NEW.INTERFACE.NAME NEW.INTERFACE FRAME.NAME FRAME.LIST FIRST.FRAME.FLG
DELETE.CHANGE.FRAME.ITEM.FLG)
(* N.H.Briggs " 5-Mar-85 10:30")
(* CHECKS SUPERFRAMES OF A FRAME TO DETERMINE IF THEY CONTAIN FRAME CHANGERS TO FRAMES NOT IN THE INTERFACE.
IF SO, A NEW SUPERFRAME IS CREATED WITHOUT THOSE AND REPLACES THE OLD SUPERFRAME)
(PROG ((FRAME (FIND.FRAME NEW.INTERFACE FRAME.NAME))
SUPERFRAME.LIST SUPERFRAME PARAMETERS OPFORM ITYPE PTYPE NEW.SUPERFRAME
NEW.SUPERFRAME.NAME ITEM.LIST)
(SETQ SUPERFRAME.LIST (fetch.frame.fieldq FRAME SUPERFRAMES))
(for SUPERFRAME.NAME in SUPERFRAME.LIST
do ((SETQ SUPERFRAME (FIND.FRAME (FIND.INTERFACE OLD.INTERFACE.NAME)
SUPERFRAME.NAME))
[for ITEM in (fetch.frame.fieldq SUPERFRAME ITEMS)
do ((SETQ ITYPE (ITEM.TYPE ITEM))
(SETQ PARAMETERS (GET.FIELDQ (ITEM.TYPE.DESCRIPTION ITYPE)
PARAMETERS))
(for PARAMETER in PARAMETERS
do ((SETQ PTYPE (GET.FIELDQ PARAMETER TYPE))
(COND
([OR [AND (EQUAL PTYPE (QUOTE (FRAME)))
(NOT (EQ (LISTGET ITEM (QUOTE FRAME))
NIL))
(NOT (FMEMB (LISTGET ITEM (QUOTE FRAME))
FRAME.LIST))
(OR (EQ DELETE.CHANGE.FRAME.ITEM.FLG (QUOTE DELETE.ALL))
(CONFIRM (CONCAT "DELETE ITEM IN FRAME "
SUPERFRAME.NAME " POINTING TO FRAME "
(LISTGET ITEM (QUOTE FRAME))
"?"]
(AND FIRST.FRAME.FLG (EQUAL (GET.FIELDQ PARAMETER NAME)
(QUOTE STACK.OPERATION))
(EQUAL (LISTGET ITEM (QUOTE STACK.OPERATION))
(QUOTE POP))
(OR (EQ DELETE.CHANGE.FRAME.ITEM.FLG (QUOTE DELETE.ALL))
(CONFIRM "DELETE POP FRAME ITEM FROM FIRST FRAME?"]
(SETQ ITEM.LIST (CONS ITEM ITEM.LIST]
(COND
(ITEM.LIST (SETQ NEW.SUPERFRAME (create.frame (NAME (SETQ NEW.SUPERFRAME.NAME
(NEW.OBJECT.NAME
SUPERFRAME.NAME
NEW.INTERFACE.NAME)))
(ITEMS (for ITEM
in (fetch.frame.fieldq
SUPERFRAME ITEMS)
when (NOT (MEMBER ITEM
ITEM.LIST))
collect ITEM))
(ANALYZED NIL)))
(ADD.NEW.FRAME NEW.INTERFACE NEW.SUPERFRAME)
(MARK.INTERFACE NEW.INTERFACE)
(replace.frame.fieldq FRAME SUPERFRAMES (CONS NEW.SUPERFRAME.NAME
(REMOVE SUPERFRAME.NAME
(
fetch.frame.fieldq FRAME SUPERFRAMES])
(RESOLVE.BITMAP.NAME.CONFLICTS
[LAMBDA (INTERFACE1 INTERFACE2) (* SGK "29-AUG-83 13:25")
(PROG (FRAME.CLASSES CONFLICTING.NAMES BITMAP.FRAME.NAMES)
[for BITMAP.NAME bind (FRAME BITMAP.ITEM) in (GET.CONFLICTING.BITMAP.NAMES INTERFACE1
INTERFACE2)
do (COND
((EQUAL.BITMAPS (LISTGET (for ITEM in (fetch.frame.fieldq (FIND.FRAME INTERFACE1
(CDR
BITMAP.NAME))
ITEMS)
thereis (EQUAL (LISTGET ITEM (QUOTE NAME))
(CAR BITMAP.NAME)))
(QUOTE BITMAP))
(LISTGET [SETQ BITMAP.ITEM (for ITEM
in (fetch.frame.fieldq
(SETQ FRAME (FIND.FRAME
INTERFACE2
(CDR BITMAP.NAME)))
ITEMS)
thereis (EQUAL (LISTGET ITEM
(QUOTE NAME))
(CAR BITMAP.NAME]
(QUOTE BITMAP))
(CAR BITMAP.NAME))
(DELETE.OLD.ITEM.IN.INTERFACE FRAME BITMAP.ITEM INTERFACE2]
[COND
((NULL (LISTGET (SETQ FRAME.CLASSES (LISTGET (GET.FIELDQ INTERFACE2 PROFILE INTERFACE)
(QUOTE FRAME.CLASSES)))
(QUOTE BITMAP.FRAMES)))
(COND
[(NULL FRAME.CLASSES)
(SET.FIELDQ (GET.FIELDQ INTERFACE2 PROFILE INTERFACE)
FRAME.CLASSES
(CONS (QUOTE BITMAP.FRAMES)
(LIST (LIST (QUOTE BITMAPS]
(T (SET.FIELDQ FRAME.CLASSES BITMAP.FRAMES (LIST (QUOTE BITMAPS]
(SETQ CONFLICTING.NAMES (INTERSECTION (GET.BITMAP.FRAME.NAMES INTERFACE1)
(GET.BITMAP.FRAME.NAMES INTERFACE2)))
(* LOOP TO RENAME BITMAP FRAMES IN SECOND INTERFACE
WHICH HAVE SAME NAMES AS BITMAP FRAMES IN FIRST
INTERFACE)
[for FRAME.NAMES on (LISTGET (SETQ FRAME.CLASSES (LISTGET (GET.FIELDQ INTERFACE2 PROFILE
INTERFACE)
(QUOTE FRAME.CLASSES)))
(QUOTE BITMAP.FRAMES))
do (COND
((MEMBER (CAR FRAME.NAMES)
CONFLICTING.NAMES)
(RPLACA FRAME.NAMES (CHANGE.FRAME.NAME (CAR FRAME.NAMES)
(NEW.OBJECT.NAME (CAR FRAME.NAMES)
(GET.FIELDQ INTERFACE2
NAME
INTERFACE))
INTERFACE2]
(LISTPUT [COND
((LISTGET (SETQ BITMAP.FRAME.NAMES (LISTGET (GET.FIELDQ INTERFACE1 PROFILE
INTERFACE)
(QUOTE FRAME.CLASSES)))
(QUOTE BITMAP.FRAMES))
BITMAP.FRAME.NAMES)
(T [SET.FIELDQ (GET.FIELDQ INTERFACE1 PROFILE INTERFACE)
FRAME.CLASSES
(APPEND (QUOTE (BITMAP.FRAMES (BITMAPS)))
(LISTGET (GET.FIELDQ INTERFACE1 PROFILE INTERFACE)
(QUOTE FRAME.CLASSES]
(LISTGET (GET.FIELDQ INTERFACE1 PROFILE INTERFACE)
(QUOTE FRAME.CLASSES]
(QUOTE BITMAP.FRAMES)
(COND
((LISTGET BITMAP.FRAME.NAMES (QUOTE BITMAP.FRAMES))
(INTERSECTION [SETQ BITMAP.FRAME.NAMES (APPEND (GET.BITMAP.FRAME.NAMES
INTERFACE2)
(LISTGET BITMAP.FRAME.NAMES
(QUOTE BITMAP.FRAMES]
BITMAP.FRAME.NAMES))
(T (CONS (QUOTE BITMAPS)
(GET.BITMAP.FRAME.NAMES INTERFACE2])
(CHANGE.FRAME.NAME
[LAMBDA (OLD.FRAME.NAME NEW.FRAME.NAME INTERFACE NAME.ASSOC.LIST)
(* SGK "19-AUG-83 16:07")
(* CHANGES THE NAME OF THE FRAME IN THE GIVEN
INTERFACE, AND ALL REFERENCES TO IT IN THE FRAME;
FIRST GETS THE NEW NAME)
(PROG (FRAME.NAMES SUPERFRAMES)
(SETQ FRAME.NAMES (GET.FRAME.NAMES INTERFACE))
(SET.FIELD (FIND.FRAME INTERFACE OLD.FRAME.NAME)
(QUOTE NAME)
NEW.FRAME.NAME
(QUOTE FRAME))
[for FRAME.NAME bind FRAME in FRAME.NAMES do ([SETQ FRAME
(OR (FIND.FRAME INTERFACE FRAME.NAME)
(FIND.FRAME INTERFACE
(CDR (FASSOC FRAME.NAME
NAME.ASSOC.LIST]
(for ITEM in (fetch.frame.fieldq FRAME ITEMS)
do (for FORM in (DEEP.MEMBER
OLD.FRAME.NAME
ITEM)
do (RPLACA FORM NEW.FRAME.NAME)))
(COND
((MEMBER OLD.FRAME.NAME (SETQ SUPERFRAMES
(fetch.frame.fieldq FRAME
SUPERFRAMES)))
(for SUPERFRAME.NAMES on SUPERFRAMES
do (COND
((EQUAL SUPERFRAME.NAMES
OLD.FRAME.NAME)
(RPLACA SUPERFRAME.NAMES
NEW.FRAME.NAME]
(RETURN NEW.FRAME.NAME])
(DELETE.OLD.ITEM.IN.INTERFACE
[LAMBDA (FRAME ITEM INTERFACE) (* SGK " 4-AUG-83 09:17")
(DECLARE (GLOBALVARS CURRENT.INTERFACE.WINDOW))
(PROG (ITEMS NEWLIST EDIT.WINDOWS CORRESPONDING.EDIT.WINDOW)
(REMOVE.ITEM ITEM FRAME)
(SETQ ITEMS (fetch.frame.fieldq FRAME ITEMS))
(SETQ NEWLIST (DREMOVE ITEM ITEMS))
(OR NEWLIST (replace.frame.fieldq FRAME ITEMS NIL))
(MARK.FRAME.CONTEXT.OBSOLETE FRAME)
(MARK.INTERFACE INTERFACE)
(COND
((ACTIVEWP CURRENT.INTERFACE.WINDOW)
(for WINDOW in (DEPENDENT.WINDOWS CURRENT.INTERFACE.WINDOW)
when (AND (EQ (WINDOWPROP WINDOW (QUOTE TRILLIUM.WINDOW.TYPE))
(QUOTE ITEM.EDITOR))
(EQ (WINDOWPROP WINDOW (QUOTE DATUM))
ITEM))
do (DELETE.DEPENDENT.WINDOW CURRENT.INTERFACE.WINDOW WINDOW)
(CLOSEW WINDOW])
(GET.BITMAP.NAMES.IN.INTERFACE
[LAMBDA (INTERFACE) (* SGK " 5-AUG-83 12:50")
(* RETURNS A LIST OF ALL BIMAPS IN THE BITMAP FRAME OR
THE FRAMES IN FRAME CLASS BITMAP.FRAME)
(for FRAME.NAME in (GET.BITMAP.FRAME.NAMES INTERFACE) join (for ITEM
in (fetch.frame.fieldq
(FIND.FRAME INTERFACE
FRAME.NAME)
ITEMS)
when (EQUAL (ITEM.TYPE ITEM)
(QUOTE BITMAP))
collect (CONS (LISTGET
ITEM
(QUOTE NAME))
FRAME.NAME])
(GET.BITMAP.FRAME.NAMES
[LAMBDA (INTERFACE) (* N.H.Briggs " 5-Mar-85 11:14")
(OR (LISTGET (LISTGET (fetch.interface.fieldq INTERFACE PROFILE)
(QUOTE FRAME.CLASSES))
(QUOTE BITMAP.FRAMES))
(QUOTE (BITMAPS])
(GET.NAMES.IN.GRAPH.ONLY
[LAMBDA (GRAPH) (* SGK "22-AUG-83 11:05")
(* GIVEN A GRAPH PRODUCED BY GRAPH.FRAMES, PRODUCE A
LIST OF THE FORM (<FRAME><SONS>) *)
(PROG ((RETURN.LIST (CONS))
(FRAMES.ALREADY.SEARCHED (CONS)))
[for FRAME in GRAPH bind FRAME.NAME
do (COND
((NOT (MEMBER (SETQ FRAME.NAME (fetch.frame.fieldq (CAR (fetch (GRAPHNODE NODEID)
of FRAME))
NAME))
(CAR FRAMES.ALREADY.SEARCHED)))
[TCONC RETURN.LIST (LIST FRAME.NAME (GET.FRAME.SONS (CAR (fetch (GRAPHNODE NODEID)
of FRAME]
(TCONC FRAMES.ALREADY.SEARCHED FRAME.NAME]
(RETURN (CAR RETURN.LIST])
(GET.ROOT.NAMES
[LAMBDA (ROOTS) (* SGK "19-AUG-83 13:02")
(* GIVEN THE ROOTS SPECIFICATION FROM THE GRAPH WINDOW,
RETURN THE ROOTS AND THEIR DESCENDENTS)
(PROG [(FRAMES (for ITEM in ROOTS collect (CAR ITEM]
(RETURN (for FRAME in FRAMES collect (CONS (fetch.frame.fieldq FRAME NAME)
(LIST (GET.FRAME.SONS FRAME])
(GET.SUPERFRAMES
[LAMBDA (INTERFACE) (* N.H.Briggs "22-Feb-85 11:20")
(* GATHERS ALL SUPERFRAMES REFERENCED BY ANY FRAME IN
INTERFACE)
(PROG (SUPERFRAMES)
[SETQ SUPERFRAMES (DREMOVE NIL (for FRAME in (fetch.interface.fieldq INTERFACE FRAMES)
join (COPY (fetch.frame.fieldq FRAME SUPERFRAMES]
(RETURN (INTERSECTION SUPERFRAMES SUPERFRAMES])
(CREATE.SPLIT.INTERFACE
[LAMBDA (FRAME.LIST OLD.INTERFACE.NAME NEW.INTERFACE.NAME FIRST.FRAME.NAME
DELETE.CHANGE.FRAME.ITEM.FLG) (* N.H.Briggs " 6-Mar-85 13:30")
(* CREATES A NEW INTERFACE WITH THE FRAMES AND LINKS
BETWEEN THEM SPECIFIED IN FRAME.LIST AND WITH NAME
INTERFACE.NAME)
(PROG (NEW.INTERFACE INTERFACE SUPERFRAMES.IN.OLD FRAME.NAMES FRAMES.TO.ADD BITMAP.CLASS
FRAME.NAME.LIST FRAME)
(SETQ INTERFACE (FIND.INTERFACE OLD.INTERFACE.NAME))
(SETQ SUPERFRAMES.IN.OLD (GET.SUPERFRAMES INTERFACE))
(SETQ FRAME.NAMES (for FRAME in FRAME.LIST collect (CAR FRAME)))
[SETQ FRAMES.TO.ADD (DREMOVE NIL (NCONC [for FRAME in FRAME.LIST
collect (COPYALL (FIND.FRAME INTERFACE
(CAR FRAME]
(COND
([AND (NOT (MEMBER (QUOTE BITMAPS)
FRAME.NAMES))
(SETQ FRAME (FIND.FRAME INTERFACE
(QUOTE BITMAPS]
(LIST (COPYALL FRAME)))
(T NIL))
(COND
[(AND (SETQ BITMAP.CLASS
(LISTGET (LISTGET (fetch.interface.fieldq
INTERFACE PROFILE)
(QUOTE FRAME.CLASSES))
(QUOTE BITMAP.FRAMES)))
(SETQ BITMAP.CLASS (LDIFFERENCE
BITMAP.CLASS
FRAME.NAMES)))
(for FRAME.NAME in (REMOVE (QUOTE BITMAPS)
BITMAP.CLASS)
collect (COPYALL (FIND.FRAME INTERFACE
FRAME.NAME]
(T NIL))
(COND
[(NOT (MEMBER (QUOTE COLORS)
FRAME.NAMES))
(LIST (COPYALL (FIND.FRAME INTERFACE
(QUOTE COLORS]
(T NIL))
(COND
((NOT (MEMBER (QUOTE CELLS)
FRAME.NAMES))
(LIST (COPYALL (FIND.FRAME INTERFACE
(QUOTE CELLS]
[COND
(SUPERFRAMES.IN.OLD (NCONC FRAMES.TO.ADD (for SUPERFRAME in (LDIFFERENCE
SUPERFRAMES.IN.OLD
FRAME.NAMES)
collect (COPYALL (FIND.FRAME INTERFACE
SUPERFRAME]
[SETQ NEW.INTERFACE (FIND.INTERFACE (PUTDEF.INTERFACE NEW.INTERFACE.NAME (QUOTE INTERFACE)
(LIST (QUOTE \TYPE)
(QUOTE INTERFACE)
(QUOTE NAME)
NEW.INTERFACE.NAME
(QUOTE FRAMES)
FRAMES.TO.ADD
(QUOTE REGION)
(fetch.interface.fieldq
INTERFACE
REGION)
(QUOTE FIRST.FRAME)
FIRST.FRAME.NAME
(QUOTE PROFILE)
NEW.PROFILE]
(for FRAME in (fetch.interface.fieldq NEW.INTERFACE FRAMES) do (replace.frame.fieldq FRAME
ANALYZED? NIL)
)
(COND
((NOT (EQ DELETE.CHANGE.FRAME.ITEM.FLG (QUOTE DO.NOT.DELETE)))
(CAUTERIZE.INTERFACE FRAME.LIST FIRST.FRAME.NAME NEW.INTERFACE
DELETE.CHANGE.FRAME.ITEM.FLG)))
(MARK.INTERFACE NEW.INTERFACE T)
(SETQ FRAME.NAME.LIST (for FRAMENODE in FRAME.LIST collect (CAR FRAMENODE)))
(COND
((NOT (EQ DELETE.CHANGE.FRAME.ITEM.FLG (QUOTE DO.NOT.DELETE)))
(for FRAME in (fetch.interface.fieldq NEW.INTERFACE FRAMES)
do (CAUTERIZE.SUPERFRAMES OLD.INTERFACE.NAME NEW.INTERFACE.NAME NEW.INTERFACE
(GET.FIELD FRAME (QUOTE NAME)
(QUOTE FRAME))
FRAME.NAME.LIST
(COND
((EQUAL (GET.FIELD FRAME (QUOTE NAME)
(QUOTE FRAME))
FIRST.FRAME.NAME)
T)
(T NIL))
DELETE.CHANGE.FRAME.ITEM.FLG])
(GET.FIRST.FRAME.IN.INTERFACE
[LAMBDA (INTERFACE.NAME) (* N.H.Briggs "22-Feb-85 11:22")
(* RETURNS THE NODE AND LIST OF ITS SUCCESSORS FOR USE
IN SPLIT.SUB.INTERFACE)
(PROG ((INTERFACE (FIND.INTERFACE INTERFACE.NAME))
FIRST.FRAME.NAME)
(SETQ FIRST.FRAME.NAME (fetch.interface.fieldq INTERFACE FIRST.FRAME))
(RETURN (LIST FIRST.FRAME.NAME (GET.FRAME.SONS (FIND.FRAME INTERFACE FIRST.FRAME.NAME])
(GET.FRAME.NAMES
[LAMBDA (INTERFACE) (* N.H.Briggs "22-Feb-85 11:19")
(* RETURNS A LIST OF THE NAMES OF FRAMES IN THE GIVEN
INTERFACE)
(for FRAME in (fetch.interface.fieldq INTERFACE FRAMES) collect (fetch.frame.fieldq FRAME NAME])
(GRAPH.FRAMES.FOR.SPLIT
[LAMBDA (INTERFACE.NAME) (* N.H.Briggs "13-Feb-85 14:10")
(DECLARE (GLOBALVARS CHANGE.FRAME.STRUCTURE.GRAPH.SPEC))
(PROG (INTERFACE NAME ITYPES GRAPH.SPEC FRAMES POSSIBLE.ROOTS REAL.ROOTS TITLE DEPTH
GRAPH.FRAME.WINDOW)
(THINKING (SETQ INTERFACE (FIND.INTERFACE INTERFACE.NAME))
(SETQ FRAMES (fetch.interface.fieldq INTERFACE FRAMES))
(SETQ GRAPH.SPEC CHANGE.FRAME.STRUCTURE.GRAPH.SPEC)
[SETQ POSSIBLE.ROOTS (for FRAME in FRAMES collect (CONS FRAME (QUOTE FRAME]
(SETQ REAL.ROOTS (MAKE.GRAPH.FIND.ROOTS GRAPH.SPEC POSSIBLE.ROOTS INTERFACE))
(SETQ TITLE (CONCAT "Change frame structure for splitting interface "
INTERFACE.NAME))
(SETQ DEPTH 10)
(SETQ GRAPH.FRAME.WINDOW (MAKE.GRAPH NIL TITLE GRAPH.SPEC REAL.ROOTS INTERFACE
(FUNCTION SPLIT.SUB.INTERFACE)
(QUOTE FRAME.GRAPH.WINDOW.MIDDLEBUTTONFN)
NIL DEPTH))
(WINDOWPROP GRAPH.FRAME.WINDOW (QUOTE INTERFACE.NAME)
INTERFACE.NAME)
GRAPH.FRAME.WINDOW)
(RETURN GRAPH.FRAME.WINDOW])
(MY.MERGE.INTERFACE
[LAMBDA (INTERFACE1 INTERFACE2) (* N.H.Briggs "27-Feb-85 22:28")
(RESOLVE.CELL.NAME.CONFLICTS INTERFACE1 INTERFACE2)
(RESOLVE.BITMAP.NAME.CONFLICTS INTERFACE1 INTERFACE2)
(RESOLVE.FRAME.NAME.CONFLICTS INTERFACE1 INTERFACE2)
(MERGE.INTERFACE INTERFACE1 INTERFACE2)
(DELETE.INTERFACE (fetch.interface.fieldq INTERFACE2 NAME])
(RESOLVE.CELL.NAME.CONFLICTS
[LAMBDA (INTERFACE1 INTERFACE2) (* N.H.Briggs "27-Feb-85 22:30")
(* FIRST FINDS THE CELLS REFERENCED FOR EACH FRAME. THEN CREATES AN ASSOCIATION LIST WITH CELL NAMES ASSOCIATED WITH
THE LIST OF FRAMES THEY ARE REFERENCED IN. FINALLY ASKS THE USER WHAT TO DO FOR IDENTICALLY NAMED CELLS IN DIFFERENT
INTERFACES)
(PROG (CELL.AND.FRAME.ASSOC.LIST.1 CELL.AND.FRAME.ASSOC.LIST.2 CELL.NAMES ALIST
CELL.NAME.CONFLICTS (CELLOPS (LIST (QUOTE SET.CELL)
(QUOTE CHANGE.CELL)
(QUOTE
CHANGE.CELL.NEXT.DIGIT)
(QUOTE EMPTY.CELL)
(QUOTE PUSH.TO.CELL)
(QUOTE POP.FROM.CELL)
(QUOTE SET.NTH.OF.CELL)
(QUOTE CELL.VALUE)
(QUOTE NTH.OF.CELL)))
CONFLICT.RESOLUTION.MENU)
[for FRAME in (fetch.interface.fieldq INTERFACE1 FRAMES)
do (COND
((SETQ CELL.NAMES (GET.CELL.NAMES.IN.FRAME FRAME))
(for NAME in CELL.NAMES do (COND
[(SETQ ALIST (FASSOC NAME
CELL.AND.FRAME.ASSOC.LIST.1))
(RPLACD ALIST (CONS (fetch.frame.fieldq FRAME NAME)
(CDR ALIST]
(T (SETQ CELL.AND.FRAME.ASSOC.LIST.1
(CONS (CONS NAME (LIST (fetch.frame.fieldq
FRAME NAME)))
CELL.AND.FRAME.ASSOC.LIST.1]
[for FRAME in (fetch.interface.fieldq INTERFACE2 FRAMES)
do (COND
((SETQ CELL.NAMES (GET.CELL.NAMES.IN.FRAME FRAME))
(for NAME in CELL.NAMES do (COND
[(SETQ ALIST (FASSOC NAME
CELL.AND.FRAME.ASSOC.LIST.2))
(RPLACD ALIST (CONS (fetch.frame.fieldq FRAME NAME)
(CDR ALIST]
(T (SETQ CELL.AND.FRAME.ASSOC.LIST.2
(CONS (CONS NAME (LIST (fetch.frame.fieldq
FRAME NAME)))
CELL.AND.FRAME.ASSOC.LIST.2]
(TRILLIUM.PRINTOUT ON PROMPTWINDOW
"SELECT THE CELLS YOU WISH TO RENAME: BUG *DONE* WHEN DONE")
(SETQ CELL.NAME.CONFLICTS (ACQUIRE.LIST.ITEMS (INTERSECTION (for ITEM in
CELL.AND.FRAME.ASSOC.LIST.1
collect (CAR ITEM))
(for ITEM in
CELL.AND.FRAME.ASSOC.LIST.2
collect (CAR ITEM)))
"CELL NAME CONFLICTS"))
(* NOW ASK THE USER WHAT TO DO ABOUT CONFLICTING CELL
NAMES)
(for NAME in CELL.NAME.CONFLICTS do ((SETQ CONFLICT.RESOLUTION.MENU
(create MENU
ITEMS ←(QUOTE (CHANGE.CELL.NAME.IN.FIRST
CHANGE.CELL.NAME.IN.SECOND
LEAVE.AS.IS))
TITLE ←(CONCAT
"Choices for resolving name conflict of cell"
NAME)
WHENSELECTEDFN ←(FUNCTION
CELL.NAME.CONFLICT.MENU.WHENSELECTEDFN)
CENTERFLG ← T
CHANGEOFFSETFLG ← T))
(SELECTQ (MENU CONFLICT.RESOLUTION.MENU)
(CHANGE.CELL.NAME.IN.FIRST
(CHANGE.CELL.NAME (CAR (SETQ ALIST
(FASSOC NAME
CELL.AND.FRAME.ASSOC.LIST.1)))
(CDR ALIST)
INTERFACE1))
(CHANGE.CELL.NAME.IN.SECOND
(CHANGE.CELL.NAME (CAR (SETQ ALIST
(FASSOC NAME
CELL.AND.FRAME.ASSOC.LIST.2)))
(CDR ALIST)
INTERFACE2))
(LEAVE.AS.IS NIL)
NIL])
(CHANGE.CELL.NAME
[LAMBDA (OLD.CELL.NAME FRAME.NAMES INTERFACE) (* HaKo "25-Jul-84 17:19")
(DECLARE (SPECVARS CELLOPS))
(PROG (NEW.CELL.NAME ACTIONFORM FORMS)
(TRILLIUM.PRINTOUT ON PROMPTWINDOW (CONCAT "NEW NAME FOR CELL " OLD.CELL.NAME " ? "))
(SETQ NEW.CELL.NAME (PROMPT.READ))
(for FRAME.NAME in FRAME.NAMES bind FRAME
do ((SETQ FRAME (FIND.FRAME INTERFACE FRAME.NAME))
(for ITEM in (fetch.frame.fieldq FRAME ITEMS)
do ((COND
((EQ (LISTGET ITEM (QUOTE CELL))
OLD.CELL.NAME)
(LISTPUT ITEM (QUOTE CELL)
NEW.CELL.NAME)))
(COND
((SETQ ACTIONFORM (LISTGET ITEM (QUOTE ACTION.FORM)))
(for OP in CELLOPS do (COND
((SETQ FORMS (DEEP.MEMBER OP ACTIONFORM))
(for FORM in FORMS
do (COND
((EQ (CADR FORM)
OLD.CELL.NAME)
(RPLACD FORM (CONS NEW.CELL.NAME
(CDDR FORM])
(GET.CELL.NAMES.IN.FRAME
[LAMBDA (FRAME) (* SGK "18-AUG-83 15:41")
(* RETURNS A LIST OF THE NAMES OF TRILLIUM MACHINE
CELLS USED IN THE GIVEN FRAME)
(PROG (NAME.LIST)
[SETQ NAME.LIST (for ITEM in (COPY (fetch.frame.fieldq FRAME ITEMS))
join (COND
((EQUAL (ITEM.TYPE ITEM)
(QUOTE GROUP))
(for SUBITEM in ITEM collect (GET.CELL.NAMES.IN.ITEM SUBITEM)))
(T (GET.CELL.NAMES.IN.ITEM ITEM]
(RETURN (REMOVE (QUOTE (NIL))
(INTERSECTION NAME.LIST NAME.LIST])
)
(PUTPROPS TRI-RECORD-SPLITMERGE COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1508 36105 (SPLIT.SUB.INTERFACE 1518 . 3009) (FIND.SAVED.FRAMES 3011 . 6447) (
CREATE.NEW.INTERFACES 6449 . 10230) (CAUTERIZE.INTERFACE 10232 . 12062) (CAUTERIZE.SUPERFRAMES 12064
. 14874) (RESOLVE.BITMAP.NAME.CONFLICTS 14876 . 18415) (CHANGE.FRAME.NAME 18417 . 19945) (
DELETE.OLD.ITEM.IN.INTERFACE 19947 . 20948) (GET.BITMAP.NAMES.IN.INTERFACE 20950 . 21668) (
GET.BITMAP.FRAME.NAMES 21670 . 21961) (GET.NAMES.IN.GRAPH.ONLY 21963 . 22842) (GET.ROOT.NAMES 22844 .
23362) (GET.SUPERFRAMES 23364 . 23903) (CREATE.SPLIT.INTERFACE 23905 . 27962) (
GET.FIRST.FRAME.IN.INTERFACE 27964 . 28540) (GET.FRAME.NAMES 28542 . 28920) (GRAPH.FRAMES.FOR.SPLIT
28922 . 30140) (MY.MERGE.INTERFACE 30142 . 30562) (RESOLVE.CELL.NAME.CONFLICTS 30564 . 34258) (
CHANGE.CELL.NAME 34260 . 35373) (GET.CELL.NAMES.IN.FRAME 35375 . 36103)))))
STOP