(FILECREATED "13-NOV-83 01:00:32" {PHYLUM}<LISP>SOURCES>DEDITPATCHES.;2 9040
changes to: (VARS DEDITPATCHESCOMS)
previous date: "11-NOV-83 11:44:33" {PHYLUM}<LISP>SOURCES>DEDITPATCHES.;1)
(* Copyright (c) 1983 by Xerox Corporation)
(PRETTYCOMPRINT DEDITPATCHESCOMS)
(RPAQQ DEDITPATCHESCOMS ((FNS BSELECT SELECTKEYS DEDITREADLINE DEDITWINDOWENTRYFN ACTIVEEDITW
DEDITResetTypeComs DEDITTYPEDCOM DEDITDatatype DEDITEdit)
(ADDVARS (DT.EDITMACROS))
(P (RESETDEDIT))))
(DEFINEQ
(BSELECT
[LAMBDA (CDS) (* bvm: " 4-NOV-83 17:54")
(* Does selections until a command is given)
(RESETFORM (DEDITUSER (WFROMDS CDS))
(CAR (ERSETQ (bind TMP MENUMOVED REG
do (OR (WINDOWP \DEDITMNUW)
(SETEDITMENU CDS))
(COND
((NOT (TTY.PROCESSP))
(WINDOWPROP \DEDITMNUW (QUOTE PROCESS)
(THIS.PROCESS))
(* Allow the menu window to also respond to tty
switching)
(PROCESS.PREPARE.FOR.INPUT CDS)))
(GETMOUSESTATE)
[COND
[(EQ MENUMOVED (SETQ MENUMOVED (KEYDOWNP (QUOTE TAB]
(MENUMOVED [OR REG (SETQ REG (WINDOWPROP \DEDITMNUW (QUOTE REGION]
[MOVEW \DEDITMNUW (IMIN (ADD1 LASTMOUSEX)
(IDIFFERENCE
SCREENWIDTH
(fetch (REGION WIDTH)
of REG)))
(IMAX 0 (IMIN (IDIFFERENCE LASTMOUSEY
(WINDOWPROP
\DEDITMNUW
(QUOTE YOFFSET)))
(IDIFFERENCE SCREENHEIGHT
(fetch (REGION
HEIGHT)
of REG]
(OR (\SYSBUFP)
(DISMISS 20))
(* Wait til TAB read)
(CLEARBUF T))
(T (MOVEW \DEDITMNUW (WINDOWPROP \DEDITMNUW (QUOTE HOME]
(AND [SETQ TMP (OR (AND (\SYSBUFP)
(SELECTKEYS))
(AND (INWINDOW (TOTOPW \DEDITMNUW))
(READEDITMENU]
(RETURN TMP))
(\BACKGROUND])
(SELECTKEYS
[LAMBDA NIL (* bvm: "25-OCT-83 18:47")
(CAR (ERSETQ (RESETLST (RESETSAVE (TTYDISPLAYSTREAM (GETEBUF NIL)))
(* GETEBUF of NIL returns an inactive window.)
(RESETSAVE \DEDITALLOWSELS NIL)
(RESETSAVE NIL (LIST (QUOTE SETREADTABLE)
(SETREADTABLE DEDITRDTBL T)
T))
(RESETSAVE (SETTERMTABLE DEDITTTBL))
(PROG ((LINE (DEDITREADLINE)))
(RETURN (COND
((EQ DEditTypedCom (CAR (LISTP LINE)))
(DEDITTYPEDCOM (CDR LINE)))
(T (SHADEIFNOTBUF (NXTSELECTION T)
SECSHADE)
(* Push shading)
(SHADEIFNOTBUF (TOPSELECTION T)
SWITCHSHADE)
(SHADESELECTION (SETDEDITMAP (GETEBUF T)
(PUSHSELECTION
(LIST LINE)))
PRIMSHADE)
NIL])
(DEDITREADLINE
[LAMBDA (ASLIST) (* bvm: " 4-NOV-83 15:43")
(* Read a line of input from T. This is like the grunge that goes on inside of LISPX, figuring out where the line
ends...)
(PROG ((FIRSTITEM (APPLY* LISPXREADFN T T))
CH LINE)
(RETURN (COND
((AND (LISTP FIRSTITEM)
(OR (EQ (CAR FIRSTITEM)
DEditTypedCom)
(SYNTAXP (SETQ CH (CHCON1 (LASTC T)))
(QUOTE RIGHTPAREN)
T)
(SYNTAXP CH (QUOTE RIGHTBRACKET)
T)))
(* A list is the first thing typed. Usually, there is no more, but you could get a list from an "atomic" form if
it had a read macro that turned it into a list)
(COND
(ASLIST (LIST FIRSTITEM))
(T FIRSTITEM)))
((OR (CDR (SETQ LINE (READLINE T (LIST FIRSTITEM)
T)))
ASLIST) (* There was more, so return whole list)
LINE)
(T (* Single atom)
FIRSTITEM])
(DEDITWINDOWENTRYFN
[LAMBDA (W) (* bvm: "25-OCT-83 16:12")
(* Invoked when button goes down in W when we are not the tty process. If shift is down, do shift selection
without changing tty; else do the normal thing)
(TOTOPW W) (* Bring it up, if nothing else)
(COND
([AND (EDITWINDOWP W)
(OR (KEYDOWNP (QUOTE LSHIFT))
(KEYDOWNP (QUOTE RSHIFT]
(SELECTREAD W))
(T (GIVE.TTY.PROCESS W])
(ACTIVEEDITW
[LAMBDA (W ONFLG) (* bvm: "25-OCT-83 16:19")
(WINDOWPROP W (QUOTE BUTTONEVENTFN)
(AND ONFLG (QUOTE DEDITBUTTONFN)))
[WINDOWPROP W (QUOTE RIGHTBUTTONFN)
(COND
(ONFLG (QUOTE DEDITRIGHTBUTTONFN))
(T (QUOTE DOWINDOWCOM]
(WINDOWPROP W (QUOTE RESHAPEFN)
(AND ONFLG (QUOTE DEDITRESHAPEFN)))
(WINDOWPROP W (QUOTE REPAINTFN)
(AND ONFLG (QUOTE DEDITREPAINTFN)))
(WINDOWPROP W (QUOTE SCROLLFN)
(AND ONFLG (QUOTE DEDITSCROLLFN)))
(WINDOWPROP W (QUOTE PROCESS)
(AND ONFLG (THIS.PROCESS))) (* So that bugging in this window can switch tty to us)
(WINDOWPROP W (QUOTE WINDOWENTRYFN)
(AND ONFLG (FUNCTION DEDITWINDOWENTRYFN)))
(DSPSCROLL (COND
(ONFLG (QUOTE OFF))
(T T))
(WINDOWPROP W (QUOTE DSP))) (* Buffer can get this turned on)
W])
(DEDITResetTypeComs
[LAMBDA NIL (* bvm: "25-OCT-83 18:31")
(SETQ DEditTypedCom "TypedCom")
(SETQ DEDITTTBL (COPYTERMTABLE NIL))
(SETQ DEDITRDTBL (COPYREADTABLE T))
(bind CH for TRIPLE in DEDITTYPEINCOMS
do [SETQ CH (IPLUS (CHCON1 (CAR TRIPLE))
(IDIFFERENCE (CHARCODE ↑A)
(CHARCODE A]
(ECHOCONTROL CH (QUOTE IGNORE)
DEDITTTBL)
(SETSYNTAX CH [BQUOTE (MACRO FIRST IMMEDIATE (LAMBDA (F R)
(CONS DEditTypedCom (QUOTE , (CADR TRIPLE]
DEDITRDTBL])
(DEDITTYPEDCOM
[LAMBDA (NAME) (* bvm: "25-OCT-83 18:30")
(for TRIPLE in DEDITTYPEINCOMS when (EQ (CADR TRIPLE)
NAME)
do (printout T NAME ": ")
(RETURN (CONS NAME (CONS (CADDR TRIPLE)
(DEDITREADLINE T])
(DEDITDatatype
[LAMBDA (obj) (* bvm: " 4-NOV-83 18:43")
(PROG ((DTMAC (FASSOC (TYPENAME obj)
DT.EDITMACROS))
newObj source installSourceFn changedFlg)
(DECLARE (SPECVARS changedFlg))
(OR DTMAC (RETURN (INSPECT obj)))
(* CADR is a function which gets a list structure source for the datatype. CADDR is a function which installs the
source back in the dataType. It is called when the source has been changed in the editing.)
(COND
((NULL (SETQ source (APPLY* (CADR DTMAC)
obj))) (* If this fn returns NIL, we assume it has done any
desired editing itself)
(RETURN)))
(SETQ installSourceFn (CADDR DTMAC))
LP [SETQ source (EDITE source NIL obj (TYPENAME obj)
(FUNCTION (LAMBDA NIL
(SETQ changedFlg T]
[COND
((NOT changedFlg)
(RETURN))
((NLSETQ (SETQ newObj (OR (APPLY* installSourceFn obj source)
obj)))
(RETURN (DEDITZAPCAR (TOPSELECTION)
newObj]
(PROMPTPRINT "Error in datatype edit source")
(GO LP))
(DEDITReprint])
(DEDITEdit
[LAMBDA (EDITOR EDITEE) (* bvm: " 4-NOV-83 18:24")
(RESETLST (RESETSAVE (SETCURSOR DEFAULTCURSOR)
(LIST (QUOTE SETCURSOR)
WAITINGCURSOR))
(PROG ((S (CAR (TOPSELECTION)))
A)
(SELECTQ EDITEE
[(Def NIL)
(COND
((AND (NLISTP S)
(NOT (LITATOM S)))
(DEDITDatatype S))
((AND (for old (S ←(POPSELECTION)) by (CAR S) while (LISTP S)
finally (RETURN (LITATOM S)))
(SETQ A (TYPESOF S NIL NIL (QUOTE ?)))
(SETQ A (SELECT.ATOM.ASPECT S NIL A)))
(RESETSAVE (EDITMODE EDITOR))
(* User can refuse all SELECT.ATOM.ASPECT choices)
(EDITDEF S A (QUOTE ?)))
(T (CANT "No editable aspect"]
[Form (AND [SETQ S (APPLY* (COND
((EQ EDITOR (QUOTE TTYIn))
(QUOTE DEDITCEdit))
(T (RESETSAVE (EDITMODE EDITOR))
(QUOTE EDITE)))
(LIST (COPY S]
(DEDITZAPCAR (TOPSELECTION)
(CAR S]
(SHOULDNT])
)
(ADDTOVAR DT.EDITMACROS )
(RESETDEDIT)
(PUTPROPS DEDITPATCHES COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (511 8913 (BSELECT 521 . 2189) (SELECTKEYS 2191 . 3174) (DEDITREADLINE 3176 . 4253) (
DEDITWINDOWENTRYFN 4255 . 4797) (ACTIVEEDITW 4799 . 5698) (DEDITResetTypeComs 5700 . 6280) (
DEDITTYPEDCOM 6282 . 6591) (DEDITDatatype 6593 . 7793) (DEDITEdit 7795 . 8911)))))
STOP