(FILECREATED "17-Aug-84 22:52:19" {ICE}<TRILLIUM><BIRTHDAY84>BETA>TRI-EDITSUPER.;1 11916
previous date: "16-Aug-84 15:23:13" {ICE}<TRILLIUM>BIRTHDAY84>PRE-BETA>TRI-EDITSUPER.;5)
(* Copyright (c) 1984 by Xerox Corporation)
(PRETTYCOMPRINT TRI-EDITSUPERCOMS)
(RPAQQ TRI-EDITSUPERCOMS ((FNS ADD.SFRAME ADD.SFRAMES ADD.SUPERFRAME ADD.SUPERFRAMES
FORGET.MANY.SUPERFRAMES FORGET.SFRAME FORGET.SFRAMES
FORGET.SUPERFRAMES GET.SUPERFRAME.COMMAND.MENU MANIPULATE.SUPERFRAMES
PRINT.SFRAMES PRINT.SUPERFRAMES USED.AS.SUPERFRAME.BY)
(VARS SUPERFRAME.STRUCTURE.GRAPH.SPEC (SUPERFRAME.COMMAND.MENU))))
(DEFINEQ
(ADD.SFRAME
[LAMBDA (FRAME.NAME SUPERFRAME.NAME INTERFACE) (* HaKo "25-Jul-84 16:55")
(DECLARE (GLOBALVARS CURRENT.INTERFACE))
(OR INTERFACE (SETQ INTERFACE CURRENT.INTERFACE))
(PROG ((FRAME (FIND.FRAME INTERFACE FRAME.NAME))
SUPERFRAMES SUPER.FRAME)
(SETQ SUPERFRAMES (GET.FIELDQ FRAME SUPERFRAMES))
(RETURN (COND
((EQUAL SUPERFRAME.NAME FRAME.NAME)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "A frame may not be its own superframe")
)
((MEMB FRAME.NAME (SUPERFRAMES* FRAME))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"A frame may not be a member of its own superframes"))
(T (SETQ SUPER.FRAME (FIND.FRAME INTERFACE SUPERFRAME.NAME))
(ANALYZE.FRAME.IF.NECESSARY* SUPER.FRAME)
(SETQ SUPERFRAMES (CONS SUPERFRAME.NAME SUPERFRAMES))
(SETQ SUPERFRAMES (INTERSECTION SUPERFRAMES SUPERFRAMES))
(SET.FIELDQ FRAME SUPERFRAMES SUPERFRAMES)
(* Do not sort superframes as they are to be displayed
as ordered)
(MARK.FRAME.CONTEXT.OBSOLETE FRAME)
T])
(ADD.SFRAMES
[LAMBDA (FRAME.NAME SFRAME.NAME INTERFACE) (* PO "11-OCT-83 10:56")
(PROG ((FRAME (FIND.FRAME INTERFACE FRAME.NAME))
SUPERFRAMES)
(SETQ SUPERFRAMES (GET.FIELDQ FRAME SUPERFRAMES))
(RETURN (COND
((EQ SFRAME.NAME FRAME.NAME)
NIL)
((MEMB FRAME.NAME (SUPERFRAMES* (FIND.FRAME INTERFACE SFRAME.NAME)))
NIL)
(T (SETQ SUPERFRAMES (CONS SFRAME.NAME SUPERFRAMES))
(SETQ SUPERFRAMES (INTERSECTION SUPERFRAMES SUPERFRAMES))
(SET.FIELDQ FRAME SUPERFRAMES SUPERFRAMES)
(* Do not sort superframes as they are to be displayed
as ordered)
(MARK.FRAME.CONTEXT.OBSOLETE FRAME)
T])
(ADD.SUPERFRAME
[LAMBDA (FRAME.NAME SUPERFRAME.NAME INTERFACE) (* HaKo "25-Jul-84 16:56")
(DECLARE (GLOBALVARS CURRENT.INTERFACE))
(OR INTERFACE (SETQ INTERFACE CURRENT.INTERFACE))
(PROG ((FRAME (FIND.FRAME INTERFACE FRAME.NAME))
SUPERFRAMES SUPER.FRAME)
(SETQ SUPERFRAMES (GET.FIELDQ FRAME SUPERFRAMES))
(RETURN (COND
((EQ SUPERFRAME.NAME FRAME.NAME)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "A frame may not be its own superframe")
)
((MEMB FRAME.NAME (SUPERFRAMES* FRAME))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"A frame may not be a member of its own superframes"))
(T (SETQ SUPER.FRAME (FIND.FRAME INTERFACE SUPERFRAME.NAME))
(ANALYZE.FRAME.IF.NECESSARY* SUPER.FRAME)
(SETQ SUPERFRAMES (CONS SUPERFRAME.NAME SUPERFRAMES))
(SETQ SUPERFRAMES (INTERSECTION SUPERFRAMES SUPERFRAMES))
(SET.FIELDQ FRAME SUPERFRAMES SUPERFRAMES)
(* Do not sort superframes as they are to be displayed
as ordered)
(MARK.FRAME.CONTEXT.OBSOLETE FRAME)
T])
(ADD.SUPERFRAMES
[LAMBDA (FRAME ONLY.THIS.FRAME) (* HaKo "11-Jun-84 12:58")
(* PT " 5-AUG-83 13:05")
(DECLARE (GLOBALVARS CURRENT.INTERFACE))
(PROG (FRAME.NAME FRAMES SUPERFRAME.NAMES)
(SETQ FRAME.NAME (GET.FIELDQ FRAME NAME))
(CLRPROMPT)
(COND
((SETQ SUPERFRAME.NAMES (ACQUIRE.FRAME.NAMES "Select the SUPERFRAMES to be added")))
(T (RETURN)))
(COND
(ONLY.THIS.FRAME (for SUPER.NAME in SUPERFRAME.NAMES do (ADD.SUPERFRAME FRAME.NAME
SUPER.NAME))
(MARK.INTERFACE CURRENT.INTERFACE)
(RETURN T)))
(SETQ FRAMES (ACQUIRE.FRAME.NAMES "Select the FRAMES to add them to"))
(COND
(FRAMES (for FRAME in FRAMES do (for SUPER.NAME in SUPERFRAME.NAMES
do (ADD.SUPERFRAME FRAME SUPER.NAME)))
(MARK.INTERFACE CURRENT.INTERFACE)
(RETURN T])
(FORGET.MANY.SUPERFRAMES
[LAMBDA (FRAME) (* PH " 1-Jun-84 10:16")
(DECLARE (GLOBALVARS CURRENT.INTERFACE))
(PROG (FRAME.NAMES SUPERFRAME.NAMES)
(CLRPROMPT)
(COND
((SETQ SUPERFRAME.NAMES (ACQUIRE.FRAME.NAMES "Select the SUPERFRAMES to be forgotten"))
(COND
((SETQ FRAME.NAMES (ACQUIRE.FRAME.NAMES "Select the FRAMES to be affected"))
(for FRAME.NAME in FRAME.NAMES do (for SUPER.NAME in SUPERFRAME.NAMES
do (FORGET.SFRAME FRAME.NAME SUPER.NAME)))
(MARK.INTERFACE CURRENT.INTERFACE)
(RETURN FRAME.NAMES])
(FORGET.SFRAME
[LAMBDA (FRAME.NAME SUPER.NAME INTERFACE) (* HaKo "25-Jul-84 16:57")
(DECLARE (GLOBALVARS CURRENT.INTERFACE))
(OR INTERFACE (SETQ INTERFACE CURRENT.INTERFACE))
(PROG ((FRAME (FIND.FRAME INTERFACE FRAME.NAME))
SUPERFRAMES)
(SETQ SUPERFRAMES (GET.FIELDQ FRAME SUPERFRAMES))
(COND
((AND (MEMB SUPER.NAME SUPERFRAMES)
(CONFIRM (CONCAT "Forget superframe " SUPER.NAME "?")))
(SET.FIELDQ FRAME SUPERFRAMES (REMOVE SUPER.NAME SUPERFRAMES))
(MARK.FRAME.CONTEXT.OBSOLETE FRAME))
(T (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS SUPER.NAME " is not a superframe of "
FRAME.NAME])
(FORGET.SFRAMES
[LAMBDA (FRAME.NAME SFRAME.NAME INTERFACE) (* PT " 5-AUG-83 13:08")
(PROG ((FRAME (FIND.FRAME INTERFACE FRAME.NAME))
SUPERFRAMES)
(SETQ SUPERFRAMES (GET.FIELDQ FRAME SUPERFRAMES))
(COND
((NULL SUPERFRAMES)
NIL)
((MEMB SFRAME.NAME SUPERFRAMES)
(SET.FIELDQ FRAME SUPERFRAMES (REMOVE SFRAME.NAME SUPERFRAMES))
(MARK.FRAME.CONTEXT.OBSOLETE FRAME))
(T NIL])
(FORGET.SUPERFRAMES
[LAMBDA (FRAME) (* HaKo "25-Jul-84 16:57")
(DECLARE (GLOBALVARS CURRENT.INTERFACE))
(PROG (FRAME.NAME SUPERFRAMES SUPERFRAME.NAME)
(SETQ FRAME.NAME (GET.FIELDQ FRAME NAME))
(SETQ SUPERFRAMES (GET.FIELDQ FRAME SUPERFRAMES))
(COND
((NULL SUPERFRAMES)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"This frame has no superframes; can't forget one")
(RETURN)))
(COND
((SETQ SUPERFRAME.NAME
(MENU (create MENU
ITEMS ← SUPERFRAMES
CENTERFLG ← T
CHANGEOFFSETFLG ← T
TITLE ← "Select SUPERFRAME")))
(COND
(SUPERFRAME.NAME (FORGET.SFRAME FRAME.NAME SUPERFRAME.NAME)
(MARK.INTERFACE CURRENT.INTERFACE)
(RETURN T])
(GET.SUPERFRAME.COMMAND.MENU
[LAMBDA NIL (* PH "31-May-84 11:17")
(* PT "29-JUL-83 09:24")
(* * EVAL THIS WHEN MENU IS CHANGED (SETQ SUPERFRAME.COMMAND.MENU))
(DECLARE (GLOBALVARS SUPERFRAME.COMMAND.MENU))
(OR SUPERFRAME.COMMAND.MENU (SETQ SUPERFRAME.COMMAND.MENU (create MENU
TITLE ← "SUPERFRAME COMMANDS"
ITEMS ←(QUOTE
((ADD.SUPERS.TO.THIS.FRAME
(QUOTE ADD.TO.ONE)
"For adding one or more SUPERFRAMES to current FRAME")
(ADD.SUPERS.TO.MANY.FRAMES
(QUOTE ADD.TO.MANY)
"For adding one or more SUPERFRAMES to one or more FRAMES")
(FORGET.SUPER.OF.THIS.FRAME
(QUOTE FORGET.ONE)
"For forgetting a SUPERFRAME from the current FRAME")
(
FORGET.SUPERS.OF.MANY.FRAMES (QUOTE FORGET.MANY)
"For forgetting one or more SUPERFRAMES from one or more FRAMES")
(
PRINT.SUPERFRAMES.OF.THIS.FRAME (QUOTE SUPERS.OF.THIS.FRAME)
"For listing the SUPERFRAMES of one or more FRAMES")
(
PRINT.SUPERFRAMES.OF.MANY.FRAMES (QUOTE PRINT.SUPERFRAMES)
"For listing the SUPERFRAMES of one or more FRAMES")
(PRINT.FRAMES.OF.SUPERFRAMES
(QUOTE PRINT.FRAMES)
"For listing all FRAMES that have specific SUPERFRAMES")
(QUIT (QUOTE QUIT)
"To return to Frame Editor")))
CENTERFLG ← T
CHANGEOFFSETFLG ← T])
(MANIPULATE.SUPERFRAMES
[LAMBDA (FRAME) (* HaKo "27-Jul-84 11:03")
(* PT "29-JUL-83 10:31")
(do (SELECTQ (MENU (GET.SUPERFRAME.COMMAND.MENU))
(NIL NIL)
[ADD.TO.ONE (COND
((ADD.SUPERFRAMES FRAME T)
(DISPLAY.FRAME FRAME]
[ADD.TO.MANY (COND
((ADD.SUPERFRAMES FRAME)
(DISPLAY.FRAME FRAME]
[FORGET.ONE (COND
((FORGET.SUPERFRAMES FRAME T)
(DISPLAY.FRAME FRAME]
[FORGET.MANY (COND
((FORGET.MANY.SUPERFRAMES FRAME)
(DISPLAY.FRAME FRAME]
(PRINT.SUPERFRAMES (PRINT.SFRAMES))
(SUPERS.OF.THIS.FRAME (PRINT.SUPERFRAMES FRAME))
(PRINT.FRAMES (PRINT.FRAMES))
(QUIT (RETURN))
(SHOULDNT "Illegal command in Manipulate.Superframes"])
(PRINT.SFRAMES
[LAMBDA (INTERFACE) (* HaKo "16-Aug-84 14:59")
(* PT " 5-AUG-83 13:17")
(DECLARE (GLOBALVARS CURRENT.INTERFACE))
(OR INTERFACE (SETQ INTERFACE CURRENT.INTERFACE))
(PROG (FRAME.NAMES SUPERFRAMES)
(CLRPROMPT)
(SETQ FRAME.NAMES (ACQUIRE.FRAME.NAMES "Select FRAMES to show SUPERFRAMES"))
(for FRAME.NAME in FRAME.NAMES
do (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS " ")
(PRINT.SUPERFRAMES (FIND.FRAME INTERFACE FRAME.NAME)
SUPERFRAMES])
(PRINT.SUPERFRAMES
[LAMBDA (FRAME) (* HaKo "16-Aug-84 15:00")
(* DAHJr "19-JAN-83 16:16")
(PROG (FRAME.NAME SUPERFRAMES)
(SETQ FRAME.NAME (GET.FIELDQ FRAME NAME FRAME))
(SETQ SUPERFRAMES (GET.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])
(USED.AS.SUPERFRAME.BY
[LAMBDA (SUPERFRAME.NAME INTERFACE) (* HaKo " 8-SEP-83 11:48")
(for FRAME in (GET.FIELDQ INTERFACE FRAMES INTERFACE) when (MEMB SUPERFRAME.NAME
(GET.FIELDQ FRAME SUPERFRAMES))
collect (GET.FIELDQ FRAME NAME])
)
(RPAQQ SUPERFRAME.STRUCTURE.GRAPH.SPEC [FRAME (LABEL (GET.FIELDQ DATUM NAME)
SONS
((GRAPH.FRAMES.MENTION.AS.SUPERFRAME DATUM
CONTEXT)
(QUOTE FRAME])
(RPAQQ SUPERFRAME.COMMAND.MENU NIL)
(PUTPROPS TRI-EDITSUPER COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (646 11589 (ADD.SFRAME 656 . 1836) (ADD.SFRAMES 1838 . 2619) (ADD.SUPERFRAME 2621 . 3802
) (ADD.SUPERFRAMES 3804 . 4821) (FORGET.MANY.SUPERFRAMES 4823 . 5477) (FORGET.SFRAME 5479 . 6159) (
FORGET.SFRAMES 6161 . 6619) (FORGET.SUPERFRAMES 6621 . 7437) (GET.SUPERFRAME.COMMAND.MENU 7439 . 9092)
(MANIPULATE.SUPERFRAMES 9094 . 9947) (PRINT.SFRAMES 9949 . 10588) (PRINT.SUPERFRAMES 10590 . 11281) (
USED.AS.SUPERFRAME.BY 11283 . 11587)))))
STOP