(FILECREATED "19-Nov-84 18:23:56" {AZTEC}<TRILLIUM>BIRTHDAY84>RERELEASE>TRI-EDITINTERFACE.;2 16537
changes to: (FNS COPY.INTERFACE CREATE.NEW.INTERFACE RENAME.INTERFACE)
(VARS TRI-EDITINTERFACECOMS)
previous date: "24-Aug-84 15:46:08" {AZTEC}<TRILLIUM>BIRTHDAY84>RERELEASE>TRI-EDITINTERFACE.;1
)
(* Copyright (c) 1984 by Xerox Corporation)
(PRETTYCOMPRINT TRI-EDITINTERFACECOMS)
(RPAQQ TRI-EDITINTERFACECOMS ((FNS ADD.NEW.INTERFACE COPY.INTERFACE CREATE.NEW.INTERFACE
DELETE.INTERFACE FREEZE.INTERFACE
GET.EDIT.INTERFACE.WINDOW.COMMAND.MENU
GET.MANIPULATE.INTERFACE.COMMAND.MENU INTERACT&FREEZE.INTERFACE
MANIPULATE.INTERFACE MARK.INTERFACE MERGE.INTERFACE
REGISTER.INTERFACE.NAME RENAME.INTERFACE RESET.INTERFACE
UNREGISTER.INTERFACE.NAME)
(VARS (MANIPULATE.INTERFACE.COMMAND.MENU))))
(DEFINEQ
(ADD.NEW.INTERFACE
[LAMBDA (NEW.INTERFACE) (* edited: "15-APR-83 20:44")
(PROG ((NEW.NAME (GET.FIELDQ NEW.INTERFACE NAME INTERFACE)))
(PUTDEF.INTERFACE NEW.NAME (QUOTE INTERFACES)
NEW.INTERFACE)
(REGISTER.INTERFACE.NAME NEW.NAME])
(COPY.INTERFACE
[LAMBDA (INTERFACE) (* kkm "19-Nov-84 12:50")
(PROG (NAME NEW.NAME NEW.INTERFACE FRAMES FIRST.FRAME REGION PROFILE BACKGROUND.COLOR)
(SETQ NAME (GET.FIELDQ INTERFACE NAME INTERFACE))
(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 (GET.FIELDQ INTERFACE FRAMES) collect (COPY.FRAME FRAME)))
(SETQ FIRST.FRAME (GET.FIELDQ INTERFACE FIRST.FRAME))
(SETQ REGION (COPY (GET.FIELDQ INTERFACE REGION)))
(SETQ PROFILE (COPYALL (GET.FIELDQ INTERFACE PROFILE)))
(SETQ BACKGROUND.COLOR (COPYALL (GET.FIELDQ INTERFACE BACKGROUND.COLOR)))
(SETQ NEW.INTERFACE (ITEM.CREATE INTERFACE (NAME NEW.NAME)
(FRAMES FRAMES)
(FIRST.FRAME FIRST.FRAME)
(REGION REGION)
(PROFILE PROFILE)
(BACKGROUND.COLOR BACKGROUND.COLOR)))
(ADD.NEW.INTERFACE NEW.INTERFACE)
(MARK.INTERFACE NEW.INTERFACE T)
(RETURN NEW.NAME])
(CREATE.NEW.INTERFACE
[LAMBDA NIL (* PH "24-Aug-84 09:38")
(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
(ITEM.CREATE INTERFACE (NAME NEW.NAME)
[FRAMES (LIST (ITEM.CREATE FRAME (NAME (QUOTE BEGIN)))
(ITEM.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)))
(ITEM.CREATE FRAME (NAME (QUOTE COLORS))
(ITEMS (LIST (ITEM.CREATE
COLOR
(PLACEMENT (CONS 10 10))
(NAME (QUOTE GRAY))
(COLOR 4)
(REPRESENTATIVE.GRAY 42405]
(FIRST.FRAME (QUOTE BEGIN))
(COLOR.MAP.INTENSITIES NIL)
(BACKGROUND.COLOR (QUOTE WHITE]
(ADD.NEW.INTERFACE NEW.INTERFACE)
(MARK.INTERFACE NEW.INTERFACE T)
(RETURN NEW.NAME])
(DELETE.INTERFACE
[LAMBDA (INTERFACE.NAME) (* edited: "15-APR-83 17:28")
(UNREGISTER.INTERFACE.NAME INTERFACE.NAME)
(UNMARKASCHANGED INTERFACE.NAME (QUOTE INTERFACES))
(DELDEF.INTERFACE INTERFACE.NAME (QUOTE INTERFACES])
(FREEZE.INTERFACE
[LAMBDA (INTERFACE FROZEN.INTERFACE) (* HaKo "31-AUG-83 15:46")
(PROG (FRAME.NAME WAS.FROZEN (FROZEN.FRAMES (CONS)))
(for FRAME in (GET.FIELDQ INTERFACE FRAMES INTERFACE)
do (SETQ FRAME.NAME (GET.FIELDQ FRAME NAME FRAME))
(SETQ WAS.FROZEN (GET.FIELDQ FRAME FROZEN))
(OR WAS.FROZEN (FREEZE.FRAME FRAME INTERFACE))
(TCONC FROZEN.FRAMES (ITEM.CREATE FRAME (NAME FRAME.NAME)
(SUPERFRAMES (COPY (GET.FIELDQ FRAME SUPERFRAMES)))
(ITEMS (COPYALL (GET.FIELDQ FRAME ITEMS)))
(FROZEN T)))
(OR WAS.FROZEN (THAW.FRAME FRAME INTERFACE)))
(SET.FIELDQ FROZEN.INTERFACE FRAMES (CAR FROZEN.FRAMES))
(SET.FIELDQ FROZEN.INTERFACE FIRST.FRAME (GET.FIELDQ INTERFACE FIRST.FRAME))
(SET.FIELDQ FROZEN.INTERFACE REGION (COPY (GET.FIELDQ INTERFACE REGION)))
(SET.FIELDQ FROZEN.INTERFACE PROFILE (COPYALL (GET.FIELDQ INTERFACE PROFILE)))
(RETURN T])
(GET.EDIT.INTERFACE.WINDOW.COMMAND.MENU
[LAMBDA NIL (* DAHJr "19-JAN-83 17:56")
(* USE THIS WHEN CHANGING THE MENU
(SETQ INTERFACE.WINDOW.EDITOR.COMMAND.MENU))
(DECLARE (GLOBALVARS INTERFACE.WINDOW.EDITOR.COMMAND.MENU))
(OR INTERFACE.WINDOW.EDITOR.COMMAND.MENU (SETQ INTERFACE.WINDOW.EDITOR.COMMAND.MENU
(create MENU
ITEMS ←(QUOTE (SET.INTERFACE.LOCATION SET.WINDOW.FROM.INTERFACE
CENTER.FRAME.IN.WINDOW
FIT.WINDOW.AROUND.FRAME
ALIGN.FRAME.WITH.WINDOW QUIT))
TITLE ← "Window/frame alignment commands"
CENTERFLG ← T
CHANGEOFFSETFLG ← T])
(GET.MANIPULATE.INTERFACE.COMMAND.MENU
[LAMBDA NIL (* HaKo " 8-Aug-84 12:39")
(* WHEN MENU CHANGES EVAL: (SETQ
MANIPULATE.INTERFACE.COMMAND.MENU NIL))
(DECLARE (GLOBALVARS MANIPULATE.INTERFACE.COMMAND.MENU))
(OR MANIPULATE.INTERFACE.COMMAND.MENU
(SETQ MANIPULATE.INTERFACE.COMMAND.MENU
(create MENU
ITEMS ←(QUOTE (ANALYZE.INTERFACE ANALYZE.INTERFACE.WHERE.NECESSARY RESET.INTERFACE
HARDCOPY.INTERFACE USED.ITEM.TYPES
UNDEFINED.ITEM.TYPES SET.FIRST.FRAME
SET.BACKGROUND.COLOR EDIT.COLOR.MAP
INSPECT.MACHINE.STATE (" " NIL)
SET.INTERFACE.LOCATION SET.WINDOW.FROM.INTERFACE
CENTER.FRAME.IN.WINDOW FIT.WINDOW.AROUND.FRAME
ALIGN.FRAME.WITH.WINDOW (" " NIL)
QUIT))
TITLE ← "Interface manipulation"
CENTERFLG ← T
CHANGEOFFSETFLG ← T])
(INTERACT&FREEZE.INTERFACE
[LAMBDA NIL (* HaKo "16-Aug-84 14:50")
(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."))
((GET.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 (ITEM.CREATE INTERFACE (NAME FROZEN.INTERFACE.NAME)
(FROZEN T)))
(ADD.NEW.INTERFACE FROZEN.INTERFACE))
(T (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "FREEZE.INTERFACE aborted.")
(RETURN]
((CONFIRM (CONCAT "Overwrite current " FROZEN.INTERFACE.NAME "?"))
(SET.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 " !"])
(MANIPULATE.INTERFACE
[LAMBDA (INTERFACE) (* HaKo "16-Aug-84 14:53")
(* 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 (GET.FIELDQ INTERFACE NAME INTERFACE))
(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 (SET.FIELDQ INTERFACE FIRST.FRAME FRAME.NAME
DIALOG)
(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 (SET.FIELDQ CURRENT.INTERFACE
BACKGROUND.COLOR COLOR.NAME
INTERFACE)
(DISPLAY.FRAME CURRENT.FRAME]
(SET.INTERFACE.LOCATION (SET.FIELDQ CURRENT.INTERFACE REGION
(WINDOWPROP CURRENT.INTERFACE.WINDOW
(QUOTE REGION))
INTERFACE)
(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
(GET.FIELDQ INTERFACE REGION INTERFACE)))
(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])
(MARK.INTERFACE
[LAMBDA (INTERFACE NEW) (* HaKo "16-Aug-84 14:53")
(DECLARE (GLOBALVARS TRILLIUM.MARKFLG))
(PROG ((NAME (GET.FIELDQ INTERFACE NAME INTERFACE))
(TYPE (QUOTE INTERFACES)))
(COND
((NULL TRILLIUM.MARKFLG))
((MARKASCHANGEDP NAME TYPE))
(T (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Marking interface " NAME " as changed")
(MARKASCHANGED NAME TYPE NEW])
(MERGE.INTERFACE
[LAMBDA (WHOLE.INTERFACE PART.INTERFACE) (* HaKo "27-Jul-84 13:29")
(PROG (W.FRAMES W.FRAME FRAME.NAME)
(RESET.INTERFACE PART.INTERFACE T)
(SETQ W.FRAMES (GET.FIELDQ WHOLE.INTERFACE FRAMES))
[for P.FRAME in (GET.FIELDQ PART.INTERFACE FRAMES)
do (SETQ FRAME.NAME (GET.FIELDQ P.FRAME NAME))
(SETQ W.FRAME (FIND.FRAME WHOLE.INTERFACE FRAME.NAME))
(COND
(W.FRAME (* FRAME WITH THAT NAME IS ALREADY THERE;
REPLACE IT)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Frame " FRAME.NAME
" already defined; no change made"))
(T (* NEW FRAME; ADD IT)
(NCONC1 W.FRAMES (COPYALL P.FRAME]
(SORT W.FRAMES (QUOTE SORT.FRAMES])
(REGISTER.INTERFACE.NAME
[LAMBDA (NAME) (* DAHJr "18-JAN-83 14:42")
(DECLARE (GLOBALVARS INTERFACES))
(SETQ INTERFACES (NCONC1 INTERFACES NAME))
(SETQ INTERFACES (INTERSECTION INTERFACES INTERFACES))
(SORT INTERFACES])
(RENAME.INTERFACE
[LAMBDA NIL (* kkm "19-Nov-84 13:43")
(* PH "14-Nov-84 14:15")
(DECLARE (GLOBALVARS CURRENT.INTERFACE.WINDOW))
(PROG (INTERFACE 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))
(SET.FIELDQ INTERFACE NAME NEW.NAME)
(PUTDEF.INTERFACE NEW.NAME (QUOTE INTERFACES)
INTERFACE)
(MARK.INTERFACE INTERFACE 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!"])
(RESET.INTERFACE
[LAMBDA (INTERFACE RESET.ITEMS) (* DAHJr " 5-DEC-83 15:42")
(RESET.FRAMES (GET.FIELDQ INTERFACE FRAMES INTERFACE)
RESET.ITEMS)
(COMPRESS.PROPLIST INTERFACE])
(UNREGISTER.INTERFACE.NAME
[LAMBDA (NAME) (* DAHJr "18-JAN-83 14:49")
(DECLARE (GLOBALVARS INTERFACES))
(SETQ INTERFACES (DREMOVE NAME INTERFACES])
)
(RPAQQ MANIPULATE.INTERFACE.COMMAND.MENU NIL)
(PUTPROPS TRI-EDITINTERFACE COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (869 16398 (ADD.NEW.INTERFACE 879 . 1189) (COPY.INTERFACE 1191 . 2697) (
CREATE.NEW.INTERFACE 2699 . 4384) (DELETE.INTERFACE 4386 . 4666) (FREEZE.INTERFACE 4668 . 5655) (
GET.EDIT.INTERFACE.WINDOW.COMMAND.MENU 5657 . 6391) (GET.MANIPULATE.INTERFACE.COMMAND.MENU 6393 . 7373
) (INTERACT&FREEZE.INTERFACE 7375 . 8930) (MANIPULATE.INTERFACE 8932 . 12992) (MARK.INTERFACE 12994 .
13446) (MERGE.INTERFACE 13448 . 14299) (REGISTER.INTERFACE.NAME 14301 . 14593) (RENAME.INTERFACE 14595
. 15956) (RESET.INTERFACE 15958 . 16181) (UNREGISTER.INTERFACE.NAME 16183 . 16396)))))
STOP