(FILECREATED " 6-Mar-85 13:52:10" 
{PHYLUM}<TRILLIUM>BIRTHDAY84>ENHANCEMENTS>RECORDS-NHB>TRI-RECORD-EDITSUPER.;3
 7884   

      changes to:  (FNS ADD.SFRAME ADD.SFRAMES ADD.SUPERFRAMES ADD.SUPERFRAME FORGET.SUPERFRAMES 
			FORGET.SFRAME FORGET.SFRAMES USED.AS.SUPERFRAME.BY)

      previous date: " 1-Mar-85 16:06:05" 
{PHYLUM}<TRILLIUM>BIRTHDAY84>ENHANCEMENTS>RECORDS-NHB>TRI-RECORD-EDITSUPER.;2)


(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT TRI-RECORD-EDITSUPERCOMS)

(RPAQQ TRI-RECORD-EDITSUPERCOMS
 ((FNS ADD.SFRAME ADD.SFRAMES ADD.SUPERFRAMES ADD.SUPERFRAME 
				      FORGET.SUPERFRAMES FORGET.SFRAME FORGET.SFRAMES 
				      USED.AS.SUPERFRAME.BY)))
(DEFINEQ

(ADD.SFRAME

  [LAMBDA (
FRAME.NAME
 SUPERFRAME.NAME INTERFACE)             (* N.H.Briggs " 1-Mar-85 14:24")

    (DECLARE
 (
GLOBALVARS
 CURRENT.INTERFACE))
    (
OR
 INTERFACE (
SETQ
 INTERFACE CURRENT.INTERFACE))
    (
PROG
 ((FRAME (
FIND.FRAME
 INTERFACE FRAME.NAME))
	   SUPERFRAMES SUPER.FRAME)
          (
SETQ
 SUPERFRAMES (fetch.frame.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))
		       (replace.frame.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)                 (* N.H.Briggs " 1-Mar-85 14:24")

    (
PROG
 ((FRAME (
FIND.FRAME
 INTERFACE FRAME.NAME))
	   SUPERFRAMES)
          (
SETQ
 SUPERFRAMES (fetch.frame.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))
		       (replace.frame.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)                            (* N.H.Briggs " 1-Mar-85 14:24")

                                                             (* PT " 5-AUG-83 13:05")

    (DECLARE
 (
GLOBALVARS
 CURRENT.INTERFACE))
    (
PROG
 (
FRAME.NAME
 FRAMES SUPERFRAME.NAMES)
          (
SETQ
 FRAME.NAME (fetch.frame.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])

(ADD.SUPERFRAME

  [LAMBDA (
FRAME.NAME
 SUPERFRAME.NAME INTERFACE)             (* N.H.Briggs " 1-Mar-85 14:24")

    (DECLARE
 (
GLOBALVARS
 CURRENT.INTERFACE))
    (
OR
 INTERFACE (
SETQ
 INTERFACE CURRENT.INTERFACE))
    (
PROG
 ((FRAME (
FIND.FRAME
 INTERFACE FRAME.NAME))
	   SUPERFRAMES SUPER.FRAME)
          (
SETQ
 SUPERFRAMES (fetch.frame.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))
		       (replace.frame.fieldq FRAME SUPERFRAMES SUPERFRAMES)
                                                             (* Do not sort superframes as they are to be displayed 

							     as ordered)

		       (
MARK.FRAME.CONTEXT.OBSOLETE
 FRAME)
		       T])

(FORGET.SUPERFRAMES

  [LAMBDA (FRAME)                                            (* N.H.Briggs " 1-Mar-85 14:25")

    (DECLARE
 (
GLOBALVARS
 CURRENT.INTERFACE))
    (
PROG
 (
FRAME.NAME
 SUPERFRAMES SUPERFRAME.NAME)
          (
SETQ
 FRAME.NAME (fetch.frame.fieldq FRAME NAME))
          (
SETQ
 SUPERFRAMES (fetch.frame.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])

(FORGET.SFRAME

  [LAMBDA (
FRAME.NAME
 SUPER.NAME INTERFACE)                  (* N.H.Briggs " 1-Mar-85 14:25")

    (DECLARE
 (
GLOBALVARS
 CURRENT.INTERFACE))
    (
OR
 INTERFACE (
SETQ
 INTERFACE CURRENT.INTERFACE))
    (
PROG
 ((FRAME (
FIND.FRAME
 INTERFACE FRAME.NAME))
	   SUPERFRAMES)
          (
SETQ
 SUPERFRAMES (fetch.frame.fieldq FRAME SUPERFRAMES))
          (
COND

	    ((
AND
 (
MEMB
 SUPER.NAME SUPERFRAMES)
		  (
CONFIRM
 (
CONCAT
 "Forget superframe " SUPER.NAME "?")))
	      (replace.frame.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)                 (* N.H.Briggs " 1-Mar-85 14:25")

    (
PROG
 ((FRAME (
FIND.FRAME
 INTERFACE FRAME.NAME))
	   SUPERFRAMES)
          (
SETQ
 SUPERFRAMES (fetch.frame.fieldq FRAME SUPERFRAMES))
          (
COND

	    ((
NULL
 SUPERFRAMES)
	      NIL)
	    ((
MEMB
 SFRAME.NAME SUPERFRAMES)
	      (replace.frame.fieldq FRAME SUPERFRAMES (
REMOVE
 SFRAME.NAME SUPERFRAMES))
	      (
MARK.FRAME.CONTEXT.OBSOLETE
 FRAME))
	    (T NIL])

(USED.AS.SUPERFRAME.BY

  [LAMBDA (SUPERFRAME.NAME INTERFACE)                        (* N.H.Briggs " 1-Mar-85 14:26")

    (for
 FRAME in
 (fetch.interface.fieldq INTERFACE FRAMES) when
 (
MEMB
 SUPERFRAME.NAME
								       (fetch.frame.fieldq FRAME 
										      SUPERFRAMES))
       collect
 (fetch.frame.fieldq FRAME NAME])
)
(PUTPROPS TRI-RECORD-EDITSUPER COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (707 7793 (ADD.SFRAME 717 . 2001) (ADD.SFRAMES 2003 . 2870) (ADD.SUPERFRAMES 2872 . 3971
) (ADD.SUPERFRAME 3973 . 5258) (FORGET.SUPERFRAMES 5260 . 6154) (FORGET.SFRAME 6156 . 6916) (
FORGET.SFRAMES 6918 . 7438) (USED.AS.SUPERFRAME.BY 7440 . 7791)))))
STOP