(FILECREATED "17-AUG-78 13:55:47" <KRL>DEVENTS.;23 29997
changes to: EVENTSMENU EventDuration
previous date: " 2-AUG-78 20:07:04" <KRL>DEVENTS.;22)
(PRETTYCOMPRINT DEVENTSCOMS)
(RPAQQ DEVENTSCOMS [(FNS LoadEsys SetUpEsys EVENTSDEMO)
(* functions for viewing the event space)
(FNS * DEVENTFNS)
(FNS FilterEventsFile LoadEventsIndex MakeEventsIndex StartBarTrace SetBarTrace
StopBarTrace)
(FNS * FILTERFNS)
(VARS EVENTFIELDLST TRIGGERTYPES ESYSFILES)
(RECORDS InputEvent TriggerEvent TriggerActionEvent FILTER)
(PROP (WINDOWSPECS MENUCOMS)
EVENTSMENU)
(P (SETQ MENULST (CONS (QUOTE EVENTSMENU)
MENULST))
(ADDPROP (QUOTE MENUMENU)
(QUOTE MENUCOMS)
(QUOTE (EVENTSMENU "Events"))
T))
(BLOCKS (TriggerTree TriggerTree (TriggerTree))
(LastActionEvent LastActionEvent (LastActionEvent)))
[DECLARE: DONTCOPY EVAL@COMPILE DONTEVAL@LOAD
(P (OR (NEQ (GETATOMVAL (QUOTE BACKGROUNDLST))
(QUOTE NOBIND))
(SETQ BACKGROUNDLST NIL))
(LOAD? (QUOTE <KBA>RECORDS)
(QUOTE SYSLOAD))
(LOAD? (QUOTE <KBA>DISPCOMP)
(QUOTE SYSLOAD]
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML DisplayTriggerValue DisplayTrigger])
(DEFINEQ
(LoadEsys
[LAMBDA (DONTSETUPFLG)
(DECLARE (USEDFREE ESYSFILES))
(LOADFILES 'KRL ESYSFILES 'COM T)
(OR DONTSETUPFLG (SetUpEsys])
(SetUpEsys
[LAMBDA NIL
(if ~ADISOFILE
then (CONNECT T])
(EVENTSDEMO
[LAMBDA (FLG DATEFLG) (* mlm: "11-MAY-78 17:20")
(SELECTQ FLG
(0 EVENTSFIL←(INPUT (INFILE '<MODEL>EVENTS.NEWBOARD))
(LoadEventsIndex '<MODEL>EVENTSINDEX.NEWBOARD))
(1 SHOWTIMEFLG←NIL
(SETWINDOWSPECS 'TYPESCRIPT '((CAPTION "TYPESCRIPT")))
(CHATPRINT)
(SETWINDOWSPECS 'TYPESCRIPT '((TOP 775)
(HEIGHT 5 LINES)))
[SETWINDOWSPECS 'PROMPTWINDOW '((HEIGHT 8 LINES)
(TOP 25 LESS THAN (TYPESCRIPT BOTTOM]
(SETWINDOWSPECS 'MENUMENU '((WIDTH SAME)
(LEFT 25)
(HEIGHT SAME)
(TOP 25 LESS THAN (PROMPTWINDOW BOTTOM))
(ONTOP T)
(VISIBLE T)))
(SETWINDOWSPECS 'EVENTSMENU '((HEIGHT SAME)
(TOP SAMEAS MENUMENU)
(LEFT 10 MORE THAN (MENUMENU RIGHT))
(VISIBLE T)
(ONTOP T)))
[if (GETWINDOW 'EDITSCRIPT T)
then (SETWINDOWSPECS 'EDITSCRIPT '((TOP 5 LESS THAN (TYPESCRIPT BOTTOM))
(LEFT SAMEAS TYPESCRIPT)
(RIGHT SAME)
(HEIGHT 10 LINES]
GCGAGFLG←T)
[2 (CHATPRINT)
(CREATEWINDOW 'TRIGGERTREE NIL '((LEFT 25)
(RIGHT 400)
(BOTTOM 50)
(TOP 20 LESS THAN (MENUMENU BOTTOM))
(CAPTION "Trigger Tree" (BACKGROUND BLACK]
(HELP "actions not defined for FLG in EVENTSDEMO" FLG))
(AND DATEFLG (DATE])
)
(* functions for viewing the event space)
(RPAQQ DEVENTFNS (EVENTSMENU GetEvent EventParent EventSuccessors EventType EventTypes EventDuration
DisplayTriggerTree TriggerTree LastActionEvent TriggerActionDuration
TriggerDuration OrderActionsByDuration CREATEFILTER FILTER FILTERCOUNT
DisplayFilterEvents DisplayFilteredEvents DisplayTrigger
DisplayTriggerValue LoadEvents EventsFromSelections
SetUpEventFieldSelector KillEventSelector EVENTFIELDTOUCHFN
DisplayEventFieldSelector))
(DEFINEQ
(EVENTSMENU
[LAMBDA (KEY)
(DECLARE (USEDFREE CURRWIN)) (* edited: " 2-AUG-78 17:09")
(SELECTQ KEY
(SELECTEVENTFIELDS (MENUSELECT 'EVENTSMENU)
(VISIBLE CURRWIN)
(DisplayEventFieldSelector CURRWIN))
(DONESELECTFIELDS (MENUSELECT 'EVENTSMENU)
[if 'BLANKWINDOW =CURRWIN:1
then (MAKECURRWIN (OR CURRWIN:WINDOW.USER
(HELP
"Window indicated for Done Selecting Fields is a BLANKWINDOW,
but its user field does not point to a filter window"
CURRWIN]
(DisplayFilterEvents CURRWIN)
(INVISIBLE CURRWIN:WINDOW.USER:FILTER.selectorWindow))
[CREATEFILTER (PROG (DESC LST)
(CHATPRINT)
GETDESC
(DESC←(MENUREAD 'EVENTSMENU '(Enter filter expression:)
'READLINE 'EXPRESSION T))
GETLST (* (LST← (MENUREAD 'EVENTSMENU '
(List of candidates (defaults to MONITOREVENTS) % :)
'TEXTREADLINE 'EXPRESSION T)))
(CREATEFILTER (if (AND (LISTP DESC)
'LAMBDA ~=DESC:1)
then <'LAMBDA '(EVENT)
DESC>
else DESC]
[CHANGEFILTER (MENUSELECT 'EVENTSMENU)
(PROG (DESC ($FILT (CURRWIN:WINDOW.USER)))
(CHATPRINT "Current filter expression/function is: ")
(CHATPRINT (KWOTE $FILT:FILTER.description))
(DESC←(MENUREAD 'EVENTSMENU '(Enter new expression
(NIL to leave as is):)
'READLINE 'EXPRESSION T))
(if DESC
then ($FILT:FILTER.description←DESC)
(KILLWINDOW $FILT:FILTER.selectorWindow)
($FILT:FILTER.selectorWindow←NIL)
(DisplayFilterEvents CURRWIN T]
(EXTENDOWN (PROG (TMP VAR DESC ($FILT (CURRWIN:WINDOW.USER)))
(DESC←$FILT:FILTER.description)
(VAR←(GENNAME DESC:2:1))
(TMP← <'LAMBDA <VAR> <'OR <'APPLY* <'FUNCTION DESC> VAR>
<'PROG <<'PAR '(EventParent VAR)>>
<'RETURN
<'AND 'PAR
<'APPLY* <'FUNCTION DESC> 'PAR
>>>>>>)
(* to make DWMIMFY of next expression work)
($FILT:FILTER.description←TMP)
($FILT:FILTER.events←(for EV in $FILT:FILTER.events
join <EV ! (SDIFF (EventSuccessors EV)
$FILT:FILTER.events) >))
(DisplayFilterEvents CURRWIN)))
(EXTENDUP (PRIN1 "Not implemented yet
"))
(PROGN (PRINT KEY)
(LISPXUNREAD <KEY>])
(GetEvent
[LAMBDA (EVNT) (* gets an event from its number)
(SETFILEPTR EVENTSFIL (ELT EVENTSINDEX EVNT))
(READ EVENTSFIL])
(EventParent
[LAMBDA (EV)
(GetEvent (SELECTQ (EventType EV)
(TriggerEvent EV:TriggerEvent.firingEvent)
(TriggerActionEvent EV:TriggerActionEvent.triggerEvent)
NIL])
(EventSuccessors
[LAMBDA (EV)
(for SUCC in (SELECTQ (EventType EV)
(InputEvent EV:InputEvent.firedTriggers)
(TriggerEvent EV:TriggerEvent.actions)
(TriggerActionEvent EV:TriggerActionEvent.firedTriggers)
NIL)
collect (GetEvent SUCC])
(EventType
[LAMBDA (EVNT)
(OR (AND (LISTP EVNT)
EVNT:1)
(AND EVENTSINDEX (ELTD EVENTSINDEX EVNT))
(AND EVENTSINDEX (SETFILEPTR EVENTSFIL (ELT EVENTSINDEX EVNT))
(READ EVENTSFIL):1])
(EventTypes
[LAMBDA (LST)
(UNIQUELIST (for E in LST collect (EventType E])
(EventDuration
[LAMBDA (EVNT INCFLG)
(PROG [DUR (EVENT (OR (LISTP EVNT)
(GetEvent EVNT]
(DUR←(SELECTQ EVENT:1
(TriggerEvent (if INCFLG
then EVENT:TriggerEvent.inclusiveDuration
else EVENT:TriggerEvent.duration))
(TriggerActionEvent (if INCFLG
then EVENT:TriggerActionEvent.inclusiveDuration
else EVENT:TriggerActionEvent.duration))
NIL))
(RETURN (if (AND ~INCFLG (1 GT (OR DUR 0)))
then (EventDuration EVENT T)
else (OR DUR 0])
(DisplayTriggerTree
[LAMBDA (TRIGEVENT PRUNEFN) (* mlm: "16-MAY-78 12:09")
(PROG ((TREE (TriggerTree TRIGEVENT T PRUNEFN)))
(DisplayTree 'TRIGGERTREE TREE NIL (FUNCTION (LAMBDA (NODE)
(if 'TriggerActionEvent =(EventType (OR (FIXP NODE:1)
(CAAR NODE)))
then '((BACKGROUND GREY)
(TEXTSTRING 1 (BOLD T)))
else '((BACKGROUND BLACK)
(TEXTSTRING 1 (BOLD T])
(TriggerTree
[LAMBDA (TRIGEVENT TIMESFLG PRUNEFN)
(* PRUNEFN is applied to TriggerActionEvents and if T the event is not expanded, being succeeded only with a node
containing ". . ." and, if TIMESFLG, the total time of the successor events)
(PROG (($TRIGEVENT (GetEvent TRIGEVENT)))
(RETURN <TRIGEVENT
! (for TEA in $TRIGEVENT:TriggerEvent.actions bind $ACTEVENT
collect ($ACTEVENT←(GetEvent TEA))
(<(if TIMESFLG
then (LIST TEA (EventDuration $ACTEVENT))
else TEA)
! (if ~(AND PRUNEFN $ACTEVENT:TriggerActionEvent.firedTriggers
(APPLY* PRUNEFN $ACTEVENT))
then (for SUBEVENT
in $ACTEVENT:TriggerActionEvent.firedTriggers
collect (TriggerTree SUBEVENT TIMESFLG PRUNEFN))
else <<(if TIMESFLG
then <". . ." ((EventDuration $ACTEVENT)
-(EventDuration $ACTEVENT T))>
else ". . .")>>)>)) >])
(LastActionEvent
[LAMBDA (ACTEVENT) (* mlm: "11-MAY-78 13:31")
(* takes a trigger action event and looks for the
time-wise last trigger action event that descended from
this one)
(PROG [acts (trigs (fetch (TriggerActionEvent firedTriggers) of (ELT MONITOREVENTS ACTEVENT]
(RETURN (if ~trigs
then ACTEVENT
elseif acts←(fetch (TriggerEvent actions) of (ELT MONITOREVENTS trigs:-1))=NIL
then ACTEVENT
else (LastActionEvent acts:-1])
(TriggerActionDuration
[LAMBDA (TEA DONTINCLUDESUBTIMESFLG) (* mlm: "16-MAY-78 11:58")
(PROG (START END TIMES (EVENT (if (FIXP TEA)
then (ELT MONITOREVENTS TEA)
else TEA)))
(RETURN (if TIMES←(ELTD MONITOREVENTS EVENT:TriggerActionEvent.ID)
then (if DONTINCLUDESUBTIMESFLG
then TIMES::1
else TIMES:1)
else START←EVENT:TriggerActionEvent.startTime
END←[OR EVENT:TriggerActionEvent.endTime
(PROG [(LASTEV (ELT MONITOREVENTS
(LastActionEvent EVENT:TriggerActionEvent.ID]
(RETURN (OR (FIXP LASTEV:TriggerActionEvent.endTime)
(FIXP LASTEV:TriggerActionEvent.startTime]
(AND (FIXP END)
(if ~DONTINCLUDESUBTIMESFLG
then END-START
else END-START-(for TRIG
in EVENT:TriggerActionEvent.firedTriggers
sum (TriggerDuration TRIG])
(TriggerDuration
[LAMBDA (TE DONTINCLUDESUBTIMESFLG) (* mlm: "12-MAY-78 20:14")
(PROG (TIMES (EVENT (if (FIXP TE)
then (ELT MONITOREVENTS TE)
else TE)))
(RETURN (if TIMES←(ELTD MONITOREVENTS EVENT:TriggerEvent.ID)
then (if DONTINCLUDESUBTIMESFLG
then TIMES::1
else TIMES:1)
else (for ACT in EVENT:TriggerEvent.actions
sum (TriggerActionDuration ACT DONTINCLUDESUBTIMESFLG])
(OrderActionsByDuration
[LAMBDA (LST DONTINCLUDESUBTIMESFLG)
(DECLARE (SPECVARS DONTINCLUDESUBTIMESFLG)) (* mlm: "12-MAY-78 16:30")
(SORT LST (FUNCTION (LAMBDA (ACT1 ACT2)
(DECLARE (USEDFREE DONTINCLUDESUBTIMESFLG))
((TriggerActionDuration ACT1 DONTINCLUDESUBTIMESFLG)
GT
(TriggerActionDuration ACT2 DONTINCLUDESUBTIMESFLG])
(CREATEFILTER
[LAMBDA (DESCRIPTION) (* mlm: "10-MAY-78 15:39")
(PROG ($FDOC $FWIN (FNAM (GENNAME 'FILTER)))
[$FDOC←(CREATEDOCUMENT FNAM 'SCRATCH 'ACTIVE '((TYPE TEXT]
($FWIN←(MENUCREATEWINDOW FNAM $FDOC 'EVENTSMENU '((With the left mouse button, specify the
two corners of the new filter
window.)
(Now indicate the corner diagonally opposite the one just
indicated.))
<'(WHENCHANGED KillEventSelector)
<'CAPTION (MKSTRING FNAM)> '(INITIMEFUSE NIL)
'(LEFTMARGIN 8)>))
($FWIN:WINDOW.USER←(create FILTER description ← DESCRIPTION))
(DisplayFilterEvents $FWIN T])
(FILTER
[LAMBDA (DESCRIPTION LIMIT ARRY)
(DECLARE (USEDFREE MONITOREVENTS)) (* mlm: "15-MAY-78 11:04")
(AND DESCRIPTION (PROG (($ARRY (OR ARRY MONITOREVENTS)))
(RETURN (for J from 1 to (ARRAYSIZE $ARRY) bind K←0 collect (K←K+1)
(ELT $ARRY J)
when (APPLY* DESCRIPTION (ELT $ARRY J))
until (AND LIMIT K=LIMIT])
(FILTERCOUNT
[LAMBDA (DESCRIPTION ARRY)
(DECLARE (USEDFREE MONITOREVENTS)) (* mlm: "10-MAY-78 16:01")
(PROG (($ARRY (OR ARRY MONITOREVENTS)))
(RETURN (for J from 1 to (ARRAYSIZE $ARRY) bind CNT←0 do CNT←CNT+1
when (APPLY* DESCRIPTION (ELT $ARRY J)) finally (RETURN CNT])
(DisplayFilterEvents
[LAMBDA (WIN REFILTERFLG) (* mlm: "10-MAY-78 15:23")
(PROG ($DOC $FILT ($WIN (GETWINDOW WIN)))
($DOC←$WIN:DOCWINDOW.DOCUMENT)
($FILT←$WIN:WINDOW.USER)
(VISIBLE $WIN)
(SETDOCUMENTSPECS $DOC '((ACTIVE T)))
(if REFILTERFLG
then ($FILT:FILTER.events←(FilterEventsFile $FILT:FILTER.description)))
(DisplayFilteredEvents $DOC $WIN $FILT:FILTER.events $FILT:FILTER.selectors)
(SETDOCUMENTSPECS $DOC '((ACTIVE NIL])
(DisplayFilteredEvents
[LAMBDA ($DOC $WIN LST SELECTORS) (* mlm: " 8-MAY-78 11:02")
(CLEARDOCUMENT $DOC)
(SETFILEPTR $DOC:DOCUMENT.FILENAME -1)
$DOC:DOCUMENT.END←(GETFILEPTR $DOC:DOCUMENT.FILENAME)
(RESETFORM (OUTPUT $DOC:DOCUMENT.FILENAME)
(for OBJ in LST do (NEWGLUMP $DOC (CADR OBJ))
(PRINTXDTMSG BOLDMSG)
(PRIN1 (CADR OBJ))
(TAB 8 1)
(PRINT OBJ:1)
(for S in (CDR (FASSOC OBJ:1 EVENTFIELDLST))
do (PRINTXDTMSG ITALICMSG)
(TAB 4)
(PRIN1 S)
(PRIN1 ":")
(PRINTXDTMSG NORMALMSG)
(SPACES 2)
(PRINT (RECORDACCESS S OBJ (RECLOOK OBJ:1)
'FETCH))
when (MEMBER <OBJ:1 ! S> SELECTORS))
(PRINTXDTMSG NORMALMSG)
(TERPRI)
finally (NEWGLUMP $DOC 'DUMMYLAST])
(DisplayTrigger
[NLAMBDA (TYPE SLOT PROTOTYPE ANCHOR TRIGGERLEVEL) (* mlm: " 1-MAY-78 11:48")
(PROG (LEFTCOL ($DOC (GETDOCUMENT 'TRIGGERS)))
(SETDOCUMENTSPECS $DOC '((ACTIVE T)))
(VISIBLE 'TRIGGERS)
(NEWGLUMP 'TRIGGERS SLOT)
(RESETLST (RESETSAVE (OUTPUT $DOC:DOCUMENT.FILENAME))
(TAB LEFTCOL←(6*((OR TRIGGERLEVEL 1)+ -1))
0)
(PRINTXDTMSG BOLDMSG)
(PRIN1 TYPE)
(PRINTXDTMSG NORMALMSG)
(PRIN1 " fired, slot ")
(PRINTXDTMSG BOLDMSG)
(PRIN1 SLOT)
(PRINTXDTMSG NORMALMSG)
(PRIN1 " of prototype ")
(PRINTXDTMSG BOLDMSG)
(PRIN1 PROTOTYPE)
(TERPRI)
(TAB 4+LEFTCOL)
(PRINTXDTMSG ITALICMSG)
(PRIN1 "anchor: ")
(PRINTXDTMSG NORMALMSG)
(PRINT ANCHOR)
(TERPRI))
(UPDATEDOCUMENT 'TRIGGERS)
(SETWINDOWCONTENTS 'TRIGGERS SLOT)
(SETDOCUMENTSPECS $DOC '((ACTIVE NIL])
(DisplayTriggerValue
[NLAMBDA (TRIG VAL TRIGGERLEVEL) (* mlm: " 1-MAY-78 11:47")
(PROG (LEFTCOL ($DOC (GETDOCUMENT 'TRIGGERS)))
(SETDOCUMENTSPECS $DOC '((ACTIVE T)))
(VISIBLE 'TRIGGERS)
(RESETLST (RESETSAVE (OUTPUT $DOC:DOCUMENT.FILENAME))
[TAB LEFTCOL←(4+(6*((OR TRIGGERLEVEL 1)+ -1]
(PRINTXDTMSG ITALICMSG)
(PRIN1 "form: ")
(PRINTXDTMSG NORMALMSG)
(PRINT TRIG)
(TAB 8+LEFTCOL)
(PRINTXDTMSG BOLDITALICMSG)
(PRIN1 "value: ")
(PRINTXDTMSG NORMALMSG)
(PRINT VAL)
(TERPRI))
(UPDATEDOCUMENT 'TRIGGERS)
(SETDOCUMENTSPECS $DOC '((ACTIVE NIL])
(LoadEvents
[LAMBDA (FILE ARRAYNM) (* mlm: "12-MAY-78 20:22")
(PROG (SIZ ARRY (FIL (INPUT (INFILE FILE)))
($ARRAYNM (OR ARRAYNM 'MONITOREVENTS)))
(if ~FIL
then (HELP FILE "not opened"))
(SIZ←(READ FIL))
(ARRY←(SET $ARRAYNM (ARRAY SIZ)))
(for J from SIZ to 1 by -1 do ((ELT ARRY J)←(READ FIL))
(SELECTQ (CAR (ELT ARRY J))
(TriggerEvent (SETD ARRY J
<(TriggerDuration J)
! (TriggerDuration J T)>))
(TriggerActionEvent
(SETD ARRY J <(TriggerActionDuration J)
! (TriggerActionDuration J T)>))
NIL))
(RETURN SIZ])
(EventsFromSelections
[LAMBDA (WIN) (* mlm: " 5-MAY-78 16:50")
(PROG (SEL1S (SELS ((GETWINDOW WIN):DOCWINDOW.CURRSELECTIONS)))
(SEL1S←(for SEL in SELS collect SEL:SELECTION.LASTSEL))
(RETURN (for X in SEL1S collect (GETHASH (MKATOM X:SELECTION1.OBJECT)
MONITOREVENTSARRAY)
when 'WORD =X:SELECTION1.TYPE])
(SetUpEventFieldSelector
[LAMBDA ($FWIN) (* edited: " 2-AUG-78 17:06")
(PROG (LASTOP SUBHEIGHT SUBWIDTH FNTARRY TOP WINWIDTH $SWIN FNAM ETYPLST
($FILT ($FWIN:WINDOW.USER))
($FNT (GETFONT 'HELVETICA7))
(SNAM (PACK* $FWIN:WINDOW.NAME '.Selector)))
(DECLARE (SPECVARS LASTOP EVENTYP $SWIN WINWIDTH FNTARRY TOP SUBHEIGHT))
(ETYPLST←(EventTypes $FILT:FILTER.events))
(FNAM←$FWIN:WINDOW.NAME)
($SWIN←(CREATEWINDOW SNAM NIL
<<'LEFT 'SAMEAS FNAM> <'RIGHT 'SAMEAS FNAM>
<'TOP 'SAMEAS <FNAM 'BOTTOM >> '(HEIGHT 600)
'(BACKGROUND BLACK)
'(INITIMEFUSE 8)
'[BORDERSTRIPES (QUOTE ((2 WHITE]
'(VISIBLE NIL)
>))
(WINWIDTH←$SWIN:WINDOW.WIDTH)
(TOP←$SWIN:WINDOW.HEIGHT-5)
(FNTARRY←$FNT:FONTREC.FONTARRAY)
(SUBHEIGHT←(6+$FNT:FONTREC.CHARHEIGHT))
[$SWIN:WINDOW.USER←(for EVENTYP in (for X in EVENTFIELDLST when (FMEMB X:1 ETYPLST)
collect X)
declare (SPECVARS EVENTYP) bind NXTLFT declare (SPECVARS NXTLFT)
collect (NXTLFT←NIL)
(PROG1
<EVENTYP:1
!(for FLD in EVENTYP bind SUBREG TMP
collect (NXTLFT←(if NXTLFT
then
$SWIN:WINDOW.SUBREGIONS:-1:SUBREGION.RELDIMENSIONS:DIMENSIONS.RIGHT
else 2)+ 1)
(if 0 GT WINWIDTH-(NXTLFT+15+(WIDTHSTR FLD
FNTARRY))
then
(* no room on this line -- start a new one)
(NXTLFT←35)
(TOP←TOP-(SUBHEIGHT+1)))
(SETWINDOWSPECS $SWIN
<'SUBREGION
'CREATE
<'TEXTSTRING
(MKSTRING FLD) '(FONT
HELVETICA7)
'(BACKGROUND BLACK)
'INVERTED
<'BOLD (3=NXTLFT)
>> <'LEFT NXTLFT>
<'TOP TOP> '(WHENTOUCHED
EVENTFIELDTOUCHFN)
>)
(SUBREG←$SWIN:WINDOW.SUBREGIONS:-1)
(TMP← <EVENTYP:1 ! FLD>)
(* to make DWMIMIFY of next expression work)
(SUBREG:SUBREGION.USER←TMP)
(<FLD ! SUBREG>))
>
LASTOP←TOP←TOP-(SUBHEIGHT+1]
(LASTOP←LASTOP-(SUBHEIGHT+1))
(for S in $SWIN:BLANKWINDOW.SUBREGIONS
do (SETSPECS S <<'TOP LASTOP 'LESS > <'BOTTOM LASTOP 'LESS >>))
(SETWINDOWSPECS SNAM <'(TOP SAME)
<'BOTTOM LASTOP 'MORE >>)
(RETURN $FILT:FILTER.selectorWindow←$SWIN])
(KillEventSelector
[LAMBDA ($FWIN)
(PROG NIL])
(EVENTFIELDTOUCHFN
[LAMBDA ($SUBREG B C) (* mlm: " 8-MAY-78 14:52")
(PROG [FILT (SELECTOR (fetch (SUBREGION USER) of $SUBREG))
(BACKGROUND (fetch (SUBREGION BACKGROUND) of $SUBREG))
($EVWIN (fetch (WINDOW USER) of (fetch (SUBREGION WINDOW) of $SUBREG]
(SETQ FILT (fetch (WINDOW USER) of $EVWIN))
(COND
[(EQ 0 BACKGROUND) (* already selected, so deselect)
[SETSPECS $SUBREG (QUOTE ((BACKGROUND BLACK)
(TEXTSTRING INVERTED]
(replace (FILTER selectors) of FILT with (DREMOVE SELECTOR (fetch (FILTER selectors)
of FILT]
(T (* wasn't selected)
[SETSPECS $SUBREG (QUOTE ((BACKGROUND WHITE)
(TEXTSTRING (INVERTED NIL]
(replace (FILTER selectors) of FILT with (CONS SELECTOR (fetch (FILTER selectors)
of FILT])
(DisplayEventFieldSelector
[LAMBDA ($FWIN) (* mlm: " 8-MAY-78 14:51")
(PROG (SUBREGLST $SWIN (SELECTEDFIELDS (fetch (FILTER selectors) of (fetch (WINDOW USER)
of $FWIN)))
($FILT (fetch (WINDOW USER) of $FWIN)))
(SETQ $SWIN (OR (fetch (FILTER selectorWindow) of $FILT)
(SetUpEventFieldSelector $FWIN)))
(SETQ SUBREGLST (fetch (WINDOW SUBREGIONS) of $SWIN))
[for SUBREG in SUBREGLST do (SETSPECS SUBREG (COND
[(MEMBER (fetch (SUBREGION USER) of SUBREG)
SELECTEDFIELDS)
(QUOTE ((BACKGROUND WHITE)
(TEXTSTRING (INVERTED NIL]
(T (QUOTE ((BACKGROUND BLACK)
(TEXTSTRING (INVERTED T]
(* for each of the selected EVENTYPExFIELD combinations,
display the corresponding subregion with
((BACKGROUND WHITE) (INVERTED NIL)))
(* REWRITE TOUCHFN)
(replace (WINDOW USER) of $SWIN with CURRWIN)
(VISIBLE $SWIN])
)
(DEFINEQ
(FilterEventsFile
[LAMBDA (DESCRIPTION LIMIT)
(DECLARE (USEDFREE EVENTSFIL))
(PROG (NEVENTS EV)
(SETFILEPTR EVENTSFIL 0)
(NEVENTS←(READ EVENTSFIL))
(StartBarTrace)
(RETURN (REVERSE (for J from NEVENTS to 1 by -1 bind K←0 collect (K←K+1)
EV
when (APPLY* DESCRIPTION EV←(READ EVENTSFIL))
until (AND LIMIT K=LIMIT) eachtime (SetBarTrace J NEVENTS)
finally (StopBarTrace])
(LoadEventsIndex
[LAMBDA (EFIL)
(DECLARE (USEDFREE EVENTSINDEX)) (* mlm: "18-JUL-78 11:00")
(PROG (NEVENTS N PTR TYP)
(EFIL←(INPUT (INFILE EFIL)))
(SETFILEPTR EFIL 0)
(NEVENTS←(READ EFIL))
(EVENTSINDEX←(ARRAY NEVENTS))
(if ADISOFILE
then (StartBarTrace))
(for J from NEVENTS to 1 by -1 do (AND ADISOFILE (SetBarTrace J NEVENTS))
(READ EFIL)
(* skip event number (same as J))
((ELT EVENTSINDEX J)←(READ EFIL))
(* the fileptr for the event)
(SETD EVENTSINDEX J (READ EFIL))
(* the type of the event)
finally (AND ADISOFILE (StopBarTrace))
(CLOSEF EFIL])
(MakeEventsIndex
[LAMBDA (EFIL IFIL) (* mlm: "18-JUL-78 10:59")
(PROG (NEVENTS PTR TYP)
(EFIL←(INPUT (INFILE EFIL)))
(SETFILEPTR EFIL 0)
(IFIL←(OUTPUT (OUTFILE IFIL)))
(NEVENTS←(READ EFIL))
(PRINT NEVENTS IFIL)
(if ADISOFILE
then (StartBarTrace))
(for J from NEVENTS to 1 by -1 do (AND ADISOFILE (SetBarTrace J NEVENTS))
(PTR←(GETFILEPTR EFIL))
(TYP←(READ EFIL):1)
(PRIN1 J IFIL)
(TAB 10 1 IFIL)
(PRIN1 PTR IFIL)
(TAB 25 1 IFIL)
(PRINT TYP IFIL)
finally (AND ADISOFILE (StopBarTrace))
(CLOSEF IFIL])
(StartBarTrace
[LAMBDA NIL
(DECLARE (USEDFREE TRACEBAR))
TRACEBAR←[CAR (fetch (BLANKWINDOW SUBREGIONS)
of (CREATEWINDOW 'BARTRACE NIL '((BOTTOM SAMEAS TYPESCRIPT)
(HEIGHT 104)
(LEFT 30 MORE THAN (TYPESCRIPT RIGHT))
(WIDTH 46)
(BACKGROUND BLACKSTRIPESRIGHT)
(BORDER 2)
(SUBREGION NEW (LEFT 0)
(WIDTH 42)
(BOTTOM 0)
(HEIGHT 0)
(BACKGROUND WHITESTRIPESRIGHT))
(INITIMEFUSE 5]
(PUTPROP 'TRACEBAR 'LAST NIL])
(SetBarTrace
[LAMBDA (N M GRAIN)
(DECLARE (USEDFREE TRACEBAR))
(PROG ((LAST (GETPROP 'TRACEBAR 'LAST))
(NN (if M
then (100*N)/M
else N)))
(if (OR LAST=NIL ((ABS LAST-NN)
GEQ
(OR GRAIN 5)))
then (SETSPECS TRACEBAR <'(BOTTOM SAME)
<'HEIGHT NN>>)
(PUTPROP 'TRACEBAR 'LAST NN])
(StopBarTrace
[LAMBDA NIL
(KILLWINDOW 'BARTRACE])
)
(RPAQQ FILTERFNS (FILT1 FILT2 FILT3))
(DEFINEQ
(FILT1
[LAMBDA (EV) (* mlm: " 5-MAY-78 16:06")
(AND 'ToFind =EV:TriggerEvent.type])
(FILT2
[LAMBDA (EV) (* mlm: " 5-MAY-78 16:06")
(AND (EQ (QUOTE TriggerEvent)
(CAR EV))
(EQ (QUOTE WhenFilled)
(fetch (TriggerEvent type) of EV))
(EQ (QUOTE InputEvent)
(EventType (fetch (TriggerEvent firingEvent) of EV])
(FILT3
[LAMBDA (EV) (* mlm: " 5-MAY-78 16:06")
(OR (EQ (QUOTE InputEvent)
(EventType EV))
(AND (EQ (QUOTE TriggerEvent)
(EventType EV))
(EQ (QUOTE WhenFilled)
(fetch (TriggerEvent type) of EV))
(EQ (QUOTE InputEvent)
(EventType (fetch (TriggerEvent firingEvent) of EV])
)
(RPAQQ EVENTFIELDLST ((InputEvent time expression firedTriggers)
(TriggerEvent type time inclusiveDuration duration protoname protoslot
triggerAnchor firingEvent actions)
(TriggerActionEvent triggerEvent firedTriggers form value startTime endTime
inclusiveDuration duration)))
(RPAQQ TRIGGERTYPES (ToProcess BeforeFilled WhenDescribed ToInitialize ToFind WhenFilled))
(RPAQQ ESYSFILES (<MODEL>DMISC <KBA>DNET DISPLAYFNS DSYSCHANGES))
(DECLARE: EVAL@COMPILE
(TYPERECORD InputEvent (ID time expression firedTriggers))
(TYPERECORD TriggerEvent (ID type (time inclusiveDuration duration)
firingEvent
(protoname protoslot . triggerAnchor)
actions))
(TYPERECORD TriggerActionEvent (ID form value (triggerEvent firedTriggers)
(startTime endTime inclusiveDuration duration)))
(RECORD FILTER (description selectors events selectorWindow))
)
(PUTPROPS EVENTSMENU WINDOWSPECS ((HEIGHT 6 LINES)
(CAPTION "EVENTS" CENTERED)
(LEFT 5 MORE THAN (TYPESCRIPT RIGHT)
600)
(BOTTOM SAMEAS TYPESCRIPT)
(VISIBLE NIL)
(INITIMEFUSE NIL)))
(PUTPROPS EVENTSMENU MENUCOMS ((CREATEFILTER "Create Filter Window"
(You will be asked for a description and then to mark
out a window.))
(EXTENDOWN "Successor Events"
(Adds the events immediately caused by the ones already selected to the window
and changes the filter function accordingly.))
(EXTENDUP "Parent Events"
(Adds the events causing the ones already selected to the window and changes the
filter function accordingly))
(CHANGEFILTER "Change Window Filter" (Allows changing the filter expression/function of a
filter window.))
(SELECTEVENTFIELDS "Select Event Fields"
(Allows changing which event fields are displayed for the events in the
designated filter window))
(DONESELECTFIELDS "Done Selecting Fields"
(Will cause the Filter window associated with this invocation of the
Event Field Selector to be rewritten and the Event Field Selector
to disappear))))
(SETQ MENULST (CONS (QUOTE EVENTSMENU)
MENULST))
(ADDPROP (QUOTE MENUMENU)
(QUOTE MENUCOMS)
(QUOTE (EVENTSMENU "Events"))
T)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: TriggerTree TriggerTree (TriggerTree))
(BLOCK: LastActionEvent LastActionEvent (LastActionEvent))
]
(DECLARE: DONTCOPY EVAL@COMPILE DONTEVAL@LOAD
(OR (NEQ (GETATOMVAL (QUOTE BACKGROUNDLST))
(QUOTE NOBIND))
(SETQ BACKGROUNDLST NIL))
(LOAD? (QUOTE <KBA>RECORDS)
(QUOTE SYSLOAD))
(LOAD? (QUOTE <KBA>DISPCOMP)
(QUOTE SYSLOAD))
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML DisplayTriggerValue DisplayTrigger)
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (1368 2967 (LoadEsys 1380 . 1537) (SetUpEsys 1541 . 1618) (EVENTSDEMO 1622 . 2964)) (
3524 22859 (EVENTSMENU 3536 . 6173) (GetEvent 6177 . 6363) (EventParent 6367 . 6581) (EventSuccessors
6585 . 6882) (EventType 6886 . 7097) (EventTypes 7101 . 7203) (EventDuration 7207 . 7783) (
DisplayTriggerTree 7787 . 8272) (TriggerTree 8276 . 9319) (LastActionEvent 9323 . 9989) (
TriggerActionDuration 9993 . 10971) (TriggerDuration 10975 . 11507) (OrderActionsByDuration 11511 .
11922) (CREATEFILTER 11926 . 12658) (FILTER 12662 . 13098) (FILTERCOUNT 13102 . 13465) (
DisplayFilterEvents 13469 . 14046) (DisplayFilteredEvents 14050 . 14915) (DisplayTrigger 14919 . 15899)
(DisplayTriggerValue 15903 . 16612) (LoadEvents 16616 . 17372) (EventsFromSelections 17376 . 17808) (
SetUpEventFieldSelector 17812 . 20496) (KillEventSelector 20500 . 20558) (EVENTFIELDTOUCHFN 20562 .
21607) (DisplayEventFieldSelector 21611 . 22856)) (22861 26128 (FilterEventsFile 22873 . 23401) (
LoadEventsIndex 23405 . 24345) (MakeEventsIndex 24349 . 25111) (StartBarTrace 25115 . 25680) (
SetBarTrace 25684 . 26060) (StopBarTrace 26064 . 26125)) (26175 27062 (FILT1 26187 . 26331) (FILT2
26335 . 26663) (FILT3 26667 . 27059)))))
STOP