(FILECREATED "14-Mar-85 14:12:34" 
{PHYLUM}<TRILLIUM>BIRTHDAY84>ENHANCEMENTS>RECORDS-NHB>TRI-RECORD-CREATE.;6
 5296   

      changes to:  (FNS ACQUIRE.INTERFACE.NAME)

      previous date: " 6-Mar-85 13:53:54" 
{PHYLUM}<TRILLIUM>BIRTHDAY84>ENHANCEMENTS>RECORDS-NHB>TRI-RECORD-CREATE.;5)


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

(PRETTYCOMPRINT TRI-RECORD-CREATECOMS)

(RPAQQ TRI-RECORD-CREATECOMS
 ((FNS ACQUIRE.CLASS.NAME ACQUIRE.FRAME.NAME ACQUIRE.INTERFACE.NAME 
				   ACQUIRE.NAMED.ITEM.FROM CREATE.COLOR.NAME HITS.IN.FRAME)))
(DEFINEQ

(ACQUIRE.CLASS.NAME

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

    (
PROG
 (CLASSES CLASS.MENU CLASS)
          [
SETQ
 CLASSES (for
 FRAME in
 (fetch.interface.fieldq INTERFACE FRAMES)
			   join
 (
COPY
 (fetch.frame.fieldq FRAME CLASSES]
          (
SETQ
 CLASSES (
INTERSECTION
 CLASSES CLASSES))
          (
SORT
 CLASSES)
          [
SETQ
 CLASSES (
NCONC1
 CLASSES (
QUOTE
 ("New class" (
QUOTE
 $$NEW.CLASS$$]
          (
SETQ
 CLASS.MENU (create
 MENU
				   TITLE ← "Frame classes"
				   ITEMS ← CLASSES
				   CENTERFLG ← T
				   CHANGEOFFSETFLG ← T))
          (
SETQ
 CLASS (
MENU
 CLASS.MENU))
          (
RETURN
 (
COND

		    ((
EQ
 CLASS (
QUOTE
 $$NEW.CLASS$$))
		      (TRILLIUM.PRINTOUT ON PROMPTWINDOW "New class name for frame: ")
		      (
PROMPT.READ
))
		    (T CLASS])

(ACQUIRE.FRAME.NAME

  [LAMBDA (INTERFACE)                                        (* N.H.Briggs "20-Feb-85 15:33")

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

      (FRAME.NAME.MENU)
      (T (
SETQ
 FRAME.NAME.MENU (
KEYWORD.MENU.CREATE
 (fetch.interface.fieldq INTERFACE FRAMES)
						    (
FUNCTION
 FRAME.CLASSES)
						    (
QUOTE
 (TITLE "Frames" CENTERFLG T))
						    (
FUNCTION
 FRAME.NAME]
    (
KEYWORD.MENU.INVOKE
 FRAME.NAME.MENU])

(ACQUIRE.INTERFACE.NAME

  [LAMBDA NIL                                                (* N.H.Briggs "13-Mar-85 17:20")


          (* * Changed to print out a message if there are no interfaces in the system)



    (DECLARE
 (
GLOBALVARS
 TRILLIUM.INTERFACES))
    (if
 TRILLIUM.INTERFACES
	then
 (
MENU
 (create
 MENU
			   ITEMS ← (for
 INTERFACE in
 TRILLIUM.INTERFACES collect
 (
fetch.interface.fieldq INTERFACE NAME))
			   TITLE ← "Interfaces"
			   CENTERFLG ← T
			   CHANGEOFFSETFLG ← T))
      else
 (TRILLIUM.PRINTOUT T "No interfaces!" T])

(ACQUIRE.NAMED.ITEM.FROM

  [LAMBDA (FRAME SUPERFRAMES.TOO ITYPE)                      (* N.H.Briggs " 1-Mar-85 14:05")

    (
PROG
 (NAME MENU.ITEMS NAME.MENU)
          [
SETQ
 MENU.ITEMS (for
 ITEM in
 (fetch.frame.fieldq FRAME ITEMS)
			      when
 [
AND
 (
OR
 (
NULL
 ITYPE)
					    (
EQ
 ITYPE (ITEM.TYPE ITEM)))
					(
SETQ
 NAME (
LISTGET
 ITEM (
QUOTE
 NAME]
			      collect
 (
LIST
 NAME (
KWOTE
 ITEM]
          (
RETURN
 (
COND

		    (MENU.ITEMS (
SETQ
 MENU.ITEMS (
SORT
 MENU.ITEMS (
FUNCTION
 MENU.ITEM.GREATER)))
				[
SETQ
 NAME.MENU (
CHUNK.MENU.CREATE
 MENU.ITEMS
								   (
QUOTE
 (TITLE "Named items" 
										 CENTERFLG T]
				(
CHUNK.MENU.INVOKE
 NAME.MENU))
		    (T (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "This frame has no named items")
		       (
WAITNOBUG
)
		       NIL])

(CREATE.COLOR.NAME

  [LAMBDA NIL                                                (* kkm "19-Nov-84 11:51")

    (DECLARE
 (
GLOBALVARS
 CURRENT.INTERFACE))
    (
PROG
 (COLOR.NAMES)
          (
SETQ
 COLOR.NAMES (for
 ITEM in
 (fetch.frame.fieldq (
FIND.FRAME
 CURRENT.INTERFACE
									 (
QUOTE
 COLORS))
							     ITEMS)
			       when
 (
EQ
 (ITEM.TYPE ITEM)
					(
QUOTE
 COLOR))
			       collect
 (GET.PARAMQ ITEM NAME COLOR)))
          (
RETURN
 (
MENU
 (create
 MENU
				ITEMS ←(
MERGEINSERT
 (
QUOTE
 BLACK)
						    (
MERGEINSERT
 (
QUOTE
 WHITE)
								 (
SORT
 COLOR.NAMES)
								 T)
						    T)
				CENTERFLG ← T
				CHANGEOFFSETFLG ← T])

(HITS.IN.FRAME

  [LAMBDA (FRAME FROM.SUPERFRAMES.TOO ITYPE XCOORD YCOORD)   (* N.H.Briggs " 1-Mar-85 14:05")

                                                             (* DAHJr "19-APR-83 15:59")


          (* * Note: this function makes sure to return the list of items such that the topmost item is in front.)



    (DECLARE
 (
GLOBALVARS
 CURRENT.INTERFACE))
    (
PROG
 (HITS)
          (
COND

	    (FROM.SUPERFRAMES.TOO (for
 SUPERFRAME.NAME in
 (fetch.frame.fieldq FRAME SUPERFRAMES)
				     do
 (
SETQ
 HITS (
NCONC
 (HITS.IN.FRAME
 (
FIND.FRAME
 
										CURRENT.INTERFACE 
										  SUPERFRAME.NAME)
									 FROM.SUPERFRAMES.TOO ITYPE 
									 XCOORD YCOORD)
							  HITS)))
				  y))
          (for
 ITEM in
 (fetch.frame.fieldq FRAME ITEMS) when
 (
AND
 (
OR
 (
NULL
 ITYPE)
								      (
EQ
 ITYPE (ITEM.TYPE ITEM)))
								  (
INSIDEP
 (
BOUNDING.BOX
 ITEM)
									   XCOORD YCOORD))
	     do
 (
SETQ
 HITS (
CONS
 ITEM HITS)))
          (
RETURN
 HITS])
)
(PUTPROPS TRI-RECORD-CREATE COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (569 5208 (ACQUIRE.CLASS.NAME 579 . 1482) (ACQUIRE.FRAME.NAME 1484 . 1969) (
ACQUIRE.INTERFACE.NAME 1971 . 2561) (ACQUIRE.NAMED.ITEM.FROM 2563 . 3432) (CREATE.COLOR.NAME 3434 . 
4146) (HITS.IN.FRAME 4148 . 5206)))))
STOP