(FILECREATED " 8-May-86 14:18:28" {ERIS}<JAMES>LISP>AREDIT.;8 148221 

      changes to:  (FNS AR.GET.AR AR.GET.NEXT AR.GATHER.NEW.AR.DATA AR.INDEX.PRINT AR.QFORM.FN.QUERY)

      previous date: " 5-May-86 14:30:44" {ERIS}<JAMES>LISP>AREDIT.;7)


(* Copyright (c) 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT AREDITCOMS)

(RPAQQ AREDITCOMS ((* * AR.FORM functions and variables)
	(FNS AR.BUTTON.GET.MENU AR.BUTTON.GET.SUBMENU AR.BUTTON.OBJ.CREATE AR.BUTTONFN.DOMENU 
	     AR.BUTTONFN.DOSUBMENU AR.BUTTONFN.SELFIELD AR.CHECK.FIELDS AR.CHECK.MENU 
	     AR.CHECK.SHORTSTRING AR.CHECK.SUBMENU AR.CONFIRM AR.COPY.AND.INDEX.AR 
	     AR.DELETE.FIELD.VAL AR.DISCONNECT.WINDOW AR.FIND.BUTTON AR.FIND.EDIT.CHANGES 
	     AR.FIND.UNPROTECTED.CH# AR.FORM AR.FORM.CLEAR AR.FORM.CREATE AR.FORM.FILL.INS 
	     AR.FORM.GROUP.CREATE AR.FORM.MENU.TITLEMENUFN AR.JUST.GET.SUBMIT.NUM 
	     AR.JUST.PRINT.AR.NUM AR.KILL.ATTACHED.TEDIT.CLOSEFN AR.FORM.MENU.ACTIONFN 
	     AR.FORM.MENU.BUTTONFN AR.FORM.SAVE AR.GET.AR AR.GET.ASSOCIATED.MENU.VAL 
	     AR.GET.BUTTON.FIELD.AS.TEXT AR.GET.MENU.FROM.MAIN.WINDOW AR.GET.NEXT AR.GET.SUBMIT.NUM 
	     AR.GET.BUTTON.FIELD.AS.LIST AR.GET.FILENAME AR.MARK.ACTIVE AR.MENU.CR.FN 
	     AR.MENU.FN.CLEAR AR.MENU.FN.GET AR.MENU.FN.PUT AR.PROMPT AR.PROTECT.WARNING 
	     AR.PUT.FAILED AR.RECONNECT.WINDOW AR.REPLACE.FIELD.VAL AR.REPLACE.FILL.INS AR.RESET.SEL 
	     AR.SCRATCH.LOAD AR.SEND.MESSAGE AR.TEXTSTREAM.LOAD AR.TOBJ.ACTIVEP AR.UPDATE.AR.INFO 
	     AR.USERNAME IMAGEOBJPROPS.MACRO)
	(* * AR INDEX functions)
	(FNS AR.ENTRY.LIST.AND AR.ENTRY.LIST.OR AR.ENTRY.LIST.WINDOW.REPAINTFN 
	     AR.ENTRY.LIST.WINDOW.BUTTONEVENTFN AR.EDIT.USING.CORRESPONDING.FORM 
	     AR.GATHER.NEW.AR.DATA AR.GET.ENTRY.NUM AR.GET.FIELD.VAL.DATA AR.GET.FIELD.VAL.LENGTH 
	     AR.GET.FIELD.VAL.PTR AR.GET.FIELD.VAL AR.INDEX.CREATE AR.GET.ENUMERATED.FIELD.KEYS 
	     AR.INDEX.DATA.UNPACK AR.INDEX.FIND.ENTRY.PTR AR.INDEX.OPEN AR.INDEX.FILE.REOPEN 
	     AR.INDEX.PRINT AR.INDEX.REWRITE.ENTRY.DATA AR.INDEX.REWRITE.FIELD.DATA 
	     AR.INDEX.SEARCH.HAS AR.INDEX.SEARCH.IS AR.GET.ENTRY.PTRS.FROM.FIELD.PTRS AR.INDEX.UPDATE 
	     AR.QFORM.ACTIONFN AR.QFORM.PROMPT.LIST.FN AR.GET.QLIST.PROMPT.MENU 
	     AR.GET.SLIST.PROMPT.MENU AR.QFORM.BUTTONFN AR.QFORM.CREATE AR.QFORM.FN.PRINT 
	     AR.QFORM.FN.QUERY AR.QFORM.FN.UPDATE AR.QFORM.GROUP.CREATE AR.QUERY AR.QUERY.EVAL.QLIST 
	     AR.PRINT AR.SORT AR.QFORM.DISPLAY.DISCONNECT AR.QFORM.DISPLAY.CONNECT)
	(VARS AR.FORM.FORMAT AR.FORM.SPECS)
	(INITVARS [AR.ENTRY.LIST.WINDOW.FIELDS (QUOTE ((Number: 5)
						       (Status: 5)
						       (Subject: 45)
						       (Attn: 15)
						       (System: 15)
						       (Subsystem: 15)
						       (Source: 15]
		  [AR.ENTRY.LIST.PRINT.FIELDS (QUOTE ((Number: 5)
						      (Date: 9)
						      (System: 14)
						      (Subsystem: 14)
						      (Status: 10)
						      (Attn: 11)
						      (Subject: 50)
						      (Priority: 10)
						      (Difficulty: 10)
						      (Impact: 9)
						      (Problem% Type: 13]
		  (AR.ENTRY.LIST.PRINT.MULTILINE.FLAG T)
		  (AR.INDEX.DEFAULT.FIELDS (QUOTE (Subject: Source: Date: Submitter: Assigned% To: 
							    Attn: Status: In/By: Problem% Type: 
							    Impact: Difficulty: Frequency: Priority: 
							    System: Subsystem: Machine: Disk: 
							    Lisp% Version: Source% Files: 
							    Microcode% Version: Memory% Size: 
							    File% Server: Server% Software% Version: 
							    Edit-By: Edit-Date:)))
		  (AR.NO.MESSAGE.FLG NIL))
	(VARS (AR.INDEX.DEFAULT.FILE.NAME (QUOTE {ERIS}<LISPARS>AR.INDEX))
	      (AR.INFO.FILE.NAME (QUOTE {ERIS}<LISPARS>LISPARS.TDS))
	      (AR.SUBMIT.NUM.FILE.NAME (QUOTE {ERIS}<LISPARS>LISPARS.NUM))
	      (AR.SUBMIT.FILE.NAME (QUOTE {ERIS}<LISPARS>LISPARS.SUBMIT))
	      (AR.DIRECTORY (QUOTE {PHYLEX:PARC:XEROX}<LISPARS>)))
	[INITVARS (ARBUTTONFONT (FONTCREATE (QUOTE HELVETICA)
					    12
					    (QUOTE BOLD)))
		  (ARFONT (FONTCREATE (QUOTE TIMESROMAN)
				      10))
		  (ARBOLDFONT (FONTCREATE (QUOTE HELVETICA)
					  10
					  (QUOTE BOLD]
	(* * old vars and fns for AR.SHOW)
	(FNS AR.SHOW AR.SHOW3 AR.SHOW2 AR.PARSE AR.SHOWFIELD AR.SUMMARY AR.LAYOUT.WINDOW AR.FILENAME)
	(VARS AR.MAP AR.SUMMARY.MAP AR.THIN.SUMMARY.MAP)
	(INITVARS (AR.LAYOUT.WINDOW)
		  (ARPARALEADING 2)
		  (AR.READ.WITH.RNUMBERFLG T))
	(GLOBALVARS AR.LAYOUT.WINDOW ARFONT ARBOLDFONT ARPARALEADING AR.MAP AR.SUMMARY.MAP 
		    AR.THIN.SUMMARY.MAP)
	(FILES READNUMBER)
	[ADDVARS (BackgroundMenuCommands ("AR Edit" (QUOTE (AR.FORM))
						    
					      "Create an AR.FORM editor for the Lisp AR database"
						    (SUBITEMS ("New AR form" (QUOTE (AR.FORM))
									     
						  "Creates new AR.FORM editor, initially cleared")
							      ("Load AR form" (QUOTE (AR.FORM
										       (RNUMBER)))
									      
				"Creates new AR.FORM editor, initally loaded with a specified AR")
							      ("AR.SHOW" (QUOTE (AR.SHOW (RNUMBER)))
									 
		   "Calls the old AR.SHOW bug-report displayer to quickly display a specified AR")
							      ("AR Query Form" (QUOTE (AR.QFORM.CREATE
											))
									       
								       "Creates an AR Query Form"]
	(VARS (BackgroundMenu))
	[VARS (AR.INDEX.MONITORLOCK (CREATE.MONITORLOCK (QUOTE AR.INDEX.LOCK]
	(MACROS AR.ENTRY.PTR.TO.KEY.VAL.PTR AR.ENTRY.TO.NUM AR.INDEX.DATA.CONTEXT 
		AR.KEY.VAL.PTR.TO.ENTRY.PTR ARSPECGET ARSPECPUT IMAGEOBJPROPS)
	(RECORDS AR.INDEX.DATA)
	(UGLYVARS AR.FORM.ICON AR.QFORM.ICON)
	(RESOURCES SCRATCHSTRING)))
(* * AR.FORM functions and variables)

(DEFINEQ

(AR.BUTTON.GET.MENU
  [LAMBDA (OBJ)                                              (* mjs "20-Apr-84 15:02")
    (if (IMAGEOBJPROP OBJ (QUOTE AR.MENU))
      else [IMAGEOBJPROP OBJ (QUOTE AR.MENU)
			 (create MENU
				 ITEMS ←[APPEND (IMAGEOBJPROP OBJ (QUOTE AR.MENU.LIST))
						(LIST (LIST NIL (KWOTE (PACKC]
				 TITLE ←(IMAGEOBJPROP OBJ (QUOTE MBTEXT]
	   (IMAGEOBJPROP OBJ (QUOTE AR.MENU])

(AR.BUTTON.GET.SUBMENU
  [LAMBDA (OBJ ASSOCIATED.MENU.VAL)                          (* mjs "20-Apr-84 15:02")
    (if (LISTGET (IMAGEOBJPROP OBJ (QUOTE AR.SUBMENUS))
		 ASSOCIATED.MENU.VAL)
      else (PROG ((CORRESPONDING.SUBMENU.LIST (LISTGET (IMAGEOBJPROP OBJ (QUOTE AR.SUBMENU.LIST))
						       ASSOCIATED.MENU.VAL))
		  CORRESPONDING.SUBMENU)
	         [SETQ CORRESPONDING.SUBMENU (create MENU
						     ITEMS ←[APPEND CORRESPONDING.SUBMENU.LIST
								    (LIST (LIST NIL (KWOTE (PACKC]
						     TITLE ←(IMAGEOBJPROP OBJ (QUOTE MBTEXT]
	         (if (IMAGEOBJPROP OBJ (QUOTE AR.SUBMENUS))
		     then (LISTPUT (IMAGEOBJPROP OBJ (QUOTE AR.SUBMENUS))
				   ASSOCIATED.MENU.VAL CORRESPONDING.SUBMENU)
		   else (IMAGEOBJPROP OBJ (QUOTE AR.SUBMENUS)
				      (LIST ASSOCIATED.MENU.VAL CORRESPONDING.SUBMENU)))
	         (RETURN CORRESPONDING.SUBMENU])

(AR.BUTTON.OBJ.CREATE
  [LAMBDA (AR.SPECS BUTTON.NAME BUTTON.FONT)                 (* edited: "21-Aug-84 14:39")
    (PROG ((BUTTON.TYPE (ARSPECGET AR.SPECS BUTTON.NAME (QUOTE FIELDTYPE)))
	   BUTTON.FN OBJ)
          (if (AND (EQ BUTTON.TYPE (QUOTE STRING))
		   (ARSPECGET AR.SPECS BUTTON.NAME (QUOTE MAXCHARS)))
	      then                                           (* if a string has a max length given, treat it as a 
							     SHORTSTRING)
		   (SETQ BUTTON.TYPE (QUOTE SHORTSTRING)))
          [SETQ BUTTON.FN (if (ARSPECGET AR.SPECS BUTTON.NAME (QUOTE FN))
			    else (SELECTQ BUTTON.TYPE
					  (BUTTON (ARSPECGET AR.SPECS BUTTON.NAME (QUOTE FN)))
					  (PROTECTEDSTRING (FUNCTION AR.PROTECT.WARNING))
					  ((STRING SHORTSTRING)
					    (FUNCTION AR.BUTTONFN.SELFIELD))
					  (MENU (FUNCTION AR.BUTTONFN.DOMENU))
					  (SUBMENU (FUNCTION AR.BUTTONFN.DOSUBMENU))
					  (ERROR "Bad Button Type" BUTTON.TYPE]
          (SETQ BUTTON.FONT (if (ARSPECGET AR.SPECS BUTTON.NAME (QUOTE FONT))
			      else BUTTON.FONT))
          (SETQ OBJ (MBUTTON.CREATE BUTTON.NAME BUTTON.FN BUTTON.FONT))
          (IMAGEOBJPROPS OBJ (QUOTE AR.PRE.FIELD)
			 (SELECTQ BUTTON.TYPE
				  (BUTTON "")
				  ((MENU SUBMENU)
				    "  {")
				  "  ")
			 (QUOTE AR.POST.FIELD)
			 (SELECTQ BUTTON.TYPE
				  ((MENU SUBMENU)
				    "}")
				  "")
			 (QUOTE AR.CHECK.FN)
			 (SELECTQ BUTTON.TYPE
				  ((BUTTON PROTECTEDSTRING STRING)
				    (FUNCTION NILL))
				  (SHORTSTRING (FUNCTION AR.CHECK.SHORTSTRING))
				  (MENU (FUNCTION AR.CHECK.MENU))
				  (SUBMENU (FUNCTION AR.CHECK.SUBMENU))
				  (ERROR "Bad Button Type" BUTTON.TYPE))
			 (QUOTE AR.PROTECTED.FLG)
			 (SELECTQ BUTTON.TYPE
				  ((BUTTON PROTECTEDSTRING MENU SUBMENU)
				    T)
				  NIL))
          (SELECTQ BUTTON.TYPE
		   [SHORTSTRING (IMAGEOBJPROP OBJ (QUOTE AR.MAX.LEN)
					      (ARSPECGET AR.SPECS BUTTON.NAME (QUOTE MAXCHARS]
		   [MENU (IMAGEOBJPROPS OBJ (QUOTE AR.ASSOCIATED.SUBMENU)
					(ARSPECGET AR.SPECS BUTTON.NAME (QUOTE ASSOCSUBMENU))
					(QUOTE AR.MENU.LIST)
					(ARSPECGET AR.SPECS BUTTON.NAME (QUOTE MENULIST]
		   [SUBMENU (IMAGEOBJPROPS OBJ (QUOTE AR.ASSOCIATED.MENU)
					   (ARSPECGET AR.SPECS BUTTON.NAME (QUOTE ASSOCMENU))
					   (QUOTE AR.SUBMENU.LIST)
					   (ARSPECGET AR.SPECS BUTTON.NAME (QUOTE SUBMENULIST]
		   NIL)
          (RETURN OBJ])

(AR.BUTTONFN.DOMENU
  [LAMBDA (OBJ SEL WINDOW)                                   (* edited: "30-Aug-84 09:57")
    (PROG [(STREAM (WINDOWPROP WINDOW (QUOTE TEXTSTREAM)))
	   (NEWVAL (MENU (AR.BUTTON.GET.MENU OBJ)))
	   (ASSOC.SUBMENU (IMAGEOBJPROP OBJ (QUOTE AR.ASSOCIATED.SUBMENU]
          [if [AND NEWVAL (NOT (EQUAL NEWVAL (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.VALUE]
	      then (AR.REPLACE.FIELD.VAL OBJ (fetch (SELECTION CH#) of SEL)
					 STREAM NEWVAL)
		   (if ASSOC.SUBMENU
		       then (PROG ((BUTTON (AR.FIND.BUTTON STREAM ASSOC.SUBMENU)))
			          (if (NULL BUTTON)
				      then (ERROR "Can't find associated submenu button" 
						  ASSOC.SUBMENU))
			          (AR.REPLACE.FIELD.VAL (CAR BUTTON)
							(CDR BUTTON)
							STREAM
							(PACKC))
			          (IMAGEOBJPROP (CAR BUTTON)
						(QUOTE AR.ASSOCIATED.MENU.VAL)
						NEWVAL]
          (AR.RESET.SEL WINDOW])

(AR.BUTTONFN.DOSUBMENU
  [LAMBDA (OBJ SEL WINDOW)                                   (* edited: "30-Aug-84 09:57")
    (PROG ((STREAM (WINDOWPROP WINDOW (QUOTE TEXTSTREAM)))
	   (ASSOCIATED.MENU.VAL (AR.GET.ASSOCIATED.MENU.VAL OBJ WINDOW))
	   NEWVAL)
          (SETQ NEWVAL (MENU (AR.BUTTON.GET.SUBMENU OBJ ASSOCIATED.MENU.VAL)))
          (if [AND NEWVAL (NOT (EQUAL NEWVAL (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.VALUE]
	      then (AR.REPLACE.FIELD.VAL OBJ (fetch (SELECTION CH#) of SEL)
					 STREAM NEWVAL))
          (AR.RESET.SEL WINDOW])

(AR.BUTTONFN.SELFIELD
  [LAMBDA (OBJ SEL WINDOW)                                   (* edited: "30-Aug-84 09:59")
    (PROG ((TOBJ (fetch (SELECTION \TEXTOBJ) of SEL))
	   FIELD.SEL FIELD.CH# FIELD.LEN)
          (MBUTTON.FIND.NEXT.FIELD TOBJ (fetch (SELECTION CH#) of SEL))
          (SETQ FIELD.SEL (fetch (TEXTOBJ SCRATCHSEL) of TOBJ))
          (SETQ FIELD.CH# (fetch (SELECTION CH#) of FIELD.SEL))
          (SETQ FIELD.LEN (fetch (SELECTION DCH) of FIELD.SEL))
          (TEDIT.SETSEL TOBJ FIELD.CH# FIELD.LEN (QUOTE LEFT)
			T])

(AR.CHECK.FIELDS
  [LAMBDA (FORMWINDOW)                                       (* edited: "27-Jul-84 10:49")
    (PROG ([TOBJ (TEXTOBJ (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM]
	   (CH# 0)
	   (CHECK.VALUE NIL)
	   OBJ BUTTON SEL FIELD.CH# FIELD.LEN)
          (while (PROGN (add CH# 1)
			(SETQ BUTTON (MBUTTON.FIND.NEXT.BUTTON TOBJ CH#)))
	     do (BLOCK)
		(SETQ OBJ (CAR BUTTON))
		(SETQ CH# (CDR BUTTON))
		(if (IMAGEOBJPROP OBJ (QUOTE AR.PROTECTED.FLG))
		    then (SETQ FIELD.CH# (IPLUS (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.START))
						CH#))
			 (SETQ FIELD.LEN (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.LEN)))
		  else (SETQ SEL (MBUTTON.FIND.NEXT.FIELD TOBJ CH#))
		       (SETQ FIELD.CH# (fetch (SELECTION CH#) of SEL))
		       (SETQ FIELD.LEN (fetch (SELECTION DCH) of SEL)))
	     repeatuntil (SETQ CHECK.VALUE (APPLY* (IMAGEOBJPROP OBJ (QUOTE AR.CHECK.FN))
						   FORMWINDOW OBJ CH# FIELD.CH# FIELD.LEN)))
          (if CHECK.VALUE
	      then (RETURN (APPEND (LIST "Bad value for field [" (IMAGEOBJPROP OBJ (QUOTE MBTEXT))
					 "] --- ")
				   CHECK.VALUE))
	    else (RETURN NIL])

(AR.CHECK.MENU
  [LAMBDA (FORMWINDOW OBJ CH# FIELD.CH# FIELD.LEN)           (* edited: "21-Aug-84 14:42")
    (PROG ((CLIST NIL)
	   (TSTREAM (TEXTSTREAM FORMWINDOW))
	   VAL)
          (SETFILEPTR TSTREAM (SUB1 FIELD.CH#))
          (SETQ CLIST (for X from 1 to FIELD.LEN until (EOFP TSTREAM) collect (BIN TSTREAM)))
          (if (EOFP TSTREAM)
	      then (SHOULDNT "Reached end of textstream while retrieving menu value"))
          (if (NULL CLIST)
	      then                                           (* a null menu value of always correct)
		   (RETURN NIL))
          (SETQ VAL (PACKC CLIST))
          (if (MEMB VAL (IMAGEOBJPROP OBJ (QUOTE AR.MENU.LIST)))
	      then (RETURN NIL)
	    else (IMAGEOBJPROP OBJ (QUOTE AR.MENU)
			       NIL)
		 (RETURN (LIST "bad menu value: " VAL " --- please reset"])

(AR.CHECK.SHORTSTRING
  [LAMBDA (FORMWINDOW OBJ CH# FIELD.CH# FIELD.LEN)           (* edited: "27-Jul-84 10:51")
    (if (ILEQ FIELD.LEN (IMAGEOBJPROP OBJ (QUOTE AR.MAX.LEN)))
	then NIL
      else (LIST "max length= " (IMAGEOBJPROP OBJ (QUOTE AR.MAX.LEN))
		 "; current length= " FIELD.LEN])

(AR.CHECK.SUBMENU
  [LAMBDA (FORMWINDOW OBJ CH# FIELD.CH# FIELD.LEN)           (* edited: "21-Aug-84 14:42")
    (PROG ((CLIST NIL)
	   (TSTREAM (TEXTSTREAM FORMWINDOW))
	   VAL)
          (SETFILEPTR TSTREAM (SUB1 FIELD.CH#))
          (SETQ CLIST (for X from 1 to FIELD.LEN until (EOFP TSTREAM) collect (BIN TSTREAM)))
          (if (EOFP TSTREAM)
	      then (SHOULDNT "Reached end of textstream while retrieving submenu value"))
          (IMAGEOBJPROP OBJ (QUOTE AR.ASSOCIATED.MENU.VAL)
			NIL)
          (if (NULL CLIST)
	      then                                           (* a null menu value of always correct)
		   (RETURN NIL))
          (SETQ VAL (PACKC CLIST))
          (if (MEMB VAL (LISTGET (IMAGEOBJPROP OBJ (QUOTE AR.SUBMENU.LIST))
				 (AR.GET.ASSOCIATED.MENU.VAL OBJ FORMWINDOW)))
	      then (RETURN NIL)
	    else (IMAGEOBJPROP OBJ (QUOTE AR.SUBMENUS)
			       NIL)
		 (IMAGEOBJPROP OBJ (QUOTE AR.ASSOCIATED.MENU.VAL)
			       NIL)
		 (RETURN (LIST "bad menu value: " VAL " --- please reset"])

(AR.CONFIRM
  [LAMBDA (WORDS FORMWINDOW)                                 (* mjs " 4-May-84 14:51")
    (AR.PROMPT WORDS FORMWINDOW)
    (MOUSECONFIRM NIL NIL (GETPROMPTWINDOW FORMWINDOW 2])

(AR.COPY.AND.INDEX.AR
  [LAMBDA (ARSTREAM SCRATCH.STREAM INDEX.FIELDS)             (* mjs " 7-Jul-84 11:29")
    (PROG ((INDEX NIL))
          [until (EOFP ARSTREAM)
	     do (BLOCK)
		(PROG ([FIELD.NAME (PACKC (bind CHAR collect (SETQ CHAR (BIN ARSTREAM))
					     repeatuntil (EQ CHAR (CHARCODE :]
		       (PTR (GETFILEPTR SCRATCH.STREAM)))    (* skip extra space after ":")
		      (BIN ARSTREAM)
		      (if (OR (NLISTP INDEX.FIELDS)
			      (MEMB FIELD.NAME INDEX.FIELDS))
			  then (bind CHAR
				  do (BOUT SCRATCH.STREAM
					   (SELCHARQ (SETQ CHAR (BIN ARSTREAM))
						     (' (BLOCK)
							(BIN ARSTREAM))
						     [CR (RETURN (OR (EQ (BIN ARSTREAM)
									 (CHARCODE CR))
								     (ERROR!]
						     CHAR)))
			       (push INDEX (LIST FIELD.NAME PTR (IDIFFERENCE (GETFILEPTR 
										   SCRATCH.STREAM)
									     PTR)))
			else (bind CHAR do (SELCHARQ (SETQ CHAR (BIN ARSTREAM))
						     (' (BLOCK)
							(BIN ARSTREAM))
						     [CR (RETURN (OR (EQ (BIN ARSTREAM)
									 (CHARCODE CR))
								     (ERROR!]
						     CHAR]
          (RETURN INDEX])

(AR.DELETE.FIELD.VAL
  [LAMBDA (OBJ CH# WINDOW)                                   (* edited: "30-Aug-84 09:57")
    (PROG ((STREAM (WINDOWPROP WINDOW (QUOTE TEXTSTREAM)))
	   SEL)
          (if (IMAGEOBJPROP OBJ (QUOTE AR.PROTECTED.FLG))
	      then (TEDIT.DELETE STREAM (IPLUS (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.START))
					       CH#)
				 (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.LEN)))
		   (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.LEN)
				 0)
		   (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.VALUE)
				 (PACKC))
	    else (SETQ SEL (MBUTTON.FIND.NEXT.FIELD (TEXTOBJ STREAM)
						    CH#))
		 (if (NULL SEL)
		     then (SHOULDNT "Can't find field for button"))
		 (TEDIT.DELETE STREAM (fetch (SELECTION CH#) of SEL)
			       (fetch (SELECTION DCH) of SEL])

(AR.DISCONNECT.WINDOW
  [LAMBDA (FORMWINDOW)                                       (* mjs "17-Feb-85 16:03")
    (replace (TEXTOBJ \WINDOW) of (TEXTOBJ (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM))) with NIL])

(AR.FIND.BUTTON
  [LAMBDA (WINDOW NAME)                                      (* edited: "30-Aug-84 09:57")
    (PROG ((TOBJ (TEXTOBJ WINDOW))
	   (CH# 0)
	   OBJ BUTTON)
          [while (PROGN (add CH# 1)
			(SETQ BUTTON (MBUTTON.FIND.NEXT.BUTTON TOBJ CH#)))
	     do (SETQ OBJ (CAR BUTTON))
		(SETQ CH# (CDR BUTTON))
	     repeatuntil (EQ NAME (IMAGEOBJPROP OBJ (QUOTE MBTEXT]
          (RETURN BUTTON])

(AR.FIND.EDIT.CHANGES
  [LAMBDA (FORMWINDOW)                                       (* edited: "22-Aug-84 16:09")
    (PROG ((SCRATCH.STREAM (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.STREAM)))
	   (SCRATCH.MAP (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.MAP)))
	   (FORMSTREAM (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM)))
	   (CH# 0)
	   OBJ BUTTON BUTTON.NAME PROTECT.FIELD.FLG FIELD.CH# FIELD.LEN TOBJ SCRATCH.MAP.SPEC 
	   SCRATCH.PTR SCRATCH.FIELD.LEN (EDIT.CHANGES NIL))
          (if (NULL SCRATCH.MAP)
	      then (RETURN NIL))
          (SETQ TOBJ (TEXTOBJ FORMSTREAM))
          [while (PROGN (add CH# 1)
			(SETQ BUTTON (MBUTTON.FIND.NEXT.BUTTON TOBJ CH#)))
	     do (BLOCK)
		(SETQ OBJ (CAR BUTTON))
		(SETQ CH# (CDR BUTTON))
		(SETQ BUTTON.NAME (IMAGEOBJPROP OBJ (QUOTE MBTEXT)))
		(SETQ PROTECT.FIELD.FLG (IMAGEOBJPROP OBJ (QUOTE AR.PROTECTED.FLG)))
		[if PROTECT.FIELD.FLG
		    then (SETQ FIELD.CH# (IPLUS (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.START))
						CH#))
			 (SETQ FIELD.LEN (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.LEN)))
		  else (PROG ((SEL (MBUTTON.FIND.NEXT.FIELD TOBJ CH#)))
			     (if (NULL SEL)
				 then (SHOULDNT "Can't find field for button"))
			     (SETQ FIELD.CH# (fetch (SELECTION CH#) of SEL))
			     (SETQ FIELD.LEN (fetch (SELECTION DCH) of SEL]
		(SETFILEPTR FORMSTREAM (SUB1 FIELD.CH#))
		(SETQ SCRATCH.MAP.SPEC (ASSOC BUTTON.NAME SCRATCH.MAP)) 
                                                             (* note that you default to a zero-length field if it is
							     not specified in the file)
		(SETQ SCRATCH.PTR (if (CADR SCRATCH.MAP.SPEC)
				    else 0))
		(SETQ SCRATCH.FIELD.LEN (if (CADDR SCRATCH.MAP.SPEC)
					  else 0))
		(if [OR (NOT (EQP FIELD.LEN SCRATCH.FIELD.LEN))
			(NOT (for X from 1 to FIELD.LEN
				first (SETFILEPTR FORMSTREAM (SUB1 FIELD.CH#))
				      (SETFILEPTR SCRATCH.STREAM SCRATCH.PTR)
				always (EQ (BIN FORMSTREAM)
					   (BIN SCRATCH.STREAM]
		    then                                     (* we know that the current value of the field is not 
							     equal to the value when loaded)
			 (push EDIT.CHANGES BUTTON.NAME)
			 (if (MEMB (ARSPECGET AR.FORM.SPECS BUTTON.NAME (QUOTE FIELDTYPE))
				   (QUOTE (MENU SUBMENU)))
			     then (push EDIT.CHANGES
					(LIST (PACKC (NCONC (for X from 1 to SCRATCH.FIELD.LEN
							       first (SETFILEPTR SCRATCH.STREAM 
										 SCRATCH.PTR)
							       collect (BIN SCRATCH.STREAM))
							    (APPEND (CHARCODE (- >)))
							    (NCONC (for X from 1 to FIELD.LEN
								      first (SETFILEPTR FORMSTREAM
											(SUB1 
											FIELD.CH#))
								      collect (BIN FORMSTREAM]
          (RETURN (DREVERSE EDIT.CHANGES])

(AR.FIND.UNPROTECTED.CH#
  [LAMBDA (STREAM)                                           (* edited: "21-Aug-84 14:41")
    (PROG ((TOBJ (TEXTOBJ STREAM))
	   (CH# 0)
	   OBJ BUTTON SEL)
          (while (PROGN (add CH# 1)
			(SETQ BUTTON (MBUTTON.FIND.NEXT.BUTTON TOBJ CH#)))
	     do (SETQ OBJ (CAR BUTTON))
		(SETQ CH# (CDR BUTTON))
	     repeatwhile (IMAGEOBJPROP OBJ (QUOTE AR.PROTECTED.FLG)))
          (if (NULL BUTTON)
	      then (SHOULDNT "Can't find unprotected button field"))
          (SETQ SEL (MBUTTON.FIND.NEXT.FIELD TOBJ CH#))
          (RETURN (fetch (SELECTION CH#) of SEL])

(AR.FORM
  [LAMBDA (NUM)                                              (* edited: " 4-Jul-84 15:19")
    (ADD.PROCESS (LIST (FUNCTION AR.FORM.GROUP.CREATE)
		       (KWOTE NUM))
		 (QUOTE NAME)
		 (QUOTE AR.FORM.TEMP])

(AR.FORM.CLEAR
  [LAMBDA (FORMWINDOW FILL.INS)                              (* edited: " 7-Jun-84 14:21")
    (PROG ([TOBJ (TEXTOBJ (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM]
	   (CH# 0)
	   OBJ BUTTON)
          (while (PROGN (add CH# 1)
			(SETQ BUTTON (MBUTTON.FIND.NEXT.BUTTON TOBJ CH#)))
	     do (BLOCK)
		(SETQ OBJ (CAR BUTTON))
		(SETQ CH# (CDR BUTTON))
		(AR.DELETE.FIELD.VAL OBJ CH# FORMWINDOW))
          (AR.REPLACE.FILL.INS FORMWINDOW FILL.INS)
          (TEDIT.STREAMCHANGEDP (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM))
				T])

(AR.FORM.CREATE
  [LAMBDA (FORMWINDOW BUTTONFONT FORM.SPECS FORM.FORMAT)     (* edited: "12-Jul-84 13:20")
    (PROG [(FORMSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (LIST (QUOTE FONT)
							    ARFONT
							    (QUOTE TEDIT.TENTATIVE)
							    NIL)))
	   (TABS 0)
	   (TAB.CH# NIL)
	   (AR.PARALOOKS NIL)
	   (AR.CHARLOOKS NIL)
	   (FORMWINDOW.WIDTH (WINDOWPROP FORMWINDOW (QUOTE WIDTH]
          (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.NUMBER)
		      NIL)
          (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.STREAM)
		      NIL)
          [for FIELD.OR.SPACE in FORM.FORMAT
	     do (BLOCK)
		(if (EQ FIELD.OR.SPACE (QUOTE TAB))
		    then (SETQ TAB.CH# (ADD1 (GETFILEPTR FORMSTREAM)))
			 (BOUT FORMSTREAM (CHARCODE TAB))
			 (add TABS 1)
		  elseif (EQ FIELD.OR.SPACE (QUOTE CR))
		    then (if (IGREATERP TABS 0)
			     then (push AR.PARALOOKS
					[LIST (QUOTE TABS)
					      (CONS NIL (for I from 1 to TABS
							   bind (TABWIDTH ←(IQUOTIENT 
										 FORMWINDOW.WIDTH
										      (ADD1 TABS)))
							   collect (CONS (ITIMES I TABWIDTH)
									 (QUOTE LEFT]
					TAB.CH# 1))
			 (SETQ TABS 0)
			 (BOUT FORMSTREAM (CHARCODE CR))
		  elseif (STRINGP FIELD.OR.SPACE)
		    then (PRIN1 FIELD.OR.SPACE FORMSTREAM)
		  else (PROG ((BUTTON.OBJ (AR.BUTTON.OBJ.CREATE FORM.SPECS FIELD.OR.SPACE BUTTONFONT))
			      (CH# (ADD1 (GETFILEPTR FORMSTREAM)))
			      PRE.FIELD.NCHARS POST.FIELD.NCHARS FIELD.LEN)
			     (BLOCK)
			     (TEDIT.INSERT.OBJECT BUTTON.OBJ FORMSTREAM CH#)
			     (push AR.CHARLOOKS (QUOTE (PROTECTED OFF))
				   CH# 1)
			     (add CH# 1)
			     (SETFILEPTR FORMSTREAM (SUB1 CH#))
			     (PRIN1 (IMAGEOBJPROP BUTTON.OBJ (QUOTE AR.PRE.FIELD))
				    FORMSTREAM)
			     (SETQ PRE.FIELD.NCHARS (IDIFFERENCE (ADD1 (GETFILEPTR FORMSTREAM))
								 CH#))
			     (IMAGEOBJPROP BUTTON.OBJ (QUOTE AR.FIELD.START)
					   (ADD1 PRE.FIELD.NCHARS))
			     (IMAGEOBJPROP BUTTON.OBJ (QUOTE AR.FIELD.LEN)
					   0)
			     (if (NOT (IMAGEOBJPROP BUTTON.OBJ (QUOTE AR.PROTECTED.FLG)))
				 then (push AR.CHARLOOKS (QUOTE (PROTECTED ON SELECTPOINT ON))
					    (IPLUS CH# (SUB1 PRE.FIELD.NCHARS))
					    1))
			     (PRIN1 (IMAGEOBJPROP BUTTON.OBJ (QUOTE AR.POST.FIELD))
				    FORMSTREAM]
          (TEDIT.PARALOOKS FORMSTREAM (LIST (QUOTE PARALEADING)
					    2)
			   1
			   (GETEOFPTR FORMSTREAM))           (* default char looks: PROTECTED ON)
          (TEDIT.LOOKS FORMSTREAM (QUOTE (PROTECTED ON))
		       1
		       (GETEOFPTR FORMSTREAM))
          (while AR.CHARLOOKS bind (LOOKS CH# LEN)
	     do (BLOCK)
		(SETQ LOOKS (pop AR.CHARLOOKS))
		(SETQ CH# (pop AR.CHARLOOKS))
		(SETQ LEN (pop AR.CHARLOOKS))
		(TEDIT.LOOKS FORMSTREAM LOOKS CH# LEN))
          (while AR.PARALOOKS bind (LOOKS CH# LEN)
	     do (BLOCK)
		(SETQ LOOKS (pop AR.PARALOOKS))
		(SETQ CH# (pop AR.PARALOOKS))
		(SETQ LEN (pop AR.PARALOOKS))
		(TEDIT.PARALOOKS FORMSTREAM LOOKS CH# LEN))
          (TEDIT.STREAMCHANGEDP FORMSTREAM T)
          (replace (TEXTOBJ MENUFLG) of (TEXTOBJ FORMSTREAM) with T)
          (PROG ((FORMWINDOW.PROC (WINDOWPROP FORMWINDOW (QUOTE PROCESS)))
		 (FORMWINDOW.PROC.NAME (WINDOWPROP FORMWINDOW (QUOTE AR.WINDOW.PROC.NAME)))
		 (SAFE.CH# (AR.FIND.UNPROTECTED.CH# FORMSTREAM))
		 NEWPROC TEDIT.PROCS)
	        (COND
		  ((AND FORMWINDOW.PROC (PROCESSP FORMWINDOW.PROC))
		    (TEDIT.KILL FORMWINDOW)))
	        (SETQ TEDIT.PROCS (LIST (QUOTE SEL)
					SAFE.CH#
					(QUOTE LEAVETTY)
					T
					(QUOTE FONT)
					ARFONT
					(QUOTE TEDIT.TENTATIVE)
					NIL))
	        [if (WINDOWPROP FORMWINDOW (QUOTE AR.TEDIT.READTABLE))
		    then (push TEDIT.PROCS (QUOTE READTABLE)
			       (WINDOWPROP FORMWINDOW (QUOTE AR.TEDIT.READTABLE]
	        [if (WINDOWPROP FORMWINDOW (QUOTE AR.TEDIT.TITLEMENUFN))
		    then (push TEDIT.PROCS (QUOTE TITLEMENUFN)
			       (WINDOWPROP FORMWINDOW (QUOTE AR.TEDIT.TITLEMENUFN]
	        (SETQ NEWPROC (TEDIT FORMSTREAM FORMWINDOW NIL TEDIT.PROCS))
	        (if FORMWINDOW.PROC.NAME
		    then (PROCESSPROP NEWPROC (QUOTE NAME)
				      FORMWINDOW.PROC.NAME])

(AR.FORM.FILL.INS
  [LAMBDA NIL                                                (* ckj "22-Mar-86 16:37")
    (PROG ((CURRENT.USER (AR.USERNAME)))
	    (RETURN (LIST (QUOTE (Status: New))
			      (LIST (QUOTE Source:)
				      CURRENT.USER)
			      (LIST (QUOTE Submitter:)
				      CURRENT.USER)
			      (LIST (QUOTE Microcode% Version:)
				      (MICROCODEVERSION))
			      (LIST (QUOTE Machine:)
				      (SELECTQ (MACHINETYPE)
						 (DANDELION 1108)
						 (DOLPHIN 1100)
						 (DORADO 1132)
						 (DOVE 1186)
						 (PACKC)))
			      (LIST (QUOTE Lisp% Version:)
				      MAKESYSDATE)
			      (LIST (QUOTE Memory% Size:)
				      (REALMEMORYSIZE])

(AR.FORM.GROUP.CREATE
  [LAMBDA (INITIAL.NUM)                                      (* edited: "30-Aug-84 11:20")
    (PROG ((FORMWINDOW (CREATEW (GETREGION 450 60)
				"New Bug Report"))
	   MENUW WREG)

          (* * set up main window)


          (WINDOWADDPROP FORMWINDOW (QUOTE CLOSEFN)
			 (FUNCTION AR.KILL.ATTACHED.TEDIT.CLOSEFN))
          (WINDOWPROP FORMWINDOW (QUOTE MINSIZE)
		      (CONS 450 60))
          (WINDOWPROP FORMWINDOW (QUOTE AR.WINDOW.PROC.NAME)
		      (QUOTE AR.FORM))
          (WINDOWPROP FORMWINDOW (QUOTE ICON)
		      AR.FORM.ICON)

          (* * set up menu window)


          (SETQ WREG (WINDOWPROP FORMWINDOW (QUOTE REGION)))
          (SETQ MENUW (CREATEW (create REGION
				       LEFT ←(fetch (REGION LEFT) of WREG)
				       BOTTOM ←(fetch (REGION TOP) of WREG)
				       WIDTH ←(fetch (REGION WIDTH) of WREG)
				       HEIGHT ← 40)
			       "AR Bug Report Editor"))
          (ATTACHWINDOW MENUW FORMWINDOW (QUOTE TOP)
			(QUOTE JUSTIFY)
			NIL)
          (WINDOWPROP MENUW (QUOTE MAXSIZE)
		      (CONS 0 40))
          (WINDOWPROP MENUW (QUOTE MINSIZE)
		      (CONS 0 40))
          (WINDOWPROP MENUW (QUOTE ICON)
		      AR.FORM.ICON)
          (WINDOWPROP MENUW (QUOTE AR.WINDOW.PROC.NAME)
		      (QUOTE AR.FORM.MENU))
          (if (NOT (AND (BOUNDP (QUOTE AR.MENU.READTABLE))
			(READTABLEP AR.MENU.READTABLE)))
	      then (SETQ AR.MENU.READTABLE (COPYREADTABLE TEDIT.READTABLE))
		   (TEDIT.SETFUNCTION (CHARCODE CR)
				      (FUNCTION AR.MENU.CR.FN)
				      AR.MENU.READTABLE))
          (WINDOWPROP MENUW (QUOTE AR.TEDIT.READTABLE)
		      AR.MENU.READTABLE)
          (WINDOWPROP MENUW (QUOTE AR.TEDIT.TITLEMENUFN)
		      (FUNCTION AR.FORM.MENU.TITLEMENUFN))
          (GETPROMPTWINDOW FORMWINDOW 2)

          (* * create AR forms for main and menu windows)


          (AR.FORM.CREATE FORMWINDOW ARBOLDFONT AR.FORM.SPECS AR.FORM.FORMAT)
          (AR.FORM.CREATE MENUW ARBUTTONFONT (QUOTE ((New FIELDTYPE BUTTON FN AR.FORM.MENU.BUTTONFN)
						      (Get FIELDTYPE BUTTON FN AR.FORM.MENU.BUTTONFN)
						      (Put FIELDTYPE BUTTON FN AR.FORM.MENU.BUTTONFN)
						      (Number: FIELDTYPE STRING)))
			  (QUOTE (New TAB Get TAB Put TAB Number: TAB CR)))
          (until (AND (WINDOWPROP FORMWINDOW (QUOTE LINES))
		      (WINDOWPROP MENUW (QUOTE LINES)))
	     do                                              (* wait until the two Tedit windows are totally 
							     initialized)
		(BLOCK 1000))
          (if INITIAL.NUM
	      then (AR.FORM.MENU.ACTIONFN MENUW (QUOTE Get)
					  INITIAL.NUM)
	    else (AR.FORM.MENU.ACTIONFN MENUW (QUOTE New])

(AR.FORM.MENU.TITLEMENUFN
  [LAMBDA (TEXTSTREAM)                                     (* ckj "29-Apr-86 15:11")
    (PROG (OP)
	    (if (NOT (AND (BOUNDP (QUOTE AR.FORM.MENU.TITLEMENU))
				AR.FORM.MENU.TITLEMENU))
		then (SETQ AR.FORM.MENU.TITLEMENU (create MENU
								ITEMS ←(QUOTE
								  ((Clear (QUOTE Clear)
									  
								"Clears all the fields of the AR")
								    (New (QUOTE New)
									 
		    "Clears all fields of the AR, and substitutes default values for some fields")
								    (Get (QUOTE Get)
									 
				"Retrieves the AR whose number is given in the %"Number:%" field")
								    (Put (QUOTE Put)
									 
						  "Saves an edited of an AR, or submits a new AR")
								    (Put&GetNext (QUOTE Put&GetNext)
										 
					   "Stores the current AR, and Gets the next existing AR")
								    (Put&Get (QUOTE Put&Get)
									     
							"Stores the current AR, and Gets another")
								    (Get% From% File (QUOTE 
										  Get% From% File)
										     
								   "Retrieves AR from named file")
								    (Put% To% File (QUOTE 
										    Put% To% File)
										   
								      "Stores AR into named file")))
								TITLE ← "AR Ops")))
	    (SETQ OP (MENU AR.FORM.MENU.TITLEMENU))
	    (if OP
		then (AR.FORM.MENU.ACTIONFN (CAR (fetch (TEXTOBJ \WINDOW)
							  of (TEXTOBJ TEXTSTREAM)))
						OP])

(AR.JUST.GET.SUBMIT.NUM
  [LAMBDA (FORMWINDOW)                                       (* ckj "29-Apr-86 15:47")
                                                             (* returns number of next new AR to be submitted or 
							     NIL)
    (PROG ((SUBMIT.NUM.FILE NIL)
	     VAL CURR.NEXT.NUM)
	    (if (NOT (INFILEP AR.SUBMIT.NUM.FILE.NAME))
		then (RETURN NIL))
	    (for X from 1 to 10 until [AND (NOT (OPENP AR.SUBMIT.NUM.FILE.NAME))
						     (SETQ SUBMIT.NUM.FILE
						       (CAR (NLSETQ (OPENSTREAM
									  AR.SUBMIT.NUM.FILE.NAME
									  (QUOTE BOTH)
									  (QUOTE OLD)
									  (QUOTE ((DON'T.CACHE
										       T)
										     (DON'TCACHE
										       T]
	       do (AR.PROMPT (LIST "submit number file busy: " AR.SUBMIT.NUM.FILE.NAME 
					 "- - - please wait")
				 FORMWINDOW)
		    (DISMISS 5000))
	    (if (NULL SUBMIT.NUM.FILE)
		then (RETURN NIL))
	    [SETQ VAL (NLSETQ (PROGN (SETFILEPTR SUBMIT.NUM.FILE 0)
					   (SETQ CURR.NEXT.NUM (READ SUBMIT.NUM.FILE))
					   (if (NOT (FIXP CURR.NEXT.NUM))
					       then (ERROR!]
	    (CLOSEF SUBMIT.NUM.FILE)
	    (if VAL
		then (RETURN CURR.NEXT.NUM)
	      else (RETURN NIL])

(AR.JUST.PRINT.AR.NUM
  [LAMBDA (WINDOW CURR.NUM)                                  (* ckj " 5-May-86 14:04")
    (PROG ([TOBJ (TEXTOBJ (WINDOWPROP WINDOW (QUOTE TEXTSTREAM]
	     (CH# 0)
	     (BUTTON.NAME (QUOTE Number:))
	     OBJ BUTTON SEL)
	    [while (PROGN (add CH# 1)
			      (SETQ BUTTON (MBUTTON.FIND.NEXT.BUTTON TOBJ CH#)))
	       do (SETQ OBJ (CAR BUTTON))
		    (SETQ CH# (CDR BUTTON))
	       repeatuntil (EQ BUTTON.NAME (IMAGEOBJPROP OBJ (QUOTE MBTEXT]
	    (RETURN (if BUTTON
			  then (MBUTTON.SET.FIELD TOBJ (QUOTE Number:)
						      CURR.NUM)
			else (ERROR "Can't find named button" BUTTON.NAME])

(AR.KILL.ATTACHED.TEDIT.CLOSEFN
  [LAMBDA (WINDOW)                                           (* edited: "30-Aug-84 09:58")
    (for AW in (ATTACHEDWINDOWS WINDOW) bind TSTREAM when (SETQ TSTREAM (WINDOWPROP AW (QUOTE 
										       TEXTSTREAM)))
       do (DETACHWINDOW AW)
	  (TEDIT.KILL (TEXTOBJ TSTREAM))
	  (CLOSEW AW)
       finally (if (SETQ TSTREAM (WINDOWPROP WINDOW (QUOTE TEXTSTREAM)))
		   then (TEDIT.KILL (TEXTOBJ TSTREAM])

(AR.FORM.MENU.ACTIONFN
  [LAMBDA (MENUWINDOW OPERATION NUM.FOR.GET)               (* ckj "30-Apr-86 12:13")
    (ALLOW.BUTTON.EVENTS)
    (PROG ((MENUWINDOW.TEXTOBJ (WINDOWPROP MENUWINDOW (QUOTE TEXTOBJ)))
	     (FORMWINDOW (WINDOWPROP MENUWINDOW (QUOTE MAINWINDOW)))
	     FORMWINDOW.TEXTOBJ)
	    (DECLARE (SPECVARS MENUWINDOW.TEXTOBJ FORMWINDOW FORMWINDOW.TEXTOBJ))
	    (SETQ FORMWINDOW.TEXTOBJ (WINDOWPROP FORMWINDOW (QUOTE TEXTOBJ)))
	    (if (OR (NOT (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM)))
			(NULL MENUWINDOW.TEXTOBJ)
			(NULL FORMWINDOW.TEXTOBJ))
		then (AR.PROMPT "AR form munged!! --- Close this AR window and create another" 
				    FORMWINDOW)
		       (RETURN))
	    (if (OR (AR.TOBJ.ACTIVEP MENUWINDOW.TEXTOBJ)
			(AR.TOBJ.ACTIVEP FORMWINDOW.TEXTOBJ))
		then (AR.PROMPT "Edit or AR operation in progress -- please wait" FORMWINDOW)
		       (RETURN))
	    (AR.MARK.ACTIVE MENUWINDOW.TEXTOBJ OPERATION)
	    (AR.MARK.ACTIVE FORMWINDOW.TEXTOBJ OPERATION)
	    (DSPFILL NIL 72 (QUOTE PAINT)
		       MENUWINDOW)
	    (CLEARW FORMWINDOW)
	    (AR.DISCONNECT.WINDOW FORMWINDOW)
	    (AR.PROMPT (LIST OPERATION " initiated...")
			 FORMWINDOW)
	    (NLSETQ (SELECTQ OPERATION
				 (Clear (AR.MENU.FN.CLEAR FORMWINDOW))
				 (New (AR.MENU.FN.CLEAR FORMWINDOW (AR.FORM.FILL.INS)))
				 [Get (AR.MENU.FN.GET FORMWINDOW (if NUM.FOR.GET
								     else
								      (MKATOM (
								      AR.GET.BUTTON.FIELD.AS.TEXT
										  MENUWINDOW
										  (QUOTE Number:]
				 (Put (AR.MENU.FN.PUT FORMWINDOW))
				 (Put&GetNext (PROGN (AR.MENU.FN.PUT FORMWINDOW)
						       (AR.GET.NEXT FORMWINDOW)))
				 (Put&Get (PROG ((NUM (RNUMBER)))
					          (AR.MENU.FN.PUT FORMWINDOW)
					          (AR.MENU.FN.GET FORMWINDOW NUM)))
				 [(Get% From% File Put% To% File)
				   (AR.PROMPT "" FORMWINDOW)
				   (PROG [(FILE (MKATOM (PROMPTFORWORD
							      (if (EQ OPERATION (QUOTE 
										  Get% From% File))
								  then "Get File: "
								else "Put File: ")
							      (WINDOWPROP FORMWINDOW (QUOTE
									      AR.GET/PUT.FILE.NAME))
							      NIL
							      (GETPROMPTWINDOW FORMWINDOW]
				           (if (NULL FILE)
					       then (RETURN))
				           (WINDOWPROP FORMWINDOW (QUOTE AR.GET/PUT.FILE.NAME)
							 FILE)
				           (if (EQ OPERATION (QUOTE Get% From% File))
					       then (AR.GET.AR FORMWINDOW FILE)
					     else (AR.FORM.SAVE FORMWINDOW FILE]
				 (AR.PROMPT "Unknown AR.FORM button name!" FORMWINDOW)))
	    (AR.MARK.ACTIVE MENUWINDOW.TEXTOBJ NIL)
	    (AR.MARK.ACTIVE FORMWINDOW.TEXTOBJ NIL)
	    (REDISPLAYW MENUWINDOW)
	    (AR.RECONNECT.WINDOW FORMWINDOW)
	    (SCROLLW FORMWINDOW 0.0 0.0])

(AR.FORM.MENU.BUTTONFN
  [LAMBDA (OBJ SEL WINDOW)                                   (* jds "14-Feb-85 10:43")
    (AR.FORM.MENU.ACTIONFN (\TEDIT.PRIMARYW (fetch (SELECTION \TEXTOBJ) of SEL))
			   (IMAGEOBJPROP OBJ (QUOTE MBTEXT])

(AR.FORM.SAVE
  [LAMBDA (FORMWINDOW FILENAME)                              (* ckj "30-Apr-86 18:22")
    (PROG ((OUTSTREAM (OPENSTREAM FILENAME (QUOTE OUTPUT)
				      (QUOTE NEW)))
	     OUTSTREAMNAME)
	    (DECLARE (SPECVARS OUTSTREAM OUTSTREAMNAME))
	    (SETQ OUTSTREAMNAME (FULLNAME OUTSTREAM))
	    (RESETLST (RESETSAVE (RADIX 10))
			[RESETSAVE NIL (LIST (FUNCTION (LAMBDA NIL
						     (if RESETSTATE
							 then (if (OPENP OUTSTREAM)
								    then (CLOSEF OUTSTREAM))
								(DELFILE (FULLNAME OUTSTREAM))
								(AR.PROMPT (LIST 
							      "SAVE ERROR - bad bug report file "
										     (FULLNAME
										       OUTSTREAM)
										     " deleted")
									     FORMWINDOW)
								(SETQ OUTSTREAMNAME NIL]
			(PROG ((FORMSTREAM (TEXTSTREAM FORMWINDOW))
				 (TOBJ (TEXTOBJ FORMWINDOW))
				 (CH# 1)
				 BUTTON.OBJ FIELD.START FIELD.LEN SEL TOBJ)
			        (LINELENGTH MAX.SMALLP OUTSTREAM)
			    loop(BLOCK)
			        (SETQ CH# (CDR (MBUTTON.FIND.NEXT.BUTTON TOBJ CH#)))
			        (if (NULL CH#)
				    then (CLOSEF OUTSTREAM)
					   (RETURN))
			        (SETFILEPTR FORMSTREAM (SUB1 CH#))
			        (SETQ BUTTON.OBJ (BIN FORMSTREAM))
			        (PRIN1 (IMAGEOBJPROP BUTTON.OBJ (QUOTE MBTEXT))
					 OUTSTREAM)
			        (BOUT OUTSTREAM (CHARCODE SPACE))
			        (if (IMAGEOBJPROP BUTTON.OBJ (QUOTE AR.PROTECTED.FLG))
				    then (SETQ FIELD.START (IPLUS (IMAGEOBJPROP BUTTON.OBJ
											(QUOTE
											  
										   AR.FIELD.START))
									CH#))
					   (SETQ FIELD.LEN (IMAGEOBJPROP BUTTON.OBJ (QUOTE
									       AR.FIELD.LEN)))
				  else (SETQ SEL (MBUTTON.FIND.NEXT.FIELD TOBJ CH#))
					 (SETQ FIELD.START (fetch (SELECTION CH#) of SEL))
					 (SETQ FIELD.LEN (fetch (SELECTION DCH) of SEL)))
			        (SETFILEPTR FORMSTREAM (SUB1 FIELD.START))
			        (for X from 1 to FIELD.LEN bind C
				   do (SETQ C (BIN FORMSTREAM))
					(if (NOT (FIXP C))
					    then (AR.PROMPT (LIST "non-char found in "
									(IMAGEOBJPROP BUTTON.OBJ
											(QUOTE
											  MBTEXT))
									" field -- ignored")
								FORMWINDOW)
					  elseif (FMEMB C (CHARCODE (CR : "'")))
					    then (BLOCK)
						   (BOUT OUTSTREAM (CHARCODE "'"))
						   (BOUT OUTSTREAM C)
					  else (BOUT OUTSTREAM C)))
			        (TERPRI OUTSTREAM)
			        (TERPRI OUTSTREAM)
			        (SETQ CH# (ADD1 CH#))
			        (GO loop)))
	    (RETURN OUTSTREAMNAME])

(AR.GET.AR
  [LAMBDA (FORMWINDOW NUM/OR/FILE)                           (* ckj " 8-May-86 12:22")
    (PROG (LOAD.ERROR FILE ARSTREAM)
	    (SETQ FILE (if (NUMBERP NUM/OR/FILE)
			     then (AR.GET.FILENAME NUM/OR/FILE NIL)
			   else (FULLNAME NUM/OR/FILE)))
	    (if (NULL FILE)
		then (AR.PROMPT (LIST "Bad file number: " NUM/OR/FILE " --- Get aborted")
				    FORMWINDOW)
		       (RETURN (QUOTE NO.FILE)))
	    (SETQ LOAD.ERROR (if (OPENP FILE)
				   then (RESETLST (RESETSAVE (RADIX 10))
						      (LIST "The file for AR " NUM/OR/FILE 
							      " is already open --- Get aborted"))
				 elseif [NULL (NLSETQ (SETQ ARSTREAM (OPENSTREAM
								FILE
								(QUOTE INPUT)
								(QUOTE OLD]
				   then (RESETLST (RESETSAVE (RADIX 10))
						      (LIST "AR " NUM/OR/FILE 
							      " doesn't exist -- Get aborted"))
				 elseif (NULL (NLSETQ (AR.SCRATCH.LOAD FORMWINDOW ARSTREAM)))
				   then (LIST "UNKNOWN LOAD ERROR --- Get aborted")
				 else NIL))
	    (if (AND ARSTREAM (OPENP ARSTREAM))
		then (CLOSEF ARSTREAM))
	    (if LOAD.ERROR
		then (AR.PROMPT LOAD.ERROR FORMWINDOW)
		       (RETURN LOAD.ERROR))
	    (if [OR (NULL (NLSETQ (AR.FORM.CLEAR FORMWINDOW)))
			(NULL (NLSETQ (AR.TEXTSTREAM.LOAD FORMWINDOW]
		then (AR.PROMPT 
		      "UNKNOWN SCRATCH COPY ERROR --- form in inconsistant state --- Get aborted"
				    FORMWINDOW)
		       (RESETLST (RESETSAVE (RADIX 10))
				   (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.NUMBER)
						 NIL))
		       (WINDOWPROP FORMWINDOW (QUOTE TITLE)
				     "--- form inconsistant --- Please GET or NEW")
	      else (RESETLST (RESETSAVE (RADIX 10))
				 (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.NUMBER)
					       (if (NUMBERP NUM/OR/FILE)
						   then NUM/OR/FILE
						 else NIL)))
		     (RESETLST (RESETSAVE (RADIX 10))
				 (WINDOWPROP FORMWINDOW (QUOTE TITLE)
					       (CONCAT "Editing AR " NUM/OR/FILE])

(AR.GET.ASSOCIATED.MENU.VAL
  [LAMBDA (OBJ WINDOW)                                       (* edited: "30-Aug-84 09:58")
    (PROG [(BUTTON (AR.FIND.BUTTON (WINDOWPROP WINDOW (QUOTE TEXTSTREAM))
				   (IMAGEOBJPROP OBJ (QUOTE AR.ASSOCIATED.MENU]
          [if (NULL BUTTON)
	      then (ERROR "Can't find associated menu value" (IMAGEOBJPROP OBJ (QUOTE 
									       AR.ASSOCIATED.MENU]
          (RETURN (IMAGEOBJPROP (CAR BUTTON)
				(QUOTE AR.FIELD.VALUE])

(AR.GET.BUTTON.FIELD.AS.TEXT
  [LAMBDA (WINDOW BUTTON.NAME)                               (* edited: "21-Aug-84 14:40")
    (PROG ([TOBJ (TEXTOBJ (WINDOWPROP WINDOW (QUOTE TEXTSTREAM]
	   (CH# 0)
	   OBJ BUTTON SEL)
          [while (PROGN (add CH# 1)
			(SETQ BUTTON (MBUTTON.FIND.NEXT.BUTTON TOBJ CH#)))
	     do (SETQ OBJ (CAR BUTTON))
		(SETQ CH# (CDR BUTTON))
	     repeatuntil (EQ BUTTON.NAME (IMAGEOBJPROP OBJ (QUOTE MBTEXT]
          (RETURN (if BUTTON
		      then (MBUTTON.NEXT.FIELD.AS.TEXT TOBJ CH#)
		    else (ERROR "Can't find named button" BUTTON.NAME])

(AR.GET.MENU.FROM.MAIN.WINDOW
  [LAMBDA (FORMWINDOW)                                       (* ckj " 1-May-86 17:10")
    (PROG* ((ATTACHEDWINDOWS (ALLATTACHEDWINDOWS FORMWINDOW))
	    (NUMWINDOWS (LENGTH ATTACHEDWINDOWS)))
           (if (EQ NUMWINDOWS 2)
	       then (SETQ ATTACHEDWINDOWS (CAR ATTACHEDWINDOWS)))
           (RETURN ATTACHEDWINDOWS])

(AR.GET.NEXT
  [LAMBDA (FORMWINDOW)                                       (* ckj " 8-May-86 14:01")
    (PROG ((AR.LIMIT (AR.JUST.GET.SUBMIT.NUM FORMWINDOW))
	     (AR.NEXT.NUM (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.NUMBER)))
	     ARDONEFLG ARSTREAM)
	    (do (SETQ AR.NEXT.NUM (ADD1 AR.NEXT.NUM))
		  (if (EQP AR.NEXT.NUM AR.LIMIT)
		      then                                 (* next AR number is equal to the number to be 
							     assigned to the next AR submitted)
			     (AR.PROMPT "Next AR hasn't been submitted yet" FORMWINDOW)
			     (SETQ ARDONEFLG T))
		  (if [NLSETQ (SETQ ARSTREAM (OPENSTREAM (AR.FILENAME AR.NEXT.NUM)
								 (QUOTE INPUT)
								 (QUOTE OLD]
		      then                                 (* ar exists)
			     (CLOSEF ARSTREAM)
			     (AR.MENU.FN.GET FORMWINDOW AR.NEXT.NUM)
			     (RETURN NIL))
		  (if (EQUAL ARDONEFLG NIL)
		      then                                 (* AR doesn't exist, increment next AR number and try 
							     again)
			     (RESETLST (RESETSAVE (RADIX 10))
					 (AR.PROMPT (LIST "ar #" AR.NEXT.NUM 
							      " doesn't exist, checking next ar")
						      FORMWINDOW)
					 (PRINTOUT NIL "ar #" AR.NEXT.NUM 
						   " doesn't exist, checking next ar"
						   T)))
	       until (OR ARDONEFLG])

(AR.GET.SUBMIT.NUM
  [LAMBDA (FORMWINDOW)                                       (* mjs "31-Jul-85 09:32")
    (PROG ((SUBMIT.NUM.FILE NIL)
	   VAL CURR.NEXT.NUM)
          (if (NOT (INFILEP AR.SUBMIT.NUM.FILE.NAME))
	      then (RETURN NIL))
          (for X from 1 to 10 until [AND (NOT (OPENP AR.SUBMIT.NUM.FILE.NAME))
					 (SETQ SUBMIT.NUM.FILE
					   (CAR (NLSETQ (OPENSTREAM AR.SUBMIT.NUM.FILE.NAME
								    (QUOTE BOTH)
								    (QUOTE OLD)
								    (QUOTE ((DON'T.CACHE T)
									     (DON'TCACHE T]
	     do (AR.PROMPT (LIST "submit number file busy: " AR.SUBMIT.NUM.FILE.NAME 
				 " --- please wait")
			   FORMWINDOW)
		(DISMISS 5000))
          (if (NULL SUBMIT.NUM.FILE)
	      then (RETURN NIL))
          [SETQ VAL (NLSETQ (PROGN (SETFILEPTR SUBMIT.NUM.FILE 0)
				   (SETQ CURR.NEXT.NUM (READ SUBMIT.NUM.FILE))
				   (if (NOT (FIXP CURR.NEXT.NUM))
				       then (ERROR!))
				   (SETFILEPTR SUBMIT.NUM.FILE 0)
				   (PRINT (ADD1 CURR.NEXT.NUM)
					  SUBMIT.NUM.FILE]
          (CLOSEF SUBMIT.NUM.FILE)
          (if VAL
	      then (RETURN CURR.NEXT.NUM)
	    else (RETURN NIL])

(AR.GET.BUTTON.FIELD.AS.LIST
  [LAMBDA (FORMWINDOW FIELD.NAME)                            (* mjs " 8-Aug-84 15:18")
    (bind READ.VAL (STR ←(OPENSTRINGSTREAM (AR.GET.BUTTON.FIELD.AS.TEXT FORMWINDOW FIELD.NAME)))
       while (SETQ READ.VAL (NLSETQ (READ STR))) collect (CAR READ.VAL])

(AR.GET.FILENAME
  [LAMBDA (NUM PUTFLG)                                       (* mjs " 7-May-84 11:49")

          (* * PROG (FILE) (CLRPROMPT) (SETQ FILE (PROMPTFORWORD (CONCAT "What file should I use for AR# " NUM "? ") NIL NIL
	  PROMPTWINDOW)) (if FILE then (RETURN (MKATOM FILE))) (if PUTFLG then (FRESHLINE PROMPTWINDOW) 
	  (printout PROMPTWINDOW "do you really want to PUT to the lispar database?") (if (NULL (MOUSECONFIRM)) then 
	  (RETURN NIL))) (RETURN (AR.FILENAME NUM)))


    (if (FIXP NUM)
	then (AR.FILENAME NUM)
      else NIL])

(AR.MARK.ACTIVE
  [LAMBDA (TOBJ OP)                                          (* edited: "16-May-84 16:13")
    (if TOBJ
	then (replace (TEXTOBJ EDITOPACTIVE) of TOBJ with OP])

(AR.MENU.CR.FN
  [LAMBDA (TSTREAM TOBJ)                                     (* jds "14-Feb-85 10:47")
    (AR.MARK.ACTIVE TOBJ NIL)
    (AR.FORM.MENU.ACTIONFN (\TEDIT.PRIMARYW TOBJ)
			   (QUOTE Get])

(AR.MENU.FN.CLEAR
  [LAMBDA (FORMWINDOW FILL.INS)                              (* edited: " 4-Jul-84 18:19")
    (PROG NIL
          (if (TEDIT.STREAMCHANGEDP FORMWINDOW)
	      then (if (NULL (AR.CONFIRM "Form has been changed  --- confirm CLEAR" FORMWINDOW))
		       then (RETURN)))
          (CLEARW FORMWINDOW)
          (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.NUMBER)
		      NIL)
          (AR.FORM.CLEAR FORMWINDOW FILL.INS)
          (WINDOWPROP FORMWINDOW (QUOTE TITLE)
		      "New Bug Report")
          (AR.PROMPT "New form cleared" FORMWINDOW])

(AR.MENU.FN.GET
  [LAMBDA (FORMWINDOW CURR.NUM)                              (* ckj " 2-May-86 14:14")
    (PROG ((BAD.GET NIL))
	    (if (FIXP CURR.NUM)
		then (if (TEDIT.STREAMCHANGEDP FORMWINDOW)
			   then (if (NULL (AR.CONFIRM 
							 "Form has been changed  --- confirm GET"
							      FORMWINDOW))
				      then (AR.PROMPT "Get aborted" FORMWINDOW)
					     (RETURN)))
		       (RESETLST (RESETSAVE (RADIX 10))
				   (AR.PROMPT (LIST "Retrieving AR " CURR.NUM " ...")
						FORMWINDOW))
		       (if (AR.GET.AR FORMWINDOW CURR.NUM)
			   then (SETQ BAD.GET T))
	      else (RESETLST (RESETSAVE (RADIX 10))
				 (AR.PROMPT (LIST "Bad number %"" CURR.NUM "%" --- Get aborted")
					      FORMWINDOW))
		     (SETQ BAD.GET T))
	    (if (NOT BAD.GET)
		then (RESETLST (RESETSAVE (RADIX 10))
				   (AR.PROMPT (LIST "AR " CURR.NUM " retrieved")
						FORMWINDOW))
		       (AR.JUST.PRINT.AR.NUM (AR.GET.MENU.FROM.MAIN.WINDOW FORMWINDOW)
					       CURR.NUM])

(AR.MENU.FN.PUT
  [LAMBDA (FORMWINDOW)                                       (* ckj " 2-May-86 17:14")
    (PROG ((CURR.NUM (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.NUMBER)))
	     FILE CHECK.VALUE SAVE.VALUE EDIT.CHANGES.LIST EDIT.CHANGES.STRING SUBMIT.NUM)
	    (if (NOT (TEDIT.STREAMCHANGEDP FORMWINDOW))
		then (if (NULL (AR.CONFIRM "Form has NOT been changed  --- confirm PUT" 
						   FORMWINDOW))
			   then (AR.PROMPT "Put aborted" FORMWINDOW)
				  (RETURN)))
	    [if CURR.NUM
		then [SETQ EDIT.CHANGES.LIST (CONS (AR.USERNAME)
							 (CONS (DATE)
								 (AR.FIND.EDIT.CHANGES FORMWINDOW]
		       (PROG ((TSTREAM (TEXTSTREAM FORMWINDOW))
				BUTTON SEL)
			       (SETQ BUTTON (AR.FIND.BUTTON FORMWINDOW (QUOTE Disposition:)))
			       (if (OR (NULL BUTTON)
					   (IMAGEOBJPROP (CAR BUTTON)
							   (QUOTE AR.PROTECTED.FLG)))
				   then (SHOULDNT 
					       "Bad Disposition field -- can't insert edit marks"))
			       (SETQ SEL (MBUTTON.FIND.NEXT.FIELD (TEXTOBJ TSTREAM)
								      (CDR BUTTON)))
			       [SETQ EDIT.CHANGES.STRING
				 (CONCATLIST (for X on EDIT.CHANGES.LIST
						  join (APPEND (if (EQ X EDIT.CHANGES.LIST)
								       then
									(LIST (CHARACTER
										  (CHARCODE CR))
										"["))
								   (UNPACK (CAR X)
									     T)
								   (if (NULL (CDR X))
								       then (LIST "]")
								     elseif (NLISTP (CADR
											  X))
								       then (LIST " "]
			       (TEDIT.INSERT TSTREAM EDIT.CHANGES.STRING
					       (IPLUS (fetch (SELECTION CH#) of SEL)
							(fetch (SELECTION DCH) of SEL))
					       NIL T))
		       [AR.REPLACE.FILL.INS FORMWINDOW (LIST (LIST (QUOTE Edit-By:)
									 (AR.USERNAME))
								 (LIST (QUOTE Edit-Date:)
									 (DATE]
	      else (AR.PROMPT "Getting Submit number..." FORMWINDOW)
		     (SETQ SUBMIT.NUM (AR.GET.SUBMIT.NUM FORMWINDOW))
		     (if SUBMIT.NUM
			 then (AR.REPLACE.FILL.INS FORMWINDOW (LIST (LIST (QUOTE Number:)
										  SUBMIT.NUM)))
		       else (AR.PUT.FAILED 
				       "Can't get AR submit number --- Put Aborted --- Try again"
					       FORMWINDOW)
			      (RETURN))
		     (AR.REPLACE.FILL.INS FORMWINDOW (LIST (LIST (QUOTE Date:)
								       (DATE]
	    (if (SETQ CHECK.VALUE (AR.CHECK.FIELDS FORMWINDOW))
		then (AR.PUT.FAILED (CONCAT "Bad bug report form: " CHECK.VALUE 
						  " --- Put Aborted")
					FORMWINDOW)
		       (RETURN))
	    (AR.PROMPT "Updating TDS file..." FORMWINDOW)
	    (if [NULL (NLSETQ (if CURR.NUM
					then (AR.UPDATE.AR.INFO FORMWINDOW (QUOTE EDIT)
								    CURR.NUM EDIT.CHANGES.LIST)
				      else (AR.UPDATE.AR.INFO FORMWINDOW (QUOTE SUBMIT)
								  SUBMIT.NUM
								  (LIST (AR.USERNAME)
									  (DATE]
		then (AR.PUT.FAILED "Cannot update TDS file --- Put aborted -- try again" 
					FORMWINDOW)
		       (RETURN))
	    (CLEARW FORMWINDOW)
	    [if CURR.NUM
		then (RESETLST (RESETSAVE (RADIX 10))
				   (AR.PROMPT (LIST "Saving AR " CURR.NUM " ...")
						FORMWINDOW))
		       (SETQ SAVE.VALUE (AR.FORM.SAVE FORMWINDOW (AR.GET.FILENAME CURR.NUM T)))
	      else (AR.PROMPT "Submitting AR ..." FORMWINDOW)
		     (SETQ SAVE.VALUE (AR.FORM.SAVE FORMWINDOW (AR.GET.FILENAME SUBMIT.NUM T]
	    (TEDIT.STREAMCHANGEDP FORMWINDOW T)
	    (if SAVE.VALUE
		then (if CURR.NUM
			   then (RESETLST (RESETSAVE (RADIX 10))
					      (AR.PROMPT (LIST "Saved AR " CURR.NUM)
							   FORMWINDOW)
					      (WINDOWPROP FORMWINDOW (QUOTE TITLE)
							    (CONCAT "Editing AR " CURR.NUM 
								      "  --- saved")))
				  (AR.SEND.MESSAGE FORMWINDOW (QUOTE EDIT)
						     CURR.NUM EDIT.CHANGES.STRING)
			 else (RESETLST (RESETSAVE (RADIX 10))
					    (AR.PROMPT (LIST "Bug Report Submitted -- AR # " 
								 SUBMIT.NUM)
							 FORMWINDOW))
                                                             (* make sure that noone tries accessing the scratch 
							     stream)
				(WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.MAP)
					      NIL)
				(WINDOWPROP FORMWINDOW (QUOTE AR.FORM.NUMBER)
					      SUBMIT.NUM)
				(WINDOWPROP FORMWINDOW (QUOTE TITLE)
					      (CONCAT "Editing AR " SUBMIT.NUM "  --- saved"))
				(AR.SEND.MESSAGE FORMWINDOW (QUOTE SUBMIT)
						   SUBMIT.NUM))
	      else (AR.PUT.FAILED "Unknown bug -- AR not saved -- try again" FORMWINDOW))
	    (REDISPLAYW FORMWINDOW])

(AR.PROMPT
  [LAMBDA (WORDS FORMWINDOW)                                 (* mjs "27-Apr-84 12:22")
    (PROG ((PWINDOW (GETPROMPTWINDOW FORMWINDOW 2)))
          (CLEARW PWINDOW)
          (if (LISTP WORDS)
	      then (for X in WORDS do (PRIN1 X PWINDOW))
	    else (PRIN1 WORDS PWINDOW])

(AR.PROTECT.WARNING
  [LAMBDA (OBJ SEL WINDOW)                                   (* edited: "30-Aug-84 09:58")
    (AR.PROMPT (LIST "The field %"" (IMAGEOBJPROP OBJ (QUOTE MBTEXT))
		     "%" is protected from editing")
	       WINDOW])

(AR.PUT.FAILED
  [LAMBDA (MSG FORMWINDOW)                                   (* mjs "28-Jun-85 12:23")
    (for X from 1 to 5
       do (RINGBELLS)
	  (FLASHWINDOW FORMWINDOW 1))
    (AR.PROMPT (MKLIST MSG)
	       FORMWINDOW)
    (WINDOWPROP FORMWINDOW (QUOTE TITLE)
		(MKSTRING MSG])

(AR.RECONNECT.WINDOW
  [LAMBDA (FORMWINDOW)                                       (* mjs "17-Feb-85 16:02")
    (PROG [(TOBJ (TEXTOBJ (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM]
          (replace (TEXTOBJ \WINDOW) of TOBJ with (LIST FORMWINDOW))
          [\TEDIT.MARK.LINES.DIRTY TOBJ 1 (ADD1 (GETEOFPTR (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM]
          (TEDIT.UPDATE.SCREEN TOBJ])

(AR.REPLACE.FIELD.VAL
  [LAMBDA (OBJ CH# WINDOW NEWVAL)                            (* mjs "25-Oct-84 12:27")
    (DECLARE (SPECVARS OBJ CH# WINDOW NEWVAL))
    (RESETFORM (RADIX 10)
	       (PROG ((STREAM (TEXTSTREAM WINDOW))
		      (NEWVAL.NCHARS (NCHARS NEWVAL))
		      INSERT.CH# SEL)
		     (if (IMAGEOBJPROP OBJ (QUOTE AR.PROTECTED.FLG))
			 then (SETQ INSERT.CH# (IPLUS (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.START))
						      CH#))
			      (TEDIT.DELETE STREAM INSERT.CH# (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.LEN)))
			      (if (IGREATERP NEWVAL.NCHARS 0)
				  then (TEDIT.INSERT STREAM (if (NUMBERP NEWVAL)
								then (MKSTRING NEWVAL)
							      else NEWVAL)
						     INSERT.CH#)
				       (TEDIT.LOOKS STREAM (QUOTE (PROTECTED ON))
						    INSERT.CH# NEWVAL.NCHARS))
			      (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.LEN)
					    NEWVAL.NCHARS)
			      (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.VALUE)
					    NEWVAL)
		       else (SETQ SEL (MBUTTON.FIND.NEXT.FIELD (TEXTOBJ STREAM)
							       CH#))
			    (if (NULL SEL)
				then (SHOULDNT "Can't find button field"))
			    (SETQ INSERT.CH# (fetch (SELECTION CH#) of SEL))
			    (TEDIT.DELETE STREAM INSERT.CH# (fetch (SELECTION DCH) of SEL))
			    (if (IGREATERP NEWVAL.NCHARS 0)
				then (TEDIT.INSERT STREAM (if (NUMBERP NEWVAL)
							      then (MKSTRING NEWVAL)
							    else NEWVAL)
						   INSERT.CH#)
				     (TEDIT.LOOKS STREAM (QUOTE (PROTECTED OFF))
						  INSERT.CH# NEWVAL.NCHARS])

(AR.REPLACE.FILL.INS
  [LAMBDA (FORMWINDOW FILL.INS)                              (* mjs " 7-May-84 15:42")
    (for X in FILL.INS bind BUTTON (FORMSTREAM ←(TEXTSTREAM FORMWINDOW))
       do (BLOCK)
	  (SETQ BUTTON (AR.FIND.BUTTON FORMSTREAM (CAR X)))
	  (if BUTTON
	      then (AR.REPLACE.FIELD.VAL (CAR BUTTON)
					 (CDR BUTTON)
					 FORMSTREAM
					 (CADR X])

(AR.RESET.SEL
  [LAMBDA (WINDOW)                                           (* edited: "30-Aug-84 09:58")
                                                             (* (TEDIT.SHOWSEL WINDOW) (replace 
							     (SELECTION SET) of TEDIT.SELECTION with NIL))

          (* * for now, since I can't figure out how to turn off the selection, just put the selection in the first safe 
	  <i.e. unprotected> place)


    (TEDIT.SETSEL (WINDOWPROP WINDOW (QUOTE TEXTSTREAM))
		  (AR.FIND.UNPROTECTED.CH# (WINDOWPROP WINDOW (QUOTE TEXTSTREAM)))
		  0
		  (QUOTE LEFT])

(AR.SCRATCH.LOAD
  [LAMBDA (FORMWINDOW ARSTREAM)                              (* mjs " 5-Jul-84 16:13")
    (PROG [(SCRATCH.STREAM (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.STREAM]
          [if (NOT (AND SCRATCH.STREAM (OPENP SCRATCH.STREAM)))
	      then (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.STREAM)
			       (SETQ SCRATCH.STREAM (OPENSTREAM (QUOTE {NODIRCORE})
								(QUOTE BOTH)
								(QUOTE NEW]
          (SETFILEPTR SCRATCH.STREAM 0)
          (SETFILEPTR ARSTREAM 0)
          (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.MAP)
		      (AR.COPY.AND.INDEX.AR ARSTREAM SCRATCH.STREAM])

(AR.SEND.MESSAGE
  [LAMBDA (FORMWINDOW OPERATION NUM EDIT.CHANGES.STRING)     (* ckj " 5-May-86 13:39")
    (PROG (RECIPIENTS TXT SUBM)
	    (if AR.NO.MESSAGE.FLG
		then (RETURN))
	    (if (OR (NOT (GETD (QUOTE LAFITEMODE)))
			(NOT (LAFITEMODE)))
		then (PROMPTPRINT "Can't send AR message -- LAFITE not turned on")
		       (RETURN))
	    (SETQ RECIPIENTS (AR.GET.BUTTON.FIELD.AS.TEXT FORMWINDOW (QUOTE Attn:)))
	    (SETQ SUBM (AR.GET.BUTTON.FIELD.AS.TEXT FORMWINDOW (QUOTE Submitter:)))
	    (if (AND (EQ OPERATION (QUOTE EDIT))
			 (NOT (EQUAL SUBM "")))
		then (SETQ RECIPIENTS (CONCAT RECIPIENTS (if (EQUAL RECIPIENTS "")
								   then ""
								 else ", ")
						    SUBM)))
	    (if (EQUAL RECIPIENTS "")
		then (SETQ RECIPIENTS ">>Recipients<<"))
	    (SETQ TXT (OPENTEXTSTREAM "" NIL NIL NIL (LIST (QUOTE FONT)
								 LAFITEEDITORFONT)))
	    (LINELENGTH MAX.SMALLP TXT)
	    (RESETLST (RESETSAVE (RADIX 10))
			(printout TXT "Subject: " (if (EQ OPERATION (QUOTE SUBMIT))
						      then "Submitted AR "
						    else "Edited AR ")
				  (if NUM
				    else "<unknown number>")))
	    (printout TXT ": " (AR.GET.BUTTON.FIELD.AS.TEXT FORMWINDOW (QUOTE Subject:))
		      T "To: " RECIPIENTS T T (if (EQ OPERATION (QUOTE SUBMIT))
						  then (AR.GET.BUTTON.FIELD.AS.TEXT FORMWINDOW
											(QUOTE
											  
										     Description:))
						else EDIT.CHANGES.STRING)
		      T T)
	    (ADD.PROCESS (LIST (FUNCTION \SENDMESSAGE)
				   (KWOTE TXT))
			   (QUOTE NAME)
			   (QUOTE MESSAGESENDER])

(AR.TEXTSTREAM.LOAD
  [LAMBDA (FORMWINDOW FILL.INS)                              (* edited: "20-Aug-84 10:44")
    (PROG ((SCRATCH.STREAM (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.STREAM)))
	   (SCRATCH.MAP (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.MAP)))
	   (FORMSTREAM (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM)))
	   (CH# 0)
	   (FIELD.LEN 0)
	   OBJ BUTTON PROTECT.FIELD.FLG FIELD.CH# TOBJ SEL SCRATCH.MAP.SPEC SCRATCH.PTR)
          (SETQ TOBJ (TEXTOBJ FORMSTREAM))
          [while (PROGN (add CH# 1)
			(SETQ BUTTON (MBUTTON.FIND.NEXT.BUTTON TOBJ CH#)))
	     do (BLOCK)
		(SETQ OBJ (CAR BUTTON))
		(SETQ CH# (CDR BUTTON))
		(SETQ PROTECT.FIELD.FLG (IMAGEOBJPROP OBJ (QUOTE AR.PROTECTED.FLG)))
		(if PROTECT.FIELD.FLG
		    then (SETQ FIELD.CH# (IPLUS (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.START))
						CH#))
		  else (SETQ SEL (MBUTTON.FIND.NEXT.FIELD TOBJ CH#))
		       (if (NULL SEL)
			   then (HELP "Can't find field for button"))
		       (SETQ FIELD.CH# (fetch (SELECTION CH#) of SEL)))
		(SETFILEPTR FORMSTREAM (SUB1 FIELD.CH#))
		(SETQ SCRATCH.MAP.SPEC (ASSOC (IMAGEOBJPROP OBJ (QUOTE MBTEXT))
					      SCRATCH.MAP))
		(if (NULL SCRATCH.MAP.SPEC)
		    then (HELP "Null scatch map spec")
			 (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.VALUE)
				       NIL)
		  else (SETQ SCRATCH.PTR (CADR SCRATCH.MAP.SPEC))
		       (SETQ FIELD.LEN (CADDR SCRATCH.MAP.SPEC))
		       (TEDIT.SETSEL FORMSTREAM FIELD.CH# 0 (QUOTE LEFT)
				     NIL T)
		       (if (IGREATERP FIELD.LEN 0)
			   then (TEDIT.INCLUDE FORMSTREAM SCRATCH.STREAM SCRATCH.PTR
					       (IPLUS SCRATCH.PTR FIELD.LEN)))
		       [if PROTECT.FIELD.FLG
			   then (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.LEN)
					      FIELD.LEN)
				(IMAGEOBJPROP OBJ (QUOTE AR.FIELD.VALUE)
					      (PROGN (SETFILEPTR SCRATCH.STREAM SCRATCH.PTR)
						     (PACKC (for X from 1 to FIELD.LEN
							       collect (BIN SCRATCH.STREAM]
		       (if (NOT (EQP FIELD.LEN 0))
			   then (TEDIT.LOOKS FORMSTREAM (if PROTECT.FIELD.FLG
							    then (QUOTE (PROTECTED ON))
							  else (QUOTE (PROTECTED OFF)))
					     FIELD.CH# FIELD.LEN]
          (AR.REPLACE.FILL.INS FORMWINDOW FILL.INS)
          (TEDIT.STREAMCHANGEDP (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM))
				T])

(AR.TOBJ.ACTIVEP
  [LAMBDA (TOBJ)                                             (* edited: "16-May-84 16:15")
    (if (NULL TOBJ)
	then NIL
      else (fetch (TEXTOBJ EDITOPACTIVE) of TOBJ])

(AR.UPDATE.AR.INFO
  [LAMBDA (FORMWINDOW OP AR.INFO USER.INFO)                  (* mjs "31-Jul-85 09:32")
    (PROG ((INFO.FILE NIL))
          (if (NOT (INFILEP AR.INFO.FILE.NAME))
	      then [SETQ INFO.FILE (OPENSTREAM AR.INFO.FILE.NAME (QUOTE OUTPUT)
					       (QUOTE NEW)
					       (QUOTE ((DON'T.CACHE T)
							(DON'TCACHE T]
	    else (for X from 1 to 10 until [AND (NOT (OPENP AR.INFO.FILE.NAME))
						(SETQ INFO.FILE
						  (CAR (NLSETQ (OPENSTREAM AR.INFO.FILE.NAME
									   (QUOTE APPEND)
									   (QUOTE OLD)
									   (QUOTE ((DON'T.CACHE
										      T)
										    (DON'TCACHE
										      T]
		    do (AR.PROMPT (LIST "info file busy: " AR.INFO.FILE.NAME " --- please wait")
				  FORMWINDOW)
		       (DISMISS 5000)))
          (if (NULL INFO.FILE)
	      then (ERROR))
          (RESETLST (RESETSAVE (RADIX 10))
		    (RESETSAVE NIL (LIST (FUNCTION CLOSEF)
					 INFO.FILE))
		    (PROG NIL
		          (LINELENGTH MAX.SMALLP INFO.FILE)
		          (printout INFO.FILE "  --  " (LIST OP AR.INFO USER.INFO)
				    T)
		          (if (EQ OP (QUOTE SUBMIT))
			      then 

          (* * printout INFO.FILE ,,, "WindowOnTop[SimpleExec]" T ,,, "AppendCommand[SimpleExec.execTTY, " 
	  (QUOTE %") "ftp phylum dir lispars " "Retrieve'/S " (PACKFILENAME (QUOTE HOST) NIL (QUOTE DIRECTORY) NIL 
	  (QUOTE BODY) AR.INFO) " SUBMIT.TEMP" T (QUOTE %") "]" T)



          (* * printout INFO.FILE ,,, "WindowOnTop[AdobeSubmit]" T ,,, "TOOL ← " (QUOTE %") "AdobeSubmit" 
	  (QUOTE %") T ,,, "SUBWINDOW ← " (QUOTE %") "cmdsw" (QUOTE %") T ,,, "File ← SUBMIT.TEMP" T ,,, "Get" T ,,, "Get" T 
	  ,,, "Submit" T T)


				   NIL
			    elseif (EQ OP (QUOTE EDIT))
			      then 

          (* * printout INFO.FILE ,,, "WindowOnTop[AdobeQueryList]", "TOOL ← " (QUOTE %") "AdobeQueryList" 
	  (QUOTE %") T)



          (* * printout INFO.FILE ,,, "formSW.List ← " (QUOTE %") AR.INFO (QUOTE %"), "SUBWINDOW ← " (QUOTE %") "cmdsw" 
	  (QUOTE %"), "Operand1 ← " (QUOTE %") "List" (QUOTE %"), "Result ← " (QUOTE %") "SysQL" (QUOTE %"), "Copy" T)



          (* * printout INFO.FILE ,,, "WindowOnTop[AdobeEdit]", "TOOL ← " (QUOTE %") "AdobeEdit" (QUOTE %") T ,,, 
"SUBWINDOW ← " (QUOTE %") "cmdsw" (QUOTE %"), "UseQL ← FALSE UseQL ← TRUE", "Next", "Checkout", "AbortCheckout" T T)


				   ])

(AR.USERNAME
  [LAMBDA NIL                                                (* mjs "21-Jun-85 14:10")
    (PROG ((NAM (FULLUSERNAME)))
          (RETURN (if (U-CASEP NAM)
		      then (L-CASE NAM T)
		    else NAM])

(IMAGEOBJPROPS.MACRO
  [LAMBDA (X)                                                (* edited: "21-Aug-84 14:22")
    (BQUOTE (PROG ((OBJ , (CAR X)))
	      ,@  (for XX on (CDR X) by (CDDR XX) collect (LIST (QUOTE IMAGEOBJPROP)
								(QUOTE OBJ)
								(CAR XX)
								(CADR XX)))
	          (RETURN OBJ])
)
(* * AR INDEX functions)

(DEFINEQ

(AR.ENTRY.LIST.AND
  [LAMBDA (A B)                                              (* mjs "22-Jul-84 14:49")
    (if (EQ A T)
	then B
      elseif (EQ B T)
	then A
      else (for X in A when (MEMBER X B) collect X])

(AR.ENTRY.LIST.OR
  [LAMBDA (A B)                                              (* mjs "22-Jul-84 14:52")
    (if (OR (EQ A T)
	    (EQ B T))
	then T
      else (PROG ((VAL (APPEND A)))
	         (for X in B unless (MEMBER X A) do (SETQ VAL (CONS X VAL)))
	         (RETURN (SORT VAL])

(AR.ENTRY.LIST.WINDOW.REPAINTFN
  [LAMBDA (WINDOW REGION)                                    (* mjs " 8-Aug-84 18:00")
    (AR.INDEX.DATA.CONTEXT (WINDOWPROP WINDOW (QUOTE MAINWINDOW))
			   (PROG ((ENTRY.ALIST (WINDOWPROP (WINDOWPROP WINDOW (QUOTE MAINWINDOW))
							   (QUOTE AR.ENTRY.ALIST)))
				  (LINE.HEIGHT (IMINUS (DSPLINEFEED NIL WINDOW)))
				  ENTRIES.TO.PRINT LINENUM #LINES)
			         (SETQ LINENUM (IPLUS 1 (IQUOTIENT (IMINUS (fetch (REGION TOP)
									      of REGION))
								   LINE.HEIGHT)))
			         (SETQ #LINES (IPLUS 2 (IQUOTIENT (fetch (REGION HEIGHT)
								     of REGION)
								  LINE.HEIGHT)))
			         (SETQ ENTRIES.TO.PRINT (if (ILEQ LINENUM 0)
							    then NIL
							  else (NTH ENTRY.ALIST LINENUM)))
			         (DSPFILL REGION WHITESHADE NIL WINDOW)
			         (DSPXPOSITION 0 WINDOW)
			         (DSPYPOSITION (IMINUS (ITIMES LINENUM LINE.HEIGHT))
					       WINDOW)
			         (for ENTRY.DATA in ENTRIES.TO.PRINT as CNT from 1 to #LINES
				    bind ENTRY
				    do                       (* ENTRY.DATA is a plist of form 
							     (<entryptr> <propname> <val> ...))
				       (SETQ ENTRY (CAR ENTRY.DATA))
				       [if (NULL (CDR ENTRY.DATA))
					   then              (* make sure that there is at least one prop-val pair, 
							     so future LISTPUTs will work)
						(RPLACD ENTRY.DATA (LIST (QUOTE Number:)
									 (AR.GET.FIELD.VAL
									   ENTRY
									   (QUOTE Number:]
				       (for FIELD.SPEC in AR.ENTRY.LIST.WINDOW.FIELDS
					  bind FIELD.NAME FIELD.WIDTH FIELD.VAL
					  do (SETQ FIELD.NAME (CAR FIELD.SPEC))
					     (SETQ FIELD.WIDTH (CADR FIELD.SPEC))
					     (SETQ FIELD.VAL (LISTGET (CDR ENTRY.DATA)
								      FIELD.NAME))
					     (if (NOT FIELD.VAL)
						 then (SETQ FIELD.VAL (AR.GET.FIELD.VAL ENTRY 
										       FIELD.NAME))
						      (LISTPUT (CDR ENTRY.DATA)
							       FIELD.NAME FIELD.VAL))
					     (if (ILEQ (NCHARS FIELD.VAL)
						       FIELD.WIDTH)
						 then (PRIN1 FIELD.VAL WINDOW)
						      (SPACES (IDIFFERENCE FIELD.WIDTH (NCHARS 
											FIELD.VAL))
							      WINDOW)
					       else (for X from 1 to FIELD.WIDTH
						       do (PRIN1 (NTHCHAR FIELD.VAL X)
								 WINDOW)))
					     (PRIN1 "  " WINDOW))
				       (TERPRI WINDOW])

(AR.ENTRY.LIST.WINDOW.BUTTONEVENTFN
  [LAMBDA (WINDOW)                                           (* edited: "21-Aug-84 14:18")
    (if (MOUSESTATE (OR LEFT MIDDLE))
	then (PROG ((CREG (DSPCLIPPINGREGION NIL WINDOW))
		    (ENTRY.ALIST (WINDOWPROP (WINDOWPROP WINDOW (QUOTE MAINWINDOW))
					     (QUOTE AR.ENTRY.ALIST)))
		    (LINE.HEIGHT (IMINUS (DSPLINEFEED NIL WINDOW)))
		    (POS (create POSITION))
		    (LINENUM NIL)
		    (SELECTED.LINENUM NIL)
		    (SELECTED.WITH.MIDDLE.BUTTON.FLG (MOUSESTATE MIDDLE))
		    SELECTED.ENTRY.DATA SELECTED.ENTRY.NUMBER CREG.LEFT CREG.WIDTH)
	           (AR.PROMPT (if SELECTED.WITH.MIDDLE.BUTTON.FLG
				  then "Select AR to be edited with AREDIT"
				else "Select AR to be displayed with AR.SHOW")
			      (WINDOWPROP WINDOW (QUOTE MAINWINDOW)))
	           (SETQ CREG.LEFT (fetch (REGION LEFT) of CREG))
	           (SETQ CREG.WIDTH (fetch (REGION WIDTH) of CREG))
	           (repeatwhile NEWLINENUM bind NEWLINENUM
		      do (BLOCK)
			 [if (NOT (MOUSESTATE (OR LEFT MIDDLE)))
			     then (SETQ SELECTED.LINENUM LINENUM)
				  (SETQ NEWLINENUM NIL)
			   elseif [NOT (INSIDEP CREG (SETQ POS (CURSORPOSITION NIL WINDOW POS]
			     then (SETQ NEWLINENUM NIL)
			   else (SETQ NEWLINENUM (IPLUS 1 (IQUOTIENT (IMINUS (fetch (POSITION YCOORD)
										of POS))
								     LINE.HEIGHT]
			 (if (NOT (EQP NEWLINENUM LINENUM))
			     then (if (NUMBERP LINENUM)
				      then (DSPFILL (CREATEREGION CREG.LEFT (IMINUS (ITIMES LINENUM 
										      LINE.HEIGHT))
								  CREG.WIDTH LINE.HEIGHT)
						    BLACKSHADE
						    (QUOTE INVERT)
						    WINDOW))
				  (if (NUMBERP NEWLINENUM)
				      then (DSPFILL (CREATEREGION CREG.LEFT (IMINUS (ITIMES 
										       NEWLINENUM 
										      LINE.HEIGHT))
								  CREG.WIDTH LINE.HEIGHT)
						    BLACKSHADE
						    (QUOTE INVERT)
						    WINDOW))
				  (SETQ LINENUM NEWLINENUM)))
	           (AR.PROMPT "" (WINDOWPROP WINDOW (QUOTE MAINWINDOW)))
	           (if (NULL SELECTED.LINENUM)
		       then (RETURN (QUOTE NotInsideWindow)))
	           (ALLOW.BUTTON.EVENTS)
	           (if (ILEQ SELECTED.LINENUM 0)
		       then (RETURN (LIST (QUOTE BadLineNum)
					  LINENUM))
		     elseif [NULL (SETQ SELECTED.ENTRY.DATA (CAR (NTH ENTRY.ALIST SELECTED.LINENUM]
		       then (RETURN (QUOTE NoNumOnLine)))
	           [SETQ SELECTED.ENTRY.NUMBER (if (LISTGET (CDR SELECTED.ENTRY.DATA)
							    (QUOTE Number:))
						 else (AR.INDEX.DATA.CONTEXT (WINDOWPROP
									       WINDOW
									       (QUOTE MAINWINDOW))
									     (AR.GET.FIELD.VAL
									       (CAR 
									      SELECTED.ENTRY.DATA)
									       (QUOTE Number:]
	           (if SELECTED.WITH.MIDDLE.BUTTON.FLG
		       then (AR.EDIT.USING.CORRESPONDING.FORM WINDOW SELECTED.ENTRY.NUMBER)
		     else (AR.SHOW SELECTED.ENTRY.NUMBER])

(AR.EDIT.USING.CORRESPONDING.FORM
  [LAMBDA (WINDOW NUM)                                       (* edited: "30-Aug-84 09:56")
    (PROG [(MENU.WINDOW (WINDOWPROP WINDOW (QUOTE AR.ASSOCIATED.AREDIT.MENU.WINDOW]
          (if [NOT (AND MENU.WINDOW (WINDOWP MENU.WINDOW)
			(OPENWP MENU.WINDOW)
			(EQ (WINDOWPROP MENU.WINDOW (QUOTE AR.WINDOW.PROC.NAME))
			    (QUOTE AR.FORM.MENU]
	      then (AR.PROMPT "Please button the AR Edit window you wish to use" (WINDOWPROP
				WINDOW
				(QUOTE MAINWINDOW)))
		   (SETQ MENU.WINDOW (WHICHW (GETPOSITION)))
		   (AR.PROMPT "" (WINDOWPROP WINDOW (QUOTE MAINWINDOW)))
		   (if (NULL MENU.WINDOW)
		       then (RETURN))
		   [SETQ MENU.WINDOW (for POSSIBLE.WINDOW
					in (APPEND MENU.WINDOW (ALLATTACHEDWINDOWS
						     (if (WINDOWPROP MENU.WINDOW (QUOTE MAINWINDOW))
						       else MENU.WINDOW)))
					thereis (AND (OPENWP POSSIBLE.WINDOW)
						     (EQ (WINDOWPROP POSSIBLE.WINDOW (QUOTE 
									      AR.WINDOW.PROC.NAME))
							 (QUOTE AR.FORM.MENU]
		   (if (NULL MENU.WINDOW)
		       then (AR.PROMPT "Bad AR edit window selected" (WINDOWPROP WINDOW (QUOTE 
										       MAINWINDOW)))
			    (RETURN))
		   (WINDOWPROP WINDOW (QUOTE AR.ASSOCIATED.AREDIT.MENU.WINDOW)
			       MENU.WINDOW))
          (if MENU.WINDOW
	      then (AR.FORM.MENU.ACTIONFN MENU.WINDOW (QUOTE Get)
					  NUM])

(AR.GATHER.NEW.AR.DATA
  [LAMBDA (FORMWINDOW AR.NUM.LIST AR.SCRATCH.FILE)           (* ckj " 8-May-86 14:12")

          (* * AR.NUM.DATA should be a sorted list of AR numbers. AR.GATHER.NEW.AR.DATA returns a list with elements of the 
	  form (<arnum> <arptr> . <ar.scratch.assoc>))


    (PROG ((AR.NUM.DATA NIL))
	    (for AR.NUM in AR.NUM.LIST bind ARSTREAM AR.FILE.NAME INDEX.INFO
	       do (BLOCK)
		    (if [AND (SETQ AR.FILE.NAME (AR.GET.FILENAME AR.NUM NIL))
				 (NOT (OPENP AR.FILE.NAME))
				 [NLSETQ (SETQ ARSTREAM (OPENSTREAM AR.FILE.NAME (QUOTE
									    INPUT)
									  (QUOTE OLD]
				 (NLSETQ (RESETLST (RESETSAVE NIL
								    (LIST (FUNCTION CLOSEF)
									    ARSTREAM))
						       (RESETSAVE NIL
								    (LIST [FUNCTION (LAMBDA (FILE
										  PTR)
										(if RESETSTATE
										    then
										     (SETFILEPTR
										       FILE PTR]
									    AR.SCRATCH.FILE
									    (GETFILEPTR 
										  AR.SCRATCH.FILE)))
						       (SETQ INDEX.INFO (AR.COPY.AND.INDEX.AR
							   ARSTREAM AR.SCRATCH.FILE 
							   AR.INDEX.FIELD.LIST]
			then (RESETLST (RESETSAVE (RADIX 10))
					   (AR.PROMPT (LIST "analyzed AR # " AR.NUM)
							FORMWINDOW))
			       (SETQ AR.NUM.DATA (CONS (CONS AR.NUM (CONS NIL INDEX.INFO))
							   AR.NUM.DATA))
		      else (RESETLST (RESETSAVE (RADIX 10))
					 (AR.PROMPT (LIST "Can't get AR info for AR # " AR.NUM)
						      FORMWINDOW))
			     (SETQ AR.NUM.DATA (CONS (CONS AR.NUM (CONS NIL (QUOTE DELETE)))
							 AR.NUM.DATA)))
	       finally (SETQ AR.NUM.DATA (REVERSE AR.NUM.DATA)))
	    [for X in AR.NUM.DATA do (RPLACA (CDR X)
						     (AR.INDEX.FIND.ENTRY.PTR (CAR X]
	    (RETURN AR.NUM.DATA])

(AR.GET.ENTRY.NUM
  [LAMBDA (PTR)                                              (* edited: "13-Jul-84 11:42")
    (if (IGEQ PTR AR.INDEX.ENTRY.END.PTR)
	then MAX.FIXP
      else (SETFILEPTR AR.INDEX.FILE PTR)
	   (\DWIN AR.INDEX.FILE])

(AR.GET.FIELD.VAL.DATA
  [LAMBDA (ENTRY.PTR FIELD.NAME FIELD.OFFSET FIELD.VAL.BEGIN.PTR FIELD.VAL.END.PTR)
                                                             (* edited: "13-Jul-84 14:45")
    [if (NULL FIELD.OFFSET)
	then (SETQ FIELD.OFFSET (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME (QUOTE FIELD.OFFSET]
    [if (NULL FIELD.VAL.BEGIN.PTR)
	then (SETQ FIELD.VAL.BEGIN.PTR (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME (QUOTE 
										  FIELD.BEGIN.PTR]
    (CONS (AR.GET.FIELD.VAL.PTR ENTRY.PTR FIELD.NAME FIELD.OFFSET FIELD.VAL.BEGIN.PTR 
				FIELD.VAL.END.PTR)
	  (AR.GET.FIELD.VAL.LENGTH ENTRY.PTR FIELD.NAME FIELD.OFFSET FIELD.VAL.BEGIN.PTR 
				   FIELD.VAL.END.PTR])

(AR.GET.FIELD.VAL.LENGTH
  [LAMBDA (ENTRY.PTR FIELD.NAME FIELD.OFFSET FIELD.VAL.BEGIN.PTR FIELD.VAL.END.PTR)
                                                             (* edited: "13-Jul-84 14:45")
    (if (ILESSP ENTRY.PTR AR.INDEX.ENTRY.END.PTR)
	then (PROG ((NEXT.ENTRY.PTR (IPLUS ENTRY.PTR AR.INDEX.ENTRY.SIZE))
		    CURRENT.RELPTR NEXT.RELPTR)
	           [if (NULL FIELD.OFFSET)
		       then (SETQ FIELD.OFFSET (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME
							  (QUOTE FIELD.OFFSET]
	           (SETFILEPTR AR.INDEX.FILE (IPLUS ENTRY.PTR FIELD.OFFSET))
	           (SETQ CURRENT.RELPTR (\DWIN AR.INDEX.FILE))
	           [SETQ NEXT.RELPTR (if (ILESSP NEXT.ENTRY.PTR AR.INDEX.ENTRY.END.PTR)
					 then (SETFILEPTR AR.INDEX.FILE (IPLUS NEXT.ENTRY.PTR 
									       FIELD.OFFSET))
					      (\DWIN AR.INDEX.FILE)
				       else (IDIFFERENCE (if FIELD.VAL.END.PTR
							   else (ARSPECGET AR.INDEX.FIELD.SPECS 
									   FIELD.NAME (QUOTE 
										    FIELD.END.PTR)))
							 (if FIELD.VAL.BEGIN.PTR
							   else (ARSPECGET AR.INDEX.FIELD.SPECS 
									   FIELD.NAME (QUOTE 
										  FIELD.BEGIN.PTR]
	           (RETURN (IDIFFERENCE NEXT.RELPTR CURRENT.RELPTR)))
      else 0])

(AR.GET.FIELD.VAL.PTR
  [LAMBDA (ENTRY.PTR FIELD.NAME FIELD.OFFSET FIELD.VAL.BEGIN.PTR FIELD.VAL.END.PTR)
                                                             (* edited: "13-Jul-84 15:41")
    (if (ILESSP ENTRY.PTR AR.INDEX.ENTRY.END.PTR)
	then [SETFILEPTR AR.INDEX.FILE (IPLUS ENTRY.PTR (if FIELD.OFFSET
							  else (ARSPECGET AR.INDEX.FIELD.SPECS 
									  FIELD.NAME (QUOTE 
										     FIELD.OFFSET]
	     (IPLUS (if FIELD.VAL.BEGIN.PTR
		      else (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME (QUOTE FIELD.BEGIN.PTR)))
		    (\DWIN AR.INDEX.FILE))
      else (if FIELD.VAL.END.PTR
	     else (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME (QUOTE FIELD.END.PTR])

(AR.GET.FIELD.VAL
  [LAMBDA (ENTRY.PTR FIELD.NAME)                             (* mjs " 8-Aug-84 12:45")
    (if (EQ FIELD.NAME (QUOTE Number:))
	then (AR.ENTRY.TO.NUM ENTRY.PTR)
      elseif (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME (QUOTE FIELD.OFFSET))
	then (PROG ((VAL.DATA (AR.GET.FIELD.VAL.DATA ENTRY.PTR FIELD.NAME))
		    VAL.STRING)
	           (SETQ VAL.STRING (ALLOCSTRING (CDR VAL.DATA)))
	           (SETFILEPTR AR.INDEX.FILE (CAR VAL.DATA))
	           (AIN VAL.STRING 1 (CDR VAL.DATA)
			AR.INDEX.FILE)
	           (RETURN VAL.STRING))
      else (PROG ((FIELD.KEYLIST (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME (QUOTE 
									 ENUMERATED.FIELD.KEYLIST)))
		  [KEY.VAL.PTR (AR.ENTRY.PTR.TO.KEY.VAL.PTR ENTRY.PTR (ARSPECGET AR.INDEX.FIELD.SPECS 
										 FIELD.NAME
										 (QUOTE 
										  FIELD.BEGIN.PTR]
		  KEY.VAL)
	         (SETFILEPTR AR.INDEX.FILE KEY.VAL.PTR)
	         (SETQ KEY.VAL (BIN AR.INDEX.FILE))
	         (RETURN (if (EQP 0 KEY.VAL)
			     then (PACK)
			   elseif (CAR (for X on FIELD.KEYLIST by (CDDR X)
					  when (EQP KEY.VAL (CADR X)) collect (CAR X)))
			   else (PACK])

(AR.INDEX.CREATE
  [LAMBDA (FILENAME FIELD.LIST FORM.SPECS)                   (* edited: "16-Jul-84 16:13")
    (SETQ FIELD.LIST (if FIELD.LIST
		       else AR.INDEX.DEFAULT.FIELDS))
    (SETQ FORM.SPECS (if FORM.SPECS
		       else AR.FORM.SPECS))
    (PROG ((FILE (OPENSTREAM FILENAME (QUOTE OUTPUT)
			     (QUOTE NEW)))
	   (INDEX.DATA (create AR.INDEX.DATA
			       AR.INDEX.FILE ← NIL
			       AR.INDEX.ENTRY.BEGIN.PTR ← 0
			       AR.INDEX.ENTRY.END.PTR ← 0
			       AR.INDEX.FIELD.LIST ← FIELD.LIST))
	   (FIELD.SPECS (for X in FIELD.LIST collect (LIST X (QUOTE FIELD.BEGIN.PTR)
							   0
							   (QUOTE FIELD.END.PTR)
							   0)))
	   (FIELD.PTR.OFFSET 4))
          (for FIELD in FIELD.LIST bind ENUMERATED.FIELD.KEYS
	     do (if (SETQ ENUMERATED.FIELD.KEYS (AR.GET.ENUMERATED.FIELD.KEYS FORM.SPECS FIELD))
		    then (ARSPECPUT FIELD.SPECS FIELD (QUOTE ENUMERATED.FIELD.KEYLIST)
				    (for FIELD.KEY in ENUMERATED.FIELD.KEYS as NUM from 1
				       join (LIST FIELD.KEY NUM)))
		  else (ARSPECPUT FIELD.SPECS FIELD (QUOTE FIELD.OFFSET)
				  FIELD.PTR.OFFSET)
		       (add FIELD.PTR.OFFSET 4)))
          (replace (AR.INDEX.DATA AR.INDEX.FIELD.SPECS) of INDEX.DATA with FIELD.SPECS)
          (replace (AR.INDEX.DATA AR.INDEX.ENTRY.SIZE) of INDEX.DATA with FIELD.PTR.OFFSET)
          (SETFILEPTR FILE 0)
          (PRINT INDEX.DATA FILE)                            (* set DIR.FORMAT.PTR to 0)
          (\DWOUT FILE 0)
          (CLOSEF FILE])

(AR.GET.ENUMERATED.FIELD.KEYS
  [LAMBDA (FORM.SPECS FIELD)                                 (* mjs "22-Jul-84 13:51")
    (PROG ((FIELD.KEY.LIST (SELECTQ (ARSPECGET FORM.SPECS FIELD (QUOTE FIELDTYPE))
				    [MENU (APPEND (ARSPECGET FORM.SPECS FIELD (QUOTE MENULIST]
				    (SUBMENU (for X in (CDR (ARSPECGET FORM.SPECS FIELD (QUOTE 
										      SUBMENULIST)))
						by (CDDR X) join (APPEND X)))
				    NIL)))                   (* destructively remove duplicates)
          [bind (X ← FIELD.KEY.LIST) while (CDR X) do (if (MEMB (CAR X)
								(CDR X))
							  then (RPLNODE X (CADR X)
									(CDDR X))
							else (SETQ X (CDR X]
          (RETURN FIELD.KEY.LIST])

(AR.INDEX.DATA.UNPACK
  [LAMBDA (INDEX.DATA)                                       (* edited: "21-Aug-84 14:43")
    (if (type? AR.INDEX.DATA INDEX.DATA)
	then [for FIELD in (RECORDFIELDNAMES (QUOTE AR.INDEX.DATA))
		bind (DEC ←(RECLOOK (QUOTE AR.INDEX.DATA))) do (SET FIELD (RECORDACCESS FIELD 
										       INDEX.DATA DEC
											(QUOTE FETCH]
      else (SHOULDNT "Bad AR.INDEX.DATA Record"])

(AR.INDEX.FIND.ENTRY.PTR
  [LAMBDA (NUM LOW.HINT HIGH.HINT)                           (* edited: "21-Aug-84 14:37")
    (PROG ((LOW (if LOW.HINT
		  else AR.INDEX.ENTRY.BEGIN.PTR))
	   (HIGH (if HIGH.HINT
		   else AR.INDEX.ENTRY.END.PTR))
	   LOW.NUM HIGH.NUM TEST TEST.NUM)
          (SETQ LOW.NUM (AR.GET.ENTRY.NUM LOW))
          (SETQ HIGH.NUM (AR.GET.ENTRY.NUM HIGH))
          (if (IGREATERP NUM HIGH.NUM)
	      then (SHOULDNT "Entry pointer higher than higher bound"))
      loop(if (EQP NUM LOW.NUM)
	      then (RETURN (CONS LOW T)))
          (if (EQP NUM HIGH.NUM)
	      then (RETURN (CONS HIGH T)))
          (SETQ TEST (IPLUS LOW (ITIMES (IQUOTIENT (IQUOTIENT (IDIFFERENCE HIGH LOW)
							      2)
						   AR.INDEX.ENTRY.SIZE)
					AR.INDEX.ENTRY.SIZE)))
          (if (EQP TEST LOW)
	      then (RETURN (CONS HIGH NIL)))
          (SETQ TEST.NUM (AR.GET.ENTRY.NUM TEST))
          (if (IGEQ NUM TEST.NUM)
	      then (SETQ LOW TEST)
		   (SETQ LOW.NUM TEST.NUM)
	    else (SETQ HIGH TEST)
		 (SETQ HIGH.NUM TEST.NUM))
          (GO loop])

(AR.INDEX.OPEN
  [LAMBDA (FORMWINDOW FILENAME)                              (* edited: "13-Jul-84 10:44")
    (PROG (INDEX.DATA)
          (if [NULL (NLSETQ (SETQ AR.INDEX.FILE (OPENSTREAM FILENAME (QUOTE INPUT)
							    (QUOTE OLD]
	      then (AR.PROMPT "Can't open AR index file" FORMWINDOW)
		   (RETURN))
          (SETFILEPTR AR.INDEX.FILE (IDIFFERENCE (GETEOFPTR AR.INDEX.FILE)
						 4))
          (SETFILEPTR AR.INDEX.FILE (\DWIN AR.INDEX.FILE))
          (SETQ INDEX.DATA (READ AR.INDEX.FILE))
          (if (NOT (type? AR.INDEX.DATA INDEX.DATA))
	      then (AR.PROMPT "Bad AR index file format" FORMWINDOW)
		   (CLOSEF AR.INDEX.FILE)
		   (RETURN))
          (replace (AR.INDEX.DATA AR.INDEX.FILE) of INDEX.DATA with AR.INDEX.FILE)
          (RETURN INDEX.DATA])

(AR.INDEX.FILE.REOPEN
  [LAMBDA (QFORMWINDOW)                                      (* edited: "30-Aug-84 11:23")
    (if (NOT (OPENP AR.INDEX.FILE))
	then (AR.PROMPT "Re-opening index file" QFORMWINDOW)
	     (SETQ AR.INDEX.FILE (OPENSTREAM (FULLNAME AR.INDEX.FILE)
					     (QUOTE INPUT)
					     (QUOTE OLD)))
	     (replace (AR.INDEX.DATA AR.INDEX.FILE) of (WINDOWPROP QFORMWINDOW (QUOTE AR.INDEX.DATA))
		with AR.INDEX.FILE])

(AR.INDEX.PRINT
  [LAMBDA (FILE PRINT.ENTRY.DATA.FLG)                        (* ckj " 8-May-86 14:16")
    (RESETLST (RESETSAVE (RADIX 10))
		(printout FILE "Total file size: " (GETEOFPTR AR.INDEX.FILE)
			  " bytes" T T))
    (RESETLST (RESETSAVE (RADIX 10))
		(printout FILE "Total Field Space: " .TAB 20 AR.INDEX.ENTRY.BEGIN.PTR " bytes" T))
    (for FIELD.NAME in AR.INDEX.FIELD.LIST bind FIELD.BYTES
       do [SETQ FIELD.BYTES (IDIFFERENCE (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME
							  (QUOTE FIELD.END.PTR))
					       (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME
							  (QUOTE FIELD.BEGIN.PTR]
	    (RESETLST (RESETSAVE (RADIX 10))
			(printout FILE FIELD.NAME .TAB 20 FIELD.BYTES T)))
    (RESETLST (RESETSAVE (RADIX 10))
		(printout FILE T "Total Entry Space: " (IDIFFERENCE AR.INDEX.ENTRY.END.PTR 
								      AR.INDEX.ENTRY.BEGIN.PTR)
			  " bytes" T))
    (RESETLST (RESETSAVE (RADIX 10))
		(printout T (IQUOTIENT (IDIFFERENCE AR.INDEX.ENTRY.END.PTR 
							AR.INDEX.ENTRY.BEGIN.PTR)
					 AR.INDEX.ENTRY.SIZE)
			  " entries of " AR.INDEX.ENTRY.SIZE " bytes" T))
    (if (EQ (QUOTE ALL)
		PRINT.ENTRY.DATA.FLG)
	then [for ENTRY.PTR from AR.INDEX.ENTRY.BEGIN.PTR by AR.INDEX.ENTRY.SIZE
		  until (IGEQ ENTRY.PTR AR.INDEX.ENTRY.END.PTR)
		  do (RESETLST (RESETSAVE (RADIX 10))
				   (printout FILE "Entry # " (PROGN (SETFILEPTR AR.INDEX.FILE 
										    ENTRY.PTR)
								      (\DWIN AR.INDEX.FILE))
					     T))
		       (for FIELD.NAME in AR.INDEX.FIELD.LIST bind VAL.DATA FIELD.OFFSET 
									 FIELD.KEYLIST 
									 FIELD.BEGIN.PTR VAL.NUM
			  do (SETQ FIELD.BEGIN.PTR (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME
								  (QUOTE FIELD.BEGIN.PTR)))
			       (SETQ FIELD.OFFSET (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME
							       (QUOTE FIELD.OFFSET)))
			       (if FIELD.OFFSET
				   then (SETQ VAL.DATA (AR.GET.FIELD.VAL.DATA ENTRY.PTR 
										    FIELD.NAME 
										    FIELD.OFFSET 
										  FIELD.BEGIN.PTR))
					  (printout FILE FIELD.NAME " %"")
					  (SETFILEPTR AR.INDEX.FILE (CAR VAL.DATA))
					  (COPYBYTES AR.INDEX.FILE FILE (CDR VAL.DATA))
					  (printout FILE "%"" T)
				 else (SETQ FIELD.KEYLIST (ARSPECGET AR.INDEX.FIELD.SPECS 
									 FIELD.NAME (QUOTE 
									 ENUMERATED.FIELD.KEYLIST)))
					(SETFILEPTR AR.INDEX.FILE (AR.ENTRY.PTR.TO.KEY.VAL.PTR
							ENTRY.PTR FIELD.BEGIN.PTR))
					(SETQ VAL.NUM (BIN AR.INDEX.FILE))
					(if (EQP 0 VAL.NUM)
					    then (printout FILE FIELD.NAME " %"%"" T)
					  else (printout FILE FIELD.NAME " %""
							   (CAR (for X on FIELD.KEYLIST
								     by (CDDR X)
								     when (EQP VAL.NUM
										   (CADR X))
								     collect (CAR X)))
							   "%"" T]
      elseif PRINT.ENTRY.DATA.FLG
	then (printout FILE "Contains entries: ")
	       (for ENTRY.PTR from AR.INDEX.ENTRY.BEGIN.PTR by AR.INDEX.ENTRY.SIZE
		  until (IGEQ ENTRY.PTR AR.INDEX.ENTRY.END.PTR)
		  do (printout FILE (PROGN (SETFILEPTR AR.INDEX.FILE ENTRY.PTR)
					       (\DWIN AR.INDEX.FILE))
				 ,))
	       (TERPRI FILE])

(AR.INDEX.REWRITE.ENTRY.DATA
  [LAMBDA (NEW.FILE NUM.DATA.LIST)                           (* edited: "16-Jul-84 15:55")
    (PROG ((ENTRY.PTR AR.INDEX.ENTRY.BEGIN.PTR)
	   (FIELDS.WITH.OFFSETS (for FIELD.NAME in AR.INDEX.FIELD.LIST when (ARSPECGET 
									     AR.INDEX.FIELD.SPECS 
										       FIELD.NAME
										       (QUOTE 
										     FIELD.OFFSET))
				   collect FIELD.NAME))
	   FIELD.INCREMENT.LIST)
          (SETQ FIELD.INCREMENT.LIST (for X in FIELDS.WITH.OFFSETS collect 0))
          (until (AND (NULL NUM.DATA.LIST)
		      (IGEQ ENTRY.PTR AR.INDEX.ENTRY.END.PTR))
	     bind NUM.DATA NEXT.HIGHER.ENTRY.PTR REPLACE.FLG
	     do (SETQ NUM.DATA (CAR NUM.DATA.LIST))
		(SETQ NEXT.HIGHER.ENTRY.PTR (CAR (CADR NUM.DATA)))
		(SETQ REPLACE.FLG (CDR (CADR NUM.DATA)))
		(if (OR (NULL NUM.DATA.LIST)
			(IGREATERP NEXT.HIGHER.ENTRY.PTR ENTRY.PTR))
		    then 

          (* * copy an existing AR entry, rather than create a new one)


			 (SETFILEPTR AR.INDEX.FILE ENTRY.PTR) 
                                                             (* copy AR number to new entry)
			 (\DWOUT NEW.FILE (\DWIN AR.INDEX.FILE)) 
                                                             (* copy ptrs to various fields, adding on current 
							     increments)
			 [for X in FIELD.INCREMENT.LIST do (\DWOUT NEW.FILE (IPLUS X (\DWIN 
										    AR.INDEX.FILE]
			 (SETQ ENTRY.PTR (GETFILEPTR AR.INDEX.FILE))
		  else 

          (* * add a new AR entry from NUM.DATA.LIST)


		       [if (NOT (EQ (CDDR NUM.DATA)
				    (QUOTE DELETE)))
			   then                              (* put out new number)
				(\DWOUT NEW.FILE (CAR NUM.DATA)) 
                                                             (* put out field ptrs for next higher field)
				[for FIELD.NAME in FIELDS.WITH.OFFSETS as X in FIELD.INCREMENT.LIST
				   as FIELD.OFFSET from 4 by 4 bind FIELD.BEGIN.PTR
				   do (SETQ FIELD.BEGIN.PTR (ARSPECGET AR.INDEX.FIELD.SPECS 
								       FIELD.NAME (QUOTE 
										  FIELD.BEGIN.PTR)))
				      (\DWOUT NEW.FILE (IPLUS X (IDIFFERENCE (AR.GET.FIELD.VAL.PTR
									       NEXT.HIGHER.ENTRY.PTR 
									       FIELD.NAME 
									       FIELD.OFFSET 
									       FIELD.BEGIN.PTR)
									     FIELD.BEGIN.PTR]
                                                             (* now, add field lengths to FIELD.INCREMENT.LIST)
				(for FIELD.NAME in FIELDS.WITH.OFFSETS as INC.LIST on 
									     FIELD.INCREMENT.LIST
				   bind AR.FIELD.DATA
				   do (SETQ AR.FIELD.DATA (ASSOC FIELD.NAME (CDDR NUM.DATA)))
				      (if AR.FIELD.DATA
					  then (RPLACA INC.LIST (IPLUS (CAR INC.LIST)
								       (CADDR AR.FIELD.DATA]
                                                             (* if we are replacing an old AR, we must SUBTRACT the 
							     field lengths of the old AR from FIELD.INCREMENT.LIST)
		       (if REPLACE.FLG
			   then (for INC.LIST on FIELD.INCREMENT.LIST as LENGTH.TO.BE.DELETED
				   in (for FIELD.NAME in FIELDS.WITH.OFFSETS collect (
AR.GET.FIELD.VAL.LENGTH NEXT.HIGHER.ENTRY.PTR FIELD.NAME)) do (RPLACA INC.LIST (IDIFFERENCE
									(CAR INC.LIST)
									LENGTH.TO.BE.DELETED)))
				(SETQ ENTRY.PTR (IPLUS ENTRY.PTR AR.INDEX.ENTRY.SIZE)))
		       (SETQ NUM.DATA.LIST (CDR NUM.DATA.LIST])

(AR.INDEX.REWRITE.FIELD.DATA
  [LAMBDA (NEWFILE SCRATCHFILE FIELD.NAME NUM.DATA.LIST)     (* mjs "28-Feb-85 12:11")
    (PROG ((FIELD.KEYLIST (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME (QUOTE ENUMERATED.FIELD.KEYLIST))
			  )
	   (FIELD.OFFSET (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME (QUOTE FIELD.OFFSET)))
	   (FIELD.DATA.BEGIN.PTR (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME (QUOTE FIELD.BEGIN.PTR)))
	   (FIELD.DATA.END.PTR (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME (QUOTE FIELD.END.PTR)))
	   DATA.PTR)
          (if (NOT (OR FIELD.KEYLIST FIELD.OFFSET))
	      then (ERROR "Field doesn't have keylist or offset" FIELD.NAME))
          (SETQ DATA.PTR FIELD.DATA.BEGIN.PTR)
          (for NUM.DATA in NUM.DATA.LIST bind NEXT.HIGHER.ENTRY.PTR REPLACE.FLG 
					      NEXT.HIGHER.FIELD.VAL.PTR NUM.DATA.FOR.FIELD 
					      SCRATCH.FIELD.PTR SCRATCH.FIELD.LEN
	     do (SETQ NEXT.HIGHER.ENTRY.PTR (CAR (CADR NUM.DATA)))
		(SETQ REPLACE.FLG (CDR (CADR NUM.DATA)))
		(SETQ NEXT.HIGHER.FIELD.VAL.PTR (if FIELD.OFFSET
						    then (AR.GET.FIELD.VAL.PTR NEXT.HIGHER.ENTRY.PTR 
									       FIELD.NAME 
									       FIELD.OFFSET 
									     FIELD.DATA.BEGIN.PTR 
									       FIELD.DATA.END.PTR)
						  else (AR.ENTRY.PTR.TO.KEY.VAL.PTR 
									    NEXT.HIGHER.ENTRY.PTR 
									     FIELD.DATA.BEGIN.PTR)))
		(if (ILESSP DATA.PTR NEXT.HIGHER.FIELD.VAL.PTR)
		    then (COPYBYTES AR.INDEX.FILE NEWFILE DATA.PTR NEXT.HIGHER.FIELD.VAL.PTR))
		[if (NOT (EQ (CDDR NUM.DATA)
			     (QUOTE DELETE)))
		    then (SETQ NUM.DATA.FOR.FIELD (ASSOC FIELD.NAME (CDDR NUM.DATA)))
			 (SETQ SCRATCH.FIELD.PTR (CADR NUM.DATA.FOR.FIELD))
			 (SETQ SCRATCH.FIELD.LEN (CADDR NUM.DATA.FOR.FIELD))
			 (if NUM.DATA.FOR.FIELD
			     then (SETFILEPTR SCRATCHFILE SCRATCH.FIELD.PTR)
				  (if FIELD.OFFSET
				      then (if (IGREATERP SCRATCH.FIELD.LEN 0)
					       then (COPYBYTES SCRATCHFILE NEWFILE SCRATCH.FIELD.LEN))
				    else (BOUT NEWFILE
					       (if [LISTGET FIELD.KEYLIST
							    (PACKC (PROGN (for X from 1 to 
										SCRATCH.FIELD.LEN
									     collect (BIN SCRATCHFILE]
						 else 0)))
			   else (if FIELD.OFFSET
				    then NIL
				  else (BOUT NEWFILE 0]
		(SETQ DATA.PTR (if REPLACE.FLG
				   then (if FIELD.OFFSET
					    then (AR.GET.FIELD.VAL.PTR (IPLUS NEXT.HIGHER.ENTRY.PTR 
									      AR.INDEX.ENTRY.SIZE)
								       FIELD.NAME FIELD.OFFSET 
								       FIELD.DATA.BEGIN.PTR 
								       FIELD.DATA.END.PTR)
					  else (ADD1 NEXT.HIGHER.FIELD.VAL.PTR))
				 else NEXT.HIGHER.FIELD.VAL.PTR)))
          (if (ILESSP DATA.PTR FIELD.DATA.END.PTR)
	      then (COPYBYTES AR.INDEX.FILE NEWFILE DATA.PTR FIELD.DATA.END.PTR])

(AR.INDEX.SEARCH.HAS
  [LAMBDA (QFORMWINDOW FIELD.NAME SEARCH.STRING)             (* mjs "16-Oct-84 10:30")
    (PROG ((FIELD.OFFSET (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME (QUOTE FIELD.OFFSET)))
	   (FIELD.VAL.BEGIN.PTR (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME (QUOTE FIELD.BEGIN.PTR)))
	   (FIELD.VAL.END.PTR (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME (QUOTE FIELD.END.PTR)))
	   FOUND.PTRS FOUND.ENTRY.PTRS HAS.HARRAY HAS.HARRAY.INDEX)
          (if (NOT (MEMB FIELD.NAME AR.INDEX.FIELD.LIST))
	      then (AR.PROMPT (LIST "Unknown field name: " FIELD.NAME)
			      QFORMWINDOW)
		   (ERROR!)
	    elseif (NULL FIELD.OFFSET)
	      then (AR.PROMPT (LIST "Non-variable field: " FIELD.NAME " -- use IS")
			      QFORMWINDOW)
		   (ERROR!))
          (SETQ SEARCH.STRING (U-CASE (MKSTRING SEARCH.STRING)))
          (if (EQP 0 (NCHARS SEARCH.STRING))
	      then (RETURN))
          (SETQ HAS.HARRAY (WINDOWPROP QFORMWINDOW (QUOTE AR.SEARCH.HAS.HARRAY)))
          (SETQ HAS.HARRAY.INDEX (PACK* FIELD.NAME (QUOTE /HAS/)
					SEARCH.STRING))
          [if (AND (LISTP HAS.HARRAY)
		   (HARRAYP (CAR HAS.HARRAY)))
	      then (SETQ FOUND.ENTRY.PTRS (GETHASH HAS.HARRAY.INDEX HAS.HARRAY))
		   (if (EQ FOUND.ENTRY.PTRS (QUOTE NONE))
		       then (RETURN NIL)
		     elseif FOUND.ENTRY.PTRS
		       then (RETURN FOUND.ENTRY.PTRS))
	    else (WINDOWPROP QFORMWINDOW (QUOTE AR.SEARCH.HAS.HARRAY)
			     (SETQ HAS.HARRAY (LIST (HARRAY 20]
          (SETFILEPTR AR.INDEX.FILE FIELD.VAL.BEGIN.PTR)
          (SETQ FOUND.PTRS (bind PTR (LAST.POS ←(SUB1 FIELD.VAL.END.PTR))
			      while (SETQ PTR (FFILEPOS SEARCH.STRING AR.INDEX.FILE NIL LAST.POS NIL 
							T UPPERCASEARRAY))
			      collect                        (* remember that these pointers are to the filepos 
							     AFTER the last char of the match)
				      PTR))
          (SETQ FOUND.ENTRY.PTRS (AR.GET.ENTRY.PTRS.FROM.FIELD.PTRS FOUND.PTRS 
								    AR.INDEX.ENTRY.BEGIN.PTR 
								    AR.INDEX.ENTRY.END.PTR FIELD.NAME 
								    FIELD.OFFSET FIELD.VAL.BEGIN.PTR 
								    FIELD.VAL.END.PTR))
          (PUTHASH HAS.HARRAY.INDEX (if FOUND.ENTRY.PTRS
				      else (QUOTE NONE))
		   HAS.HARRAY)
          (RETURN FOUND.ENTRY.PTRS])

(AR.INDEX.SEARCH.IS
  [LAMBDA (QFORMWINDOW FIELD.NAME SEARCH.STRING)             (* mjs "16-Oct-84 10:30")
    (PROG ((FIELD.KEYLIST (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME (QUOTE ENUMERATED.FIELD.KEYLIST))
			  )
	   (FIELD.VAL.BEGIN.PTR (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME (QUOTE FIELD.BEGIN.PTR)))
	   (FIELD.VAL.END.PTR (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME (QUOTE FIELD.END.PTR)))
	   SEARCH.KEY.NUM FOUND.ENTRY.PTRS)
          (if (NOT (MEMB FIELD.NAME AR.INDEX.FIELD.LIST))
	      then (AR.PROMPT (LIST "Unknown field name: " FIELD.NAME)
			      QFORMWINDOW)
		   (ERROR!))
          (if (NULL FIELD.KEYLIST)
	      then (if (NULL SEARCH.STRING)
		       then (RETURN (for X from AR.INDEX.ENTRY.BEGIN.PTR to AR.INDEX.ENTRY.END.PTR
				       by AR.INDEX.ENTRY.SIZE bind (FIELD.OFFSET ←(ARSPECGET
										   
									     AR.INDEX.FIELD.SPECS 
										   FIELD.NAME
										   (QUOTE 
										     FIELD.OFFSET)))
				       unless (IGEQ X AR.INDEX.ENTRY.END.PTR)
				       when (EQP 0 (AR.GET.FIELD.VAL.LENGTH X FIELD.NAME FIELD.OFFSET 
									    FIELD.VAL.BEGIN.PTR 
									    FIELD.VAL.END.PTR))
				       collect X)))
		   (AR.PROMPT (LIST "Non-enumerated field: " FIELD.NAME " -- use HAS")
			      QFORMWINDOW)
		   (ERROR!))
          [SETQ SEARCH.KEY.NUM (if (NULL SEARCH.STRING)
				   then 0
				 else (LISTGET FIELD.KEYLIST (MKATOM SEARCH.STRING]
          (if (NULL SEARCH.KEY.NUM)
	      then (AR.PROMPT (LIST "Unknown key: " SEARCH.STRING " for field: " FIELD.NAME)
			      QFORMWINDOW)
		   (ERROR!))
          (SETFILEPTR AR.INDEX.FILE FIELD.VAL.BEGIN.PTR)
          (SETQ SEARCH.STRING (MKSTRING (CHARACTER SEARCH.KEY.NUM)))
          (SETQ FOUND.ENTRY.PTRS (bind PTR (LAST.POS ←(SUB1 FIELD.VAL.END.PTR))
				    while (SETQ PTR (FILEPOS SEARCH.STRING AR.INDEX.FILE NIL LAST.POS 
							     NIL T))
				    collect                  (* collect corresponding entry pointers immediately)
					    (AR.KEY.VAL.PTR.TO.ENTRY.PTR (SUB1 PTR)
									 FIELD.VAL.BEGIN.PTR)))
          (RETURN FOUND.ENTRY.PTRS])

(AR.GET.ENTRY.PTRS.FROM.FIELD.PTRS
  [LAMBDA (FIELD.PTRS LOW.ENTRY.PTR HIGH.ENTRY.PTR FIELD.NAME FIELD.OFFSET FIELD.VAL.BEGIN.PTR 
		      FIELD.VAL.END.PTR)                     (* edited: "12-Jul-84 15:29")
    (PROG (TEST TEST.DATA FIRST.CHAR LAST.CHAR.PLUS.1 AFTER.LIST AFTER.LIST.MINUS.FOUND.PTRS 
		BEFORE.LIST)
          (if (NULL FIELD.PTRS)
	      then (RETURN NIL))
          (SETQ TEST (IPLUS LOW.ENTRY.PTR (ITIMES (IQUOTIENT (IQUOTIENT (IDIFFERENCE HIGH.ENTRY.PTR 
										    LOW.ENTRY.PTR)
									2)
							     AR.INDEX.ENTRY.SIZE)
						  AR.INDEX.ENTRY.SIZE)))
          (SETQ TEST.DATA (AR.GET.FIELD.VAL.DATA TEST FIELD.NAME FIELD.OFFSET FIELD.VAL.BEGIN.PTR 
						 FIELD.VAL.END.PTR))
          (SETQ FIRST.CHAR (CAR TEST.DATA))
          (SETQ LAST.CHAR.PLUS.1 (IPLUS FIRST.CHAR (CDR TEST.DATA)))
          (SETQ AFTER.LIST (for X on FIELD.PTRS thereis (IGREATERP (CAR X)
								   FIRST.CHAR)))
          (SETQ BEFORE.LIST (LDIFF FIELD.PTRS AFTER.LIST))
          (SETQ AFTER.LIST.MINUS.FOUND.PTRS (for X on AFTER.LIST thereis (IGREATERP (CAR X)
										    LAST.CHAR.PLUS.1))
	    )
          (RETURN (NCONC (if (AND BEFORE.LIST (NEQ TEST LOW.ENTRY.PTR))
			     then (AR.GET.ENTRY.PTRS.FROM.FIELD.PTRS BEFORE.LIST LOW.ENTRY.PTR TEST 
								     FIELD.NAME FIELD.OFFSET 
								     FIELD.VAL.BEGIN.PTR 
								     FIELD.VAL.END.PTR)
			   else NIL)
			 (if (NEQ AFTER.LIST AFTER.LIST.MINUS.FOUND.PTRS)
			     then (CONS TEST)
			   else NIL)
			 (if AFTER.LIST.MINUS.FOUND.PTRS
			     then (AR.GET.ENTRY.PTRS.FROM.FIELD.PTRS AFTER.LIST.MINUS.FOUND.PTRS TEST 
								     HIGH.ENTRY.PTR FIELD.NAME 
								     FIELD.OFFSET FIELD.VAL.BEGIN.PTR 
								     FIELD.VAL.END.PTR)
			   else NIL])

(AR.INDEX.UPDATE
  [LAMBDA (FORMWINDOW AR.NUM.LIST)                           (* edited: "21-Aug-84 14:10")
    (AR.INDEX.DATA.CONTEXT FORMWINDOW
			   (PROG ((AR.NUM.DATA NIL)
				  AR.SCRATCH.FILE NEW.AR.INDEX.FILE NEW.AR.INDEX.DATA NEW.FIELD.SPECS 
				  NEW.AR.INDEX.DATA.PTR)
			         (if [OR (NLISTP AR.NUM.LIST)
					 (for X in AR.NUM.LIST thereis (NOT (FIXP X]
				     then (AR.PROMPT "Bad AR number list" FORMWINDOW)
					  (RETURN))
			         (SORT AR.NUM.LIST)          (* destructively remove duplicates)
			         [bind (X ← AR.NUM.LIST) while (CDR X)
				    do (if (MEMB (CAR X)
						 (CDR X))
					   then (RPLNODE X (CADR X)
							 (CDDR X))
					 else (SETQ X (CDR X]
			         (SETQ AR.SCRATCH.FILE (OPENSTREAM (PACKFILENAME (QUOTE VERSION)
										 NIL
										 (QUOTE BODY)
										 (QUOTE AR.TEMP)
										 (QUOTE BODY)
										 (FULLNAME 
										    AR.INDEX.FILE))
								   (QUOTE BOTH)
								   (QUOTE NEW)))
			         (SETQ AR.NUM.DATA (AR.GATHER.NEW.AR.DATA FORMWINDOW AR.NUM.LIST 
									  AR.SCRATCH.FILE))
			         (SETQ NEW.AR.INDEX.FILE (OPENSTREAM (PACKFILENAME (QUOTE VERSION)
										   NIL
										   (QUOTE BODY)
										   (QUOTE ARINDEX.NEW)
										   (QUOTE BODY)
										   (FULLNAME 
										    AR.INDEX.FILE))
								     (QUOTE OUTPUT)
								     (QUOTE NEW)))
			         (SETQ NEW.AR.INDEX.DATA
				   (create AR.INDEX.DATA
					   AR.INDEX.FILE ← NIL
					   AR.INDEX.FIELD.LIST ← AR.INDEX.FIELD.LIST
					   AR.INDEX.ENTRY.SIZE ← AR.INDEX.ENTRY.SIZE))
			         (SETQ NEW.FIELD.SPECS (COPYALL AR.INDEX.FIELD.SPECS))
			         (for FIELD.NAME in AR.INDEX.FIELD.LIST
				    do (ARSPECPUT NEW.FIELD.SPECS FIELD.NAME (QUOTE FIELD.BEGIN.PTR)
						  (GETFILEPTR NEW.AR.INDEX.FILE))
				       (AR.INDEX.REWRITE.FIELD.DATA NEW.AR.INDEX.FILE AR.SCRATCH.FILE 
								    FIELD.NAME AR.NUM.DATA)
				       (ARSPECPUT NEW.FIELD.SPECS FIELD.NAME (QUOTE FIELD.END.PTR)
						  (GETFILEPTR NEW.AR.INDEX.FILE)))
			         (replace (AR.INDEX.DATA AR.INDEX.FIELD.SPECS) of NEW.AR.INDEX.DATA
				    with NEW.FIELD.SPECS)
			         (CLOSEF AR.SCRATCH.FILE)
			         (DELFILE (FULLNAME AR.SCRATCH.FILE))
			         (replace (AR.INDEX.DATA AR.INDEX.ENTRY.BEGIN.PTR) of 
										NEW.AR.INDEX.DATA
				    with (GETFILEPTR NEW.AR.INDEX.FILE))
			         (AR.INDEX.REWRITE.ENTRY.DATA NEW.AR.INDEX.FILE AR.NUM.DATA)
			         (replace (AR.INDEX.DATA AR.INDEX.ENTRY.END.PTR) of NEW.AR.INDEX.DATA
				    with (GETFILEPTR NEW.AR.INDEX.FILE))
			         (SETQ NEW.AR.INDEX.DATA.PTR (GETFILEPTR NEW.AR.INDEX.FILE))
			         (PRINT NEW.AR.INDEX.DATA NEW.AR.INDEX.FILE)
			         (\DWOUT NEW.AR.INDEX.FILE NEW.AR.INDEX.DATA.PTR)
			         (CLOSEF NEW.AR.INDEX.FILE)
			         (RETURN (RENAMEFILE (FULLNAME NEW.AR.INDEX.FILE)
						     (PACKFILENAME (QUOTE VERSION)
								   NIL
								   (QUOTE BODY)
								   (FULLNAME AR.INDEX.FILE])

(AR.QFORM.ACTIONFN
  [LAMBDA (QFORMWINDOW OPERATION)                            (* mjs " 8-Aug-84 17:47")
    (ALLOW.BUTTON.EVENTS)
    (PROCESSPROP (THIS.PROCESS)
		 (QUOTE NAME)
		 (QUOTE AR.QFORM.TEMP))
    (PROG [(TOBJ (WINDOWPROP QFORMWINDOW (QUOTE TEXTOBJ]
          (AR.MARK.ACTIVE TOBJ OPERATION)
          (DSPFILL NIL 72 (QUOTE PAINT)
		   QFORMWINDOW)
          [NLSETQ (PROGN (AR.PROMPT (LIST OPERATION " initiated...")
				    QFORMWINDOW)
			 (SELECTQ OPERATION
				  (Query (AR.QFORM.FN.QUERY QFORMWINDOW))
				  (Update (AR.QFORM.FN.UPDATE QFORMWINDOW))
				  (Print (AR.QFORM.FN.PRINT QFORMWINDOW))
				  ((Print% Index% Stats Debug)
				    (AR.INDEX.DATA.CONTEXT QFORMWINDOW
							   (SELECTQ OPERATION
								    (Print% Index% Stats
								      (TTY.PROCESS (THIS.PROCESS))
								      (AR.INDEX.PRINT T)
								      (AR.PROMPT "done" QFORMWINDOW))
								    (Debug (HELP 
				"Debug from within AR Query Form env --- type (RETURN) to return")
									   (AR.PROMPT "done" 
										      QFORMWINDOW))
								    NIL)))
				  (AR.PROMPT "Unknown AR Query Form button name!" QFORMWINDOW]
          (AR.MARK.ACTIVE TOBJ NIL)
          (REDISPLAYW QFORMWINDOW])

(AR.QFORM.PROMPT.LIST.FN
  [LAMBDA (OBJ SEL WINDOW)                                   (* mjs "17-Feb-85 16:03")
    (PROG ((TOBJ (fetch (SELECTION \TEXTOBJ) of SEL))
	   [WINDOW (CAR (fetch (TEXTOBJ \WINDOW) of (fetch (SELECTION \TEXTOBJ) of SEL]
	   (BUTTON (IMAGEOBJPROP OBJ (QUOTE MBTEXT)))
	   STRING.TO.ADD FIELD.SEL FIELD.END.CH#)
          (SETQ STRING.TO.ADD (MENU (SELECTQ BUTTON
					     (Query% List: (AR.GET.QLIST.PROMPT.MENU WINDOW))
					     (Sort% List: (AR.GET.SLIST.PROMPT.MENU WINDOW))
					     NIL)))
          (if STRING.TO.ADD
	      then (MBUTTON.FIND.NEXT.FIELD TOBJ (fetch (SELECTION CH#) of SEL))
		   (SETQ FIELD.SEL (fetch (TEXTOBJ SCRATCHSEL) of TOBJ))
		   (SETQ FIELD.END.CH# (IPLUS (fetch (SELECTION CH#) of FIELD.SEL)
					      (fetch (SELECTION DCH) of FIELD.SEL)))
		   (TEDIT.INSERT (TEXTSTREAM WINDOW)
				 STRING.TO.ADD FIELD.END.CH#)
		   (TEDIT.INSERT (TEXTSTREAM WINDOW)
				 " "
				 (IPLUS FIELD.END.CH# (NCHARS STRING.TO.ADD])

(AR.GET.QLIST.PROMPT.MENU
  [LAMBDA (QFORMWINDOW)                                      (* mjs "19-Aug-84 09:57")
    (PROG [(VAL (WINDOWPROP QFORMWINDOW (QUOTE AR.QLIST.PROMPT.MENU]
          [if (NULL VAL)
	      then
	       (WINDOWPROP
		 QFORMWINDOW
		 (QUOTE AR.QLIST.PROMPT.MENU)
		 (SETQ VAL
		   (AR.INDEX.DATA.CONTEXT
		     QFORMWINDOW
		     (create MENU
			     TITLE ← "Query Options"
			     ITEMS ←(APPEND (QUOTE ("(OR" "(AND"))
					    [for FIELD.NAME in AR.INDEX.FIELD.LIST bind FIELD.KEYLIST 
									      FIELD.PROMPT.STRING
					       when (SETQ FIELD.KEYLIST (ARSPECGET 
									     AR.INDEX.FIELD.SPECS 
										   FIELD.NAME
										   (QUOTE 
									 ENUMERATED.FIELD.KEYLIST)))
					       collect
						(SETQ FIELD.PROMPT.STRING (MKSTRING
						    (LIST FIELD.NAME (QUOTE IS)
							  (QUOTE ...))
						    T))
						(LIST FIELD.PROMPT.STRING (KWOTE FIELD.PROMPT.STRING)
						      NIL
						      (CONS (QUOTE SUBITEMS)
							    (for KEY.VAL in FIELD.KEYLIST
							       by (CDDR KEY.VAL)
							       collect (MKSTRING (LIST FIELD.NAME
										       (QUOTE IS)
										       KEY.VAL)
										 T]
					    (for FIELD.NAME in AR.INDEX.FIELD.LIST
					       unless (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME
								 (QUOTE ENUMERATED.FIELD.KEYLIST))
					       collect (MKSTRING (LIST FIELD.NAME (QUOTE HAS)
								       (QUOTE xxxx))
								 T]
          (RETURN VAL])

(AR.GET.SLIST.PROMPT.MENU
  [LAMBDA (QFORMWINDOW)                                      (* mjs "19-Aug-84 09:57")
    (PROG [(VAL (WINDOWPROP QFORMWINDOW (QUOTE AR.SLIST.PROMPT.MENU]
          [if (NULL VAL)
	      then (WINDOWPROP QFORMWINDOW (QUOTE AR.SLIST.PROMPT.MENU)
			       (SETQ VAL (AR.INDEX.DATA.CONTEXT QFORMWINDOW
								(create MENU
									TITLE ← "Sort Options"
									ITEMS ←(for FIELD.NAME
										  in 
									      AR.INDEX.FIELD.LIST
										  when
										   (ARSPECGET
										     
									     AR.INDEX.FIELD.SPECS 
										     FIELD.NAME
										     (QUOTE 
									 ENUMERATED.FIELD.KEYLIST))
										  collect
										   (MKSTRING 
										       FIELD.NAME T]
          (RETURN VAL])

(AR.QFORM.BUTTONFN
  [LAMBDA (OBJ SEL WINDOW)                                   (* mjs "17-Feb-85 16:03")
    (AR.QFORM.ACTIONFN (CAR (fetch (TEXTOBJ \WINDOW) of (fetch (SELECTION \TEXTOBJ) of SEL)))
		       (IMAGEOBJPROP OBJ (QUOTE MBTEXT])

(AR.QFORM.CREATE
  [LAMBDA (AR.INDEX.FILE.NAME WINDOW)                        (* edited: "21-Aug-84 16:05")
    (ADD.PROCESS (LIST (FUNCTION AR.QFORM.GROUP.CREATE)
		       (KWOTE AR.INDEX.FILE.NAME)
		       (KWOTE WINDOW))
		 (QUOTE NAME)
		 (QUOTE AR.QUERY.FORM.TEMP])

(AR.QFORM.FN.PRINT
  [LAMBDA (QFORMWINDOW)                                      (* mjs " 8-Aug-84 17:44")
    (PROG ([PRINT.FILE.NAME (CAR (AR.GET.BUTTON.FIELD.AS.LIST QFORMWINDOW (QUOTE Print% File:]
	   FILE)
          (if (OR (EQ PRINT.FILE.NAME NIL)
		  (EQ PRINT.FILE.NAME T))
	      then (TTY.PROCESS (THIS.PROCESS))
		   (SETQ FILE PRINT.FILE.NAME)
	    elseif [NLSETQ (SETQ FILE (OPENSTREAM PRINT.FILE.NAME (QUOTE OUTPUT)
						  (QUOTE NEW]
	    else (AR.PROMPT (LIST "Bad Print file: " PRINT.FILE.NAME)
			    QFORMWINDOW)
		 (RETURN))
          (AR.PRINT QFORMWINDOW FILE)
          (NLSETQ (CLOSEF FILE])

(AR.QFORM.FN.QUERY
  [LAMBDA (QFORMWINDOW)                                      (* ckj " 8-May-86 14:18")
    (PROG [[QLIST (CONS (QUOTE AND)
			    (AR.GET.BUTTON.FIELD.AS.LIST QFORMWINDOW (QUOTE Query% List:]
	     (SLIST (AR.GET.BUTTON.FIELD.AS.LIST QFORMWINDOW (QUOTE Sort% List:]
	    (AR.QFORM.DISPLAY.DISCONNECT QFORMWINDOW)
	    (AR.QUERY QFORMWINDOW QLIST)
	    (AR.PROMPT (RESETLST (RESETSAVE (RADIX 10))
				     (LIST "Total: " (LENGTH (WINDOWPROP QFORMWINDOW
									       (QUOTE 
										   AR.ENTRY.ALIST)))
					     " entries found"))
			 QFORMWINDOW)
	    (AR.SORT QFORMWINDOW SLIST)
	    (AR.QFORM.DISPLAY.CONNECT QFORMWINDOW])

(AR.QFORM.FN.UPDATE
  [LAMBDA (QFORMWINDOW)                                      (* mjs " 8-Aug-84 15:18")
    (PROG ((ULIST (AR.GET.BUTTON.FIELD.AS.LIST QFORMWINDOW (QUOTE Update% List:)))
	   VAL)
          (SETQ VAL (AR.INDEX.UPDATE QFORMWINDOW ULIST))
          (AR.PROMPT (LIST "Update done --- new file: " VAL)
		     QFORMWINDOW])

(AR.QFORM.GROUP.CREATE
  [LAMBDA (AR.INDEX.FILE.NAME WINDOW)                        (* mjs " 4-Jun-85 11:26")
    (PROG ((QFORMWINDOW (if WINDOW
			  else (CREATEW (GETREGION 400 100)
					"AR Query Window")))
	   QFORMWINDOW.REGION QFORM.ENTRY.WINDOW)

          (* * set up main window)


          (WINDOWPROP QFORMWINDOW (QUOTE AR.WINDOW.PROC.NAME)
		      (QUOTE AR.QUERY.FORM))
          (WINDOWPROP QFORMWINDOW (QUOTE MINSIZE)
		      (CONS 200 100))
          (WINDOWPROP QFORMWINDOW (QUOTE MAXSIZE)
		      (CONS 99999 100))
          (WINDOWPROP QFORMWINDOW (QUOTE ICON)
		      AR.QFORM.ICON)
          (WINDOWADDPROP QFORMWINDOW (QUOTE CLOSEFN)
			 (FUNCTION AR.KILL.ATTACHED.TEDIT.CLOSEFN))
          [WINDOWADDPROP QFORMWINDOW (QUOTE CLOSEFN)
			 (FUNCTION (LAMBDA (WINDOW)
			     (PROG [(INDEX.FILE (fetch (AR.INDEX.DATA AR.INDEX.FILE)
						   of (WINDOWPROP WINDOW (QUOTE AR.INDEX.DATA]
			           (if (OPENP INDEX.FILE)
				       then (CLOSEF INDEX.FILE]
          (WINDOWPROP QFORMWINDOW (QUOTE AR.TEDIT.TITLEMENUFN)
		      (FUNCTION NILL))

          (* * set up entry window)


          (SETQ QFORMWINDOW.REGION (WINDOWPROP QFORMWINDOW (QUOTE REGION)))
          (SETQ QFORM.ENTRY.WINDOW (CREATEW (create REGION
						    LEFT ←(fetch (REGION LEFT) of QFORMWINDOW.REGION)
						    BOTTOM ←(fetch (REGION TOP) of QFORMWINDOW.REGION)
						    WIDTH ←(fetch (REGION WIDTH) of 
									       QFORMWINDOW.REGION)
						    HEIGHT ← 100)
					    "AR Query Browser"))
          (ATTACHWINDOW QFORM.ENTRY.WINDOW QFORMWINDOW (QUOTE TOP)
			(QUOTE JUSTIFY)
			NIL)
          (WINDOWPROP QFORMWINDOW (QUOTE QFORM.ENTRY.WINDOW)
		      QFORM.ENTRY.WINDOW)
          (WINDOWPROP QFORM.ENTRY.WINDOW (QUOTE MINSIZE)
		      (CONS 10 100))
          (if (NULL AR.INDEX.FILE.NAME)
	      then (SETQ AR.INDEX.FILE.NAME AR.INDEX.DEFAULT.FILE.NAME))
          (WINDOWPROP QFORMWINDOW (QUOTE AR.INDEX.DATA)
		      (if (AR.INDEX.OPEN QFORMWINDOW AR.INDEX.FILE.NAME)
			else (RETURN)))
          (GETPROMPTWINDOW QFORMWINDOW 2)

          (* * create AR forms for main window)


          (AR.FORM.CREATE QFORMWINDOW ARBOLDFONT (BQUOTE ((Query% List: FIELDTYPE STRING FN 
									AR.QFORM.PROMPT.LIST.FN)
							  (Sort% List: FIELDTYPE STRING FN 
								       AR.QFORM.PROMPT.LIST.FN)
							  (Query FIELDTYPE BUTTON FN 
								 AR.QFORM.BUTTONFN FONT , 
								 ARBUTTONFONT)
							  (Print% File: FIELDTYPE STRING)
							  (Print FIELDTYPE BUTTON FN 
								 AR.QFORM.BUTTONFN FONT , 
								 ARBUTTONFONT)
							  (Update% List: FIELDTYPE STRING)
							  (Update FIELDTYPE BUTTON FN 
								  AR.QFORM.BUTTONFN FONT , 
								  ARBUTTONFONT)
							  (Print% Index% Stats FIELDTYPE BUTTON FN 
									       AR.QFORM.BUTTONFN FONT 
									       , ARBUTTONFONT)
							  (Debug FIELDTYPE BUTTON FN 
								 AR.QFORM.BUTTONFN FONT , 
								 ARBUTTONFONT)))
			  (QUOTE (Query% List: CR Sort% List: CR Query CR CR Print% File: CR Print CR]
)

(AR.QUERY
  [LAMBDA (QFORMWINDOW QLIST)                                (* mjs "16-Oct-84 10:19")
    (AR.INDEX.DATA.CONTEXT QFORMWINDOW (AR.QFORM.DISPLAY.DISCONNECT QFORMWINDOW)
			   (WINDOWPROP QFORMWINDOW (QUOTE AR.ENTRY.ALIST)
				       (for X in (AR.QUERY.EVAL.QLIST QFORMWINDOW QLIST)
					  collect (CONS X)))
			   (WINDOWPROP QFORMWINDOW (QUOTE AR.ENTRY.ALIST.QLIST)
				       QLIST)
			   (WINDOWPROP QFORMWINDOW (QUOTE AR.ENTRY.ALIST.SLIST)
				       NIL])

(AR.QUERY.EVAL.QLIST
  [LAMBDA (QFORMWINDOW QLIST)                                (* mjs "16-Oct-84 10:19")
    (if (NULL QLIST)
	then NIL
      elseif (EQ QLIST T)
	then (for X from AR.INDEX.ENTRY.BEGIN.PTR to AR.INDEX.ENTRY.END.PTR by AR.INDEX.ENTRY.SIZE
		unless (IGEQ X AR.INDEX.ENTRY.END.PTR) collect X)
      elseif (NLISTP QLIST)
	then (AR.PROMPT (LIST "Bad Query Spec: " QLIST)
			QFORMWINDOW)
	     (ERROR!)
      elseif (EQ (CAR QLIST)
		 (QUOTE NOT))
	then (for X from AR.INDEX.ENTRY.BEGIN.PTR to AR.INDEX.ENTRY.END.PTR by AR.INDEX.ENTRY.SIZE
		bind (VALS ←(AR.QUERY.EVAL.QLIST QFORMWINDOW (CADR QLIST)))
		unless (OR (IGEQ X AR.INDEX.ENTRY.END.PTR)
			   (MEMBER X VALS))
		collect X)
      elseif (EQ (CAR QLIST)
		 (QUOTE AND))
	then [if (NULL (CADR QLIST))
		 then NIL
	       elseif (NULL (CDDR QLIST))
		 then (AR.QUERY.EVAL.QLIST QFORMWINDOW (CADR QLIST))
	       else (AR.ENTRY.LIST.AND (AR.QUERY.EVAL.QLIST QFORMWINDOW (CADR QLIST))
				       (AR.QUERY.EVAL.QLIST QFORMWINDOW (CONS (QUOTE AND)
									      (CDDR QLIST]
      elseif (EQ (CAR QLIST)
		 (QUOTE OR))
	then [if (NULL (CADR QLIST))
		 then NIL
	       elseif (NULL (CDDR QLIST))
		 then (AR.QUERY.EVAL.QLIST QFORMWINDOW (CADR QLIST))
	       else (AR.ENTRY.LIST.OR (AR.QUERY.EVAL.QLIST QFORMWINDOW (CADR QLIST))
				      (AR.QUERY.EVAL.QLIST QFORMWINDOW (CONS (QUOTE OR)
									     (CDDR QLIST]
      elseif (EQ (CADR QLIST)
		 (QUOTE HAS))
	then (AR.INDEX.SEARCH.HAS QFORMWINDOW (CAR QLIST)
				  (CADDR QLIST))
      elseif (EQ (CADR QLIST)
		 (QUOTE IS))
	then (AR.INDEX.SEARCH.IS QFORMWINDOW (CAR QLIST)
				 (CADDR QLIST))
      else (AR.PROMPT (LIST "Bad Query Spec: " QLIST)
		      QFORMWINDOW)
	   (ERROR!])

(AR.PRINT
  [LAMBDA (QFORMWINDOW FILE)                                 (* mjs "21-Jun-85 11:44")
    (AR.INDEX.DATA.CONTEXT QFORMWINDOW (LINELENGTH MAX.SMALLP FILE)
			   (printout FILE "AR Summary generated on " (DATE)
				     T)
			   (printout FILE "Generated with Query Spec: " (WINDOWPROP QFORMWINDOW
										    (QUOTE 
									     AR.ENTRY.ALIST.QLIST))
				     T)
			   (printout FILE "Sorted with Sort Spec: " (WINDOWPROP QFORMWINDOW
										(QUOTE 
									     AR.ENTRY.ALIST.SLIST))
				     T T)
			   (for FIELD.SPEC in AR.ENTRY.LIST.PRINT.FIELDS bind FIELD.NAME FIELD.WIDTH 
									      VAL.NCHARS
			      do (SETQ FIELD.NAME (CAR FIELD.SPEC))
				 (SETQ FIELD.WIDTH (CADR FIELD.SPEC))
				 (for X from 1 to FIELD.WIDTH bind (NAME.NCHARS ←(NCHARS FIELD.NAME))
				    do (if (ILEQ X NAME.NCHARS)
					   then (PRIN1 (NTHCHAR FIELD.NAME X)
						       FILE)
					 else (PRIN1 " " FILE)))
				 (PRIN1 "  " FILE))
			   (printout FILE T T)
			   (for ENTRY.DATA in (WINDOWPROP QFORMWINDOW (QUOTE AR.ENTRY.ALIST))
			      bind ENTRY PRINT.DATA.ALIST
			      do                             (* ENTRY.DATA is a plist of form 
							     (<entryptr> <propname> <val> ...))
				 (SETQ ENTRY (CAR ENTRY.DATA))
				 [SETQ PRINT.DATA.ALIST (for FIELD.SPEC in AR.ENTRY.LIST.PRINT.FIELDS
							   bind FIELD.NAME
							   join 
                                                             (* grab all of the data needed to print this entry)
								(SETQ FIELD.NAME (CAR FIELD.SPEC))
								(LIST FIELD.NAME
								      (if (LISTGET (CDR ENTRY.DATA)
										   FIELD.NAME)
									else (AR.GET.FIELD.VAL ENTRY 
										       FIELD.NAME]
				 (for OVERFLOW.LINE.NUM from 0 bind OVERFLOW.FIELD.FLG
				    repeatwhile (AND AR.ENTRY.LIST.PRINT.MULTILINE.FLAG 
						     OVERFLOW.FIELD.FLG)
				    do (SETQ OVERFLOW.FIELD.FLG NIL)
				       (for FIELD.SPEC in AR.ENTRY.LIST.PRINT.FIELDS
					  bind FIELD.NAME FIELD.WIDTH FIELD.VAL FIELD.START.CHAR 
					       FIELD.END.CHAR VAL.NCHARS
					  do (SETQ FIELD.NAME (CAR FIELD.SPEC))
					     (SETQ FIELD.WIDTH (CADR FIELD.SPEC))
					     (SETQ FIELD.VAL (LISTGET PRINT.DATA.ALIST FIELD.NAME))
					     (SETQ FIELD.START.CHAR (ADD1 (ITIMES FIELD.WIDTH 
										OVERFLOW.LINE.NUM)))
					     (SETQ FIELD.END.CHAR (SUB1 (IPLUS FIELD.START.CHAR 
									       FIELD.WIDTH)))
					     (SETQ VAL.NCHARS (NCHARS FIELD.VAL))
					     (if (IGREATERP FIELD.START.CHAR VAL.NCHARS)
						 then (SPACES FIELD.WIDTH FILE)
					       else (for X from FIELD.START.CHAR to FIELD.END.CHAR
						       do (if (ILEQ X VAL.NCHARS)
							      then (PRIN1 (NTHCHAR FIELD.VAL X)
									  FILE)
							    else (PRIN1 " " FILE)))
						    (if (IGREATERP VAL.NCHARS FIELD.END.CHAR)
							then (SETQ OVERFLOW.FIELD.FLG T)))
					     (PRIN1 "  " FILE))
				       (TERPRI FILE])

(AR.SORT
  [LAMBDA (QFORMWINDOW SLIST)                                (* edited: "13-Aug-84 15:59")
    (AR.INDEX.DATA.CONTEXT QFORMWINDOW (AR.QFORM.DISPLAY.DISCONNECT QFORMWINDOW)
			   (PROG ((ENTRY.ALIST (WINDOWPROP QFORMWINDOW (QUOTE AR.ENTRY.ALIST)))
				  MULTIPLIERS)
			         (if (NULL SLIST)
				     then (RETURN))

          (* MULTIPLIERS is a list of integers which are multiplied by the enumerated value numbers of the corresponding 
	  fields in SLIST, so that the first field counts the most in sorting.)


			         [SETQ MULTIPLIERS (REVERSE (for FIELD.NAME in (REVERSE SLIST)
							       bind (CUMUL ← 1)
								    NUM KEYLIST
							       collect (SETQ KEYLIST
									 (ARSPECGET 
									     AR.INDEX.FIELD.SPECS 
										    FIELD.NAME
										    (QUOTE 
									 ENUMERATED.FIELD.KEYLIST)))
								       (if (NULL KEYLIST)
									   then (RETURN NIL))
								       (SETQ NUM (IQUOTIENT
									   (LENGTH KEYLIST)
									   2))
								       (PROG1 CUMUL
									      (SETQ CUMUL
										(ITIMES CUMUL
											(ADD1 NUM]
			         (if [OR (NULL MULTIPLIERS)
					 (for X in MULTIPLIERS thereis (NOT (FIXP X]
				     then (AR.PROMPT (LIST "Bad Sorting Spec: " SLIST 
							   " -- not sorted")
						     QFORMWINDOW)
					  (RETURN))
			         (for ENTRY in ENTRY.ALIST
				    do                       (* initialize sort numbers)
				       (if (NULL (CDR ENTRY))
					   then (RPLACD ENTRY (LIST (QUOTE AR.SORT.NUM)
								    0))
					 else (LISTPUT (CDR ENTRY)
						       (QUOTE AR.SORT.NUM)
						       0)))
			         [for FIELD.NAME in SLIST as MULT in MULTIPLIERS bind FIELD.BEGIN.PTR
				    do (SETQ FIELD.BEGIN.PTR (ARSPECGET AR.INDEX.FIELD.SPECS 
									FIELD.NAME (QUOTE 
										  FIELD.BEGIN.PTR)))
				       (for ENTRY in ENTRY.ALIST bind FIELD.VAL
					  do (SETFILEPTR AR.INDEX.FILE (AR.ENTRY.PTR.TO.KEY.VAL.PTR
							   (CAR ENTRY)
							   FIELD.BEGIN.PTR))
					     (SETQ FIELD.VAL (BIN AR.INDEX.FILE))
					     (LISTPUT (CDR ENTRY)
						      (QUOTE AR.SORT.NUM)
						      (IPLUS (LISTGET (CDR ENTRY)
								      (QUOTE AR.SORT.NUM))
							     (ITIMES FIELD.VAL MULT]
			         [SORT ENTRY.ALIST (FUNCTION (LAMBDA (A B)
					   (PROG [(ASORTNUM (LISTGET (CDR A)
								     (QUOTE AR.SORT.NUM)))
						  (BSORTNUM (LISTGET (CDR B)
								     (QUOTE AR.SORT.NUM]
					         (RETURN (if (EQP ASORTNUM BSORTNUM)
							     then (ILESSP (CAR A)
									  (CAR B))
							   else (ILESSP ASORTNUM BSORTNUM]
			         (WINDOWPROP QFORMWINDOW (QUOTE AR.ENTRY.ALIST.SLIST)
					     SLIST])

(AR.QFORM.DISPLAY.DISCONNECT
  [LAMBDA (QFORMWINDOW)                                      (* edited: "13-Aug-84 16:40")
    (PROG [(QFORM.ENTRY.WINDOW (WINDOWPROP QFORMWINDOW (QUOTE QFORM.ENTRY.WINDOW]
          (WINDOWPROP QFORM.ENTRY.WINDOW (QUOTE REPAINTFN)
		      (FUNCTION NILL))
          (WINDOWPROP QFORM.ENTRY.WINDOW (QUOTE BUTTONEVENTFN)
		      (FUNCTION NILL))
          (CLEARW QFORM.ENTRY.WINDOW])

(AR.QFORM.DISPLAY.CONNECT
  [LAMBDA (QFORMWINDOW)                                      (* edited: "13-Aug-84 16:40")
    (PROG ((QFORM.ENTRY.WINDOW (WINDOWPROP QFORMWINDOW (QUOTE QFORM.ENTRY.WINDOW)))
	   (QUERY.ENTRIES (WINDOWPROP QFORMWINDOW (QUOTE AR.ENTRY.ALIST)))
	   ENTRY.LIST.HEIGHT)
          (SETQ ENTRY.LIST.HEIGHT (ITIMES (ABS (DSPLINEFEED NIL QFORM.ENTRY.WINDOW))
					  (LENGTH QUERY.ENTRIES)))
          (WINDOWPROP QFORM.ENTRY.WINDOW (QUOTE EXTENT)
		      (CREATEREGION 0 (IMINUS ENTRY.LIST.HEIGHT)
				    2000 ENTRY.LIST.HEIGHT))
          (WINDOWPROP QFORM.ENTRY.WINDOW (QUOTE REPAINTFN)
		      (FUNCTION AR.ENTRY.LIST.WINDOW.REPAINTFN))
          (WINDOWPROP QFORM.ENTRY.WINDOW (QUOTE BUTTONEVENTFN)
		      (FUNCTION AR.ENTRY.LIST.WINDOW.BUTTONEVENTFN))
          (WINDOWPROP QFORM.ENTRY.WINDOW (QUOTE SCROLLFN)
		      (FUNCTION SCROLLBYREPAINTFN))
          (WINDOWPROP QFORM.ENTRY.WINDOW (QUOTE RESHAPEFN)
		      (FUNCTION RESHAPEBYREPAINTFN))
          (DSPRIGHTMARGIN MAX.SMALLP QFORM.ENTRY.WINDOW)
          (SCROLLW QFORM.ENTRY.WINDOW 0.0 0.0)
          (REDISPLAYW QFORM.ENTRY.WINDOW])
)

(RPAQQ AR.FORM.FORMAT (Number: TAB Date: CR Submitter: TAB Source: CR CR Subject: CR CR 
				 Assigned% To: TAB Attn: CR CR Status: TAB In/By: CR Problem% Type: 
				 TAB Impact: CR Difficulty: TAB Frequency: CR TAB Priority: CR CR 
				 System: TAB Subsystem: CR CR Machine: TAB Disk: CR Lisp% Version: 
				 TAB Source% Files: CR Microcode% Version: TAB Memory% Size: CR 
				 File% Server: TAB Server% Software% Version: CR CR Disposition: CR 
				 CR Description: CR CR Workaround: CR Test% Case: CR CR Edit-By: TAB 
				 Edit-Date: CR))

(RPAQQ AR.FORM.SPECS ((Number: FIELDTYPE PROTECTEDSTRING)
	(Date: FIELDTYPE PROTECTEDSTRING)
	(Submitter: FIELDTYPE STRING)
	(Source: FIELDTYPE STRING)
	(Subject: FIELDTYPE STRING)
	(Assigned% To: FIELDTYPE STRING)
	(Attn: FIELDTYPE STRING)
	(Status: FIELDTYPE MENU MENULIST (New Open Fixed Closed Declined Superseded Obsolete 
					      Incomplete Wish))
	(In/By: FIELDTYPE STRING)
	(Problem% Type: FIELDTYPE MENU MENULIST (Bug Design% -% Impl Feature Design% -% UI 
						     Documentation Performance))
	(Impact: FIELDTYPE MENU MENULIST (Fatal Serious Moderate Annoying Minor))
	(Difficulty: FIELDTYPE MENU MENULIST (Easy Moderate Hard Very% Hard Impossible))
	(Frequency: FIELDTYPE MENU MENULIST (Everytime Intermittent Once))
	(Priority: FIELDTYPE MENU MENULIST (Absolutely Hopefully Perhaps Unlikely))
	(System: FIELDTYPE MENU ASSOCSUBMENU Subsystem: MENULIST
		 (Communications Windows% and% Graphics Operating% System Language% Support 
				 Programming% Environment Text Common% Lisp LOOPS PCE PROLOG 
				 BusMaster Documentation Other% Software))
	(Subsystem: FIELDTYPE SUBMENU ASSOCMENU System: SUBMENULIST
		    (Communications (NS% Protocols NS% Filing NS% Printing PUP% Protocols PUP% FTP 
						   Grapevine Leaf RS232 VAX% Server DEI EVMS/RPC 
						   Lisp% Servers Clearinghouse TCP/IP Chat Other)
				    Windows% and% Graphics
				    (Window% System Library Fonts Printing Color Bitmaps Demos Other)
				    Operating% System
				    (Virtual% Memory Generic% File% Operations DLion% Disk 
						     Daybreak% Disk DLion% Floppy Daybreak% Floppy 
						     Dolphin/Dorado% Disk Processes Streams Keyboard 
						     Mouse Other)
				    Language% Support
				    (Arithmetic Compiler,% Code% Format For/If Microcode 
						Storage% Formats/Mgt Garbage% Collection 
						Read% and% Print Stack% and% Interpreter 
						Bootstrapping% and% Teleraid Diagnostics Other)
				    Programming% Environment
				    (Break% Package Code% Editor DWIM Inspector File% Package History 
						    Masterscope PSW Record% Package 
						    Performance% Tools Other)
				    Text
				    (TEdit TTYIN Lafite Other)
				    Common% Lisp
				    (Type% System Declarations Macros Control% Structure Evaluator 
						  Symbols/Packages Arithmetic Characters/Strings 
						  Sequences Lists Arrays Structures Hash% Tables 
						  Streams% and% I/O File% System% Interface 
						  Error% System Compiler Tamarin% Support 
						  Microcoded% Operations Common% Loops Other)
				    LOOPS
				    (Active% Values Composite% Objects Objects Browsers 
						    User% Interface Virtual% Copy Other)
				    PCE
				    (Monochrome% Display Color% Display Keyboard 
							 Emulated% Rigid% Disk Floppy% Disk 
							 Printer% Port User% Interface 
							 Programmatic% Interface 
							 File% System% Interface Memory Ethernet 
							 Configuration% Tools)
				    PROLOG
				    (Arithmetic Dinfo Microcode Editor% Interface Compiler 
						Interpreter I/O Debugging Prolog-Lisp% Interface 
						Other)
				    BusMaster
				    (Speech Color Other)
				    Documentation
				    (Tools 1108% Users% Guide 1186% Users% Guide Primer 
					   Product% Descr/Tech% Summary Hardware% Installation% Guide 
					   Programmers% Introduction Interlisp% Reference% Manual 
					   Library% Package% Manual Internal% System% Documentation 
					   Other)
				    Other% Software
				    (Installation% Utility Release% Procedure Other)))
	(Machine: FIELDTYPE MENU ASSOCSUBMENU Disk: MENULIST (1100 1108 1132 1186))
	(Disk: FIELDTYPE SUBMENU ASSOCMENU Machine: SUBMENULIST
	       (1100 NIL 1108 (SA1000% %(10MB%) SA4000% %(29MB%) Q2040% %(43MB%) Q2080% %(80MB%) 
						T80% %(80MB%) T300% %(300MB%) Other)
		     1132
		     (T80% %(80MB%) Century315 Other)
		     1186
		     (ST212% %(10MB%) TM703% %(20MB%) TM702% %(20MB%) ST4026% %(20MB%) Q530% %(20MB%) 
				      Q540% %(40MB%) Micropolis% 1303% %(40MB%) 
				      Micropolis% 1325% %(80MB%))))
	(Lisp% Version: FIELDTYPE STRING)
	(Source% Files: FIELDTYPE STRING)
	(Microcode% Version: FIELDTYPE STRING)
	(Memory% Size: FIELDTYPE STRING)
	(File% Server: FIELDTYPE MENU MENULIST (8037 IFS NS VAX/VMS% -% 3Mb VAX/VMS% -% 10Mb VAX/UNIX 
						     Micro% VAX/VMS Other))
	(Server% Software% Version: FIELDTYPE STRING)
	(Disposition: FIELDTYPE STRING)
	(Description: FIELDTYPE STRING)
	(Workaround: FIELDTYPE STRING)
	(Test% Case: FIELDTYPE STRING)
	(Edit-By: FIELDTYPE STRING)
	(Edit-Date: FIELDTYPE PROTECTEDSTRING)))

(RPAQ? AR.ENTRY.LIST.WINDOW.FIELDS (QUOTE ((Number: 5)
					     (Status: 5)
					     (Subject: 45)
					     (Attn: 15)
					     (System: 15)
					     (Subsystem: 15)
					     (Source: 15))))

(RPAQ? AR.ENTRY.LIST.PRINT.FIELDS (QUOTE ((Number: 5)
					    (Date: 9)
					    (System: 14)
					    (Subsystem: 14)
					    (Status: 10)
					    (Attn: 11)
					    (Subject: 50)
					    (Priority: 10)
					    (Difficulty: 10)
					    (Impact: 9)
					    (Problem% Type: 13))))

(RPAQ? AR.ENTRY.LIST.PRINT.MULTILINE.FLAG T)

(RPAQ? AR.INDEX.DEFAULT.FIELDS (QUOTE (Subject: Source: Date: Submitter: Assigned% To: Attn: 
						  Status: In/By: Problem% Type: Impact: Difficulty: 
						  Frequency: Priority: System: Subsystem: Machine: 
						  Disk: Lisp% Version: Source% Files: 
						  Microcode% Version: Memory% Size: File% Server: 
						  Server% Software% Version: Edit-By: Edit-Date:)))

(RPAQ? AR.NO.MESSAGE.FLG NIL)

(RPAQQ AR.INDEX.DEFAULT.FILE.NAME {ERIS}<LISPARS>AR.INDEX)

(RPAQQ AR.INFO.FILE.NAME {ERIS}<LISPARS>LISPARS.TDS)

(RPAQQ AR.SUBMIT.NUM.FILE.NAME {ERIS}<LISPARS>LISPARS.NUM)

(RPAQQ AR.SUBMIT.FILE.NAME {ERIS}<LISPARS>LISPARS.SUBMIT)

(RPAQQ AR.DIRECTORY {PHYLEX:PARC:XEROX}<LISPARS>)

(RPAQ? ARBUTTONFONT (FONTCREATE (QUOTE HELVETICA)
				  12
				  (QUOTE BOLD)))

(RPAQ? ARFONT (FONTCREATE (QUOTE TIMESROMAN)
			    10))

(RPAQ? ARBOLDFONT (FONTCREATE (QUOTE HELVETICA)
				10
				(QUOTE BOLD)))
(* * old vars and fns for AR.SHOW)

(DEFINEQ

(AR.SHOW
  [LAMBDA (ARN WINDOW MAP)                                   (* lmm "24-May-85 11:21")
    (RESETLST (PROG (ARSTREAM)
		    (OR ARN [FIXP (SETQ ARN (COND
				      (AR.READ.WITH.RNUMBERFLG (RNUMBER "Enter AR number:"))
				      (T (CAR (PROCESS.READ PROMPTWINDOW "AR number: " T]
			(RETURN))
		    [OR WINDOW (SETQ WINDOW (AR.LAYOUT.WINDOW (CONCAT "AR " ARN]
		    [RESETSAVE NIL (LIST (QUOTE CLOSEF)
					 (SETQ ARSTREAM (OPENSTREAM (AR.FILENAME ARN)
								    (QUOTE INPUT)
								    (QUOTE OLD]
                                                             (* Buffer whole file, since we're going to read it 
							     twice)
		    (OR MAP (SETQ MAP AR.MAP))
		    [LET ((PARSE (AR.PARSE ARSTREAM)))
		      (CLEARW WINDOW)
		      (PROG ((WIDTH (WINDOWPROP WINDOW (QUOTE WIDTH)))
			     (TEXTSTREAM (OPENSTREAM (QUOTE {NODIRCORE})
						     (QUOTE BOTH)))
			     (BOLD (LIST (QUOTE FONT)
					 ARBOLDFONT))
			     HEADINGS TABS LASTLINE LASTDESCENT THESETABS N)
			    [for ME in MAP
			       do [push HEADINGS (LIST (ADD1 (GETFILEPTR TEXTSTREAM))
						       (NCHARS (CAR ME]
				  (PRIN3 (CAR ME)
					 TEXTSTREAM)
				  (PRIN3 [CADR (OR (ASSOC (CAR ME)
							  PARSE)
						   (ERROR "Field does not have spec" (CAR ME]
					 TEXTSTREAM)
				  (COND
				    ((CADR ME)               (* Staying on same line)
				      (push THESETABS (ADD1 (GETFILEPTR TEXTSTREAM)))
				      (BOUT TEXTSTREAM (CHARCODE TAB)))
				    (T (COND
					 (THESETABS (push TABS THESETABS)
						    (SETQ THESETABS)))
				       (BOUT TEXTSTREAM (CHARCODE CR]
			    (SETQ TEXTSTREAM (OPENTEXTSTREAM TEXTSTREAM NIL NIL NIL
							     (LIST (QUOTE FONT)
								   ARFONT)))
			    (for HEAD in HEADINGS do (TEDIT.LOOKS TEXTSTREAM BOLD (CAR HEAD)
								  (CADR HEAD)))
			    (for TB in TABS
			       do                            (* Set tabstops for multifields)
				  (SETQ N (ADD1 (LENGTH TB)))
				  (TEDIT.PARALOOKS TEXTSTREAM
						   [LIST (QUOTE TABS)
							 (CONS NIL
							       (for I from 1 to (SUB1 N)
								  collect (CONS (ITIMES I
											(IQUOTIENT
											  WIDTH N))
										(QUOTE LEFT]
						   (CAR TB)
						   1))
			    (TEDIT.PARALOOKS TEXTSTREAM (LIST (QUOTE PARALEADING)
							      ARPARALEADING)
					     1
					     (GETEOFPTR TEXTSTREAM))
			    (TEDIT.SETSEL TEXTSTREAM 1 0)
			    (OPENTEXTSTREAM TEXTSTREAM WINDOW NIL NIL (QUOTE (READONLY T]
		    (FULLNAME ARSTREAM])

(AR.SHOW3
  [LAMBDA (ARN WINDOW MAP)                                   (* lmm "24-May-85 13:21")
    (RESETLST (PROG (ARSTREAM)
		    (OR ARN [FIXP (SETQ ARN (COND
				      (AR.READ.WITH.RNUMBERFLG (RNUMBER "Enter AR number:"))
				      (T (CAR (PROCESS.READ PROMPTWINDOW "AR number: " T]
			(RETURN))
		    [OR WINDOW (SETQ WINDOW (AR.LAYOUT.WINDOW (CONCAT "AR " ARN]
		    [RESETSAVE NIL (LIST (QUOTE CLOSEF)
					 (SETQ ARSTREAM (OPENSTREAM (AR.FILENAME ARN)
								    (QUOTE INPUT)
								    (QUOTE OLD]
                                                             (* Buffer whole file, since we're going to read it 
							     twice)
		    (OR MAP (SETQ MAP AR.MAP))
		    [LET* [(PARSE (AR.PARSE ARSTREAM))
		       (WIDTH (WINDOWPROP WINDOW (QUOTE WIDTH)))
		       (TEXTSTREAM (OPENTEXTSTREAM NIL (AND AR.SHOW.IMMEDIATE WINDOW)
						   NIL NIL
						   (BQUOTE (FONT , ARFONT PARALEADING , ARPARALEADING 
								 READONLY T]
		      (TEDIT.PARALOOKS TEXTSTREAM
				       (BQUOTE (TABS [NIL ., (for I from 1 to 4
								collect (CONS (ITIMES I
										      (IQUOTIENT
											WIDTH 4))
									      (QUOTE LEFT]
						     LINELEADING , ARPARALEADING PARALEADING , 
						     ARPARALEADING)))
		      [for ME in MAP
			 do (DSPFONT ARBOLDFONT TEXTSTREAM)
			    (PRIN3 (CAR ME)
				   TEXTSTREAM)
			    (DSPFONT ARFONT TEXTSTREAM)
			    (PRIN3 [CADR (OR (ASSOC (CAR ME)
						    PARSE)
					     (ERROR "Field does not have spec" (CAR ME]
				   TEXTSTREAM)
			    (BOUT TEXTSTREAM (if (CADR ME)
						 then (CHARCODE TAB)
					       else (CHARCODE CR]
		      (OR AR.SHOW.IMMEDIATE (OPENTEXTSTREAM TEXTSTREAM WINDOW NIL NIL
							    (QUOTE (READONLY T]
		    (FULLNAME ARSTREAM])

(AR.SHOW2
  [LAMBDA (ARFILE PARSE MAP WINDOW)                          (* bvm: "27-Mar-84 15:35")
    (CLEARW WINDOW)
    (PROG ((WIDTH (WINDOWPROP WINDOW (QUOTE WIDTH)))
	   (TEXTSTREAM (OPENSTREAM (QUOTE {NODIRCORE})
				   (QUOTE BOTH)))
	   (BOLD (LIST (QUOTE FONT)
		       ARBOLDFONT))
	   HEADINGS TABS LASTLINE LASTDESCENT THESETABS N)
          [for ME in MAP
	     do [push HEADINGS (LIST (ADD1 (GETFILEPTR TEXTSTREAM))
				     (NCHARS (CAR ME]
		(PRIN3 (CAR ME)
		       TEXTSTREAM)
		(AR.SHOWFIELD TEXTSTREAM (CAR ME)
			      ARFILE PARSE)
		(COND
		  ((CADR ME)                                 (* Staying on same line)
		    (push THESETABS (ADD1 (GETFILEPTR TEXTSTREAM)))
		    (BOUT TEXTSTREAM (CHARCODE TAB)))
		  (T (COND
		       (THESETABS (push TABS THESETABS)
				  (SETQ THESETABS)))
		     (BOUT TEXTSTREAM (CHARCODE CR]
          (SETQ TEXTSTREAM (OPENTEXTSTREAM TEXTSTREAM NIL NIL NIL (LIST (QUOTE FONT)
									ARFONT)))
          (for HEAD in HEADINGS do (TEDIT.LOOKS TEXTSTREAM BOLD (CAR HEAD)
						(CADR HEAD)))
          (for TB in TABS
	     do                                              (* Set tabstops for multifields)
		(SETQ N (ADD1 (LENGTH TB)))
		(TEDIT.PARALOOKS TEXTSTREAM [LIST (QUOTE TABS)
						  (CONS NIL (for I from 1 to (SUB1 N)
							       collect (CONS (ITIMES I
										     (IQUOTIENT
										       WIDTH N))
									     (QUOTE LEFT]
				 (CAR TB)
				 1))
          (TEDIT.PARALOOKS TEXTSTREAM (LIST (QUOTE PARALEADING)
					    ARPARALEADING)
			   1
			   (GETEOFPTR TEXTSTREAM))
          (TEDIT.SETSEL TEXTSTREAM 1 0)
          (OPENTEXTSTREAM TEXTSTREAM WINDOW NIL NIL (QUOTE (READONLY T])

(AR.PARSE
  [LAMBDA (STREAM)                                           (* lmm "24-May-85 11:34")
                                                             (* Reads an AR file, and parses it into a list of 
							     (FIELD STRING))
    (bind CHAR collect [LIST [PACKC (collect (SETQ CHAR (BIN STREAM)) repeatuntil
								       (EQ CHAR (CHARCODE :]
			     (LET ((BUFFER (GETRESOURCE SCRATCHSTRING))
				RESULTS
				(CHN 0))
			       (until (SELCHARQ (SETQ CHAR (BIN STREAM))
						(' (SETQ CHAR (BIN STREAM))
						   NIL)
						(CR (OR (EQ (BIN STREAM)
							    (CHARCODE CR))
							(SHOULDNT "Bad char after CR in parsed file"))
						    )
						NIL)
				  do (if (IGEQ CHN (NCHARS BUFFER))
					 then (push RESULTS BUFFER)
					      (SETQ BUFFER (GETRESOURCE SCRATCHSTRING))
					      (SETQ CHN 0))
				     (RPLCHARCODE BUFFER (add CHN 1)
						  CHAR))
			       (PROG1 [CONCATLIST (SETQ RESULTS (REVERSE (CONS (SUBSTRING BUFFER 1 
											  CHN)
									       RESULTS]
				      (MAPC RESULTS (FUNCTION (LAMBDA (X)
						(FREERESOURCE SCRATCHSTRING X]
       until (EOFP STREAM])

(AR.SHOWFIELD
  [LAMBDA (OUTFILE FIELDNAME ARFILE PARSE MAXCHARS)          (* edited: "21-Aug-84 14:38")
    (PROG ((ARSPEC (ASSOC FIELDNAME PARSE))
	   ARFIELDCOUNT CHAR)
          (COND
	    ((NULL ARSPEC)
	      (ERROR "Field does not have spec" FIELDNAME)))
          (SETFILEPTR ARFILE (CADR ARSPEC))
          (COND
	    (MAXCHARS (while (IGREATERP MAXCHARS 0)
			 do (BOUT OUTFILE (SELCHARQ (SETQ CHAR (BIN ARFILE))
						    (' (BIN ARFILE))
						    (CR (RPTQ MAXCHARS (BOUT OUTFILE (CHARCODE SPACE))
							      )
							(RETURN))
						    CHAR))
			    (add MAXCHARS -1)))
	    (T (do (BOUT OUTFILE (SELCHARQ (SETQ CHAR (BIN ARFILE))
					   (' (BIN ARFILE))
					   (CR (RETURN))
					   CHAR])

(AR.SUMMARY
  [LAMBDA (TOFILE MAP)                                       (* mjs "19-Mar-84 09:33")
    (OR MAP (SETQ MAP AR.SUMMARY.MAP))
    (PROG [(STR (OPENSTREAM TOFILE (QUOTE OUTPUT]
          [ERSETQ (for I from 1 do (PROG [(ARSTREAM (OPENSTREAM (AR.FILENAME I)
								(QUOTE INPUT)
								(QUOTE OLD]
				         (bind (PARSE ←(AR.PARSE ARSTREAM)) for ME in MAP
					    do (AR.SHOWFIELD STR (CAR ME)
							     ARSTREAM PARSE (CADR ME)))
				         (TERPRI STR)
				         (CLOSEF ARSTREAM]
          (RETURN (CLOSEF STR])

(AR.LAYOUT.WINDOW
  [LAMBDA (TITLE)                                            (* bvm: "26-Mar-84 14:56")
    (COND
      (AR.LAYOUT.WINDOW (CLEARW AR.LAYOUT.WINDOW)
			(AND TITLE (WINDOWPROP AR.LAYOUT.WINDOW (QUOTE TITLE)
					       TITLE))
			AR.LAYOUT.WINDOW)
      (T (SETQ AR.LAYOUT.WINDOW (CREATEW NIL (OR TITLE "AR Layout"])

(AR.FILENAME
  [LAMBDA (ARN)                                              (* mjs " 7-May-84 14:59")
    (PACK* AR.DIRECTORY (SUBSTRING (IPLUS 10000000 ARN)
				   -5 -1)
	   ".AR"])
)

(RPAQQ AR.MAP ((Number: T)
		 (Date: T)
		 (Submitter:)
		 (Source:)
		 (System: T)
		 (Machine:)
		 (Subsystem: T)
		 (Disk:)
		 (Problem% Type: T)
		 (Memory% Size:)
		 (Subject:)
		 (Source% Files:)
		 (Impact: T)
		 (Frequency:)
		 (Status: T)
		 (In/By: T)
		 (Attn:)
		 (Assigned% To: T)
		 (Priority: T)
		 (Difficulty:)
		 (Disposition:)
		 (Lisp% Version: T)
		 (Microcode% Version:)
		 (File% Server: T)
		 (Server% Software% Version:)
		 (Description:)
		 (Workaround:)
		 (Test% Case:)
		 (Edit-By: T)
		 (Edit-Date:)))

(RPAQQ AR.SUMMARY.MAP ((Number: 4)
			 (System: 15)
			 (Subsystem: 10)
			 (Status: 8)
			 (Problem% Type: 5)
			 (Impact: 10)
			 (Frequency: 10)
			 (Subject: 30)
			 (Priority: 10)
			 (Difficulty: 10)
			 (Attn: 10)))

(RPAQQ AR.THIN.SUMMARY.MAP ((Number: 5)
			      (Status: 5)
			      (Attn: 10)
			      (Problem% Type: 5)
			      (Priority: 5)
			      (Subject: 40)))

(RPAQ? AR.LAYOUT.WINDOW )

(RPAQ? ARPARALEADING 2)

(RPAQ? AR.READ.WITH.RNUMBERFLG T)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS AR.LAYOUT.WINDOW ARFONT ARBOLDFONT ARPARALEADING AR.MAP AR.SUMMARY.MAP 
	    AR.THIN.SUMMARY.MAP)
)
(FILESLOAD READNUMBER)

(ADDTOVAR BackgroundMenuCommands ("AR Edit" (QUOTE (AR.FORM))
					      "Create an AR.FORM editor for the Lisp AR database"
					      (SUBITEMS ("New AR form" (QUOTE (AR.FORM))
								       
						  "Creates new AR.FORM editor, initially cleared")
							("Load AR form" (QUOTE (AR.FORM (RNUMBER)))
									
				"Creates new AR.FORM editor, initally loaded with a specified AR")
							("AR.SHOW" (QUOTE (AR.SHOW (RNUMBER)))
								   
		   "Calls the old AR.SHOW bug-report displayer to quickly display a specified AR")
							("AR Query Form" (QUOTE (AR.QFORM.CREATE))
									 "Creates an AR Query Form")))
)

(RPAQQ BackgroundMenu NIL)

(RPAQ AR.INDEX.MONITORLOCK (CREATE.MONITORLOCK (QUOTE AR.INDEX.LOCK)))
(DECLARE: EVAL@COMPILE 
[PUTPROPS AR.ENTRY.PTR.TO.KEY.VAL.PTR MACRO (X (BQUOTE (IPLUS , (CADR X)
							      (IQUOTIENT (IDIFFERENCE , (CAR X)
										      
									 AR.INDEX.ENTRY.BEGIN.PTR)
									 AR.INDEX.ENTRY.SIZE]
[PUTPROPS AR.ENTRY.TO.NUM MACRO (X (BQUOTE (PROGN (SETFILEPTR AR.INDEX.FILE , (CAR X))
						  (\DWIN AR.INDEX.FILE]
[PUTPROPS AR.INDEX.DATA.CONTEXT MACRO
	  (X (BQUOTE (WITH.MONITOR AR.INDEX.MONITORLOCK
				   (PROG (AR.INDEX.FILE AR.INDEX.ENTRY.BEGIN.PTR 
							AR.INDEX.ENTRY.END.PTR AR.INDEX.ENTRY.SIZE 
							AR.INDEX.FIELD.SPECS AR.INDEX.FIELD.LIST)
					 (DECLARE (SPECVARS AR.INDEX.FILE AR.INDEX.ENTRY.BEGIN.PTR 
							    AR.INDEX.ENTRY.END.PTR 
							    AR.INDEX.ENTRY.SIZE AR.INDEX.FIELD.SPECS 
							    AR.INDEX.FIELD.LIST))
					 (AR.INDEX.DATA.UNPACK (WINDOWPROP , (CAR X)
									   (QUOTE AR.INDEX.DATA)))
					 (AR.INDEX.FILE.REOPEN , (CAR X))
					 (RETURN (PROGN ,@ (CDR X]
[PUTPROPS AR.KEY.VAL.PTR.TO.ENTRY.PTR MACRO (X (BQUOTE (IPLUS (ITIMES AR.INDEX.ENTRY.SIZE
								      (IDIFFERENCE , (CAR X)
										   ,
										   (CADR X)))
							      AR.INDEX.ENTRY.BEGIN.PTR]
[PUTPROPS ARSPECGET MACRO (X (BQUOTE (LISTGET (CDR (ASSOC , (CADR X)
							  ,
							  (CAR X)))
					      ,
					      (CADDR X]
[PUTPROPS ARSPECPUT MACRO (X (BQUOTE (LISTPUT (CDR (ASSOC , (CADR X)
							  ,
							  (CAR X)))
					      ,
					      (CADDR X)
					      ,
					      (CADDDR X]
(PUTPROPS IMAGEOBJPROPS MACRO (X (IMAGEOBJPROPS.MACRO X)))
)
[DECLARE: EVAL@COMPILE 

(TYPERECORD AR.INDEX.DATA (AR.INDEX.FILE AR.INDEX.ENTRY.BEGIN.PTR AR.INDEX.ENTRY.END.PTR 
					   AR.INDEX.ENTRY.SIZE AR.INDEX.FIELD.SPECS 
					   AR.INDEX.FIELD.LIST))
]
(READVARS AR.FORM.ICON AR.QFORM.ICON)
({(READBITMAP)(60 60
"OOOOOOOOOOOOOOO@"
"OOOOOOOOOOOOOOO@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@CO@@@@@@C@"
"L@@@@@GOH@@@@@C@"
"L@@@@@NAL@@@@@C@"
"L@@CH@L@L@@@@@C@"
"L@@OL@L@L@CN@@C@"
"L@ALL@L@L@CO@@C@"
"L@GHN@L@L@GCH@C@"
"L@N@F@L@L@FAL@C@"
"LGH@F@NAL@F@G@C@"
"LG@@BCOOO@L@CHC@"
"LD@@CGOOOIL@ALC@"
"L@@@CO@@CMH@@NC@"
"L@@@CL@@@O@@@FC@"
"L@@@CH@@@G@@@@C@"
"L@@@O@@@@CH@@@C@"
"L@@@LCOCO@L@@@C@"
"L@@@LGOCOHN@@@C@"
"L@GAHNCCALF@@@C@"
"L@GMHLCC@LF@@@C@"
"L@MOHLCC@LGOL@C@"
"LAHC@LCC@LCON@C@"
"LAHC@LCC@LC@N@C@"
"LC@C@OOCOLC@C@C@"
"LC@C@OOCOLC@C@C@"
"LF@C@LCCG@C@AHC@"
"LF@C@LCCCHC@AHC@"
"LF@C@LCCALC@@LC@"
"LF@CHLCC@LF@@NC@"
"L@@AHLCC@LF@@FC@"
"L@@AHLCC@LF@@FC@"
"L@@@LLCC@LL@@@C@"
"L@AOLLCC@LON@@C@"
"L@AOLLCC@LON@@C@"
"L@AHN@CC@ALF@@C@"
"L@AHF@CC@AHC@@C@"
"L@CHF@CC@AHC@@C@"
"L@C@C@CC@C@AH@C@"
"L@C@CHCC@G@AH@C@"
"L@C@AHCC@F@AH@C@"
"L@C@@N@@AN@AL@C@"
"L@F@@G@@CL@@L@C@"
"L@F@@CNCOH@@N@C@"
"L@N@@AOON@@@F@C@"
"L@L@@@CN@@@@C@C@"
"LAH@@@@@@@@@CHC@"
"LAH@@@@@@@@@ALC@"
"LC@@@@@@@@@@ALC@"
"LF@@@@@@@@@@@NC@"
"LF@@@@@@@@@@@FC@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"OOOOOOOOOOOOOOO@"
"OOOOOOOOOOOOOOO@")}  {(READBITMAP)(60 110
"OOOOOOOOOOOOOOO@"
"OOOOOOOOOOOOOOO@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@EMML@@@@@C@"
"L@@@@GGGF@@@@@C@"
"L@@@AMMMML@@@@C@"
"L@@@CGGGGF@@@@C@"
"L@@@MMMMMM@@@@C@"
"L@@AGGGGGG@@@@C@"
"L@@AMMMMMMH@@@C@"
"L@@CGGGGGG@@@@C@"
"L@@AMMMMMML@@@C@"
"L@@CGGGGGGF@@@C@"
"L@@AMMHAMML@@@C@"
"L@@CGF@AGGF@@@C@"
"L@@AML@@MML@@@C@"
"L@@CGD@@GGF@@@C@"
"L@@AML@@EML@@@C@"
"L@@CGF@@GGF@@@C@"
"L@@AML@@EML@@@C@"
"L@@CGF@@GGD@@@C@"
"L@@AML@@MML@@@C@"
"L@@@GD@AGGD@@@C@"
"L@@@EH@AMMH@@@C@"
"L@@@@@@GGG@@@@C@"
"L@@@@@AMMM@@@@C@"
"L@@@@@CGGF@@@@C@"
"L@@@@@EMML@@@@C@"
"L@@@@@GGG@@@@@C@"
"L@@@@@EMM@@@@@C@"
"L@@@@@GGD@@@@@C@"
"L@@@@@EML@@@@@C@"
"L@@@@@GGD@@@@@C@"
"L@@@@@EML@@@@@C@"
"L@@@@@GGD@@@@@C@"
"L@@@@@EML@@@@@C@"
"L@@@@@GGD@@@@@C@"
"L@@@@@EML@@@@@C@"
"L@@@@@GGD@@@@@C@"
"L@@@@@EML@@@@@C@"
"L@@@@@GGD@@@@@C@"
"L@@@@@EML@@@@@C@"
"L@@@@@GGD@@@@@C@"
"L@@@@@EML@@@@@C@"
"L@@@@@GGD@@@@@C@"
"L@@@@@AMH@@@@@C@"
"L@@@@@AG@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@GO@@@@@@C@"
"L@@@@@OGH@@@@@C@"
"L@@@@@MML@@@@@C@"
"L@@CH@OGF@@@@@C@"
"L@@OL@MMN@CN@@C@"
"L@ALL@OGF@CO@@C@"
"L@GHN@MMN@GCH@C@"
"L@N@F@OGF@FAL@C@"
"LCH@F@MMN@F@G@C@"
"LC@@BCOOO@L@CHC@"
"L@@@CGOOOIL@ALC@"
"L@@@CO@@CMH@@NC@"
"L@@@CL@@@O@@@FC@"
"L@@@CH@@@G@@@@C@"
"L@@@O@@@@CH@@@C@"
"L@@@LCOCO@L@@@C@"
"L@@@LGOCOHN@@@C@"
"L@GAHNCCALF@@@C@"
"L@GMHLCC@LF@@@C@"
"L@MOHLCC@LGOL@C@"
"LAHC@LCC@LCON@C@"
"LAHC@LCC@LC@N@C@"
"LC@C@OOCOLC@C@C@"
"LC@C@OOCOLC@C@C@"
"LF@C@LCCG@C@AHC@"
"LF@C@LCCCHC@AHC@"
"LF@C@LCCALC@@LC@"
"LF@CHLCC@LF@@NC@"
"L@@AHLCC@LF@@FC@"
"L@@AHLCC@LF@@FC@"
"L@@@LLCC@LL@@@C@"
"L@AOLLCC@LON@@C@"
"L@AOLLCC@LON@@C@"
"L@AHN@CC@ALF@@C@"
"L@AHF@CC@AHC@@C@"
"L@CHF@CC@AHC@@C@"
"L@C@C@CC@C@AH@C@"
"L@C@CHCC@G@AH@C@"
"L@C@AHCC@F@AH@C@"
"L@B@@N@@AN@AL@C@"
"L@F@@G@@CL@@L@C@"
"L@F@@CNCOH@@N@C@"
"L@N@@AOON@@@F@C@"
"L@L@@@CN@@@@C@C@"
"LAH@@@@@@@@@CHC@"
"LAH@@@@@@@@@ALC@"
"LC@@@@@@@@@@ALC@"
"LF@@@@@@@@@@@NC@"
"LF@@@@@@@@@@@FC@"
"L@@@@@@@@@@@@BC@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"OOOOOOOOOOOOOOO@"
"OOOOOOOOOOOOOOO@")})
(DECLARE: EVAL@COMPILE 
[PUTDEF (QUOTE SCRATCHSTRING)
	(QUOTE RESOURCES)
	(QUOTE (NEW (ALLOCSTRING 100]
)
(PUTPROPS AREDIT COPYRIGHT ("Xerox Corporation" 1984 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (5570 66537 (AR.BUTTON.GET.MENU 5580 . 5992) (AR.BUTTON.GET.SUBMENU 5994 . 6887) (
AR.BUTTON.OBJ.CREATE 6889 . 9273) (AR.BUTTONFN.DOMENU 9275 . 10223) (AR.BUTTONFN.DOSUBMENU 10225 . 
10804) (AR.BUTTONFN.SELFIELD 10806 . 11388) (AR.CHECK.FIELDS 11390 . 12544) (AR.CHECK.MENU 12546 . 
13418) (AR.CHECK.SHORTSTRING 13420 . 13731) (AR.CHECK.SUBMENU 13733 . 14815) (AR.CONFIRM 14817 . 15018
) (AR.COPY.AND.INDEX.AR 15020 . 16176) (AR.DELETE.FIELD.VAL 16178 . 16963) (AR.DISCONNECT.WINDOW 16965
 . 17207) (AR.FIND.BUTTON 17209 . 17638) (AR.FIND.EDIT.CHANGES 17640 . 20484) (AR.FIND.UNPROTECTED.CH#
 20486 . 21116) (AR.FORM 21118 . 21343) (AR.FORM.CLEAR 21345 . 21912) (AR.FORM.CREATE 21914 . 26162) (
AR.FORM.FILL.INS 26164 . 26926) (AR.FORM.GROUP.CREATE 26928 . 29645) (AR.FORM.MENU.TITLEMENUFN 29647
 . 31137) (AR.JUST.GET.SUBMIT.NUM 31139 . 32507) (AR.JUST.PRINT.AR.NUM 32509 . 33241) (
AR.KILL.ATTACHED.TEDIT.CLOSEFN 33243 . 33722) (AR.FORM.MENU.ACTIONFN 33724 . 36746) (
AR.FORM.MENU.BUTTONFN 36748 . 37010) (AR.FORM.SAVE 37012 . 39829) (AR.GET.AR 39831 . 42050) (
AR.GET.ASSOCIATED.MENU.VAL 42052 . 42533) (AR.GET.BUTTON.FIELD.AS.TEXT 42535 . 43140) (
AR.GET.MENU.FROM.MAIN.WINDOW 43142 . 43537) (AR.GET.NEXT 43539 . 44968) (AR.GET.SUBMIT.NUM 44970 . 
46282) (AR.GET.BUTTON.FIELD.AS.LIST 46284 . 46593) (AR.GET.FILENAME 46595 . 47181) (AR.MARK.ACTIVE 
47183 . 47386) (AR.MENU.CR.FN 47388 . 47612) (AR.MENU.FN.CLEAR 47614 . 48206) (AR.MENU.FN.GET 48208 . 
49339) (AR.MENU.FN.PUT 49341 . 54320) (AR.PROMPT 54322 . 54642) (AR.PROTECT.WARNING 54644 . 54892) (
AR.PUT.FAILED 54894 . 55230) (AR.RECONNECT.WINDOW 55232 . 55683) (AR.REPLACE.FIELD.VAL 55685 . 57389) 
(AR.REPLACE.FILL.INS 57391 . 57795) (AR.RESET.SEL 57797 . 58388) (AR.SCRATCH.LOAD 58390 . 59019) (
AR.SEND.MESSAGE 59021 . 60819) (AR.TEXTSTREAM.LOAD 60821 . 63164) (AR.TOBJ.ACTIVEP 63166 . 63382) (
AR.UPDATE.AR.INFO 63384 . 65947) (AR.USERNAME 65949 . 66202) (IMAGEOBJPROPS.MACRO 66204 . 66535)) (
66569 125432 (AR.ENTRY.LIST.AND 66579 . 66836) (AR.ENTRY.LIST.OR 66838 . 67158) (
AR.ENTRY.LIST.WINDOW.REPAINTFN 67160 . 69591) (AR.ENTRY.LIST.WINDOW.BUTTONEVENTFN 69593 . 72596) (
AR.EDIT.USING.CORRESPONDING.FORM 72598 . 74021) (AR.GATHER.NEW.AR.DATA 74023 . 75989) (
AR.GET.ENTRY.NUM 75991 . 76245) (AR.GET.FIELD.VAL.DATA 76247 . 76960) (AR.GET.FIELD.VAL.LENGTH 76962
 . 78221) (AR.GET.FIELD.VAL.PTR 78223 . 78943) (AR.GET.FIELD.VAL 78945 . 80137) (AR.INDEX.CREATE 80139
 . 81734) (AR.GET.ENUMERATED.FIELD.KEYS 81736 . 82463) (AR.INDEX.DATA.UNPACK 82465 . 82907) (
AR.INDEX.FIND.ENTRY.PTR 82909 . 84046) (AR.INDEX.OPEN 84048 . 84873) (AR.INDEX.FILE.REOPEN 84875 . 
85338) (AR.INDEX.PRINT 85340 . 88737) (AR.INDEX.REWRITE.ENTRY.DATA 88739 . 92234) (
AR.INDEX.REWRITE.FIELD.DATA 92236 . 95250) (AR.INDEX.SEARCH.HAS 95252 . 97756) (AR.INDEX.SEARCH.IS 
97758 . 100067) (AR.GET.ENTRY.PTRS.FROM.FIELD.PTRS 100069 . 101887) (AR.INDEX.UPDATE 101889 . 104956) 
(AR.QFORM.ACTIONFN 104958 . 106199) (AR.QFORM.PROMPT.LIST.FN 106201 . 107330) (
AR.GET.QLIST.PROMPT.MENU 107332 . 108832) (AR.GET.SLIST.PROMPT.MENU 108834 . 109610) (
AR.QFORM.BUTTONFN 109612 . 109898) (AR.QFORM.CREATE 109900 . 110179) (AR.QFORM.FN.PRINT 110181 . 
110833) (AR.QFORM.FN.QUERY 110835 . 111573) (AR.QFORM.FN.UPDATE 111575 . 111932) (
AR.QFORM.GROUP.CREATE 111934 . 115200) (AR.QUERY 115202 . 115728) (AR.QUERY.EVAL.QLIST 115730 . 117867
) (AR.PRINT 117869 . 121120) (AR.SORT 121122 . 123881) (AR.QFORM.DISPLAY.DISCONNECT 123883 . 124303) (
AR.QFORM.DISPLAY.CONNECT 124305 . 125430)) (131991 141087 (AR.SHOW 132001 . 134529) (AR.SHOW3 134531
 . 136312) (AR.SHOW2 136314 . 138058) (AR.PARSE 138060 . 139225) (AR.SHOWFIELD 139227 . 139960) (
AR.SUMMARY 139962 . 140548) (AR.LAYOUT.WINDOW 140550 . 140894) (AR.FILENAME 140896 . 141085)))))
STOP