(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "15-Sep-87 11:34:17" |{MCS:MCS:STANFORD}<LANE>SKETCHTALK.;24| 19883
changes to%: (VARS SKETCHTALKCOMS)
previous date%: "14-Sep-87 16:23:52" |{MCS:MCS:STANFORD}<LANE>SKETCHTALK.;23|)
(* "
Copyright (c) 1987 by Stanford University. All rights reserved.
")
(PRETTYCOMPRINT SKETCHTALKCOMS)
(RPAQQ SKETCHTALKCOMS ((* TALK Sketch Interface)
(FNS TALK.SKETCH.SERVER TALK.SKETCH.DISPLAY TALK.SKETCH.LISTEN)
(FNS TALK.SKETCH.FIND.ELEMENT TALK.SKETCH.FIND.SYMBOLS)
(* Sketch Viewer Control Properties)
(FNS TALK.SKETCH.WHENADDEDFN TALK.SKETCH.WHENCHANGEDFN
TALK.SKETCH.WHENDELETEDFN TALK.SKETCH.WHENMOVEDFN TALK.SKETCH.PREMOVEFN)
(FNS TALK.SKETCH.WHENGROUPEDFN TALK.SKETCH.WHENUNGROUPEDFN)
(VARS TALK.TO.SKETCH.PROPS)
(* TALK Sketch Actions)
(FNS TALK.SKETCH.ADD.ELEMENT TALK.SKETCH.CHANGE.ELEMENT
TALK.SKETCH.DELETE.ELEMENTS TALK.SKETCH.MOVE.ELEMENTS
TALK.SKETCH.POSITION.ELEMENTS)
(VARS TALK.SKETCH.ACTIONS)
(* TALK Sketch Data)
(VARS TALK.SKETCH.DELETE.ITEMS)
(INITVARS TALK.SKETCH.TRACK)
(FILES TALK SKETCH)
(ADDVARS (GAP.SERVICETYPES (7 Sketch TALK.SKETCH.SERVER)))
(APPENDVARS (TALK.SERVICETYPES (Sketch [LAMBDA NIL (FGETD 'SKETCH]
TALK.SKETCH.DISPLAY TALK.SKETCH.LISTEN))
)
(GLOBALVARS TALK.SKETCH.ACTIONS TALK.TO.SKETCH.PROPS TALK.SKETCH.DELETE.ITEMS
TALK.SKETCH.TRACK)
(* Sketch Bug Fixes)
(FNS TALK.SKETCH.NOP)
(P (CHANGENAME '\SK.PUT.FONT 'SK.INSURE.TEXT 'TALK.SKETCH.NOP))
(ADVISE BITMAPELT.CHANGEFN SK.IMAGEOBJ.CHANGEFN)))
(* TALK Sketch Interface)
(DEFINEQ
(TALK.SKETCH.SERVER
[LAMBDA (INPUTSTREAM PROGRAM PROCEDURE PARAMETERS TRANSPORT WAITTIME CREDENTIALS VERIFIER)
(* ; "Edited 23-Jun-87 07:40 by cdl")
(LET ((USER (TALK.NS.CREDENTIALS CREDENTIALS))
(ADDRESS (SPP.DESTADDRESS INPUTSTREAM)))
(with NSADDRESS ADDRESS (SETQ NSSOCKET 0))
(if (with TALK.SERVICETYPE (ASSOC 'Sketch TALK.SERVICETYPES)
(APPLY* TALK.SERVICEP))
then (if (OR TALK.GAG (NOT (TALK.ANSWER USER 'Sketch 'NS ADDRESS)))
then '(ABORT noAnswerOrBusy)
else (COURIER.RETURN INPUTSTREAM PROGRAM PROCEDURE TALK.GAP.HANDLE)
(TALK.PROCESS INPUTSTREAM (SPPOUTPUTSTREAM INPUTSTREAM)
'Sketch
'NS
'SERVER USER))
else '(ABORT serviceNotFound])
(TALK.SKETCH.DISPLAY
[LAMBDA (MAINWINDOW WINDOW INPUTSTREAM OUTPUTSTREAM PROTOCOL USER)
(* ; "Edited 23-Jun-87 07:57 by cdl")
(LET (MENUWINDOW)
(SKETCH NIL MAINWINDOW)
(SKETCH NIL WINDOW)
(DETACHWINDOW (SETQ MENUWINDOW (WINDOWPROP WINDOW 'SKETCHFIXEDMENU NIL)))
(CLOSEW MENUWINDOW)
(DETACHWINDOW (SETQ MENUWINDOW (WINDOWPROP MAINWINDOW 'SKETCHFIXEDMENU NIL)))
(CLOSEW MENUWINDOW)
(WINDOWPROP MAINWINDOW 'SKETCHFIXEDMENU (ATTACHMENU
(LET ((ITEMS (SKETCH.COMMANDMENU.ITEMS NIL T)))
(for KEY in TALK.SKETCH.DELETE.ITEMS
do (SETQ ITEMS (DREMOVE (SASSOC KEY ITEMS)
ITEMS)))
(SKETCH.COMMANDMENU ITEMS))
MAINWINDOW
'RIGHT
'TOP))
(WINDOWPROP MAINWINDOW 'SKETCHPOPUPMENU NIL)
(WINDOWPROP WINDOW 'SKETCHPOPUPMENU NIL)
(for PAIR on TALK.TO.SKETCH.PROPS do (PUTSKETCHPROP MAINWINDOW (CAR PAIR)
(CADR PAIR)))
(PUTSKETCHPROP MAINWINDOW 'TALK OUTPUTSTREAM)
(* Still need to combine the two prompt windows into one)
(WINDOWPROP MAINWINDOW 'SCROLLFN NIL)
(WINDOWPROP WINDOW 'SCROLLFN NIL)
(PUTWINDOWPROP MAINWINDOW 'DONTQUERYCHANGES T)
(PUTWINDOWPROP WINDOW 'DONTQUERYCHANGES T)
(RPLACA (CDAR (INSURE.SKETCH MAINWINDOW))
(CONCAT "Talk with " USER))
(WINDOWDELPROP WINDOW 'SHRINKFN 'SK.SHRINK.ICONCREATE)
(WINDOWDELPROP WINDOW 'SHRINKFN 'SK.RETURN.TTY])
(TALK.SKETCH.LISTEN
[LAMBDA (MAINWINDOW WINDOW INPUTSTREAM OUTPUTSTREAM PROTOCOL)
(* ; "Edited 23-Jun-87 07:47 by cdl")
(PROG [OPERATION (EVENTFN (with TALK.PROTOCOLTYPE (ASSOC PROTOCOL TALK.PROTOCOLTYPES)
TALK.EVENTFN))
(SKETCH (INSURE.SKETCH (MAINWINDOW WINDOW]
(DECLARE (GLOBALVARS TALK.CLOSED.STRING))
(while (OPENWP WINDOW) do (APPLY* EVENTFN INPUTSTREAM OUTPUTSTREAM)
(if (NOT (AND (OPENP INPUTSTREAM)
(OPENP OUTPUTSTREAM)))
then (RETURN)) (* TALK.FLASH.CARET WINDOW POSITION
(QUOTE OFF))
[SELCHARQ (PEEKCCODE INPUTSTREAM)
(↑G (TALK.RINGBELLS WINDOW))
(PROGN (SETQ OPERATION (HREAD INPUTSTREAM))
(APPLY (CADR (ASSOC (CAR OPERATION)
TALK.SKETCH.ACTIONS))
(CONS WINDOW (CDR OPERATION]
(BIN INPUTSTREAM) (* TALK.FLASH.CARET WINDOW POSITION
(QUOTE ON)))
(RPLACA (CDAR SKETCH)
(CONCAT (CADAR SKETCH)
TALK.CLOSED.STRING))
(PUTSKETCHPROP MAINWINDOW 'TALK NIL])
)
(DEFINEQ
(TALK.SKETCH.FIND.ELEMENT
[LAMBDA (SKETCH SYMBOLS) (* ; "Edited 18-Jun-87 09:21 by cdl")
(DECLARE (SPECVARS SYMBOLS))
(SKETCH.LIST.OF.ELEMENTS SKETCH (FUNCTION (LAMBDA (ELEMENT)
(EQMEMB (GETSKETCHELEMENTPROP ELEMENT 'TALK)
SYMBOLS])
(TALK.SKETCH.FIND.SYMBOLS
[LAMBDA (SKETCH ELEMENTS) (* ; "Edited 18-Jun-87 11:11 by cdl")
(for ELEMENT in ELEMENTS collect (GETSKETCHELEMENTPROP ELEMENT 'TALK])
)
(* Sketch Viewer Control Properties)
(DEFINEQ
(TALK.SKETCH.WHENADDEDFN
[LAMBDA (VIEWER ELEMENT) (* ; "Edited 23-Jun-87 07:48 by cdl")
(LET [(STREAM (GETSKETCHPROP VIEWER 'TALK]
(if (AND STREAM (OPENP STREAM))
then (PROG [(SCRATCHSTREAM (OPENSTREAM '{NODIRCORE} 'BOTH]
(PUTSKETCHELEMENTPROP ELEMENT 'TALK (GENSYM 'TALK))
(HPRINT `(ADD ,ELEMENT) SCRATCHSTREAM)
(SETFILEPTR SCRATCHSTREAM 0)
(COPYBYTES SCRATCHSTREAM STREAM)
(FORCEOUTPUT STREAM)
(CLOSEF? SCRATCHSTREAM])
(TALK.SKETCH.WHENCHANGEDFN
[LAMBDA (VIEWER ELEMENT PROPERTY NEWVALUE OLDVALUE) (* ; "Edited 23-Jun-87 07:51 by cdl")
(LET [(STREAM (GETSKETCHPROP VIEWER 'TALK]
(if (AND STREAM (OPENP STREAM))
then (PROG [(SCRATCHSTREAM (OPENSTREAM '{NODIRCORE} 'BOTH]
(HPRINT `(CHANGE ,(TALK.SKETCH.FIND.SYMBOLS VIEWER (CONS ELEMENT))
,PROPERTY
,(SELECTQ PROPERTY
(DATA (SELECTQ NEWVALUE
(CHANGED OLDVALUE)
(OR NEWVALUE OLDVALUE)))
NEWVALUE)) SCRATCHSTREAM)
(SETFILEPTR SCRATCHSTREAM 0)
(COPYBYTES SCRATCHSTREAM STREAM)
(FORCEOUTPUT STREAM)
(CLOSEF? SCRATCHSTREAM])
(TALK.SKETCH.WHENDELETEDFN
[LAMBDA (VIEWER ELEMENTS) (* ; "Edited 23-Jun-87 07:48 by cdl")
(PROG [(STREAM (GETSKETCHPROP VIEWER 'TALK]
(if (AND STREAM (OPENP STREAM))
then (HPRINT `(DELETE ,(TALK.SKETCH.FIND.SYMBOLS VIEWER ELEMENTS)) STREAM)
(FORCEOUTPUT STREAM])
(TALK.SKETCH.WHENMOVEDFN
[LAMBDA (VIEWER ELEMENTS DELTA) (* ; "Edited 23-Jun-87 10:14 by cdl")
(PROG [(STREAM (GETSKETCHPROP VIEWER 'TALK]
(if (AND STREAM (OPENP STREAM))
then [SETQ ELEMENTS
(if (EQ (CAR ELEMENTS)
T)
then [if (NULL TALK.SKETCH.TRACK)
then (if (LISTP (CAADR ELEMENTS))
then [for ELEMENT in (CDR ELEMENTS)
collect (CONS T (TALK.SKETCH.FIND.SYMBOLS
VIEWER
(LIST ELEMENT]
else (* Fix for Sketch UNDO/MOVE bug)
(with POSITION DELTA (SETQ XCOORD (MINUS XCOORD))
(SETQ YCOORD (MINUS YCOORD)))
(LIST (CONS T (TALK.SKETCH.FIND.SYMBOLS
VIEWER
(CONS (CDR ELEMENTS]
elseif (in (CAR ELEMENTS) always NUMBERP)
then [LIST (CONS (CAR ELEMENTS)
(TALK.SKETCH.FIND.SYMBOLS VIEWER (LIST (CDR ELEMENTS]
else (for ELEMENT in ELEMENTS when (OR (NEQ (CAR ELEMENT)
T)
(NOT TALK.SKETCH.TRACK))
collect (CONS (CAR ELEMENT)
(TALK.SKETCH.FIND.SYMBOLS VIEWER (CONS (CDR ELEMENT]
(HPRINT `(MOVE ,ELEMENTS ,DELTA) STREAM)
(FORCEOUTPUT STREAM])
(TALK.SKETCH.PREMOVEFN
[LAMBDA (VIEWER ELEMENTS ALIGNHOW) (* ; "Edited 23-Jun-87 07:53 by cdl")
(LET [(STREAM (GETSKETCHPROP VIEWER 'TALK]
(if (AND TALK.SKETCH.TRACK (NULL ALIGNHOW)
(EQ (CAR ELEMENTS)
T)
STREAM
(OPENP STREAM))
then (LET [(SYMBOLS (TALK.SKETCH.FIND.SYMBOLS VIEWER (CDR ELEMENTS]
(SKETCH.TRACK.ELEMENTS (CDR ELEMENTS)
VIEWER
[FUNCTION (LAMBDA (POSITION VIEWER STREAM)
(HPRINT `(POSITION ,SYMBOLS ,POSITION) STREAM)
(FORCEOUTPUT STREAM]
NIL NIL STREAM])
)
(DEFINEQ
(TALK.SKETCH.WHENGROUPEDFN
[LAMBDA (VIEWER ELEMENTS) (* ; "Edited 18-Jun-87 11:02 by cdl")
'DON'T])
(TALK.SKETCH.WHENUNGROUPEDFN
[LAMBDA (VIEWER ELEMENTS) (* ; "Edited 18-Jun-87 11:02 by cdl")
'DON'T])
)
(RPAQQ TALK.TO.SKETCH.PROPS (WHENADDEDFN TALK.SKETCH.WHENADDEDFN WHENDELETEDFN
TALK.SKETCH.WHENDELETEDFN WHENMOVEDFN TALK.SKETCH.WHENMOVEDFN
WHENCHANGEDFN TALK.SKETCH.WHENCHANGEDFN WHENGROUPEDFN
TALK.SKETCH.WHENGROUPEDFN WHENUNGROUPEDFN
TALK.SKETCH.WHENUNGROUPEDFN PREMOVEFN TALK.SKETCH.PREMOVEFN))
(* TALK Sketch Actions)
(DEFINEQ
(TALK.SKETCH.ADD.ELEMENT
[LAMBDA (SKETCH ELEMENT) (* ; "Edited 21-Jun-87 11:24 by cdl")
(SKETCH.ADD.ELEMENT ELEMENT SKETCH])
(TALK.SKETCH.CHANGE.ELEMENT
[LAMBDA (SKETCH ELEMENT PROPERTY VALUE) (* ; "Edited 21-Jun-87 10:57 by cdl")
(for ELEMENT in (TALK.SKETCH.FIND.ELEMENT SKETCH ELEMENT) do (PUTSKETCHELEMENTPROP ELEMENT
PROPERTY VALUE SKETCH)
(SELECTQ PROPERTY
(FONT (REDISPLAYW SKETCH))
NIL])
(TALK.SKETCH.DELETE.ELEMENTS
[LAMBDA (SKETCH ELEMENTS) (* ; "Edited 18-Jun-87 09:47 by cdl")
(for ELEMENT inside (TALK.SKETCH.FIND.ELEMENT SKETCH ELEMENTS) do (SKETCH.DELETE.ELEMENT ELEMENT
SKETCH])
(TALK.SKETCH.MOVE.ELEMENTS
[LAMBDA (SKETCH ELEMENTS DELTA) (* ; "Edited 18-Jun-87 17:48 by cdl")
(for PAIR in ELEMENTS
do (SELECTQ (CAR PAIR)
(T (SKETCH.MOVE.ELEMENTS (TALK.SKETCH.FIND.ELEMENT SKETCH (CDR PAIR))
DELTA SKETCH))
(bind POSITIONS POSITION CONTROLPT [ELEMENT ← (CAR (TALK.SKETCH.FIND.ELEMENT
SKETCH
(CDR PAIR] for NUMBER
in (CAR PAIR) do (SELECTQ NUMBER
((1 2 3)
(SETQ CONTROLPT (SELECTQ NUMBER
(1 '1STCONTROLPT)
(2 '2NDCONTROLPT)
(3 '3RDCONTROLPT)
(SHOULDNT)))
(with POSITION (SETQ POSITION (COPY (GETSKETCHELEMENTPROP
ELEMENT CONTROLPT)))
(add XCOORD (fetch (POSITION XCOORD) of DELTA))
(add YCOORD (fetch (POSITION YCOORD) of DELTA)))
(PUTSKETCHELEMENTPROP ELEMENT CONTROLPT POSITION SKETCH))
(if [SETQ POSITIONS (COPY (GETSKETCHELEMENTPROP ELEMENT
'DATA]
then (with POSITION (CAR (NTH POSITIONS NUMBER))
(add XCOORD (fetch (POSITION XCOORD)
of DELTA))
(add YCOORD (fetch (POSITION YCOORD)
of DELTA)))
(PUTSKETCHELEMENTPROP ELEMENT 'DATA POSITIONS SKETCH])
(TALK.SKETCH.POSITION.ELEMENTS
[LAMBDA (SKETCH SYMBOLS POSITION) (* ; "Edited 19-Jun-87 09:17 by cdl")
(LET ((ELEMENTS (TALK.SKETCH.FIND.ELEMENT SKETCH SYMBOLS)))
(SKETCH.MOVE.ELEMENTS ELEMENTS (with POSITION (GETSKETCHELEMENTPROP (CAR ELEMENTS)
'1STCONTROLPT)
(create POSITION
XCOORD ← (DIFFERENCE (fetch (POSITION XCOORD)
of POSITION)
XCOORD)
YCOORD ← (DIFFERENCE (fetch (POSITION YCOORD)
of POSITION)
YCOORD)))
SKETCH])
)
(RPAQQ TALK.SKETCH.ACTIONS ((ADD TALK.SKETCH.ADD.ELEMENT)
(DELETE TALK.SKETCH.DELETE.ELEMENTS)
(MOVE TALK.SKETCH.MOVE.ELEMENTS)
(CHANGE TALK.SKETCH.CHANGE.ELEMENT)
(POSITION TALK.SKETCH.POSITION.ELEMENTS)))
(* TALK Sketch Data)
(RPAQQ TALK.SKETCH.DELETE.ITEMS (Group UnGroup Put "Move view"))
(RPAQ? TALK.SKETCH.TRACK NIL)
(FILESLOAD TALK SKETCH)
(ADDTOVAR GAP.SERVICETYPES (7 Sketch TALK.SKETCH.SERVER))
(APPENDTOVAR TALK.SERVICETYPES (Sketch [LAMBDA NIL (FGETD 'SKETCH]
TALK.SKETCH.DISPLAY TALK.SKETCH.LISTEN))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TALK.SKETCH.ACTIONS TALK.TO.SKETCH.PROPS TALK.SKETCH.DELETE.ITEMS TALK.SKETCH.TRACK)
)
(* Sketch Bug Fixes)
(DEFINEQ
(TALK.SKETCH.NOP
[LAMBDA (X) (* ; "Edited 19-Jun-87 07:50 by cdl")
X])
)
(CHANGENAME '\SK.PUT.FONT 'SK.INSURE.TEXT 'TALK.SKETCH.NOP)
[XCL:REINSTALL-ADVICE 'BITMAPELT.CHANGEFN :AFTER '([:LAST (RPLACA (CDDAR (CADAR !VALUE))
(CADDAR (CAAR !VALUE]
(:LAST (RPLACA (CDDAR (CADAR !VALUE))
(CADDAR (CAAR !VALUE]
[XCL:REINSTALL-ADVICE 'SK.IMAGEOBJ.CHANGEFN :AFTER '([:LAST (RPLACA (CDDAR (CADAR !VALUE))
(CADDAR (CAAR !VALUE]
(:LAST (RPLACA (CDDAR (CADAR !VALUE))
(CADDAR (CAAR !VALUE]
(READVISE BITMAPELT.CHANGEFN SK.IMAGEOBJ.CHANGEFN)
(PUTPROPS SKETCHTALK COPYRIGHT ("Stanford University" 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2237 6985 (TALK.SKETCH.SERVER 2247 . 3236) (TALK.SKETCH.DISPLAY 3238 . 5282) (
TALK.SKETCH.LISTEN 5284 . 6983)) (6986 7620 (TALK.SKETCH.FIND.ELEMENT 6996 . 7392) (
TALK.SKETCH.FIND.SYMBOLS 7394 . 7618)) (7666 12638 (TALK.SKETCH.WHENADDEDFN 7676 . 8327) (
TALK.SKETCH.WHENCHANGEDFN 8329 . 9341) (TALK.SKETCH.WHENDELETEDFN 9343 . 9713) (
TALK.SKETCH.WHENMOVEDFN 9715 . 11817) (TALK.SKETCH.PREMOVEFN 11819 . 12636)) (12639 12957 (
TALK.SKETCH.WHENGROUPEDFN 12649 . 12800) (TALK.SKETCH.WHENUNGROUPEDFN 12802 . 12955)) (13438 17967 (
TALK.SKETCH.ADD.ELEMENT 13448 . 13625) (TALK.SKETCH.CHANGE.ELEMENT 13627 . 14227) (
TALK.SKETCH.DELETE.ELEMENTS 14229 . 14573) (TALK.SKETCH.MOVE.ELEMENTS 14575 . 16938) (
TALK.SKETCH.POSITION.ELEMENTS 16940 . 17965)) (18828 18976 (TALK.SKETCH.NOP 18838 . 18974)))))
STOP