(FILECREATED "18-Mar-85 15:05:15" 
{PHYLUM}<TRILLIUM>BIRTHDAY84>ENHANCEMENTS>RECORDS-NHB>TRI-RECORD-UTIL.;9
 7845   

      changes to:  (FNS FIND.FRAME WALK.INTERFACE)

      previous date: " 6-Mar-85 13:49:43" 
{PHYLUM}<TRILLIUM>BIRTHDAY84>ENHANCEMENTS>RECORDS-NHB>TRI-RECORD-UTIL.;7)


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

(PRETTYCOMPRINT TRI-RECORD-UTILCOMS)

(RPAQQ TRI-RECORD-UTILCOMS
 ((FNS ADD.FRAME.CLASS DEFINING.PTYPES.OF.FRAME ITEM.TYPES.OF.FRAME 
				 SUPERFRAMES* FIND.BITMAP FIND.ENCLOSED.ITEMS 
				 FIND.REPRESENTATIVE.GRAY FIND.COLOR.NUMBER FIND.FRAME FIND.INTERFACE 
				 FRAME.CLASSES FRAME.NAME UNMARK.INTERFACE USED.ITEM.TYPES 
				 WALK.INTERFACE WALK.FRAME)))
(DEFINEQ

(ADD.FRAME.CLASS

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

                                                             (* HaKo "25-Jul-84 17:26")

    (DECLARE
 (
GLOBALVARS
 FRAME.NAME.MENU))
    (
PROG
 (CLASSES)
          [
COND

	    ((
NULL
 CLASS)
	      (TRILLIUM.PRINTOUT ON PROMPTWINDOW "Name of class for frame " (fetch.frame.fieldq
				   FRAME NAME)
				 ": ")
	      (
SETQ
 CLASS (
PROMPT.READ
]
          (
SETQ
 CLASSES (
CONS
 CLASS (fetch.frame.fieldq FRAME CLASSES)))
          (
SETQ
 CLASSES (
INTERSECTION
 CLASSES CLASSES))
          (replace.frame.fieldq FRAME CLASSES (
SORT
 CLASSES))
          (
SETQ
 FRAME.NAME.MENU)
          (
SETQ
 CURRENT.BITMAP.FRAMES)
          (
RETURN
 CLASSES])

(DEFINING.PTYPES.OF.FRAME

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

    (for
 ITEM in
 (fetch.frame.fieldq FRAME ITEMS) join
 (
DEFINING.PTYPES.OF.ITEM
 PTYPE ITEM])

(ITEM.TYPES.OF.FRAME

  [LAMBDA (FRAME)                                            (* edited: " 4-OCT-82 17:01")

    (
PROG
 (TYPES)
          (
SETQ
 TYPES (for
 ITEM in
 (fetch.frame.fieldq FRAME ITEMS) collect
 (ITEM.TYPE ITEM)))
          (
RETURN
 (
SORT
 (
INTERSECTION
 TYPES TYPES])

(SUPERFRAMES*

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

    (DECLARE
 (
GLOBALVARS
 CURRENT.INTERFACE))
    (for
 SUPERFRAME.NAME in
 (fetch.frame.fieldq FRAME SUPERFRAMES)
       join
 (
CONS
 SUPERFRAME.NAME (SUPERFRAMES*
 (FIND.FRAME
 CURRENT.INTERFACE SUPERFRAME.NAME])

(FIND.BITMAP

  [LAMBDA (BITMAP.NAME)                                      (* HaKo "27-Jul-84 16:39")

    (DECLARE
 (
GLOBALVARS
 CURRENT.BITMAP.FRAMES CURRENT.FRAME UNKNOWN.BITMAP))
    (for
 FRAME bind
 (BITMAP) in
 (
CONS
 CURRENT.FRAME (
OR
 CURRENT.BITMAP.FRAMES (


							  
SET.CURRENT.BITMAP.FRAMES
)))
       when
 [
SETQ
 BITMAP (for
 ITEM in
 (fetch.frame.fieldq FRAME ITEMS)
			    when
 (
AND
 (
EQUAL
 (ITEM.TYPE ITEM)
					     (
QUOTE
 BITMAP))
				      (
EQUAL
 (GET.PARAMQ ITEM NAME)
					     BITMAP.NAME))
			    do
 (
RETURN
 (GET.PARAMQ ITEM BITMAP]
       do
 (
RETURN
 BITMAP)
       finally
 (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS T "Can't find bitmap " BITMAP.NAME T)
	       (
RETURN
 UNKNOWN.BITMAP])

(FIND.ENCLOSED.ITEMS

  [LAMBDA (REGION FRAME)                                     (* edited: "23-JUN-82 12:51")

    (for
 ITEM in
 (fetch.frame.fieldq FRAME ITEMS) when
 (
AND
 (TYPE.DEFINEDP ITEM)
							    (
ENCLOSESP
 REGION (GET.FIELDQ ITEM 
										     BOUNDING.BOX)))
       collect
 ITEM])

(FIND.REPRESENTATIVE.GRAY

  [LAMBDA (COLOR.NAME)                                       (* HaKo "27-Jul-84 16:40")

    (DECLARE
 (
GLOBALVARS
 CURRENT.INTERFACE))
    (
SELECTQ
 COLOR.NAME
	     (WHITE WHITESHADE)
	     (BLACK BLACKSHADE)
	     (for
 ITEM in
 (fetch.frame.fieldq (FIND.FRAME
 CURRENT.INTERFACE (
QUOTE
 COLORS))
					      ITEMS)
		when
 (
AND
 (
EQ
 (ITEM.TYPE ITEM)
			      (
QUOTE
 COLOR))
			  (
EQ
 (GET.PARAMQ ITEM NAME)
			      COLOR.NAME))
		do
 (
RETURN
 (GET.PARAMQ ITEM REPRESENTATIVE.GRAY)) finally
 (
RETURN
 42405])

(FIND.COLOR.NUMBER

  [LAMBDA (COLOR.NAME)                                       (* HaKo "27-Jul-84 16:40")

    (DECLARE
 (
GLOBALVARS
 CURRENT.INTERFACE))
    (
SELECTQ
 COLOR.NAME
	     (CLEAR NIL)
	     (WHITE 0)
	     (BLACK 15)
	     (for
 ITEM in
 (fetch.frame.fieldq (FIND.FRAME
 CURRENT.INTERFACE (
QUOTE
 COLORS))
					      ITEMS)
		when
 (
AND
 (
EQ
 (ITEM.TYPE ITEM)
			      (
QUOTE
 COLOR))
			  (
EQ
 (GET.PARAMQ ITEM NAME)
			      COLOR.NAME))
		do
 (
RETURN
 (GET.PARAMQ ITEM COLOR)) finally
 (
RETURN
 15])

(FIND.FRAME

  [LAMBDA (INTERFACE FRAME.NAME)                             (* N.H.Briggs "18-Mar-85 12:13")

    (if
 (
ATOM
 FRAME.NAME)
	then
 (for
 FRAME in
 (fetch.interface.fieldq INTERFACE FRAMES)
		do
 (if
 (
EQ
 (fetch.frame.fieldq FRAME NAME)
			   FRAME.NAME)
		       then
 (
RETURN
 FRAME))
		finally
 (
RETURN
 NIL])

(FIND.INTERFACE

  [LAMBDA (INTERFACE.NAME)
    (
GETPROP
 INTERFACE.NAME (
QUOTE
 InternalInterfaceRepresentation])

(FRAME.CLASSES

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

    (
PROG
 (CLASSES (FRAME.NAME
 (fetch.frame.fieldq FRAME NAME)))
          (
SETQ
 CLASSES (
DREMOVE
 NIL (fetch.frame.fieldq FRAME CLASSES)))
          (for
 CLASSDEFPTR on
 (GET.FIELDQ TRILLIUM.PROFILE FRAME.CLASSES) by
 (
CDDR
 CLASSDEFPTR)
	     when
 (
MEMB
 FRAME.NAME (
CADR
 CLASSDEFPTR)) do
 (
SETQ
 CLASSES (
CONS
 (
CAR
 CLASSDEFPTR)
									      CLASSES)))
          (
RETURN
 (
COND

		    (CLASSES (
SORT
 (
INTERSECTION
 CLASSES CLASSES)))
		    (T (
QUOTE
 (UNCLASSIFIED])

(FRAME.NAME

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

    (fetch.frame.fieldq FRAME NAME])

(UNMARK.INTERFACE

  [LAMBDA (INTERFACE)                                        (* N.H.Briggs "22-Feb-85 12:24")

    (
PROG
 ((NAME (fetch.interface.fieldq INTERFACE NAME))
	   (TYPE (
QUOTE
 INTERFACE)))
          (
COND

	    ((
MARKASCHANGED
 NAME TYPE)
	      (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Marking interface " NAME " as unchanged")
	      (
UNMARKASCHANGED
 NAME TYPE])

(USED.ITEM.TYPES

  [LAMBDA (INTERFACE)                                        (* N.H.Briggs "22-Feb-85 11:22")

    (
PROG
 (ITYPES ITYPE)
          (
SETQ
 ITYPES (
CONS
))
          [for
 FRAME in
 (fetch.interface.fieldq INTERFACE FRAMES)
	     do
 (for
 ITEM in
 (fetch.frame.fieldq FRAME ITEMS)
		   do
 (
SETQ
 ITYPE (ITEM.TYPE ITEM))
		      (
COND

			((
FMEMB
 ITYPE (
CAR
 ITYPES)))
			(T (
TCONC
 ITYPES ITYPE]
          (
RETURN
 (
SORT
 (
CAR
 ITYPES])

(WALK.INTERFACE

  [LAMBDA (INTERFACE CONTEXT ACTIONFN ACTIONFNARG)           (* N.H.Briggs "22-Feb-85 12:23")

    (for
 FRAME in
 (fetch.interface.fieldq INTERFACE FRAMES) bind
 (RESULT (NEWCONTEXT ←
										     (
LIST
 INTERFACE 
											  CONTEXT)))
       when
 (
SETQ
 RESULT (WALK.FRAME
 FRAME NEWCONTEXT ACTIONFN ACTIONFNARG)) do
 (
RETURN
 RESULT])

(WALK.FRAME

  [LAMBDA (FRAME CONTEXT ACTIONFN ACTIONFNARG)               (* N.H.Briggs " 1-Mar-85 14:35")

    (for
 ITEM in
 (fetch.frame.fieldq FRAME ITEMS) bind
 (RESULT (NEWCONTEXT ← (
LIST
 FRAME CONTEXT)))
       when
 (
SETQ
 RESULT (
WALK.OBJECT
 ITEM (
QUOTE
 (ITEM))
				      NEWCONTEXT ACTIONFN ACTIONFNARG))
       do
 (
RETURN
 RESULT])
)
(PUTPROPS TRI-RECORD-UTIL COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (728 7754 (ADD.FRAME.CLASS 738 . 1549) (DEFINING.PTYPES.OF.FRAME 1551 . 1787) (
ITEM.TYPES.OF.FRAME 1789 . 2105) (SUPERFRAMES* 2107 . 2462) (FIND.BITMAP 2464 . 3261) (
FIND.ENCLOSED.ITEMS 3263 . 3587) (FIND.REPRESENTATIVE.GRAY 3589 . 4183) (FIND.COLOR.NUMBER 4185 . 4756
) (FIND.FRAME 4758 . 5124) (FIND.INTERFACE 5126 . 5249) (FRAME.CLASSES 5251 . 5907) (FRAME.NAME 5909
 . 6059) (UNMARK.INTERFACE 6061 . 6459) (USED.ITEM.TYPES 6461 . 6973) (WALK.INTERFACE 6975 . 7368) (
WALK.FRAME 7370 . 7752)))))
STOP