(FILECREATED " 9-Aug-84 23:35:26" {DSK}WINDOWTRACE-NC.LISP;2 10419  

      changes to:  (FNS WINDOWTRACE W\TRACE))


(PRETTYCOMPRINT WINDOWTRACECOMS)

(RPAQQ WINDOWTRACECOMS ((FNS WINDOWTRACE W\ADDMENU W\TRACE W\GATHERINFO)
			(GLOBALVARS WFILENAME DRIBBLEFILE WProtocolfile CLOCKWINDOW WINDOWNUMBER 
				    W\LEVEL1 W\LEVEL2 W\ADVISEDFNLIST W\PRINTDATA W\STACK)
			(P (RPAQ W\WINDOWREGION (CREATE REGION USING (QUOTE (700 200 300 100)))))
			(P (RPAQ WFILENAME (MKATOM (CONCAT "{DSK}" (COND ((STREQUAL (SUBSTRING
										      (USERNAME)
										      -3)
										    ".PA")
									  (SUBATOM (USERNAME)
										   1 -4))
									 (T (USERNAME)))
							   ".WPROTOCOL"))))
			(P (RPAQ DRIBBLEFILE (MKATOM (CONCAT "{DSK}" (COND ((STREQUAL
									      (SUBSTRING (USERNAME)
											 -3)
									      ".PA")
									    (SUBATOM (USERNAME)
										     1 -4))
									   (T (USERNAME)))
							     ".DRIBBLEFILE"))))
			(P (CLDISABLE (QUOTE *)))
			(P (RPAQ W\ADVISEDFNLIST NIL))))
(DEFINEQ

(WINDOWTRACE
  (LAMBDA (ON.OFF EXPPARAM LEVELS NESTEDEVENTSFLAG)          (* NoteCards% User " 9-Aug-84 23:32")

          (* * This function advises some WINDOW functions in order to collect protocols)


    (PROG (L1.EVENTS L2.EVENTS EVENTS.LIST HEADINGS NCID)
          (SETQQ HEADINGS (EXPERIMENT EXPNO DATE SUBJECT))
          (COND
	    ((EQ (QUOTE ?)
		 ON.OFF)
	      (printout T "ON.OFF: ON OFF" T "EXPPARAM: " (LIST HEADINGS)
			T "LEVELS: 1 2 12" T 7 
	       "[WHERE 1 IS {WCLOse WOPEn WMOVe WSHApe WSHInk WEXPand} AND 2 IS {NcMAKenotecard}"))
	    ((OR (EQ (QUOTE ON)
		     ON.OFF)
		 ON.OFF)
	      (COND
		(W\ADVISEDFNLIST                             (* already traced?)
				 (RETURN W\ADVISEDFNLIST)))
	      (COND
		((NULL EXPPARAM)
		  (SETQ EXPPARAM (for I in HEADINGS collect (PROMPTFORWORD (CONCAT (CHARACTER 13)
										   I
										   (QUOTE ?)))))))
	      (SETQ W\STACK (LIST (QUOTE TOP)))
	      (SETQ W\ADVISEDFNLIST NIL)
	      (SETQ W\LEVEL1 (CREATE.MONITORLOCK (QUOTE W.LEVEL1)))
	      (SETQ W\LEVEL2 (CREATE.MONITORLOCK (QUOTE W.LEVEL2)))
	      (SETQ W\PRINTDATA (CREATE.MONITORLOCK (QUOTE W.PRINTDATA)))
	      (SETQ WINDOWTIME (CLOCK))
	      (SETQ CLOCKWINDOW (CREATEW W\WINDOWREGION (QUOTE DCLOCK)))
	      (DSPFONT (FONTCREATE (QUOTE TIMESROMAND)
				   36
				   (QUOTE BRE)
				   0
				   (QUOTE DISPLAY))
		       CLOCKWINDOW)
	      (SETQ WProtocolfile (GETSTREAM (OPENFILE (OR (CLOSEF? WFILENAME)
							   WFILENAME)
						       (QUOTE APPEND)
						       (QUOTE OLD/NEW)
						       NIL
						       (QUOTE SEQUENTIAL))
					     (QUOTE OUTPUT)))
	      (printout WProtocolfile "(*HEADING:" T)
	      (for I in HEADINGS
		 do (printout WProtocolfile 10 I 30 (CAR EXPPARAM)
			      T)
		    (SETQ EXPPARAM (CDR EXPPARAM)))
	      (printout WProtocolfile 10 (QUOTE FORMAT)
			30 .PPV (QUOTE (Event Time Parent (WindowID Title (Region)
								    (NoteCardID NoteCardTitle))
					      (WindowStack))))
	      (printout WProtocolfile T ")" T)
	      (DRIBBLE DRIBBLEFILE)
	      (WHENCLOSE WProtocolfile (QUOTE STATUS)
			 (QUOTE PERMSTATUS)
			 (QUOTE CLOSEALL)
			 (QUOTE NO))
	      (RPAQ WINDOWNUMBER 0)
	      (for i in (REVERSE (OPENWINDOWS))
		 do (W\GATHERINFO i)
		    (PRINT (LIST (QUOTE *W.INFO)
				 NIL NIL (WINDOWPROP i (QUOTE W\WINDOWPROPS)))
			   WProtocolfile))                   (* Initialise prop W\WINDOWPROPS on already existing 
							     windows)
	      (SETPROPLIST (QUOTE EVENTS.LIST)
			   (QUOTE (1 (OPENW CLOSEW MOVEW SHAPEW SHRINKW EXPANDW)
				     2
				     (NC.MakeNoteCard NC.TEditCloseFn NC.AssignTitle))))
	      (SETQ LEVELS (COND
		  ((LISTP LEVELS)
		    (PACK LEVELS))
		  (LEVELS)
		  (T 12)))
	      (SELECTQ LEVELS
		       (1 (SETQ L1.EVENTS (GETPROP (QUOTE EVENTS.LIST)
						   1)))
		       (2 (SETQ L2.EVENTS (GETPROP (QUOTE EVENTS.LIST)
						   2)))
		       ((12 21)
			 (SETQ L1.EVENTS (GETPROP (QUOTE EVENTS.LIST)
						  1))
			 (SETQ L2.EVENTS (LDIFFERENCE (GETPROP (QUOTE EVENTS.LIST)
							       2)
						      (GETPROP (QUOTE EVENTS.LIST)
							       1))))
		       (SHOULDNT "UNKNOWN EVENT"))
	      (AND NESTEDEVENTSFLAG (SETQ W\LEVEL1 W\LEVEL2))
	      (SETQ W\ADVISEDFNLIST (UNION L1.EVENTS L2.EVENTS))
	      (SETQ ADVINFOLST NIL)                          (* Initialise advised functions -- will destroy any 
							     previous advise information)
	      (for j to 2
		 do (for I in (EVAL (PACK* (QUOTE L)
					   j
					   (QUOTE .EVENTS)))
		       do (ADVISE I (QUOTE AROUND)
				  (LIST (QUOTE PROG)
					(QUOTE (CMDVALUE W\WINDOW))
					(LIST (QUOTE ATTACH)
					      (LIST (QUOTE QUOTE)
						    I)
					      (QUOTE W\STACK))
					(QUOTE (SETQ CMDVALUE *))
					(LIST (QUOTE COND)
					      (LIST (QUOTE (OR (NEQ W\LEVEL1 W\LEVEL2)
							       (ILEQ (LENGTH W\STACK)
								     2)))
						    (LIST (QUOTE WITH.MONITOR)
							  (PACK (LIST (QUOTE W\LEVEL)
								      j))
							  (QUOTE (SETQ W\WINDOW
								       (COND
									 ((BOUNDP (QUOTE WINDOW))
									   WINDOW)
									 (T NIL))))
							  (LIST (QUOTE W\TRACE)
								(LIST (QUOTE QUOTE)
								      I)
								(QUOTE W\WINDOW)
								(QUOTE CMDVALUE)))))
					(QUOTE (SETQ W\STACK (CDR W\STACK)))
					(LIST (QUOTE RETURN)
					      (QUOTE CMDVALUE))))))
	      (SETQ ADVINFOLST NIL))
	    (T (APPLY (QUOTE UNADVISE)
		      W\ADVISEDFNLIST)
	       (SETQ W\ADVISEDFNLIST NIL)
	       (CLOSEW CLOCKWINDOW)
	       (CLOSEF? WProtocolfile)
	       (DRIBBLE)

          (* (COPYFILE WFILENAME (MKATOM (CONCAT "{PHYLUM}<PSYCH>WINDOWS>" (COND ((STREQUAL (SUBSTRING 
	  (USERNAME) -3) ".PA") (SUBATOM (USERNAME) 1 -4)) (T (USERNAME))) ".WPROTOCOL"))))

                                                             (* (COPYFILE DRIBBLEFILE (MKATOM 
							     (CONCAT "{PHYLUM}<PSYCH>WINDOWS>" 
							     (USERNAME) ".DRIBBLEFILE"))))
	       ))                                            (* (W\ADDMENU FLAG) if one wishes to add it to the 
							     background menu)
          (RETURN W\ADVISEDFNLIST))))

(W\ADDMENU
  (LAMBDA (FLAG)                                             (* edited: "19-Apr-84 11:07")
    (PROG (CURRENTWINDOW (OFF.LIST ' ("Wtrace OFF" (WINDOWTRACE)
						   "Turns Window tracing OFF"))
			 (ON.LIST ' ("Wtrace ON" (WINDOWTRACE T)
						 "Turns Window tracing ON"))
			 (LAST.CHOICE (OR (SASSOC "Wtrace OFF" BackgroundMenuCommands)
					  (SASSOC "Wtrace ON" BackgroundMenuCommands))))
          (AND LAST.CHOICE (SETQ BackgroundMenuCommands (DREMOVE LAST.CHOICE BackgroundMenuCommands)))
          (NCONC1 BackgroundMenuCommands (COND
		    (FLAG                                    (* Tracing is being turned on)
			  OFF.LIST)
		    (T                                       (* Tracing is being turned off)
		       ON.LIST)))
          (SETQ BackgroundMenu NIL)
          (COND
	    (FLAG (DRIBBLE DRIBBLEFILE))
	    (T (DRIBBLE))))))

(W\TRACE
  (LAMBDA (EVENT WINDOW CMDVALUE)                            (* NoteCards% User " 9-Aug-84 23:10")
    (PROG ((CHANGEDWINDOW WINDOW)
	   EVENT.TYPE NCID)

          (* * Print the event in the following format: (event time (windowID title (region) NoteCardID) 
	  (windowstack)) -- there is a user defined WINDOWPROP, W\WINDOWPROPS, created at the time of OPENW, that keeps the 
	  printed information with the window itself. It gets modified as other events (MOVEW, SHAPEW ,ETC) happen.)


          (SETQ EVENT.TYPE EVENT)
          (SETQ CHANGEDWINDOW WINDOW)
          (SETQ TIME (IDIFFERENCE (CLOCK)
				  WINDOWTIME))
          (COND
	    ((LISTP EVENT.TYPE)
	      (SETQ EVENT.TYPE (CAR EVENT.TYPE))))
          (COND
	    ((NULL (WINDOWPROP CHANGEDWINDOW (QUOTE W\WINDOWPROPS)))
	      (W\GATHERINFO CHANGEDWINDOW)))
          (COND
	    ((SELECTQ EVENT.TYPE
		      ((OPENW CLOSEW)
			(COND
			  ((NULL (WINDOWPROP CHANGEDWINDOW (QUOTE W\WINDOWPROPS)))
			    (W\GATHERINFO CHANGEDWINDOW)))
			(SETQ EVENT.TYPE (PACK* (QUOTE W.)
						EVENT.TYPE))
			T)
		      ((MOVEW SHAPEW BURYW SHRINKW EXPANDW)
			(COND
			  ((NULL (WINDOWPROP CHANGEDWINDOW (QUOTE W\WINDOWPROPS)))
			    (W\GATHERINFO CHANGEDWINDOW)))
			(RPLACA (CDDR (WINDOWPROP CHANGEDWINDOW (QUOTE W\WINDOWPROPS)))
				(WINDOWPROP CHANGEDWINDOW (QUOTE REGION)))
			(SETQ EVENT.TYPE (PACK* (QUOTE W.)
						EVENT.TYPE))
			T)
		      (MENU (SETQ EVENT.TYPE (CAR CMDVALUE))
			    (W\GATHERINFO CHANGEDWINDOW)
			    T)
		      ((NC.AssignTitle NC.TEditCloseFn)
			(W\GATHERINFO CHANGEDWINDOW))
		      (NC.MakeNoteCard (W\GATHERINFO (SETQ CHANGEDWINDOW CMDVALUE)))
		      NIL)
	      (WITH.MONITOR W\PRINTDATA (PRINT (LIST (SUBATOM EVENT.TYPE 1 5)
						     TIME
						     (COND
						       ((ILEQ (LENGTH W\STACK)
							      2)
							 NIL)
						       (T (CDR (REVERSE (CDR W\STACK)))))
						     (WINDOWPROP CHANGEDWINDOW (QUOTE W\WINDOWPROPS))
						     (for I in (OPENWINDOWS)
							collect (CAR (WINDOWPROP I (QUOTE 
										    W\WINDOWPROPS)))))
					       WProtocolfile))
	      (CENTERPRINTINREGION TIME NIL CLOCKWINDOW))))
    EVENT))

(W\GATHERINFO
  (LAMBDA (WINDOW NCID)                                      (* NoteCards% User " 6-Aug-84 18:19")
    (WINDOWPROP WINDOW (QUOTE W\WINDOWPROPS)
		(LIST (PACK* (QUOTE W)
			     (SETQ WINDOWNUMBER (ADD1 WINDOWNUMBER)))
		      (COND
			((WINDOWPROP WINDOW (QUOTE TITLE)))
			(T "Untitled"))
		      (WINDOWPROP WINDOW (QUOTE REGION))
		      (LIST (SETQ NCID (WINDOWPROP WINDOW (QUOTE NoteCardID)))
			    (NC.FetchTitle NCID))))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS WFILENAME DRIBBLEFILE WProtocolfile CLOCKWINDOW WINDOWNUMBER W\LEVEL1 W\LEVEL2 
	  W\ADVISEDFNLIST W\PRINTDATA W\STACK)
)
(RPAQ W\WINDOWREGION (CREATE REGION USING (QUOTE (700 200 300 100))))
(RPAQ WFILENAME (MKATOM (CONCAT "{DSK}" (COND ((STREQUAL (SUBSTRING (USERNAME)
								    -3)
							 ".PA")
					       (SUBATOM (USERNAME)
							1 -4))
					      (T (USERNAME)))
				".WPROTOCOL")))
(RPAQ DRIBBLEFILE (MKATOM (CONCAT "{DSK}" (COND ((STREQUAL (SUBSTRING (USERNAME)
								      -3)
							   ".PA")
						 (SUBATOM (USERNAME)
							  1 -4))
						(T (USERNAME)))
				  ".DRIBBLEFILE")))
(CLDISABLE (QUOTE *))
(RPAQ W\ADVISEDFNLIST NIL)
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1015 9692 (WINDOWTRACE 1025 . 6186) (W\ADDMENU 6188 . 7066) (W\TRACE 7068 . 9236) (
W\GATHERINFO 9238 . 9690)))))
STOP