(FILECREATED "20-Nov-84 13:26:40" {AZTEC}<TRILLIUM>BIRTHDAY84>RERELEASE>TRI-EDIT.;3 24569
changes to: (VARS TRILLIUM.PROFILE.DESCRIPTION)
(FNS PROFILE.INIT)
previous date: "19-Nov-84 18:46:28" {AZTEC}<TRILLIUM>BIRTHDAY84>RERELEASE>TRI-EDIT.;2)
(* Copyright (c) 1984 by Xerox Corporation)
(PRETTYCOMPRINT TRI-EDITCOMS)
(RPAQQ TRI-EDITCOMS ((FNS COPY.PTYPE CREATE.PROFILE DEDIT.FORM EDIT.FORM EDIT.LIST EDIT.OBJECT
EDIT.PROFILE EDIT.PTYPE INSTALL.GRID INSTALL.PROFILE MAKE.BUTTON.BITMAP
MAKE.BUTTON.BITMAPS MAKE.CHANGES MARK.PTYPE MODIFY.PTYPE PROFILE.INIT
SHAPE.PLACEMENT TEDIT.LIST.OF.STRINGS TEDIT.STRING TRANSLATE.PLACEMENT)
(VARS BUTTON.BITMAP.BORDER BUTTON.BITMAP.DEPTH BUTTON.BITMAP.EXTRA BUTTON.BITMAP.SPACING
(TRILLIUM.SAVED.VALUE)
(BITMAP.EDITOR.COMMAND.MENU)
(BITMAP.NAME.MENU)
(TRILLIUM.MARKFLG T))
(VARS TRILLIUM.PROFILE.DESCRIPTION)
(BITMAPS UNKNOWN.BITMAP)))
(DEFINEQ
(COPY.PTYPE
[LAMBDA (PTYPE NEW.PTYPE) (* edited: "27-Jun-84 18:34")
(PROG (OLD.DESCRIPTION NEW.DESCRIPTION)
(SETQ OLD.DESCRIPTION (PTYPE.DESCRIPTION PTYPE))
(SETQ NEW.DESCRIPTION (COPYALL OLD.DESCRIPTION))
(SET.FIELDQ NEW.DESCRIPTION NAME NEW.PTYPE)
(REGISTER.PTYPE NEW.PTYPE NEW.DESCRIPTION)
(MARK.PTYPE NEW.PTYPE)
(RETURN NEW.PTYPE])
(CREATE.PROFILE
[LAMBDA NIL (* PH " 4-Sep-84 10:21")
(DECLARE (GLOBALVARS AUDIO.AVAILABLE AUTO.MAKE.CHANGES.FLG COLOR.AVAILABLE CLOSECHATWINDOWFLG
CONFIRM.VALUE.CHANGES DEditLinger DEFAULTPRINTINGHOST
DISPLAY.CHANGED.ITEM.ONLY FULL.MENU FULLPRESSPRINTER KEEP.INTERNAL.EXPRS
REPORT.FRAMES TRILLIUM.FAST.DISPLAY.FLG TRILLIUM.GRID.DX TRILLIUM.GRID.DY
TRILLIUM.GRID.POINTS.FLG TRILLIUM.GRID.X0 TRILLIUM.GRID.Y0
TRILLIUM.KNOWS.LISP TRILLIUM.MARKFLG TRILLIUM.MODE TRILLIUM.MOVE.AFTER.SHAPE
TRILLIUM.TRACE))
(ITEM.CREATE TRILLIUM.PROFILE [ACTION.ON.ERRORS (COND
(TRILLIUM.KNOWS.LISP (QUOTE CAUSE.BREAKS))
(T (QUOTE PRINT.REPORT]
[AUDIO.AVAILABLE (COND
(AUDIO.AVAILABLE (QUOTE YES))
(T (QUOTE NO]
[CHANGE.IMMEDIATELY (COND
(AUTO.MAKE.CHANGES.FLG (QUOTE YES))
(T (QUOTE NO]
[CLOSE.CHAT.WINDOW (COND
(CLOSECHATWINDOWFLG (QUOTE YES))
(T (QUOTE NO]
[CLOSE.DEDIT.WINDOW (COND
(DEditLinger (QUOTE YES))
(T (QUOTE NO]
[COLOR.AVAILABLE (COND
(COLOR.AVAILABLE (QUOTE YES))
(T (QUOTE NO]
[CONFIRM.VALUE.CHANGES (COND
(CONFIRM.VALUE.CHANGES (QUOTE YES))
(T (QUOTE NO]
(DEFAULT.PRINTER DEFAULTPRINTINGHOST)
[DISPLAY.CHANGES (COND
(DISPLAY.CHANGED.ITEM.ONLY (QUOTE CHANGED.ITEM))
(T (QUOTE ALL.ITEMS]
[EDIT.MENU.LENGTH (COND
(FULL.MENU (QUOTE LONG))
(T (QUOTE SHORT]
[FAST.DISPLAY (COND
(TRILLIUM.FAST.DISPLAY.FLG (QUOTE YES))
(T (QUOTE NO]
[GRID.DISPLAY.METHOD (COND
(TRILLIUM.GRID.POINTS.FLG (QUOTE POINTS))
(T (QUOTE LINES]
(GRID.SPEC (create REGION
LEFT ← TRILLIUM.GRID.X0
BOTTOM ← TRILLIUM.GRID.Y0
WIDTH ← TRILLIUM.GRID.DX
HEIGHT ← TRILLIUM.GRID.DY))
[KEEP.INTERNAL.EXPRS (COND
(KEEP.INTERNAL.EXPRS (QUOTE YES))
(T (QUOTE NO]
[MARK.CHANGES (COND
(TRILLIUM.MARKFLG (QUOTE YES))
(T (QUOTE NO]
[REPORT.FRAMES (COND
(REPORT.FRAMES (QUOTE YES))
(T (QUOTE NO]
[SHAPE.ITEM.ACTION (COND
(TRILLIUM.MOVE.AFTER.SHAPE (QUOTE SHAPE.THEN.MOVE))
(T (QUOTE JUST.SHAPE]
(TRILLIUM.TRACE (OR TRILLIUM.TRACE (QUOTE OFF)))
(USER (COND
(TRILLIUM.MODE (QUOTE DESIGNER))
(T (QUOTE OPERATOR])
(DEDIT.FORM
[LAMBDA (FORM) (* DAHJr "22-APR-83 12:13")
(EVAL.IN.TTY.PROCESS (BQUOTE (EDITE , (KWOTE FORM)))
T])
(EDIT.FORM
[LAMBDA (OBJECT) (* DAHJr "22-APR-83 11:32")
(PROG ((TEMP.LIST (COPYALL OBJECT)))
[COND
((NLISTP TEMP.LIST)
(SETQ TEMP.LIST (LIST (QUOTE just:)
TEMP.LIST]
(SETQ TEMP.LIST (EVAL.IN.TTY.PROCESS (LIST (QUOTE EDITE)
(KWOTE TEMP.LIST))
T))
(COND
((NLISTP TEMP.LIST)
(SHOULDNT "Weird returned value in EDIT.FORM"))
((AND (EQ (LENGTH TEMP.LIST)
2)
(EQ (CAR TEMP.LIST)
(QUOTE just:)))
(RETURN (CADR TEMP.LIST)))
(T (RETURN TEMP.LIST])
(EDIT.LIST
[LAMBDA (OBJECT PTYPE) (* edited: " 9-JUN-82 09:46")
(COND
((EQUAL PTYPE (QUOTE (STRING)))
(TEDIT.LIST.OF.STRINGS OBJECT))
(T (EDIT.FORM OBJECT])
(EDIT.OBJECT
[LAMBDA (OBJECT OTYPE PARAMETER.NAME ITEM) (* HaKo "17-Aug-84 14:48")
(DECLARE (GLOBALVARS CURRENT.INTERFACE.WINDOW))
(COND
((ATOM OTYPE)
(EDIT.WINDOW.CREATE OBJECT CURRENT.INTERFACE.WINDOW)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS T
"EDIT.OBJECT CALLED: WHAT WINDOW SHOULD IT DEPEND ON?"))
(T (PROG (EDIT.FN)
(SETQ EDIT.FN (FUNCTION.FOR.PTYPE (CAR OTYPE)
(QUOTE EDIT)))
(RETURN (COND
(EDIT.FN (APPLY* EDIT.FN OTYPE OBJECT PARAMETER.NAME ITEM))
(T (CREATE.OBJECT OTYPE PARAMETER.NAME ITEM])
(EDIT.PROFILE
[LAMBDA (WINDOW) (* DAHJr " 3-AUG-83 15:52")
(DECLARE (GLOBALVARS TRILLIUM.PROFILE TRILLIUM.PROFILE.EDITOR.WINDOW))
(COND
(TRILLIUM.PROFILE.EDITOR.WINDOW (INSPECTW.REDISPLAY TRILLIUM.PROFILE.EDITOR.WINDOW))
(T (SETQ TRILLIUM.PROFILE.EDITOR.WINDOW (PROFILE.EDITOR.CREATE TRILLIUM.PROFILE])
(EDIT.PTYPE
[LAMBDA (PTYPE) (* DAHJr "21-DEC-83 12:23")
(PROG (STARTING.DESCRIPTION NEW.DESCRIPTION)
(SETQ STARTING.DESCRIPTION (PTYPE.DESCRIPTION PTYPE))
(SETQ NEW.DESCRIPTION (COPYALL STARTING.DESCRIPTION))
(SETQ NEW.DESCRIPTION (DEDIT.FORM NEW.DESCRIPTION))
(COND
((NOT (EQUAL NEW.DESCRIPTION STARTING.DESCRIPTION))
(MODIFY.PTYPE PTYPE STARTING.DESCRIPTION NEW.DESCRIPTION)
(RETURN PTYPE))
(T (RETURN])
(INSTALL.GRID
[LAMBDA (FRAME) (* HaKo "16-Aug-84 14:43")
(OBS "Grids no longer part of Trillium")
(PROG (ITEM REGION)
(SETQ ITEM (ACQUIRE.ITEM FRAME "Point out the grid item to be installed" T (QUOTE
GRID.DEFINITION)))
(COND
((NULL ITEM)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot find any item where you pointed; install.grid command aborted"))
(T (SETQ REGION (GET.PARAMQ ITEM REGION GRID.DEFINITION))
(TRILLIUM.GRID.SETUP (fetch (REGION LEFT) of REGION)
(fetch (REGION BOTTOM) of REGION)
(IQUOTIENT (fetch (REGION WIDTH) of REGION)
(GET.PARAMQ ITEM HORIZONTAL.DIVISIONS))
(IQUOTIENT (fetch (REGION HEIGHT) of REGION)
(GET.PARAMQ ITEM VERTICAL.DIVISIONS)))
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Grid as defined by item " (GET.PARAMQ ITEM NAME)
" installed"])
(INSTALL.PROFILE
[LAMBDA (NEWPROFILE) (* kkm "19-Nov-84 15:34")
(DECLARE (GLOBALVARS AUDIO.AVAILABLE AUTO.MAKE.CHANGES.FLG CHATWINDOW COLOR.AVAILABLE
CLOSECHATWINDOWFLG COMPILE.ON.LOAD CONFIRM.VALUE.CHANGES DEditLinger
DEditWindow DEFAULTPRINTINGHOST DISPLAY.CHANGED.ITEM.ONLY
FRAME.EDITOR.COMMAND.MENU FRAME.NAME.MENU FULL.MENU ITEM.TYPE.MENU
KEEP.INTERNAL.EXPRS REPORT.FRAMES TRILLIUM.FAST.DISPLAY.FLG
TRILLIUM.KNOWS.LISP TRILLIUM.MARKFLG TRILLIUM.MODE TRILLIUM.MOVE.AFTER.SHAPE)
)
(SETQ TRILLIUM.MODE (SELECTQ (GET.PARAMQ NEWPROFILE USER)
(DESIGNER T)
NIL))
(PROG ((TRACE.METHOD (GET.PARAMQ NEWPROFILE TRILLIUM.TRACE)))
(TRILLIUM.TRACE.SETUP (SELECTQ TRACE.METHOD
(YES (QUOTE PAIRS))
((NO NIL)
(QUOTE OFF))
TRACE.METHOD)))
(SETQ DISPLAY.CHANGED.ITEM.ONLY (SELECTQ (GET.PARAMQ NEWPROFILE DISPLAY.CHANGES)
(CHANGED.ITEM T)
NIL))
(SETQ CONFIRM.VALUE.CHANGES (SELECTQ (GET.PARAMQ NEWPROFILE CONFIRM.VALUE.CHANGES)
(YES T)
NIL))
(SETQ CLOSECHATWINDOWFLG (SELECTQ (GET.PARAMQ NEWPROFILE CLOSE.CHAT.WINDOW)
(YES T)
NIL))
(AND (BOUNDP (QUOTE CHATWINDOW))
CLOSECHATWINDOWFLG
(CLOSEW CHATWINDOW))
(SETQ COMPILE.ON.LOAD (SELECTQ (GET.PARAMQ NEWPROFILE COMPILE.ON.LOAD)
(YES T)
NIL))
(SETQ DEditLinger (NOT (SELECTQ (GET.PARAMQ NEWPROFILE CLOSE.DEDIT.WINDOW)
(YES T)
NIL)))
(AND (BOUNDP (QUOTE DEditWindow))
(NOT DEditLinger)
(CLOSEW DEditWindow))
(SETQ DEFAULTPRINTINGHOST (GET.PARAMQ NEWPROFILE DEFAULT.PRINTER))
(SETQ AUTO.MAKE.CHANGES.FLG (SELECTQ (GET.PARAMQ NEWPROFILE CHANGE.IMMEDIATELY)
(YES T)
NIL))
(SETQ FRAME.NAME.MENU) (* TRIGGERS RECOMPUTING OF THE MENU)
(SETQ ITEM.TYPE.MENU) (* TRIGGERS RECOMPUTING OF THE MENU)
(SETQ TRILLIUM.MARKFLG (SELECTQ (GET.PARAMQ NEWPROFILE MARK.CHANGES)
(YES T)
NIL))
(SETQ REPORT.FRAMES (SELECTQ (GET.PARAMQ NEWPROFILE REPORT.FRAMES)
(YES T)
NIL))
(SETQ FULL.MENU (SELECTQ (GET.PARAMQ NEWPROFILE EDIT.MENU.LENGTH)
(LONG T)
NIL))
(SETQ FRAME.EDITOR.COMMAND.MENU)
(SETQ TRILLIUM.FAST.DISPLAY.FLG (SELECTQ (GET.PARAMQ NEWPROFILE FAST.DISPLAY)
(YES T)
NIL))
(SETQ TRILLIUM.MOVE.AFTER.SHAPE (SELECTQ (GET.PARAMQ NEWPROFILE SHAPE.ITEM.ACTION)
(SHAPE.THEN.MOVE T)
NIL))
(PROG ((GRID.SPEC (GET.PARAMQ NEWPROFILE GRID.SPEC)))
(TRILLIUM.GRID.SETUP (fetch (REGION LEFT) of GRID.SPEC)
(fetch (REGION BOTTOM) of GRID.SPEC)
(fetch (REGION WIDTH) of GRID.SPEC)
(fetch (REGION HEIGHT) of GRID.SPEC)
(GET.PARAMQ NEWPROFILE GRID.DISPLAY.METHOD)))
(SETQ KEEP.INTERNAL.EXPRS (SELECTQ (GET.PARAMQ NEWPROFILE KEEP.INTERNAL.EXPRS)
(YES T)
NIL))
(SETQ TRILLIUM.KNOWS.LISP (SELECTQ (GET.PARAMQ NEWPROFILE ACTION.ON.ERRORS)
(CAUSE.BREAKS T)
NIL))
(SETQ AUDIO.AVAILABLE (SELECTQ (GET.PARAMQ NEWPROFILE AUDIO.AVAILABLE)
(YES T)
NIL))
(SETQ COLOR.AVAILABLE (SELECTQ (GET.PARAMQ NEWPROFILE COLOR.AVAILABLE)
(YES T)
NIL))
(COND
((AND COLOR.AVAILABLE (LOAD? (TRILLIUM.FILENAME (QUOTE TRI-COLOR)
T)))
(COLOR.INIT])
(MAKE.BUTTON.BITMAP
[LAMBDA (WIDTH HEIGHT DX DY BORDER SPACING) (* DAHJr "16-MAR-81 10:13")
(DECLARE (GLOBALVARS TRILLIUM.GRID.DX TRILLIUM.GRID.DY))
(PROG (OLDDS X Y LX LY BM DS TX TY)
(OR WIDTH (SETQ WIDTH 1))
(OR HEIGHT (SETQ HEIGHT 1))
(OR DX (SETQ DX 5))
(OR DY (SETQ DY DX))
(OR BORDER (SETQ BORDER 2))
(OR SPACING (SETQ SPACING 1))
(SETQ X (XDIST WIDTH))
(SETQ LX (SUB1 X))
(SETQ Y (YDIST HEIGHT))
(SETQ LY (IDIFFERENCE 1 Y))
(SETQ OLDDS (CURRENTDISPLAYSTREAM))
(SETQ BM (BITMAPCREATE (IPLUS X DX SPACING)
(IPLUS Y DY SPACING)))
(SETQ DS (DSPCREATE))
(CURRENTDISPLAYSTREAM DS)
(DSPDESTINATION BM)
(DSPRESET)
(SETQ TY (IPLUS Y DY SPACING -1))
(for I to BORDER
do (MOVETO 0 TY)
(RELDRAWTO LX 0)
(SETQ TY (SUB1 TY)))
(SETQ TY (IPLUS BORDER SPACING DY -1))
(for I to BORDER
do (MOVETO 0 TY)
(RELDRAWTO (COND
((ZEROP SPACING)
(IPLUS (IDIFFERENCE LX BORDER)
I -1))
(T LX))
0)
(SETQ TY (SUB1 TY)))
(SETQ TY (IPLUS Y DY SPACING -1))
(SETQ TX 0)
(for I to BORDER
do (MOVETO TX TY)
(RELDRAWTO 0 LY)
(SETQ TX (ADD1 TX)))
(SETQ TX (IDIFFERENCE X BORDER))
(for I to BORDER
do (MOVETO TX TY)
(RELDRAWTO 0 (COND
((ZEROP SPACING)
(IPLUS LY BORDER (IMINUS I)
1))
(T LY)))
(SETQ TX (ADD1 TX)))
(SETQ TX 0)
(SETQ TY (SUB1 DY))
(for I to DY
do (MOVETO TX TY)
(RELDRAWTO LX 0)
(SETQ TX (ADD1 TX))
(SETQ TY (SUB1 TY)))
(SETQ TX (IPLUS X SPACING))
(SETQ TY (IPLUS Y DY SPACING -1))
(for I to DX
do (MOVETO TX TY)
(RELDRAWTO 0 LY)
(SETQ TX (ADD1 TX))
(SETQ TY (SUB1 TY)))
(CURRENTDISPLAYSTREAM OLDDS)
(RETURN BM])
(MAKE.BUTTON.BITMAPS
[LAMBDA (DEPTH BORDER SPACING) (* DAHJr "15-NOV-81 11:51")
(DECLARE (GLOBALVARS BUTTON.BITMAP.BORDER BUTTON.BITMAP.DEPTH BUTTON.BITMAP.EXTRA
BUTTON.BITMAP.SPACING EXTERNAL.BUTTON.BITMAP OFFPAGE.BUTTON.BITMAP
SIMPLE.BUTTON.BITMAP))
(OR DEPTH (SETQ DEPTH (OR BUTTON.BITMAP.DEPTH 2)))
(OR BORDER (SETQ BORDER (OR BUTTON.BITMAP.BORDER 2)))
(OR SPACING (SETQ SPACING (OR BUTTON.BITMAP.SPACING 1)))
(SETQ BUTTON.BITMAP.DEPTH DEPTH)
(SETQ BUTTON.BITMAP.BORDER BORDER)
(SETQ BUTTON.BITMAP.SPACING SPACING)
(SETQ BUTTON.BITMAP.EXTRA (IPLUS BUTTON.BITMAP.SPACING BUTTON.BITMAP.DEPTH))
(SETQ SIMPLE.BUTTON.BITMAP (MAKE.BUTTON.BITMAP 2 2 DEPTH DEPTH BORDER SPACING))
(SETQ OFFPAGE.BUTTON.BITMAP (MAKE.BUTTON.BITMAP 4 2 DEPTH DEPTH BORDER SPACING))
(SETQ EXTERNAL.BUTTON.BITMAP (MAKE.BUTTON.BITMAP 4 4 DEPTH DEPTH BORDER SPACING])
(MAKE.CHANGES
[LAMBDA (ITEM PATTERN) (* HaKo "27-Jul-84 17:04")
(PROG (OLD.ITEM)
(SETQ OLD.ITEM (APPEND ITEM NIL))
[for SPEC in PATTERN bind (FIELD FORM)
do (SETQ FIELD (CAR SPEC))
[COND
((EQ FIELD (QUOTE TYPE))
(SETQ FIELD (QUOTE \TYPE]
(SETQ FORM (CADR SPEC))
(SET.PARAM ITEM FIELD (COND
((LISTP FORM)
(EVAL.WITHIN.ITEM FORM OLD.ITEM))
(T FORM]
(RETURN NIL])
(MARK.PTYPE
[LAMBDA (PTYPE NEW) (* HaKo "16-Aug-84 14:43")
(DECLARE (GLOBALVARS TRILLIUM.MARKFLG))
(PROG ((TYPE (QUOTE PTYPES)))
(COND
((NULL TRILLIUM.MARKFLG))
((MARKASCHANGEDP PTYPE TYPE))
(T (TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Marking PType " PTYPE " as changed")
(MARKASCHANGED PTYPE TYPE NEW])
(MODIFY.PTYPE
[LAMBDA (PTYPE OLD.DESCRIPTION NEW.DESCRIPTION) (* DAHJr "21-DEC-83 12:23")
(THINKING (UNREGISTER.PTYPE PTYPE)
(REGISTER.PTYPE PTYPE NEW.DESCRIPTION)
(MARK.PTYPE PTYPE])
(PROFILE.INIT
[LAMBDA (DONT.LOAD.PROFILE.FLG) (* edited: "20-Nov-84 10:50")
(* DAHJr " 3-AUG-83 16:00")
(DECLARE (GLOBALVARS LOGINHOST/DIR TRILLIUM.PROFILE TRILLIUM.PROFILE.DESCRIPTION
TRILLIUM.PROFILE.EDITOR.WINDOW))
(PROG (FILE)
(SET.ITEM.TYPE.DESCRIPTION (QUOTE TRILLIUM.PROFILE)
TRILLIUM.PROFILE.DESCRIPTION)
(INSTALL.ITEM.TYPE.DEFAULTS (QUOTE TRILLIUM.PROFILE)
TRILLIUM.PROFILE.DESCRIPTION)
[SET.ANALYSISFN (QUOTE TRILLIUM.PROFILE)
(FUNCTION (LAMBDA (PROFILE)
(SET.FIELDQ PROFILE BOUNDING.BOX (CREATEREGION 0 0 16 16]
[SETQ FILE (COND
((NOT DONT.LOAD.PROFILE.FLG)
(OR (INFILEP (QUOTE TRILLIUM-PROFILE))
(INFILEP (PACK* LOGINHOST/DIR (QUOTE TRILLIUM-PROFILE]
[COND
(FILE (LOAD FILE)
(SET.FIELDQ TRILLIUM.PROFILE FULL.FILE.NAME (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
FILE)))
(T (SETQ TRILLIUM.PROFILE (CREATE.PROFILE]
(INSTALL.PROFILE TRILLIUM.PROFILE)
(TRILLIUM.EVAL (GET.PARAMQ TRILLIUM.PROFILE TRILLIUM.INITIALIZATION TRILLIUM.PROFILE))
(SETQ TRILLIUM.PROFILE.EDITOR.WINDOW NIL])
(SHAPE.PLACEMENT
[LAMBDA (ITEM DELTA.LEFT DELTA.BOTTOM DELTA.WIDTH DELTA.HEIGHT)
(* HaKo "13-Aug-84 12:08")
(PROG (ITYPE DESCRIPTION PTYPE PNAME OLDPVAL NEWPVAL)
(SETQ ITYPE (ITEM.TYPE ITEM))
(SETQ DESCRIPTION (ITEM.TYPE.DESCRIPTION ITYPE))
(for PARAMETER in (GET.FIELDQ DESCRIPTION PARAMETERS)
do (SETQ PTYPE (GET.FIELDQ PARAMETER TYPE))
(if [AND (LISTP PTYPE)
(OR (EQ (CAR PTYPE)
(QUOTE REGION))
(EQ (CAR PTYPE)
(QUOTE POSITION]
then (SETQ PNAME (GET.FIELDQ PARAMETER NAME))
(SETQ OLDPVAL (GET.PARAM ITEM PNAME))
[COND
[(EQ (CAR PTYPE)
(QUOTE REGION))
(SETQ NEWPVAL (create REGION
LEFT ←(IPLUS DELTA.LEFT (fetch (REGION LEFT)
of OLDPVAL))
BOTTOM ←(IPLUS DELTA.BOTTOM (fetch (REGION BOTTOM)
of OLDPVAL))
WIDTH ←(IPLUS DELTA.WIDTH (fetch (REGION WIDTH)
of OLDPVAL))
HEIGHT ←(IPLUS DELTA.HEIGHT (fetch (REGION HEIGHT)
of OLDPVAL]
(T (SETQ NEWPVAL (create POSITION
XCOORD ←(IPLUS DELTA.LEFT (fetch (POSITION XCOORD)
of OLDPVAL))
YCOORD ←(IPLUS DELTA.BOTTOM (fetch (POSITION
YCOORD)
of OLDPVAL]
(SET.PARAM ITEM PNAME NEWPVAL])
(TEDIT.LIST.OF.STRINGS
[LAMBDA (LST) (* DAHJr "22-APR-83 11:40")
(PROG ((STR (CAR LST))
NEW.LST STPOS ENDPOS)
(for S in (CDR LST) do (SETQ STR (CONCAT STR "
" S)))
(SETQ STR (TEDIT.STRING STR))
(SETQ STPOS 1)
[SETQ NEW.LST (while (SETQ ENDPOS (STRPOS "
" STR STPOS)) collect (PROG1 (SUBSTRING STR STPOS (SUB1 ENDPOS))
(SETQ STPOS (ADD1 ENDPOS]
(RETURN (NCONC1 NEW.LST (SUBSTRING STR STPOS (NCHARS STR])
(TEDIT.STRING
[LAMBDA (STRING) (* T.Bigham "12-Nov-84 11:03")
(* this may not be needed in Carol. In harmony, this makes tedit put the value into the item editor without the
confirmation that always pops up when changes have been made without saving the file.)
(DECLARE (GLOBALVARS TEDIT.DEFAULT.WINDOW))
(EVAL.IN.TTY.PROCESS [BQUOTE (TEDIT , (KWOTE STRING)
, TEDIT.DEFAULT.WINDOW T (QUOTE (QUITFN T]
T])
(TRANSLATE.PLACEMENT
[LAMBDA (ITEM DELTA.POSITION/DELTA.XCOORD DELTA.YCOORD) (* HaKo "13-Aug-84 10:13")
(PROG (DX DY ITYPE DESCRIPTION PTYPE TRANSLATE.FN PNAME OLDPVAL NEWPVAL)
(SETQ DX (COND
((LISTP DELTA.POSITION/DELTA.XCOORD)
(CAR DELTA.POSITION/DELTA.XCOORD))
(T DELTA.POSITION/DELTA.XCOORD)))
(SETQ DY (COND
((LISTP DELTA.POSITION/DELTA.XCOORD)
(CDR DELTA.POSITION/DELTA.XCOORD))
(T DELTA.YCOORD)))
(SETQ ITYPE (ITEM.TYPE ITEM))
(SETQ DESCRIPTION (ITEM.TYPE.DESCRIPTION ITYPE))
(for PARAMETER in (GET.FIELDQ DESCRIPTION PARAMETERS)
when [AND (SETQ PTYPE (LISTP (GET.FIELDQ PARAMETER TYPE)))
(SETQ TRANSLATE.FN (FUNCTION.FOR.PTYPE (CAR PTYPE)
(QUOTE TRANSLATE]
do (SETQ PNAME (GET.FIELDQ PARAMETER NAME))
(SETQ OLDPVAL (GET.PARAM ITEM PNAME))
(SETQ NEWPVAL (APPLY* TRANSLATE.FN OLDPVAL DX DY))
(SET.PARAM ITEM PNAME NEWPVAL])
)
(RPAQQ BUTTON.BITMAP.BORDER 3)
(RPAQQ BUTTON.BITMAP.DEPTH 5)
(RPAQQ BUTTON.BITMAP.EXTRA 6)
(RPAQQ BUTTON.BITMAP.SPACING 1)
(RPAQQ TRILLIUM.SAVED.VALUE NIL)
(RPAQQ BITMAP.EDITOR.COMMAND.MENU NIL)
(RPAQQ BITMAP.NAME.MENU NIL)
(RPAQQ TRILLIUM.MARKFLG T)
(RPAQQ TRILLIUM.PROFILE.DESCRIPTION (\TYPE ITEM.TYPE NAME TRILLIUM.PROFILE COMMENT
"Generic profile item type"
KIND INITIALIZATION PARAMETERS
((\TYPE PARAMETER NAME ACTION.ON.ERRORS TYPE
(ONEOF (PRINT.REPORT CAUSE.BREAKS))
DEFAULT PRINT.REPORT COMMENT
"for those who know lisp")
(\TYPE PARAMETER NAME AUDIO.AVAILABLE TYPE
(ONEOF (YES NO))
DEFAULT NO COMMENT "Audio available? ")
(\TYPE PARAMETER NAME CHANGE.IMMEDIATELY TYPE
(ONEOF (YES NO))
DEFAULT NO COMMENT
"Changes made in item editor take effect immediately")
(\TYPE PARAMETER NAME CLOSE.CHAT.WINDOW TYPE
(ONEOF (YES NO))
DEFAULT NO COMMENT
"Close Chat window when you quit Chatting")
(\TYPE PARAMETER NAME CLOSE.DEDIT.WINDOW TYPE
(ONEOF (YES NO))
DEFAULT NO COMMENT "Close DEdit window when done")
(\TYPE PARAMETER NAME COLOR.AVAILABLE TYPE
(ONEOF (YES NO))
DEFAULT NO COMMENT "Trillium color switch")
(\TYPE PARAMETER NAME COMPILE.ON.LOAD TYPE
(ONEOF (YES NO))
DEFAULT YES COMMENT
"Whether or not to compile the itemtype functions on loading")
(\TYPE PARAMETER NAME CONFIRM.VALUE.CHANGES TYPE
(ONEOF (YES NO))
DEFAULT YES COMMENT
"Changes to values of items require confirmation")
(\TYPE PARAMETER NAME DEFAULT.PRINTER TYPE (CONSTANT)
DEFAULT NIL COMMENT
"Name of printer - interpress printer names should have a ':' in them.")
(\TYPE PARAMETER NAME DISPLAY.CHANGES TYPE
(ONEOF (CHANGED.ITEM ALL.ITEMS))
DEFAULT ALL.ITEMS COMMENT
"Screen manipulation while designing")
(\TYPE PARAMETER NAME EDIT.MENU.LENGTH TYPE
(ONEOF (SHORT LONG))
DEFAULT SHORT COMMENT
"Controls commands on frame edit menu")
(\TYPE PARAMETER NAME FAST.DISPLAY TYPE
(ONEOF (YES NO))
DEFAULT YES COMMENT
"Fast frame display by switching off screen")
(\TYPE PARAMETER NAME FRAME.CLASSES TYPE (FRAME.CLASSES)
DEFAULT NIL COMMENT "classification of frames")
(\TYPE PARAMETER NAME GRID.DISPLAY.METHOD TYPE
(ONEOF (LINES POINTS))
DEFAULT LINES COMMENT
"display grid (CTRL key) using lines or points")
(\TYPE PARAMETER NAME GRID.SPEC TYPE (REGION)
DEFAULT
(0 0 17 17)
COMMENT "origin and size of grid")
(\TYPE PARAMETER NAME ITEM.TYPE.CLASSES TYPE (
ITYPE.CLASSES)
DEFAULT NIL COMMENT "classification of item types")
(\TYPE PARAMETER NAME KEEP.INTERNAL.EXPRS TYPE
(ONEOF (YES NO))
DEFAULT NO COMMENT "for debugging")
(\TYPE PARAMETER NAME MARK.CHANGES TYPE
(ONEOF (YES NO))
DEFAULT YES COMMENT
"mark changes to dialogs and item types")
(\TYPE PARAMETER NAME REPORT.FRAMES TYPE
(ONEOF (YES NO))
DEFAULT YES COMMENT
"report frame activity in prompt window")
(\TYPE PARAMETER NAME SHAPE.ITEM.ACTION TYPE
(ONEOF (SHAPE.THEN.MOVE JUST.SHAPE))
DEFAULT JUST.SHAPE COMMENT
"Editing action on shaping an item")
(\TYPE PARAMETER NAME TRILLIUM.INITIALIZATION TYPE
(FORM)
DEFAULT NIL COMMENT
"Form to be evaluated upon initializing Trillium")
(\TYPE PARAMETER NAME TRILLIUM.TRACE TYPE
(ONEOF (OFF PAIRS PAIRS+LINE PAIRS+TRAJECTORY))
DEFAULT OFF COMMENT "Trace changes for debugging")
(\TYPE PARAMETER NAME USER TYPE (ONEOF (DESIGNER OPERATOR)
)
DEFAULT DESIGNER COMMENT
"For controlling interactions"))
SUBITEM.SPECS NIL OTHER NIL))
(RPAQ UNKNOWN.BITMAP (READBITMAP))
(40 40
"OOOOOOOOOO@@"
"OOOOOOOOOO@@"
"L@@@@@@@@C@@"
"L@@@OO@@@C@@"
"L@@COOL@@C@@"
"L@@GOON@@C@@"
"L@@OHAO@@C@@"
"L@AN@@GH@C@@"
"L@AL@@CH@C@@"
"L@AL@@CH@C@@"
"L@AL@@CH@C@@"
"L@AL@@CH@C@@"
"L@AL@@CH@C@@"
"L@@@@@GH@C@@"
"L@@@@@O@@C@@"
"L@@@@CN@@C@@"
"L@@@@OL@@C@@"
"L@@@AOH@@C@@"
"L@@@CN@@@C@@"
"L@@@CH@@@C@@"
"L@@@CH@@@C@@"
"L@@@CH@@@C@@"
"L@@@CH@@@C@@"
"L@@@CH@@@C@@"
"L@@@CH@@@C@@"
"L@@@CH@@@C@@"
"L@@@CH@@@C@@"
"L@@@CH@@@C@@"
"L@@@@@@@@C@@"
"L@@@@@@@@C@@"
"L@@@CH@@@C@@"
"L@@@GL@@@C@@"
"L@@@GL@@@C@@"
"L@@@GL@@@C@@"
"L@@@CH@@@C@@"
"L@@@@@@@@C@@"
"L@@@@@@@@C@@"
"L@@@@@@@@C@@"
"OOOOOOOOOO@@"
"OOOOOOOOOO@@")
(PUTPROPS TRI-EDIT COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (955 19728 (COPY.PTYPE 965 . 1411) (CREATE.PROFILE 1413 . 3801) (DEDIT.FORM 3803 . 3976)
(EDIT.FORM 3978 . 4593) (EDIT.LIST 4595 . 4822) (EDIT.OBJECT 4824 . 5416) (EDIT.PROFILE 5418 . 5796)
(EDIT.PTYPE 5798 . 6332) (INSTALL.GRID 6334 . 7319) (INSTALL.PROFILE 7321 . 10804) (MAKE.BUTTON.BITMAP
10806 . 12887) (MAKE.BUTTON.BITMAPS 12889 . 13835) (MAKE.CHANGES 13837 . 14341) (MARK.PTYPE 14343 .
14737) (MODIFY.PTYPE 14739 . 14965) (PROFILE.INIT 14967 . 16268) (SHAPE.PLACEMENT 16270 . 17687) (
TEDIT.LIST.OF.STRINGS 17689 . 18236) (TEDIT.STRING 18238 . 18740) (TRANSLATE.PLACEMENT 18742 . 19726))
)))
STOP