(FILECREATED "31-Aug-84 09:55:36" {ICE}<TRILLIUM>BIRTHDAY84>BETA>TRI-SPLITMERGE.;2 49949
changes to: (FNS GRAPH.FRAMES.FOR.SPLIT)
previous date: "17-Aug-84 23:38:13" {ICE}<TRILLIUM>BIRTHDAY84>BETA>TRI-SPLITMERGE.;1)
(* Copyright (c) 1984 by Xerox Corporation)
(PRETTYCOMPRINT TRI-SPLITMERGECOMS)
(RPAQQ TRI-SPLITMERGECOMS [(FNS AMBIGUOUS.FRAMES.TO.INCLUDE CAUTERIZE.INTERFACE CAUTERIZE.SUPERFRAMES
CELL.NAME.CONFLICT.MENU.WHENSELECTEDFN CHANGE.CELL.NAME
CHANGE.FRAME.NAME CREATE.NEW.INTERFACES CREATE.SPLIT.INTERFACE
DEEP.MEMBER DELETE.FRAME.AND.SONS DELETE.FRAME.NAME
DELETE.OLD.ITEM.IN.INTERFACE EQUAL.BITMAPS FIND.BITMAPS.SAME.NAME
FIND.SAVED.FRAMES FRAME.NAME.CONFLICT.MENU.WHENSELECTEDFN
GET.ACTION.FORM.SONS GET.AND.SAVE.NEW.FRAME.NAME
GET.BITMAP.FRAME.NAMES GET.BITMAP.NAMES.IN.INTERFACE
GET.CELL.NAMES.IN.FORM GET.CELL.NAMES.IN.FRAME GET.CELL.NAMES.IN.ITEM
GET.CONDFORM.SONS GET.CONFLICTING.BITMAP.NAMES
GET.FIRST.FRAME.IN.INTERFACE GET.FRAME.NAMES GET.FRAME.SONS
GET.NAMES.IN.GRAPH.ONLY GET.NODE.REP GET.ROOT.NAMES
GET.SELECTFORM.SONS GET.SUPERFRAMES GRAPH.FRAMES.FOR.SPLIT
INTERACT&MERGE.INTERFACE MY.MERGE.INTERFACE NEW.OBJECT.NAME
RESOLVE.BITMAP.NAME.CONFLICTS RESOLVE.CELL.NAME.CONFLICTS
RESOLVE.FRAME.NAME.CONFLICTS SPLIT.SUB.INTERFACE)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
(DEFINEQ
(AMBIGUOUS.FRAMES.TO.INCLUDE
[LAMBDA (SAVE.FRAMES AMBIGUOUS.FRAMES) (* SGK " 1-SEP-83 15:12")
(* ASKS USER WHICH AMBIGUOUS FRAMES TO INCLUDE IN THE
SPLIT OFF INTERFACE)
(PROG (AFRAME SAVE.FRAMES.NAMES) (* SAVE.FRAMES.NAMES ARE THE NAMES OF FRAMES WHICH ARE
DEFINITELY NOT TO BE DELETED BY DELETE.FRAME.AND.SONS -
PASSED AS ARGUMENT TO THAT FUNCTION)
(SETQ SAVE.FRAMES.NAMES (UNION (for FRAME in (LDIFFERENCE SAVE.FRAMES AMBIGUOUS.FRAMES)
collect (CAR FRAME))
(ACQUIRE.LIST.ITEMS (for FRAME in AMBIGUOUS.FRAMES
collect (CAR FRAME))
"SELECT AMBIGUOUS FRAMES TO INCLUDE IN SPLIT INTERFACE")))
[while AMBIGUOUS.FRAMES do ((SETQ AFRAME (CAR AMBIGUOUS.FRAMES))
(COND
((MEMBER (CAR AFRAME)
SAVE.FRAMES.NAMES)
(SETQ AMBIGUOUS.FRAMES (CDR AMBIGUOUS.FRAMES)))
(T (SETQ AMBIGUOUS.FRAMES (DELETE.FRAME.AND.SONS
AFRAME
(COPY AMBIGUOUS.FRAMES)
SAVE.FRAMES.NAMES))
(SETQ SAVE.FRAMES (DELETE.FRAME.AND.SONS AFRAME
(COPY SAVE.FRAMES)
SAVE.FRAMES.NAMES]
(RETURN SAVE.FRAMES])
(CAUTERIZE.INTERFACE
[LAMBDA (FRAME.LIST FIRST.FRAME.NAME INTERFACE DELETE.CHANGE.FRAME.ITEM.FLG)
(* HaKo "16-Aug-84 16:34")
(* 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 (GET.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)
(* SGK "23-AUG-83 14:00")
(* 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 (GET.FIELDQ FRAME SUPERFRAMES FRAME))
(for SUPERFRAME.NAME in SUPERFRAME.LIST
do ((SETQ SUPERFRAME (FIND.FRAME (FIND.INTERFACE OLD.INTERFACE.NAME)
SUPERFRAME.NAME))
[for ITEM in (GET.FIELDQ SUPERFRAME ITEMS FRAME)
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 (ITEM.CREATE FRAME (NAME (SETQ NEW.SUPERFRAME.NAME
(NEW.OBJECT.NAME
SUPERFRAME.NAME
NEW.INTERFACE.NAME)))
(ITEMS (for ITEM
in (GET.FIELDQ SUPERFRAME
ITEMS FRAME)
when (NOT (MEMBER ITEM
ITEM.LIST))
collect ITEM))
(ANALYZED NIL)))
(ADD.NEW.FRAME NEW.INTERFACE NEW.SUPERFRAME)
(MARK.INTERFACE NEW.INTERFACE)
(SET.FIELDQ FRAME SUPERFRAMES (CONS NEW.SUPERFRAME.NAME
(REMOVE SUPERFRAME.NAME
(GET.FIELDQ FRAME
SUPERFRAMES])
(CELL.NAME.CONFLICT.MENU.WHENSELECTEDFN
[LAMBDA (ITEM MENU KEY) (* SGK "29-JUL-83 14:31")
ITEM])
(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 (GET.FIELDQ FRAME ITEMS FRAME)
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])
(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 (GET.FIELDQ FRAME ITEMS FRAME)
do (for FORM in (DEEP.MEMBER
OLD.FRAME.NAME
ITEM)
do (RPLACA FORM NEW.FRAME.NAME)))
(COND
((MEMBER OLD.FRAME.NAME
(SETQ SUPERFRAMES
(GET.FIELDQ FRAME SUPERFRAMES
FRAME)))
(for SUPERFRAME.NAMES on SUPERFRAMES
do (COND
((EQUAL SUPERFRAME.NAMES
OLD.FRAME.NAME)
(RPLACA SUPERFRAME.NAMES
NEW.FRAME.NAME]
(RETURN NEW.FRAME.NAME])
(CREATE.NEW.INTERFACES
[LAMBDA (OLD.INTERFACE.NAME OLD.INTERFACE.FRAMES NEW.INTERFACE.FRAMES
FIRST.FRAME.IN.SPLIT.INTERFACE WINDOW)
(* HaKo "25-Jul-84 17:20")
(* 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)))
[SET.FIELDQ (SETQ INTERFACE (FIND.INTERFACE OLD.INTERFACE.NAME))
FRAMES
(DREMOVE NIL (for FRAME
in [UNION [UNION (QUOTE (CELLS COLORS))
(OR (LISTGET (LISTGET (GET.FIELDQ INTERFACE
PROFILE
INTERFACE)
(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 (GET.FIELDQ 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 (GET.FIELD INTERFACE (QUOTE FRAMES)
(QUOTE INTERFACE))
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))
(GET.FIELDQ INTERFACE FIRST.FRAME))
T)
(T NIL))
DELETE.CHANGE.FRAME.ITEM.FLG])
(CREATE.SPLIT.INTERFACE
[LAMBDA (FRAME.LIST OLD.INTERFACE.NAME NEW.INTERFACE.NAME FIRST.FRAME.NAME
DELETE.CHANGE.FRAME.ITEM.FLG) (* SGK " 1-SEP-83 11:57")
(* 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 NEW.PROFILE FRAME)
(SETQ INTERFACE (FIND.INTERFACE OLD.INTERFACE.NAME))
(SETQ NEW.PROFILE (COPY (GET.FIELDQ INTERFACE PROFILE INTERFACE)))
(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 (GET.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 (ITEM.CREATE INTERFACE (NAME NEW.INTERFACE.NAME)
(FRAMES FRAMES.TO.ADD)
(REGION (GET.FIELDQ INTERFACE REGION))
(FIRST.FRAME FIRST.FRAME.NAME)
(PROFILE NEW.PROFILE)))
(for FRAME in (GET.FIELDQ NEW.INTERFACE FRAMES INTERFACE) do (SET.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)))
(ADD.NEW.INTERFACE NEW.INTERFACE)
(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 (GET.FIELD NEW.INTERFACE (QUOTE FRAMES)
(QUOTE INTERFACE))
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])
(DEEP.MEMBER
[LAMBDA (ELEMENT LIST) (* SGK " 2-AUG-83 14:51")
(* LIKE MEMBER BUT GOES TO ALL DEPTHS OF LIST SEARCHING
FOR ELEMENT)
(PROG (MEM)
(RETURN (COND
((NLISTP LIST)
NIL)
[(SETQ MEM (MEMBER ELEMENT LIST))
(CONS MEM (for SUBLIST in LIST join (DEEP.MEMBER ELEMENT SUBLIST]
(T (for SUBLIST in LIST join (DEEP.MEMBER ELEMENT SUBLIST])
(DELETE.FRAME.AND.SONS
[LAMBDA (FRAME FRAME.LIST DONT.DELETE.LIST) (* SGK "18-JUL-83 16:34")
(* GIVEN A FRAME AND FRAME LIST, DELETES THE FRAME AND
ALL ITS SONS)
(PROG NIL
(SETQ FRAME.LIST (REMOVE FRAME FRAME.LIST))
[for FRAMES in FRAME.LIST do (COND
((MEMBER (CAR FRAME)
(CADR FRAMES))
(DREMOVE (CAR FRAME)
(CADR FRAMES]
(* DELETES POINTERS TO DELETED FRAME)
[COND
((CADR FRAME)
(for SONS in (COPY (CADR FRAME)) do (COND
((NOT (MEMBER SONS DONT.DELETE.LIST))
(SETQ FRAME.LIST
(DELETE.FRAME.AND.SONS
(for ITEM in FRAME.LIST
thereis (EQUAL (CAR ITEM)
SONS))
FRAME.LIST DONT.DELETE.LIST]
(RETURN FRAME.LIST])
(DELETE.FRAME.NAME
[LAMBDA (INTERFACE) (* SGK "20-JUL-83 16:41")
NIL])
(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 (GET.FIELDQ FRAME ITEMS FRAME))
(SETQ NEWLIST (DREMOVE ITEM ITEMS))
(OR NEWLIST (SET.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])
(EQUAL.BITMAPS
[LAMBDA (BITMAP1 BITMAP2 BITMAP.NAME) (* SGK "29-AUG-83 13:25")
(* DISPLAYS THE BITMAPS IN THE TWO INTERFACES AND ASKS THE USER WHETHER THEY ARE THE SAME.
DONE THIS WAY BECAUSE THERE IS NO BITMAP EQUALITY TEST)
(PROG (COMPARE.WINDOW BITMAP1.WIDTH BITMAP1.HEIGHT BITMAP2.WIDTH BITMAP2.HEIGHT)
(SETQ COMPARE.WINDOW (CREATEW (create REGION
LEFT ← 10
BOTTOM ← 10
WIDTH ←(IPLUS (SETQ BITMAP1.WIDTH
(fetch (BITMAP BITMAPWIDTH)
of BITMAP1))
(SETQ BITMAP2.WIDTH
(fetch (BITMAP BITMAPWIDTH)
of BITMAP2))
20)
HEIGHT ←(IPLUS (MAX (SETQ BITMAP1.HEIGHT
(fetch (BITMAP BITMAPHEIGHT)
of BITMAP1))
(SETQ BITMAP2.HEIGHT
(fetch (BITMAP BITMAPHEIGHT)
of BITMAP2)))
30))
(CONCAT "comparison window for bitmaps of name " BITMAP.NAME))
)
(BITBLT BITMAP1 0 0 COMPARE.WINDOW 5 5 BITMAP1.WIDTH BITMAP1.HEIGHT (QUOTE INPUT)
(QUOTE REPLACE))
(BITBLT BITMAP2 0 0 COMPARE.WINDOW (IPLUS BITMAP1.WIDTH 10)
5 BITMAP2.WIDTH BITMAP2.HEIGHT (QUOTE INPUT)
(QUOTE REPLACE))
(COND
((CONFIRM "Bitmaps identical?")
(CLOSEW COMPARE.WINDOW)
(RETURN T))
(T (CLOSEW COMPARE.WINDOW)
(RETURN NIL])
(FIND.BITMAPS.SAME.NAME
[LAMBDA (INTERFACE) (* SGK "12-AUG-83 10:10")
(* FINDS ALL BITMAPS IN THE BITMAP FRAMES WHICH HAVE THE
SAME NAME)
(PROG (OLD.LIST DOUBLE.LIST)
[for ITEM in (GET.BITMAP.NAMES.IN.INTERFACE INTERFACE)
do (COND
((NOT (MEMBER (CAR ITEM)
OLD.LIST))
(SETQ OLD.LIST (CONS (CAR ITEM)
OLD.LIST)))
(T (SETQ DOUBLE.LIST (CONS ITEM DOUBLE.LIST]
(RETURN (REVERSE DOUBLE.LIST])
(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 (GET.FIELDQ (CAR (fetch (GRAPHNODE NODEID) of NODE))
NAME FRAME]
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])
(FRAME.NAME.CONFLICT.MENU.WHENSELECTEDFN
[LAMBDA (ITEM MENU KEY) (* SGK "20-JUL-83 15:31")
ITEM])
(GET.ACTION.FORM.SONS
[LAMBDA (ACTION.FORM) (* SGK "18-AUG-83 09:59")
(* FINDS ALL FRAMES WHICH ARE PUSHED TO OR GOTO'ED IN
THE GIVEN ACTION.FORM)
(PROG (IMPLICIT.SONS)
[COND
((LISTP ACTION.FORM)
(SETQ IMPLICIT.SONS (SELECTQ (CAR ACTION.FORM)
((FRAME.PUSH FRAME.GOTO)
(LIST (CADR ACTION.FORM)))
(SETQQ (COND
[(AND (EQUAL (CADR ACTION.FORM)
(QUOTE CHANGE.FRAME.SPECIFICATIONS))
(OR (DEEP.MEMBER (QUOTE PUSH)
ACTION.FORM)
(DEEP.MEMBER (QUOTE NO.CHANGE)
ACTION.FORM)))
(LIST (LISTGET (CADDR ACTION.FORM)
(QUOTE FRAME.NAME]
(T NIL)))
((IFCOND IFELSECOND ANDCOND)
(GET.CONDFORM.SONS ACTION.FORM))
((SELECT SELECTQ)
(GET.SELECTFORM.SONS ACTION.FORM))
(PROG (for FORM in (COPY (CDDR ACTION.FORM))
join (GET.ACTION.FORM.SONS FORM)))
NIL]
(RETURN (INTERSECTION IMPLICIT.SONS IMPLICIT.SONS])
(GET.AND.SAVE.NEW.FRAME.NAME
[LAMBDA (FRAME.NAME INTERFACE.NAME.LIST INTERFACE.NUMBER)
(* HaKo "25-Jul-84 17:21")
(DECLARE (SPECVARS NAME.ASSOC.LIST.INTERFACE.1 NAME.ASSOC.LIST.INTERFACE.2))
(PROG (NEW.NAME LEGAL.NAME.FLG)
(SETQ LEGAL.NAME.FLG)
[while (NOT LEGAL.NAME.FLG) do ((TRILLIUM.PRINTOUT ON PROMPTWINDOW "NEW NAME FOR FRAME "
FRAME.NAME " ? ")
(SETQ NEW.NAME (PROMPT.READ))
(COND
((NOT (LITATOM NEW.NAME))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"NAME MUST BE A LITERAL ATOM"))
((FMEMB NEW.NAME INTERFACE.NAME.LIST)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "THE NAME "
NEW.NAME " IS ALREADY IN USE"))
(T (SETQ LEGAL.NAME.FLG T]
(COND
((EQ INTERFACE.NUMBER 1)
(SETQ NAME.ASSOC.LIST.INTERFACE.1 (CONS (CONS FRAME.NAME NEW.NAME)
NAME.ASSOC.LIST.INTERFACE.1)))
(T (SETQ NAME.ASSOC.LIST.INTERFACE.2 (CONS (CONS FRAME.NAME NEW.NAME)
NAME.ASSOC.LIST.INTERFACE.2])
(GET.BITMAP.FRAME.NAMES
[LAMBDA (INTERFACE) (* SGK " 5-AUG-83 12:49")
(OR (LISTGET (LISTGET (GET.FIELDQ INTERFACE PROFILE INTERFACE)
(QUOTE FRAME.CLASSES))
(QUOTE BITMAP.FRAMES))
(QUOTE (BITMAPS])
(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 (GET.FIELDQ (FIND.FRAME
INTERFACE
FRAME.NAME)
ITEMS FRAME)
when (EQUAL (ITEM.TYPE ITEM)
(QUOTE BITMAP))
collect (CONS (LISTGET
ITEM
(QUOTE NAME))
FRAME.NAME])
(GET.CELL.NAMES.IN.FORM
[LAMBDA (ACTION.FORM) (* HaKo "11-Jun-84 15:21")
(* SGK "18-AUG-83 14:56")
(* GIVEN AN ACTION FORM, FINDS ALL CELLS REFERENCED IN
IT AND RETURNS A LIST OF THEIR NAMES)
(PROG (NAME.LIST)
(COND
[(LISTP ACTION.FORM)
(SETQ NAME.LIST (SELECTQ (CAR ACTION.FORM)
((SET.CELL CHANGE.CELL CHANGE.CELL.NEXT.DIGIT EMPTY.CELL
PUSH.TO.CELL POP.FROM.CELL SET.NTH.OF.CELL
CELL.VALUE NTH.OF.CELL)
(LIST (CADR ACTION.FORM)))
[(CELLPLUS CELLTIMES JOBDELETE JOBHOLD JOBMODIFY JOBPRINT
JOPPROOF JOPSCANSTART JOBSETSAVE PRINTNOW
PROOFBLOCK RESCANBLOCK)
(LIST (CADR (CADR ACTION.FORM]
((CELLXPLUS CELLXSUB CHANGE.CELL.FROM.CELL FLASH JOBCREATE
PLUSCELLCELL SET.CELL.FROM.CELL TIMESCELLCELL)
(for FORM in (CDR ACTION.FORM) collect (CADR FORM)))
[CHANGE.CELL.FROM.LIST (CONS (CADR ACTION.FORM)
(for FORM in (CADDR ACTION.FORM)
collect (CADR FORM]
[(IFCELLCOND IFELSECOND)
(LIST (CADR (CADDR ACTION.FORM))
(CADR (CADDDR ACTION.FORM]
[IFCOND (LIST (CADR (CADDR ACTION.FORM]
NIL))
(SETQ NAME.LIST (APPEND NAME.LIST (for FORM in (COPY ACTION.FORM) when (LISTP FORM)
join (GET.CELL.NAMES.IN.FORM FORM]
(T NIL))
(RETURN (REMOVE NIL (INTERSECTION NAME.LIST NAME.LIST])
(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 (GET.FIELDQ FRAME ITEMS FRAME))
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])
(GET.CELL.NAMES.IN.ITEM
[LAMBDA (ITEM) (* HaKo "27-Jul-84 16:38")
(* SGK "18-AUG-83 13:56")
(CONS (GET.PARAMQ ITEM CELL)
(GET.CELL.NAMES.IN.FORM (GET.PARAMQ ITEM ACTION.FORM])
(GET.CONDFORM.SONS
[LAMBDA (ACTION.FORM) (* HaKo "11-Jun-84 15:56")
(* SGK "17-AUG-83 13:07")
(* FINDS FRAMES MENTIONED IN AN ACTION FORM OF TYPE
IFCOND, ANDCOND, AND IFELSECOND)
(PROG (IMPLICIT.SONS)
(SETQ IMPLICIT.SONS (COND
[(AND (EQUAL (CAR ACTION.FORM)
(QUOTE IFCOND))
(EQUAL (CADR (CAR (CDDDDR ACTION.FORM)))
(QUOTE FRAME.PUSH)))
(LIST (CAADR (CAR (LAST ACTION.FORM]
(T NIL)))
[SETQ IMPLICIT.SONS (APPEND IMPLICIT.SONS (COND
[(AND (EQUAL (CAR ACTION.FORM)
(QUOTE ANDCOND))
(EQUAL (CADR (CADDR (CDDDDR ACTION.FORM)))
(QUOTE FRAME.PUSH)))
(LIST (CADR (CADDDR (CDDDDR ACTION.FORM]
(T NIL]
[SETQ IMPLICIT.SONS (APPEND IMPLICIT.SONS (COND
[(EQUAL (CAR ACTION.FORM)
(QUOTE IFELSECOND))
(APPEND (GET.ACTION.FORM.SONS (CADDDR ACTION.FORM))
(GET.ACTION.FORM.SONS (CAR (CDDDDR ACTION.FORM]
(T NIL]
(RETURN (INTERSECTION IMPLICIT.SONS IMPLICIT.SONS])
(GET.CONFLICTING.BITMAP.NAMES
[LAMBDA (INTERFACE1 INTERFACE2) (* SGK "11-AUG-83 09:21")
(PROG (CONFLICTING.NAMES NAMES.IN.1)
[SETQ CONFLICTING.NAMES (INTERSECTION (for ITEM in (SETQ NAMES.IN.1 (
GET.BITMAP.NAMES.IN.INTERFACE
INTERFACE1))
collect (CAR ITEM))
(for ITEM in (GET.BITMAP.NAMES.IN.INTERFACE
INTERFACE2)
collect (CAR ITEM]
(RETURN (for ITEM in NAMES.IN.1 when (MEMBER (CAR ITEM)
CONFLICTING.NAMES)
collect ITEM])
(GET.FIRST.FRAME.IN.INTERFACE
[LAMBDA (INTERFACE.NAME) (* SGK "10-AUG-83 12:55")
(* 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 (GET.FIELDQ INTERFACE FIRST.FRAME INTERFACE))
(RETURN (LIST FIRST.FRAME.NAME (GET.FRAME.SONS (FIND.FRAME INTERFACE FIRST.FRAME.NAME])
(GET.FRAME.NAMES
[LAMBDA (INTERFACE) (* SGK "20-JUL-83 16:25")
(* RETURNS A LIST OF THE NAMES OF FRAMES IN THE GIVEN
INTERFACE)
(for FRAME in (GET.FIELDQ INTERFACE FRAMES INTERFACE) collect (GET.FIELDQ FRAME NAME FRAME])
(GET.FRAME.SONS
[LAMBDA (FRAME) (* SGK "23-AUG-83 14:33")
(* FINDS ALL SONS OF A FRAME INCLUDING THOSE REACHED VIA
ACTION FORMS)
(PROG (ACTION.FORMS.IN.FRAME IMPLICIT.SONS SONS)
(SETQ ACTION.FORMS.IN.FRAME (DEFINING.PTYPES.OF.FRAME (QUOTE (FORM))
FRAME))
(SETQ IMPLICIT.SONS (for ACTION in ACTION.FORMS.IN.FRAME join (GET.ACTION.FORM.SONS ACTION))
)
(SETQ SONS (APPEND (DREMOVE NIL (DEFINING.PTYPES.OF.FRAME (QUOTE (FRAME))
FRAME))
IMPLICIT.SONS))
(RETURN (INTERSECTION SONS SONS])
(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 (GET.FIELDQ (CAR (fetch (GRAPHNODE NODEID)
of FRAME))
NAME FRAME))
(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.NODE.REP
[LAMBDA (NODE NODELIST) (* SGK "12-JUL-83 14:20")
(* GIVEN THE NAME OF A NODE (FRAME), FINDS THE
REPRESENTATION OF IT AS A NET IN THE FRAME GRAPH
STRUCTURE)
(for NODES in NODELIST thereis (EQ (CAR NODES)
NODE])
(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 (GET.FIELDQ FRAME NAME FRAME)
(LIST (GET.FRAME.SONS FRAME])
(GET.SELECTFORM.SONS
[LAMBDA (ACTION.FORM) (* SGK "17-AUG-83 14:25")
(* FINDS FRAMES MENTIONED IN AN ACTION FORM OF TYPE
SELECT)
(COND
[(OR (EQUAL (CAR ACTION.FORM)
(QUOTE SELECT))
(EQUAL (CAR ACTION.FORM)
(QUOTE SELECTQ)))
(for FORM in (COPY (CDR ACTION.FORM)) join (GET.ACTION.FORM.SONS (CADR FORM]
(T NIL])
(GET.SUPERFRAMES
[LAMBDA (INTERFACE) (* SGK "30-AUG-83 14:39")
(* GATHERS ALL SUPERFRAMES REFERENCED BY ANY FRAME IN
INTERFACE)
(PROG (SUPERFRAMES)
[SETQ SUPERFRAMES (DREMOVE NIL (for FRAME in (GET.FIELDQ INTERFACE FRAMES INTERFACE)
join (COPY (GET.FIELDQ FRAME SUPERFRAMES FRAME]
(RETURN (INTERSECTION SUPERFRAMES SUPERFRAMES])
(GRAPH.FRAMES.FOR.SPLIT
[LAMBDA (INTERFACE.NAME) (* PH "31-Aug-84 09:16")
(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 (GET.FIELDQ INTERFACE FRAMES INTERFACE))
(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])
(INTERACT&MERGE.INTERFACE
[LAMBDA NIL (* HaKo "16-Aug-84 16:34")
(PROG (INTERFACE.NAME INTERFACE.NAME.2)
(TRILLIUM.PRINTOUT ON PROMPTWINDOW "Merging interfaces:")
(TRILLIUM.PRINTOUT ON PROMPTWINDOW "Extend which interface?")
(OR (SETQ INTERFACE.NAME (ACQUIRE.INTERFACE.NAME))
(RETURN))
(TRILLIUM.PRINTOUT ON PROMPTWINDOW SAME.LINE 1 INTERFACE.NAME)
(TRILLIUM.PRINTOUT ON PROMPTWINDOW "By merging in which interface?")
(OR (SETQ INTERFACE.NAME.2 (ACQUIRE.INTERFACE.NAME))
(RETURN))
(TRILLIUM.PRINTOUT ON PROMPTWINDOW SAME.LINE 1 INTERFACE.NAME.2)
(COND
((CONFIRM (CONCAT "Merge " INTERFACE.NAME.2 " into " INTERFACE.NAME "?"))
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Merging interface " INTERFACE.NAME.2
" into interface "
INTERFACE.NAME)
(THINKING (MY.MERGE.INTERFACE (FIND.INTERFACE INTERFACE.NAME)
(FIND.INTERFACE INTERFACE.NAME.2)))
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Interface " INTERFACE.NAME.2
" merged into interface "
INTERFACE.NAME])
(MY.MERGE.INTERFACE
[LAMBDA (INTERFACE1 INTERFACE2) (* SGK "11-AUG-83 11:34")
(RESOLVE.CELL.NAME.CONFLICTS INTERFACE1 INTERFACE2)
(RESOLVE.BITMAP.NAME.CONFLICTS INTERFACE1 INTERFACE2)
(RESOLVE.FRAME.NAME.CONFLICTS INTERFACE1 INTERFACE2)
(MERGE.INTERFACE INTERFACE1 INTERFACE2)
(DELETE.INTERFACE (GET.FIELDQ INTERFACE2 NAME INTERFACE])
(NEW.OBJECT.NAME
[LAMBDA (OLDNAME SUFFIX) (* SGK "11-AUG-83 13:17")
(* CREATES A NEW OBJECT NAME BY APPENDING THE SUFFIX.
USED BY CAUTERIZE.SUPERFRAMES AND
RESOLVE.BITMAP.NAME.CONFLICTS)
(MKATOM (CONCAT OLDNAME "-" SUFFIX (GENSYM])
(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 (GET.FIELDQ (FIND.FRAME INTERFACE1
(CDR BITMAP.NAME))
ITEMS FRAME)
thereis (EQUAL (LISTGET ITEM (QUOTE NAME))
(CAR BITMAP.NAME)))
(QUOTE BITMAP))
(LISTGET [SETQ BITMAP.ITEM (for ITEM
in (GET.FIELDQ (SETQ FRAME
(FIND.FRAME
INTERFACE2
(CDR BITMAP.NAME)))
ITEMS FRAME)
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])
(RESOLVE.CELL.NAME.CONFLICTS
[LAMBDA (INTERFACE1 INTERFACE2) (* HaKo "25-Jul-84 17:24")
(* 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 (GET.FIELDQ INTERFACE1 FRAMES INTERFACE)
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 (GET.FIELDQ FRAME NAME FRAME)
(CDR ALIST]
(T (SETQ CELL.AND.FRAME.ASSOC.LIST.1
(CONS (CONS NAME (LIST (GET.FIELDQ FRAME NAME FRAME)))
CELL.AND.FRAME.ASSOC.LIST.1]
[for FRAME in (GET.FIELDQ INTERFACE2 FRAMES INTERFACE)
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 (GET.FIELDQ FRAME NAME FRAME)
(CDR ALIST]
(T (SETQ CELL.AND.FRAME.ASSOC.LIST.2
(CONS (CONS NAME (LIST (GET.FIELDQ FRAME NAME FRAME)))
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])
(RESOLVE.FRAME.NAME.CONFLICTS
[LAMBDA (INTERFACE1 INTERFACE2) (* SGK "16-AUG-83 10:38")
(PROG (FRAME.NAMES.IN.1 FRAME.NAMES.IN.2 NAMES.IN.BOTH NAME.CONFLICTS NAME.ASSOC.LIST.INTERFACE.1
NAME.ASSOC.LIST.INTERFACE.2 NAME.CONFLICTS.THIS.FRAME
FRAME.NAME.CONFLICT.MENU)
(SETQ FRAME.NAMES.IN.1 (GET.FRAME.NAMES INTERFACE1))
(SETQ FRAME.NAMES.IN.2 (GET.FRAME.NAMES INTERFACE2))
(SETQ NAMES.IN.BOTH (UNION FRAME.NAMES.IN.1 FRAME.NAMES.IN.2))
(SETQ NAME.CONFLICTS (INTERSECTION FRAME.NAMES.IN.1 FRAME.NAMES.IN.2))
[for NAME in NAME.CONFLICTS do ((SETQ FRAME.NAME.CONFLICT.MENU
(create MENU
ITEMS ←(QUOTE (CHANGE.FRAME.NAME.IN.FIRST
CHANGE.FRAME.NAME.IN.SECOND
DELETE.FRAME.IN.FIRST
DELETE.FRAME.IN.SECOND))
WHENSELECTEDFN ←(FUNCTION
FRAME.NAME.CONFLICT.MENU.WHENSELECTEDFN)
TITLE ←(CONCAT
"CHOICES FOR RESOLVING NAME CONFLICT OF FRAME "
NAME)
CENTERFLG ← T
CHANGEOFFSETFLG ← T))
(SELECTQ (MENU FRAME.NAME.CONFLICT.MENU)
(CHANGE.FRAME.NAME.IN.FIRST (
GET.AND.SAVE.NEW.FRAME.NAME NAME NAMES.IN.BOTH 1))
(CHANGE.FRAME.NAME.IN.SECOND (
GET.AND.SAVE.NEW.FRAME.NAME NAME NAMES.IN.BOTH 2))
(DELETE.FRAME.IN.FIRST (DELETE.FRAME INTERFACE1
NAME))
(DELETE.FRAME.IN.SECOND (DELETE.FRAME INTERFACE2
NAME))
(DELETE.FRAME INTERFACE2 NAME]
(for PAIR in NAME.ASSOC.LIST.INTERFACE.1 do (CHANGE.FRAME.NAME (CAR PAIR)
(CDR PAIR)
INTERFACE1
NAME.ASSOC.LIST.INTERFACE.1))
(for PAIR in NAME.ASSOC.LIST.INTERFACE.2 do (CHANGE.FRAME.NAME (CAR PAIR)
(CDR PAIR)
INTERFACE2
NAME.ASSOC.LIST.INTERFACE.2])
(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 "
(GET.FIELDQ (CAR (fetch (GRAPHNODE NODEID) of NODE))
NAME FRAME)
" ?"))
[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)
(GET.FIELDQ (CAR (fetch NODEID of NODE))
NAME FRAME)
WINDOW)
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Split command complete"))
(T (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Split command aborted"])
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PUTPROPS TRI-SPLITMERGE COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1480 49732 (AMBIGUOUS.FRAMES.TO.INCLUDE 1490 . 2843) (CAUTERIZE.INTERFACE 2845 . 4540)
(CAUTERIZE.SUPERFRAMES 4542 . 7135) (CELL.NAME.CONFLICT.MENU.WHENSELECTEDFN 7137 . 7282) (
CHANGE.CELL.NAME 7284 . 8295) (CHANGE.FRAME.NAME 8297 . 9750) (CREATE.NEW.INTERFACES 9752 . 13248) (
CREATE.SPLIT.INTERFACE 13250 . 16792) (DEEP.MEMBER 16794 . 17338) (DELETE.FRAME.AND.SONS 17340 . 18318
) (DELETE.FRAME.NAME 18320 . 18443) (DELETE.OLD.ITEM.IN.INTERFACE 18445 . 19346) (EQUAL.BITMAPS 19348
. 20765) (FIND.BITMAPS.SAME.NAME 20767 . 21353) (FIND.SAVED.FRAMES 21355 . 24504) (
FRAME.NAME.CONFLICT.MENU.WHENSELECTEDFN 24506 . 24652) (GET.ACTION.FORM.SONS 24654 . 25820) (
GET.AND.SAVE.NEW.FRAME.NAME 25822 . 26944) (GET.BITMAP.FRAME.NAMES 26946 . 27204) (
GET.BITMAP.NAMES.IN.INTERFACE 27206 . 27895) (GET.CELL.NAMES.IN.FORM 27897 . 29538) (
GET.CELL.NAMES.IN.FRAME 29540 . 30225) (GET.CELL.NAMES.IN.ITEM 30227 . 30532) (GET.CONDFORM.SONS 30534
. 31740) (GET.CONFLICTING.BITMAP.NAMES 31742 . 32366) (GET.FIRST.FRAME.IN.INTERFACE 32368 . 32911) (
GET.FRAME.NAMES 32913 . 33280) (GET.FRAME.SONS 33282 . 33990) (GET.NAMES.IN.GRAPH.ONLY 33992 . 34807)
(GET.NODE.REP 34809 . 35204) (GET.ROOT.NAMES 35206 . 35703) (GET.SELECTFORM.SONS 35705 . 36188) (
GET.SUPERFRAMES 36190 . 36694) (GRAPH.FRAMES.FOR.SPLIT 36696 . 37820) (INTERACT&MERGE.INTERFACE 37822
. 38981) (MY.MERGE.INTERFACE 38983 . 39386) (NEW.OBJECT.NAME 39388 . 39765) (
RESOLVE.BITMAP.NAME.CONFLICTS 39767 . 42990) (RESOLVE.CELL.NAME.CONFLICTS 42992 . 46382) (
RESOLVE.FRAME.NAME.CONFLICTS 46384 . 48324) (SPLIT.SUB.INTERFACE 48326 . 49730)))))
STOP