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

      changes to:  (FNS COPY.INTERFACE INTERACT&FREEZE.INTERFACE FREEZE.INTERFACE 
			CREATE.NEW.INTERFACE MARK.INTERFACE MANIPULATE.INTERFACE RESET.INTERFACE)

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


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

(PRETTYCOMPRINT TRI-RECORD-EDITINTERFACECOMS)

(RPAQQ TRI-RECORD-EDITINTERFACECOMS
 ((FNS COPY.INTERFACE INTERACT&FREEZE.INTERFACE FREEZE.INTERFACE 
					  CREATE.NEW.INTERFACE MARK.INTERFACE RENAME.INTERFACE 
					  DELETE.INTERFACE MANIPULATE.INTERFACE RESET.INTERFACE)))
(DEFINEQ

(COPY.INTERFACE

  [LAMBDA (INTERFACE)                                        (* N.H.Briggs " 5-Mar-85 15:18")

    (
PROG
 (NAME NEW.NAME NEW.INTERFACE FRAMES FIRST.FRAME REGION PROFILE BACKGROUND.COLOR)
          (
SETQ
 NAME (fetch.interface.fieldq INTERFACE NAME))
          (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Copying interface " NAME)
          (TRILLIUM.PRINTOUT ON PROMPTWINDOW "Name of copy: ")
          (
SETQ
 NEW.NAME (
PROMPT.READ
))
          (
COND

	    ((
NULL
 NEW.NAME)
	      (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Copy command aborted"))
	    ((
NOT
 (
ATOM
 NEW.NAME))
	      (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Name must be one word")
	      (
RETURN
))
	    ((
FIND.INTERFACE
 NEW.NAME)
	      (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "The name " NEW.NAME " is already in use")
	      (
RETURN
))
	    (T (
SETQ
 FRAMES (for
 FRAME in
 (fetch.interface.fieldq INTERFACE FRAMES)
			       collect
 (
COPY.FRAME
 FRAME)))
	       (
SETQ
 FIRST.FRAME (fetch.interface.fieldq INTERFACE FIRST.FRAME))
	       (
SETQ
 REGION (
COPY
 (fetch.interface.fieldq INTERFACE REGION)))
	       (
SETQ
 BACKGROUND.COLOR (fetch.interface.fieldq INTERFACE BACKGROUND.COLOR))
	       (
SETQ
 NEW.INTERFACE (create
 INTERFACE))
	       (replace.interface.fieldq NEW.INTERFACE FRAMES FRAMES)
	       (replace.interface.fieldq NEW.INTERFACE FIRST.FRAME FIRST.FRAME)
	       (replace.interface.fieldq NEW.INTERFACE REGION REGION)
	       (replace.interface.fieldq NEW.INTERFACE BACKGROUND.COLOR BACKGROUND.COLOR)
	       (
REGISTER.INTERFACE
 NEW.INTERFACE)
	       (MARK.INTERFACE
 NEW.INTERFACE T)
	       (
RETURN
 NEW.NAME])

(INTERACT&FREEZE.INTERFACE

  [LAMBDA NIL                                                (* N.H.Briggs " 5-Mar-85 11:01")

    (
PROG
 (INTERFACE INTERFACE.NAME FROZEN.INTERFACE FROZEN.INTERFACE.NAME)
          (
COND

	    ([
OR
 (
NULL
 (
SETQ
 INTERFACE.NAME (
ACQUIRE.INTERFACE.NAME
)))
		 (
NULL
 (
SETQ
 INTERFACE (
FIND.INTERFACE
 INTERFACE.NAME]
	      (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "FREEZE.INTERFACE aborted."))
	    ((fetch.interface.fieldq INTERFACE FROZEN)
	      (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Interface " INTERFACE.NAME " already frozen!"))
	    (T (
SETQ
 FROZEN.INTERFACE.NAME (
MKATOM
 (
CONCAT
 "Frozen." INTERFACE.NAME)))
	       (
SETQ
 FROZEN.INTERFACE (
FIND.INTERFACE
 FROZEN.INTERFACE.NAME))
	       (
COND

		 [(
NULL
 FROZEN.INTERFACE)
		   (
COND

		     [(
CONFIRM
 (
CONCAT
 "Freezing " INTERFACE.NAME " into " FROZEN.INTERFACE.NAME "?"))
		       (
SETQ
 FROZEN.INTERFACE (
create.interface
 (NAME FROZEN.INTERFACE.NAME)
								(FROZEN T]
		     (T (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "FREEZE.INTERFACE aborted.")
			(
RETURN
]
		 ((
CONFIRM
 (
CONCAT
 "Overwrite current " FROZEN.INTERFACE.NAME "?"))
		   (replace.interface.fieldq FROZEN.INTERFACE FRAMES NIL))
		 (T (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "FREEZE.INTERFACE aborted.")
		    (
RETURN
)))
	       (THINKING (
COND

			   ((FREEZE.INTERFACE
 INTERFACE FROZEN.INTERFACE)
			     (MARK.INTERFACE
 FROZEN.INTERFACE T)
			     (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Interface " INTERFACE.NAME 
						" frozen into "
						FROZEN.INTERFACE.NAME " !"])

(FREEZE.INTERFACE

  [LAMBDA (INTERFACE FROZEN.INTERFACE)                       (* N.H.Briggs " 5-Mar-85 10:57")

    (
PROG
 (
FRAME.NAME
 WAS.FROZEN (FROZEN.FRAMES (
CONS
)))
          (for
 FRAME in
 (fetch.interface.fieldq INTERFACE FRAMES)
	     do
 (
SETQ
 FRAME.NAME (fetch.frame.fieldq FRAME NAME))
		(
SETQ
 WAS.FROZEN (fetch.frame.fieldq FRAME FROZEN))
		(
OR
 WAS.FROZEN (
FREEZE.FRAME
 FRAME INTERFACE))
		(
TCONC
 FROZEN.FRAMES (create.frame (NAME FRAME.NAME)
						   (SUPERFRAMES (
COPY
 (fetch.frame.fieldq FRAME 
										      SUPERFRAMES)))
						   (ITEMS (
COPYALL
 (fetch.frame.fieldq FRAME ITEMS)))
						   (FROZEN T)))
		(
OR
 WAS.FROZEN (
THAW.FRAME
 FRAME INTERFACE)))
          (replace.interface.fieldq FROZEN.INTERFACE FRAMES (
CAR
 FROZEN.FRAMES))
          (replace.interface.fieldq FROZEN.INTERFACE FIRST.FRAME (fetch.interface.fieldq INTERFACE 
										      FIRST.FRAME))
          (replace.interface.fieldq FROZEN.INTERFACE REGION (
COPY
 (fetch.interface.fieldq INTERFACE 
											  REGION)))
          (replace.interface.fieldq FROZEN.INTERFACE PROFILE (
COPYALL
 (fetch.interface.fieldq 
											INTERFACE 
											  PROFILE)))
          (
RETURN
 T])

(CREATE.NEW.INTERFACE

  [LAMBDA NIL                                                (* N.H.Briggs " 5-Mar-85 10:31")

    (DECLARE
 (
GLOBALVARS
 INITIAL.BITMAPS))
    (
PROG
 (NEW.NAME NEW.INTERFACE BITMAP.ITEM)
          (TRILLIUM.PRINTOUT ON PROMPTWINDOW "Creating new interface; Name of new interface: ")
          (
SETQ
 NEW.NAME (
PROMPT.READ
))
          (
COND

	    ((
NOT
 (
ATOM
 NEW.NAME))
	      (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Name must be one word")
	      (
RETURN
))
	    ((
FIND.INTERFACE
 NEW.NAME)
	      (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "The name " NEW.NAME " is already in use")
	      (
RETURN
))
	    (T [
SETQ
 NEW.INTERFACE
		 (
FIND.INTERFACE

		   (
PUTDEF.INTERFACE
 NEW.NAME (
QUOTE
 INTERFACE)
				     (
LIST
 (
QUOTE
 \TYPE)
					   (
QUOTE
 INTERFACE)
					   (
QUOTE
 NAME)
					   NEW.NAME
					   (
QUOTE
 FRAMES)
					   [
LIST
 (create.frame (NAME (
QUOTE
 BEGIN)))
						 (create.frame
						   (NAME (
QUOTE
 BITMAPS))
						   (ITEMS (for
 SPEC in
 INITIAL.BITMAPS
							     bind
 (X ← 10)
							     collect
 [
SETQ
 BITMAP.ITEM
								       (ITEM.CREATE
									 BITMAP
									 (PLACEMENT (
CONS
 X 200))
									 (NAME (
CAR
 SPEC))
									 (BITMAP (
CADR
 SPEC]
								     [
SETQ
 X
								       (
IPLUS
 X 10
									      (fetch
 (BITMAP 
										      BITMAPWIDTH)
										 of
 (
CADR
 SPEC]
								     BITMAP.ITEM)))
						 (create.frame
						   (NAME (
QUOTE
 COLORS))
						   (ITEMS (
LIST
 (ITEM.CREATE COLOR
									     (PLACEMENT (
CONS
 10 10))
									     (NAME (
QUOTE
 GRAY))
									     (COLOR 4)
									     (REPRESENTATIVE.GRAY
									       42405]
					   (
QUOTE
 FIRST.FRAME)
					   (
QUOTE
 BEGIN)
					   (
QUOTE
 BACKGROUND.COLOR)
					   (
QUOTE
 WHITE]
	       (MARK.INTERFACE
 NEW.INTERFACE T)
	       (
RETURN
 NEW.NAME])

(MARK.INTERFACE

  [LAMBDA (INTERFACE NEW)                                    (* N.H.Briggs "13-Feb-85 14:35")

    (DECLARE
 (
GLOBALVARS
 TRILLIUM.MARKFLG))
    (
PROG
 ((NAME (fetch.interface.fieldq INTERFACE NAME))
	   (TYPE (
QUOTE
 INTERFACE)))
          (
COND

	    ((
NULL
 TRILLIUM.MARKFLG))
	    ((
MARKASCHANGEDP
 NAME TYPE))
	    (T (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Marking interface " NAME " as changed")
	       (
MARKASCHANGED
 NAME TYPE NEW])

(RENAME.INTERFACE

  [LAMBDA NIL                                                (* N.H.Briggs "13-Feb-85 14:35")

                                                             (* PH "14-Nov-84 14:15")

    (DECLARE
 (
GLOBALVARS
 CURRENT.INTERFACE.WINDOW))
    (
PROG
 (
INTERFACE
 INTERFACE.DESCRIPTION OLD.NAME NEW.NAME REDISPLAY)
          (
SETQ
 OLD.NAME (ACQUIRE.INTERFACE.NAME))
          (
SETQ
 INTERFACE (
FIND.INTERFACE
 OLD.NAME))
          (
COND

	    ((
NULL
 INTERFACE)
	      (
RETURN
)))
          (TRILLIUM.PRINTOUT "Enter new name of interface: ")
          (
SETQ
 NEW.NAME (PROMPT.READ))
          (
COND

	    ((
NOT
 (
ATOM
 NEW.NAME))
	      (TRILLIUM.PRINTOUT "Name must be one word")
	      (
RETURN
))
	    ((
FIND.INTERFACE
 NEW.NAME)
	      (TRILLIUM.PRINTOUT "The name " NEW.NAME " is already in use")
	      (
RETURN
))
	    (T (TRILLIUM.PRINTOUT "Renaming interface " OLD.NAME " to " NEW.NAME)
	       (
SETQ
 REDISPLAY (
EQ
 (
WINDOWPROP
 CURRENT.INTERFACE.WINDOW (
QUOTE
 INTERFACE))
				   INTERFACE))
	       (
SETQ
 INTERFACE.DESCRIPTION (
GETDEF.INTERFACE
 OLD.NAME (
QUOTE
 INTERFACE)))
	       (
LISTPUT
 INTERFACE.DESCRIPTION (
QUOTE
 NAME)
			NEW.NAME)
	       (
PUTDEF.INTERFACE
 NEW.NAME (
QUOTE
 INTERFACE)
				 INTERFACE.DESCRIPTION)
	       (MARK.INTERFACE
 (
FIND.INTERFACE
 NEW.NAME)
			       T)
	       (DELETE.INTERFACE OLD.NAME)
	       (
COND

		 (REDISPLAY (
INTERFACE.WINDOW.CHANGE.TITLE
)
			    (DISPLAY.FRAME CURRENT.FRAME)))
	       (
RETURN
 (TRILLIUM.PRINTOUT "Done!" T "Don't forget to refile the interface!"])

(DELETE.INTERFACE

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

    (
UNMARKASCHANGED
 INTERFACE.NAME (
QUOTE
 INTERFACES))
    (
DELDEF.INTERFACE
 INTERFACE.NAME (
QUOTE
 INTERFACES])

(MANIPULATE.INTERFACE

  [LAMBDA (INTERFACE)                                        (* N.H.Briggs " 5-Mar-85 11:04")

                                                             (* DAHJr "31-Mar-84 17:42")

    (DECLARE
 (
GLOBALVARS
 CURRENT.FRAME CURRENT.INTERFACE CURRENT.INTERFACE.WINDOW ITEM.TYPES))
    (
PROG
 (COMMAND.MENU COMMAND INTERFACE.NAME ITYPES FRAME.NAME COLOR.NAME)
          (
SETQ
 COMMAND.MENU (
GET.MANIPULATE.INTERFACE.COMMAND.MENU
))
          (
SETQ
 INTERFACE.NAME (fetch.interface.fieldq INTERFACE NAME))
          (do
 (
SETQ
 COMMAND (
MENU
 COMMAND.MENU))
	      (
TRILLIUM.CLEAR.ALL.PROMPTING
)
	      (
SELECTQ
 COMMAND
		       (NIL)
		       (QUIT (
RETURN
))
		       (
ANALYZE.INTERFACE
 (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE 
							     "Analyzing all frames in interface "
							     INTERFACE.NAME)
					  (
ANALYZE.INTERFACE
 INTERFACE)
					  (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Interface " 
							     INTERFACE.NAME " fully re-analyzed."))
		       (ANALYZE.INTERFACE.WHERE.NECESSARY (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE 
						      "Analyzing unanalyzed frames in interface "
									     INTERFACE.NAME)
							  (
ANALYZE.INTERFACE
 INTERFACE T)
							  (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE 
									     "Interface "
									     INTERFACE.NAME 
									     " fully analyzed."))
		       [RESET.INTERFACE
 (
COND

					  ((
CONFIRM
 (
CONCAT
 "Reset interface " INTERFACE.NAME))
					    (RESET.INTERFACE
 INTERFACE T)
					    (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Interface " 
							       INTERFACE.NAME " reset."]
		       (
HARDCOPY.INTERFACE
 (
HARDCOPY.INTERFACE
 INTERFACE))
		       (
USED.ITEM.TYPES
 (
SETQ
 ITYPES (
USED.ITEM.TYPES
 INTERFACE))
					(TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS 
							   "Item types used in interface "
							   INTERFACE.NAME T)
					(for
 ITYPE in
 ITYPES do
 (TRILLIUM.PRINTOUT ON 
									    TRILLIUM.DESCRIPTIONS 
										   SAME.LINE ITYPE 1))
					)
		       [UNDEFINED.ITEM.TYPES (
SETQ
 ITYPES (
LDIFFERENCE
 (
USED.ITEM.TYPES
 INTERFACE)
								       ITEM.TYPES))
					     (
COND

					       (ITYPES (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS 
						  "Item types used but not defined in interface "
									  INTERFACE.NAME T)
						       (for
 ITYPE in
 ITYPES
							  do
 (TRILLIUM.PRINTOUT ON 
									    TRILLIUM.DESCRIPTIONS 
										SAME.LINE ITYPE 1)))
					       (T (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS 
							      "All item types used in interface "
								     INTERFACE.NAME " are defined"]
		       [SET.FIRST.FRAME (
SETQ
 FRAME.NAME (
ACQUIRE.FRAME.NAME
 INTERFACE))
					(
COND

					  (
FRAME.NAME
 (replace.interface.fieldq INTERFACE FIRST.FRAME 
										FRAME.NAME)
						      (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE 
									 "First frame is now "
									 FRAME.NAME]
		       (
EDIT.COLOR.MAP
 (
EDIT.COLOR.MAP
 INTERFACE))
		       [SET.BACKGROUND.COLOR (
SETQ
 COLOR.NAME (
CREATE.COLOR.NAME
))
					     (
COND

					       (COLOR.NAME (replace.interface.fieldq INTERFACE 
										 BACKGROUND.COLOR 
										     COLOR.NAME)
							   (
DISPLAY.FRAME
 CURRENT.FRAME]
		       (SET.INTERFACE.LOCATION (replace.interface.fieldq INTERFACE REGION
									 (
WINDOWPROP
 
									 CURRENT.INTERFACE.WINDOW
										     (
QUOTE
 REGION)))
					       (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE 
					  "Location of the interface set from the current window"))
		       (INSPECT.MACHINE.STATE (
INSPECTW.REDISPLAY
 (
TRILLIUM.TRACE.MACHINE.WINDOW

								    CURRENT.INTERFACE.WINDOW))
					      NIL)
		       (SET.WINDOW.FROM.INTERFACE (
LOWERLEFTW
 CURRENT.INTERFACE.WINDOW)
						  (
SHAPEW
 CURRENT.INTERFACE.WINDOW (
							    fetch.interface.fieldq INTERFACE REGION)))
		       (CENTER.FRAME.IN.WINDOW (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS 
								  "Command not implemented yet"))
		       (FIT.WINDOW.AROUND.FRAME (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS 
								   "Command not implemented yet"))
		       (ALIGN.FRAME.WITH.WINDOW (
INTERFACE.WINDOW.LOWERLEFT
 INTERFACE 
									 CURRENT.INTERFACE.WINDOW))
		       (
SHOULDNT
])

(RESET.INTERFACE

  [LAMBDA (INTERFACE RESET.ITEMS)                            (* N.H.Briggs " 1-Feb-85 09:39")

    (
RESET.FRAMES
 (fetch.interface.fieldq INTERFACE FRAMES)
		  RESET.ITEMS])
)
(PUTPROPS TRI-RECORD-EDITINTERFACE COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (772 14152 (COPY.INTERFACE 782 . 2481) (INTERACT&FREEZE.INTERFACE 2483 . 4114) (
FREEZE.INTERFACE 4116 . 5365) (CREATE.NEW.INTERFACE 5367 . 7318) (MARK.INTERFACE 7320 . 7807) (
RENAME.INTERFACE 7809 . 9459) (DELETE.INTERFACE 9461 . 9709) (MANIPULATE.INTERFACE 9711 . 13948) (
RESET.INTERFACE 13950 . 14150)))))
STOP