(FILECREATED "14-Mar-85 14:11:57" 
{PHYLUM}<TRILLIUM>BIRTHDAY84>ENHANCEMENTS>RECORDS-NHB>TRI-RECORD-DEFINITIONS.;7
 6535   

      changes to:  (RECORDS INTERFACE)

      previous date: "12-Mar-85 17:21:47" 
{PHYLUM}<TRILLIUM>BIRTHDAY84>ENHANCEMENTS>RECORDS-NHB>TRI-RECORD-DEFINITIONS.;6)


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

(PRETTYCOMPRINT TRI-RECORD-DEFINITIONSCOMS)

(RPAQQ TRI-RECORD-DEFINITIONSCOMS
 ((RECORDS FRAME INTERFACE)
				   (FNS WHENCREATED.INTERFACE fetch.frame.field fetch.interface.field 
					replace.frame.field replace.interface.field)
				   (MACROS fetch.frame.fieldq fetch.interface.fieldq 
					   replace.frame.fieldq replace.interface.fieldq)))
[DECLARE: EVAL@COMPILE 

(DATATYPE FRAME
 (NAME ITEMS SUPERFRAMES SUPERFRAMES.CACHE CLASSES INITIALIZATIONS ARTWORKS SENSORS 
		      INHIBITORS DISPLAYERS IMPLICATIONS SERVICES ANALYZED? PRIMITIVES.CACHED? 
		      SUPERFRAMES.CACHED? OTHER))

(DATATYPE INTERFACE
 (NAME FRAMES FIRST.FRAME REGION BACKGROUND.COLOR COLOR.MAP OTHER))
]
(/DECLAREDATATYPE (QUOTE FRAME)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER POINTER POINTER POINTER POINTER POINTER POINTER)))
(/DECLAREDATATYPE (QUOTE INTERFACE)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER)))
(DEFINEQ

(WHENCREATED.INTERFACE

  [LAMBDA (INTERFACE)                                        (* N.H.Briggs "31-Jan-85 18:45")


          (* * when an interface is instantiated this function will be applied to the new instance, allowing us to remember 

	  the definition as a property on the atom that is the name of the interface (unless the name is unspecified, in which

	  case we do nothing))



    (
PROG
 ((INTERFACE.NAME (fetch
 (INTERFACE NAME) of
 INTERFACE)))
          (
COND

	    (INTERFACE.NAME (
PUTPROP
 INTERFACE.NAME (
QUOTE
 InternalInterfaceRepresentation)
				     INTERFACE)))
          (
RETURN
 INTERFACE])

(fetch.frame.field

  [LAMBDA ($frame$ $field$)                                  (* N.H.Briggs "12-Mar-85 16:31")

    (
COND

      ((
FMEMB
 $field$ (
RECORDFIELDNAMES
 (
QUOTE
 FRAME)))
	(
RECORDACCESS
 $field$ $frame$ (
RECLOOK
 (
QUOTE
 FRAME))
		      (
QUOTE
 FFETCH)))
      (T (
LISTGET
 (ffetch
 (FRAME OTHER) of
 $frame$)
		  $field$])

(fetch.interface.field

  [LAMBDA ($interface$ $field$)                              (* N.H.Briggs "12-Mar-85 16:27")

    (
COND

      ((
FMEMB
 $field$ (
RECORDFIELDNAMES
 (
QUOTE
 INTERFACE)))
	(
RECORDACCESS
 $field$ $interface$ (
RECLOOK
 (
QUOTE
 INTERFACE))
		      (
QUOTE
 FFETCH)))
      (T (
LISTGET
 (ffetch
 (INTERFACE OTHER) of
 $interface$)
		  $field$])

(replace.frame.field

  [LAMBDA ($frame$ $field$ $value$)                          (* N.H.Briggs "12-Mar-85 16:19")

    (if
 (
FMEMB
 $field$ (
RECORDFIELDNAMES
 (
QUOTE
 FRAME)))
	then
 (
RECORDACCESS
 $field$ $frame$ (
RECLOOK
 (
QUOTE
 FRAME))
			   (
QUOTE
 FREPLACE)
			   $value$)
      else
 (
PROG
 ((OTHERS (ffetch
 (FRAME OTHER) of
 $frame$)))
	         (if
 OTHERS
		     then
 (
LISTPUT
 OTHERS $field$ $value$)
		   else
 (freplace
 (FRAME OTHER) of
 $frame$ with
 (
LIST
 $field$ $value$])

(replace.interface.field

  [LAMBDA ($interface$ $field$ $value$)                      (* N.H.Briggs "12-Mar-85 16:15")

    (if
 (
FMEMB
 $field$ (
RECORDFIELDNAMES
 (
QUOTE
 INTERFACE)))
	then
 (
RECORDACCESS
 $field$ $interface$ (
RECLOOK
 (
QUOTE
 INTERFACE))
			   (
QUOTE
 FREPLACE)
			   $value$)
      else
 (
PROG
 ((OTHERS (ffetch
 (INTERFACE OTHER) of
 $interface$)))
	         (if
 OTHERS
		     then
 (
LISTPUT
 OTHERS $field$ $value$)
		   else
 (freplace
 (INTERFACE OTHER) of
 $interface$ with
 (
LIST
 $field$ $value$])
)
(DECLARE: EVAL@COMPILE 

(PUTPROPS fetch.frame.fieldq MACRO
 [frame&field
				     (
PROG
 (($frame$ (
CAR
 frame&field))
					    ($field$ (
CADR
 frame&field)))
				           (
RETURN
 (
COND

						     ((
FMEMB
 $field$ (
RECORDFIELDNAMES
 (
QUOTE
 FRAME)))
						       (
BQUOTE
 (ffetch
 (FRAME , $field$)
								  of
 , $frame$)))
						     (T (
BQUOTE
 (
LISTGET
 (ffetch
 (FRAME OTHER)
									    of
 , $frame$)
									 (
QUOTE
 , $field$])

(PUTPROPS fetch.interface.fieldq MACRO
 [interface&field
	    (
PROG
 (($interface$ (
CAR
 interface&field))
		   ($field$ (
CADR
 interface&field)))
	          (
RETURN
 (
COND

			    ((
FMEMB
 $field$ (
RECORDFIELDNAMES
 (
QUOTE
 INTERFACE)))
			      (
BQUOTE
 (ffetch
 (INTERFACE , $field$) of
 , $interface$)))
			    (T (
BQUOTE
 (
LISTGET
 (ffetch
 (INTERFACE OTHER) of
 , $interface$)
						(
QUOTE
 , $field$])

(PUTPROPS replace.frame.fieldq MACRO
 [frame&field&value
	    (
PROG
 (($frame$ (
CAR
 frame&field&value))
		   ($field$ (
CADR
 frame&field&value))
		   ($value$ (
CADDR
 frame&field&value)))
	          (
RETURN
 (
COND

			    ((
FMEMB
 $field$ (
RECORDFIELDNAMES
 (
QUOTE
 FRAME)))
			      (
BQUOTE
 (freplace
 (FRAME , $field$) of
 , $frame$ with
 , $value$)))
			    (T (
BQUOTE
 (
PROG
 ((OTHERS (ffetch
 (FRAME OTHER) of
 , $frame$)))
					     (if
 OTHERS
						 then
 (
LISTPUT
 OTHERS (
QUOTE
 , $field$)
							       , $value$)
					       else
 (freplace
 (FRAME OTHER) of
 , $frame$
						       with
 (
LIST
 (
QUOTE
 , $field$)
								  , $value$])

(PUTPROPS replace.interface.fieldq MACRO
 [interface&field&value
	    (
PROG
 (($interface$ (
CAR
 interface&field&value))
		   ($field$ (
CADR
 interface&field&value))
		   ($value$ (
CADDR
 interface&field&value)))
	          (
RETURN
 (
COND

			    ((
FMEMB
 $field$ (
RECORDFIELDNAMES
 (
QUOTE
 INTERFACE)))
			      (
BQUOTE
 (freplace
 (INTERFACE , $field$) of
 , $interface$
					 with
 , $value$)))
			    (T (
BQUOTE
 (
PROG
 ((OTHERS (ffetch
 (INTERFACE OTHER) of
 , $interface$)))
					     (if
 OTHERS
						 then
 (
LISTPUT
 OTHERS (
QUOTE
 , $field$)
							       , $value$)
					       else
 (freplace
 (INTERFACE OTHER) of
 , $interface$
						       with
 (
LIST
 (
QUOTE
 , $field$)
								  , $value$])
)
(PUTPROPS TRI-RECORD-DEFINITIONS COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1343 3953 (WHENCREATED.INTERFACE 1353 . 2009) (fetch.frame.field 2011 . 2387) (
fetch.interface.field 2389 . 2789) (replace.frame.field 2791 . 3354) (replace.interface.field 3356 . 
3951)))))
STOP