(FILECREATED "26-Nov-85 09:54:57" {ROSEBOWL}<FEUERMAN>LISP>BUGREPORT.;13 20614
changes to: (FNS BUGREPORT.GETUSERCOMMENT BUGREPORT.PRINT BUGREPORT.PRINTVARVAL BUGREPORT
BUGREPORT.CHOOSEBREAK1 BUGREPORT.MAKEREPORT?)
(VARS BUGREPORTCOMS)
previous date: "12-Apr-85 13:08:45" {ROSEBOWL}<FEUERMAN>LISP>BUGREPORT.;11)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT BUGREPORTCOMS)
(RPAQQ BUGREPORTCOMS [(* * This package is intended for use by an applications programmer who wants
to shield the user from the possibility of a Lisp break window. Instead of
the Lisp break windows, a menu appears asking if a bug report should be
made of not. If the answer is yes, the system creates a file
(BUGREPORT.TTY defaulting on a floppy if the machine is a DLION, on {DSK}
if the machine is a Dorado or Dolphin)
which contains information that the system maintenance people can use to
determine the cause of the bug. The system is customizeable by the system
designer - there are many variables that they can set to determine the
exact behavior of the system. See the description of the variables below,
or the documentation.)
(FNS BUGREPORT BUGREPORT.CHOOSEBREAK1 BUGREPORT.GETUSERCOMMENT BUGREPORT.SEGMENT.STRING
BUGREPORT.INCLUDEFRAMEP BUGREPORT.INITIALIZE BUGREPORT.INITIALIZEFILE
BUGREPORT.INSUREBRFLOPPY BUGREPORT.MAKE.FLOPPY.FILE BUGREPORT.MAKEREPORT?
BUGREPORT.PRINT BUGREPORT.PRINTENTRY BUGREPORT.PRINTVARVAL BUGREPORT.USERDATA
BUGREPORT.PRINTFORMS BUGREPORT.STRING.LENGTH)
(* These variables should be set by the programmer who wishes to use BUGREPORT to get reports
on bugs in his program. If BUGREPORT.REPORTNOBREAK? is NIL then when a BREAK occurs, the
normal break window will appear; otherwise, the user will be prompted to create a bug
report or not. BUGREPORT.DEVICE should be either {DSK}, {CORE}, or {FLOPPY}, to specify
where the file BUGREPORT.TTY will be put when created. BUGREPORT.FRAMENAMELST is a list of
frame names that the programmer wishes to see in the bug report. This will very likely be
(FILEFNSLST File)
, where File is the name of the File that the programmer has created. If
BUGREPORT.FRAMENAMELST is T, all frames will be print, if BUGREPORT.FRAMENAMELST is NIL,
no frames. BUGREPORT.FORMS is a list of forms which will be printed followed by the EVAL
of the form. This is meant to give the system creator the ability to have information in
the bug report that might not otherwise be printed.)
(GLOBALVARS BUGREPORT.REPORTNOBREAK? BUGREPORT.DEVICE BUGREPORT.FRAMENAMELST
BUGREPORT.EXCLUDED.FRAMENAMELST BUGREPORT.FORMS BUGREPORT.MENU)
[INITVARS BUGREPORT.REPORTNOBREAK? (BUGREPORT.DEVICE (QUOTE {DSK}))
(BUGREPORT.FRAMENAMELST T)
BUGREPORT.FORMS
(BUGREPORT.EXCLUDED.FRAMENAMELST (QUOTE (BUGREPORT BUGREPORT.CHOOSEBREAK1
BUGREPORT.GETUSERCOMMENT
BUGREPORT.INCLUDEFRAMEP
BUGREPORT.INITIALIZE
BUGREPORT.INITIALIZEFILE
BUGREPORT.INSUREBRFLOPPY
BUGREPORT.MAKE.FLOPPY.FILE
BUGREPORT.MAKEREPORT?
BUGREPORT.PRINT
BUGREPORT.PRINTENTRY
BUGREPORT.PRINTVARVAL
BUGREPORT.USERDATA
BUGREPORT.PRINTFORMS]
(P (BUGREPORT.INITIALIZE))
(PROP PRINTFN WINDOW)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML
BUGREPORT.CHOOSEBREAK1)
(LAMA])
(* * This package is intended for use by an applications programmer who wants to shield the
user from the possibility of a Lisp break window. Instead of the Lisp break windows, a menu
appears asking if a bug report should be made of not. If the answer is yes, the system creates
a file (BUGREPORT.TTY defaulting on a floppy if the machine is a DLION, on {DSK} if the machine
is a Dorado or Dolphin) which contains information that the system maintenance people can use
to determine the cause of the bug. The system is customizeable by the system designer - there
are many variables that they can set to determine the exact behavior of the system. See the
description of the variables below, or the documentation.)
(DEFINEQ
(BUGREPORT
[LAMBDA (BRKFN BRKTYPE ERRORN) (* Feuerman "26-Nov-85 08:46")
(* As soon as we understand how to use the arguments, we'll do it. But for now, all we'll do is ask the user if he
wants to make a bug report)
[COND
((EQ BUGREPORT.DEVICE (QUOTE {FLOPPY}))
(BUGREPORT.MAKE.FLOPPY.FILE BUGREPORT.FRAMENAMELST BUGREPORT.EXCLUDED.FRAMENAMELIST))
(T (BUGREPORT.PRINT BUGREPORT.FRAMENAMELST BUGREPORT.EXCLUDED.FRAMENAMELST
(PACKFILENAME (QUOTE HOST)
BUGREPORT.DEVICE
(QUOTE NAME)
(QUOTE BUGREPORT)
(QUOTE EXTENSION)
(QUOTE TTY]
(ERROR!])
(BUGREPORT.CHOOSEBREAK1
[NLAMBDA (BRKEXP BRKWHEN BRKFN BRKCOMS BRKTYPE ERRORN) (* Feuerman "26-Nov-85 09:22")
(* Makes the decision, based on the value of BUGREPORT.REPORTNOBREAK?, on whether to call up the normal BREAK1
(which has by this time been renamed to OLDBREAK1) or to call the BUGREPORT. By encapsulating further evaluation
inside of OLDBREAK1 and passing NIL on as the value of BRKWHEN, we are guaranteed that we will return from this
break)
(COND
((STKPOS (QUOTE BUGREPORT))
(PROGN (RINGBELLS)
(PROMPTPRINT (CHARACTER 13)
" An error has occurred while processing a bugreport."
" The bugreport in progress will not be created; the system will be reset. "
(ERRORN))
(CLOSEALL)
(RESET)))
((AND (NOT BRKCOMS)
BUGREPORT.REPORTNOBREAK?)
(SELECTQ (BUGREPORT.MAKEREPORT? ERRORN)
(YES (OLDBREAK1 (BUGREPORT BRKFN BRKTYPE ERRORN)
NIL BRKFN BRKCOMS BRKTYPE ERRORN))
(BREAK (APPLY (QUOTE OLDBREAK1)
(LIST BRKEXP BRKWHEN BRKFN BRKCOMS BRKTYPE ERRORN)))
(NO (ERROR!))
(ERROR!)))
(T (APPLY (QUOTE OLDBREAK1)
(LIST BRKEXP BRKWHEN BRKFN BRKCOMS BRKTYPE ERRORN])
(BUGREPORT.GETUSERCOMMENT
[LAMBDA (FILENAME) (* Feuerman "26-Nov-85 09:54")
(* Asks the user for some comment about the bug report that is being created. A possible user response to this is
simply a carriage return, indicating no comment)
(RESETLST (RESETSAVE (CURSOR \PROMPTFORWORD.CURSOR))
(PROG ((COMMENTWINDOW (CREATEW (QUOTE (260 233 485 305))
NIL 16)))
(PRIN1 "User Comment: " FILENAME)
(PRIN1 [BUGREPORT.SEGMENT.STRING (PROMPTFORWORD
"Type in comment to be included in bug report as an indication
in your own words of what you tried to do. Type a carriage
return to end (for no comment, simply type a carriage return):
"
NIL NIL COMMENTWINDOW
NIL NIL
(LIST (CHARACTER
13]
FILENAME)
(CLOSEW COMMENTWINDOW)
(TERPRI FILENAME)
(TERPRI FILENAME])
(BUGREPORT.SEGMENT.STRING
[LAMBDA (String) (* Newman "11-Apr-85 17:45")
(* This function segments String into 72 character long segments: it assumes that there are no carriage returns, and
uses carriage returns to do the segmenting. DVN)
(PROG [FirstPart Rest (Position (bind ((TempString ←(ALLOCSTRING 1 32))
(TestString ←(ALLOCSTRING 1 32))
(Value ← NIL)
(Num ← 72))
do (if (STREQUAL TestString (SUBSTRING String Num Num
TempString))
then (SETQ Value Num))
(SETQ Num (SUB1 Num))
until (OR Value (EQUAL Num 1)) finally (RETURN (OR Value 72]
(SETQ FirstPart (SUBSTRING String 1 Position))
(SETQ Rest (SUBSTRING String (ADD1 Position)
NIL))
(RETURN (if (OR (NULL Rest)
(GREATERP 72 (BUGREPORT.STRING.LENGTH String)))
then (SUBSTRING String 1 NIL)
else (CONCAT FirstPart (CHARACTER 13)
(BUGREPORT.SEGMENT.STRING Rest])
(BUGREPORT.INCLUDEFRAMEP
[LAMBDA (NAME FRAMENAMELST EXCLUDED.FRAMENAMELIST) (* edited: "13-Mar-85 11:22")
(* * This predicate does the determination whether to include NAME in the bug report. If NAME is a member of the
list FRAMENAMELST, print it, period. If it is a member of EXCLUDED.FRAMENAMELIST, don't print it.)
(* * It's only when FRAMENAMELST = T when we do some real checking. This is when we see if NAME is somehow specified
on EXCLUDED.FRAMENAMELIST. "Somehow specified" means that if the first character in NAME is \ and \ is included on
EXCLUDED.FRAMENAMELIST, then don't print it (exclude "internals"). The same goes for the litatom *
(for excluding "Blips"))
(COND
((EQ FRAMENAMELST T)
(COND
((MEMB NAME EXCLUDED.FRAMENAMELIST)
NIL)
((AND (EQ (SUBATOM NAME 1 1)
(QUOTE \))
(MEMB (QUOTE \)
EXCLUDED.FRAMENAMELIST))
NIL)
((AND (EQ (SUBATOM NAME 1 1)
(QUOTE *))
(MEMB (QUOTE *)
EXCLUDED.FRAMENAMELIST))
NIL)
(T T)))
(T (MEMB NAME FRAMENAMELST])
(BUGREPORT.INITIALIZE
[LAMBDA NIL (* Feuerman "26-Jul-84 14:55")
(MOVD? (QUOTE BREAK1)
(QUOTE OLDBREAK1))
(MOVD (QUOTE BUGREPORT.CHOOSEBREAK1)
(QUOTE BREAK1])
(BUGREPORT.INITIALIZEFILE
[LAMBDA (FILENAME) (* Feuerman "26-Jul-84 16:32")
(* Prints the header information to FILENAME, which
includes the current user and the date on which the
error occurred)
(PRIN1 (CONCAT "BUG REPORT DATE: " (GDATE)
" SUBMITTED BY: " USERNAME)
FILENAME)
(TERPRI FILENAME)
(TERPRI FILENAME)
(TERPRI FILENAME)
(TERPRI FILENAME)
(TERPRI FILENAME])
(BUGREPORT.INSUREBRFLOPPY
[LAMBDA (BUGFILE FLOPPYNAME) (* Newman "12-Apr-85 12:41")
(* * This function makes sure that you have a bug report floppy in the floppy drive with enough room on it for
BUGFILE KEF)
(PROG ((SIZE (GETFILEINFO BUGFILE (QUOTE SIZE)))
NEWFLOPPY?)
NEWFLOPPY
(COND
((NOT (MOUSECONFIRM (CONCAT "Are you still sure you want to make a " FLOPPYNAME
" floppy?")
NIL PROMPTWINDOW))
(RETURN)))
(PRIN1 (CONCAT "Waiting for a new " FLOPPYNAME
" floppy to be inserted into the floppy drive....")
PROMPTWINDOW)
(FLOPPY.WAIT.FOR.FLOPPY NEWFLOPPY?)
(PRIN1 "done. Thank you." PROMPTWINDOW) (* Now, check to see if the floppy is formatted or not.
If not, do so.)
(OR (\PFLOPPY.GET.PSECTOR9)
(FLOPPY.FORMAT FLOPPYNAME T)) (* Now check to see if the floppy, at this point
guaranteed to be formatted, is named FLOPPYNAME)
(COND
((NOT (OR (EQUAL (FLOPPY.NAME)
FLOPPYNAME)
(EQUAL (FLOPPY.NAME)
NIL)))
(SETQ NEWFLOPPY? T)
(RINGBELLS)
(PROMPTPRINT "That floppy is named " (FLOPPY.NAME)
" Please insert a blank floppy or a bug report floppy. ")
(GO NEWFLOPPY)))
(* OK. If we've gotten this far, then we have a floppy whose name is FLOPPYNAME Now see if there's enough room on
the floppy for the file. By recommendation, leave about 1/4 of the floppy empty (that's why we subtract 500 pages
below))
(COND
((IGREATERP SIZE (IDIFFERENCE (FLOPPY.FREE.PAGES)
500))
(GO NEWFLOPPY))
(T (RETURN T])
(BUGREPORT.MAKE.FLOPPY.FILE
[LAMBDA (FRAMENAMELST EXCLUDED.FRAMENAMELIST) (* Newman "12-Apr-85 13:00")
(* * This function prints the bugreport to FLOPPY after makeing sure the floppy is a bug report floppy with enough
room for the file. It also temporarily resets the floppy mode KEF DVN)
(RESETLST (RESETSAVE (FLOPPY.MODE (QUOTE PILOT)))
(BUGREPORT.PRINT FRAMENAMELST EXCLUDED.FRAMENAMELIST (QUOTE {DSK}BUGREPORT.SCRATCH))
[COND
((BUGREPORT.INSUREBRFLOPPY (QUOTE {DSK}BUGREPORT.SCRATCH)
(QUOTE Bug% Report))
(COPYFILE (QUOTE {DSK}BUGREPORT.SCRATCH)
(QUOTE {FLOPPY}BUGREPORT.TTY]
(DELFILE (QUOTE {DSK}BUGREPORT.SCRATCH])
(BUGREPORT.MAKEREPORT?
[LAMBDA (ERRORN) (* Feuerman "26-Nov-85 09:13")
(MENU (create MENU
ITEMS ←[LIST (QUOTE ("Make a Bug Report" (QUOTE YES)))
(QUOTE ("Exit Without Making the Report" (QUOTE NO)))
(QUOTE ("Bring up a Break Window" (QUOTE BREAK]
TITLE ←(COND
[ERRORN (COND
((NUMBERP (CAR ERRORN))
(CONCAT (ERRORSTRING (CAR ERRORN))
" - "
(CADR ERRORN)))
(T (CONCATLIST (MKLIST ERRORN]
(T "A break has occurred in the program"))
CENTERFLG ← T
MENUFONT ←(DSPFONT NIL WindowTitleDisplayStream])
(BUGREPORT.PRINT
[LAMBDA (FRAMENAMELST EXCLUDED.FRAMENAMELIST FILE) (* Feuerman "26-Nov-85 09:48")
(* Actually creates the FILE, calls up the initialization to print the header information, then steps backward
through the stack, sorting out the frames that are in the FRAMENAMELST, (and not in EXCLUDED.FRAMENAMELIST) and
prints the arguments and their values for each frame in that list)
(RESETLST (RESETSAVE (CURSOR WAITINGCURSOR))
(PROMPTPRINT "Making Bug Report ...")
[PROG ((STKPTR -1)
(FILENAME (OPENFILE FILE (QUOTE OUTPUT)))
POS)
(BUGREPORT.INITIALIZEFILE FILENAME)
(BUGREPORT.GETUSERCOMMENT FILENAME)
(BUGREPORT.PRINTFORMS FILENAME)
LOOP(COND
((SETQ POS (STKNTH STKPTR))
(COND
((BUGREPORT.INCLUDEFRAMEP (STKNAME POS)
FRAMENAMELST EXCLUDED.FRAMENAMELIST)
(BUGREPORT.PRINTENTRY POS FILENAME)))
(SETQ STKPTR (SUB1 STKPTR))
(GO LOOP))
(T (RETURN (CLOSEF FILENAME]
(PRIN1 "done." PROMPTWINDOW])
(BUGREPORT.PRINTENTRY
[LAMBDA (POS FILENAME) (* Feuerman "26-Jul-84 16:35")
(* Prints the frame name onto FILENAME and calls the
routine to print the arguments and values)
(PRINT (STKNAME POS)
FILENAME)
(for VARIABLE in (VARIABLES POS) as VALUE in (STKARGS POS) do (BUGREPORT.PRINTVARVAL VARIABLE
VALUE
FILENAME))
(TERPRI FILENAME)
(TERPRI FILENAME])
(BUGREPORT.PRINTVARVAL
[LAMBDA (VARIABLE VALUE FILENAME) (* Feuerman "26-Nov-85 09:36")
(* Prints the VARIABLE name and its VALUE to FILENAME,
according to a neat format)
(APPLY* [OR (GETPROP (TYPENAME VALUE)
(QUOTE PRINTFN))
(QUOTE (LAMBDA (VARIABLE VALUE FILENAME)
(printout FILENAME .TAB 5 VARIABLE .TAB 30 .PPV VALUE T]
VARIABLE VALUE FILENAME])
(BUGREPORT.USERDATA
[LAMBDA (INSTANCE) (* edited: "14-Dec-84 15:31")
(RECORDACCESS (QUOTE USERDATA)
INSTANCE
(QUOTE (DATATYPE WINDOW
(DSP NEXTW SAVE REG BUTTONEVENTFN RIGHTBUTTONFN CURSORINFN
CURSOROUTFN CURSORMOVEDFN REPAINTFN RESHAPEFN EXTENT USERDATA
VERTSCROLLREG HORIZSCROLLREG SCROLLFN VERTSCROLLWINDOW
HORIZSCROLLWINDOW CLOSEFN MOVEFN WTITLE NEWREGIONFN WBORDER
PROCESS WINDOWENTRYFN])
(BUGREPORT.PRINTFORMS
[LAMBDA (FILENAME) (* Newman "10-Apr-85 18:57")
(* This function prints the value of each form in BUGREPORT.FORMS and the form itself to the file FILENAME.
This enables the system creator who includes BUGREPORT in their system to specify several forms whose value they
wish to see in the bugreport. --DVN)
(COND
(BUGREPORT.FORMS (for Form in BUGREPORT.FORMS first (PROGN (TERPRI FILENAME)
(* Print header)
(TERPRI FILENAME)
(PRIN1 " ********** " FILENAME)
(TERPRI FILENAME)
(PRIN1 " Bug Report Forms. "
FILENAME)
(TERPRI FILENAME)
(TERPRI FILENAME))
do (PROGN (PRIN1 Form FILENAME) (* Print each form)
(PRIN1 " ==> " FILENAME)
(* NLSETQ avoids further errors)
(PRINT (CAR (NLSETQ (EVAL Form)))
FILENAME))
finally (PROGN (TERPRI FILENAME) (* Print Trailer)
(PRIN1 " ********** " FILENAME)
(TERPRI FILENAME)
(TERPRI FILENAME])
(BUGREPORT.STRING.LENGTH
[LAMBDA (String) (* Newman "11-Apr-85 17:57")
(* * This function figures out the string length in a tricky but efficient way. KEF)
(IQUOTIENT (STRINGWIDTH String)
7])
)
(* These variables should be set by the programmer who wishes to use BUGREPORT to get reports
on bugs in his program. If BUGREPORT.REPORTNOBREAK? is NIL then when a BREAK occurs, the normal
break window will appear; otherwise, the user will be prompted to create a bug report or not.
BUGREPORT.DEVICE should be either {DSK}, {CORE}, or {FLOPPY}, to specify where the file
BUGREPORT.TTY will be put when created. BUGREPORT.FRAMENAMELST is a list of frame names that
the programmer wishes to see in the bug report. This will very likely be (FILEFNSLST File) ,
where File is the name of the File that the programmer has created. If BUGREPORT.FRAMENAMELST
is T, all frames will be print, if BUGREPORT.FRAMENAMELST is NIL, no frames. BUGREPORT.FORMS is
a list of forms which will be printed followed by the EVAL of the form. This is meant to give
the system creator the ability to have information in the bug report that might not otherwise
be printed.)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS BUGREPORT.REPORTNOBREAK? BUGREPORT.DEVICE BUGREPORT.FRAMENAMELST
BUGREPORT.EXCLUDED.FRAMENAMELST BUGREPORT.FORMS BUGREPORT.MENU)
)
(RPAQ? BUGREPORT.REPORTNOBREAK? NIL)
(RPAQ? BUGREPORT.DEVICE (QUOTE {DSK}))
(RPAQ? BUGREPORT.FRAMENAMELST T)
(RPAQ? BUGREPORT.FORMS NIL)
(RPAQ? BUGREPORT.EXCLUDED.FRAMENAMELST (QUOTE (BUGREPORT BUGREPORT.CHOOSEBREAK1
BUGREPORT.GETUSERCOMMENT
BUGREPORT.INCLUDEFRAMEP
BUGREPORT.INITIALIZE
BUGREPORT.INITIALIZEFILE
BUGREPORT.INSUREBRFLOPPY
BUGREPORT.MAKE.FLOPPY.FILE
BUGREPORT.MAKEREPORT? BUGREPORT.PRINT
BUGREPORT.PRINTENTRY BUGREPORT.PRINTVARVAL
BUGREPORT.USERDATA BUGREPORT.PRINTFORMS)))
(BUGREPORT.INITIALIZE)
(PUTPROPS WINDOW PRINTFN [LAMBDA (VARIABLE VALUE FILENAME)
(printout FILENAME .TAB 5 VARIABLE .TAB 25 (WINDOWPROP
VALUE
(QUOTE TITLE))
T .TAB 30 .PPF (BUGREPORT.USERDATA VALUE])
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML BUGREPORT.CHOOSEBREAK1)
(ADDTOVAR LAMA )
)
(PUTPROPS BUGREPORT COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4365 18370 (BUGREPORT 4375 . 5096) (BUGREPORT.CHOOSEBREAK1 5098 . 6407) (
BUGREPORT.GETUSERCOMMENT 6409 . 7424) (BUGREPORT.SEGMENT.STRING 7426 . 8600) (BUGREPORT.INCLUDEFRAMEP
8602 . 9785) (BUGREPORT.INITIALIZE 9787 . 10041) (BUGREPORT.INITIALIZEFILE 10043 . 10627) (
BUGREPORT.INSUREBRFLOPPY 10629 . 12523) (BUGREPORT.MAKE.FLOPPY.FILE 12525 . 13299) (
BUGREPORT.MAKEREPORT? 13301 . 14029) (BUGREPORT.PRINT 14031 . 15179) (BUGREPORT.PRINTENTRY 15181 .
15753) (BUGREPORT.PRINTVARVAL 15755 . 16280) (BUGREPORT.USERDATA 16282 . 16783) (BUGREPORT.PRINTFORMS
16785 . 18086) (BUGREPORT.STRING.LENGTH 18088 . 18368)))))
STOP