(FILECREATED "21-Jan-88 18:26:19" {ERINYES}<JAMES>LISP>KOTO>AREDIT.;6 152164
changes to: (FNS AR.FORM.MENU.ACTIONFN AR.FIND.EDIT.CHANGES)
(VARS AREDITCOMS)
previous date: "21-Jan-88 12:33:36" {ERINYES}<JAMES>LISP>KOTO>AREDIT.;5)
(* Copyright (c) 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT AREDITCOMS)
(RPAQQ AREDITCOMS ((FILES TEDIT READNUMBER LAFITE)
(* * 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.FILL.INS.DEFAULT 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 {ERINYES}<LISPARS>AR.INDEX))
(AR.INFO.FILE.NAME (QUOTE {ERINYES}<LISPARS>LISPARS.TDS))
(AR.SUBMIT.NUM.FILE.NAME (QUOTE {ERINYES}<LISPARS>LISPARS.NUM))
(AR.SUBMIT.FILE.NAME (QUOTE {ERINYES}<LISPARS>LISPARS.SUBMIT))
(AR.DIRECTORY (QUOTE {ERINYES}<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)
[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)))
(FILESLOAD TEDIT READNUMBER LAFITE)
(* * 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: "19-Jan-88 13:18")
(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)
(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.FILL.INS.DEFAULT
[LAMBDA NIL (* edited: "21-Jan-88 12:22")
(PROG NIL
(RETURN (LIST (LIST (QUOTE Microcode% Version:)
(MICROCODEVERSION))
(LIST (QUOTE Machine:)
(SELECTQ (MACHINETYPE)
(DANDELION 1108)
(DOLPHIN 1100)
(DORADO 1132)
(DOVE 1186)
(PACKC)))
(LIST (QUOTE Lisp% Version:)
(CONCAT MAKESYSNAME " " MAKESYSDATE))
(LIST (QUOTE Memory% Size:)
(REALMEMORYSIZE])
(AR.FORM.GROUP.CREATE
[LAMBDA (INITIAL.NUM) (* edited: "19-Jan-88 13: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))
(replace (TEXTOBJ MENUFLG) of (TEXTOBJ MENUW) with T)
(REMOVEPROMPTWINDOW MENUW)
(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) (* edited: "21-Jan-88 12:26")
(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")
(GetNext (QUOTE GetNext)
"Gets the next existing AR")
(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")
(FillInDefaults (QUOTE
FillInDefaults)
"Fills in default values for Microcode Version, Machine Type, Lisp Version, and Memory Size")))
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) (* edited: "21-Jan-88 17:57")
(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)))
(GetNext (AR.GET.NEXT FORMWINDOW))
[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]
(FillInDefaults (AR.REPLACE.FILL.INS FORMWINDOW (
AR.FORM.FILL.INS.DEFAULT))
(AR.PROMPT (LIST OPERATION " completed")
FORMWINDOW))
(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) (* edited: "21-Jan-88 11:49")
(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) (* edited: "21-Jan-88 11:36")
(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.JUST.PRINT.AR.NUM (AR.GET.MENU.FROM.MAIN.WINDOW
FORMWINDOW)
CURR.NUM))
(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)
(AR.JUST.PRINT.AR.NUM (AR.GET.MENU.FROM.MAIN.WINDOW
FORMWINDOW)
SUBMIT.NUM))
(* 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) (* edited: "15-Jan-88 16:14")
(RINGBELLS)
(FLASHWINDOW FORMWINDOW 1)
(AR.PROMPT (MKLIST MSG)
FORMWINDOW)
(WINDOWPROP FORMWINDOW (QUOTE TITLE)
(MKSTRING MSG])
(AR.RECONNECT.WINDOW
[LAMBDA (FORMWINDOW) (* edited: "20-Jan-88 18:13")
(PROG [(TOBJ (TEXTOBJ (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM]
(replace (TEXTOBJ \WINDOW) of TOBJ with (LIST FORMWINDOW))
(replace (LINEDESCRIPTOR NEXTLINE) of (CAR (fetch (TEXTOBJ LINES) of TOBJ))
with NIL)
[\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) (* edited: "19-Jan-88 15:09")
(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 Release% Note: 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 Open/Unreleased Fixed Closed Declined Superseded
Obsolete Incomplete Internal 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 Port Maiko LOOPS PCE
PROLOG 4045 Rooms Library 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 Centronics
TTYPort Chat Chat% Interface Pup% Chat% Driver
NS% Chat% Driver RS232% Chat% Driver
TTYPort% Chat% Driver Chat% DM2500% Emulator
Chat% VT100% Emulator NSMaintain Other)
Windows% and% Graphics
(Window% System Library Fonts Printing Color Bitmaps Demos Menus
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 Edit% Interface Other)
Text
(TEdit TTYIN Lafite AR% Database 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)
Port
(Other)
Maiko
(Bytecode% Emulation Native% Code I/O% System Host% Integration
Host% User% Interface ForeignFn% Interface
Installation% Procedure Documentation 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)
4045
(XLPStream Remoteserver HQStream PSO Other)
Rooms
(Window% Types Overview Suites Buttons Documentation Other)
Library
(Cash-File CharCodeTables Copyfiles DEdit DatabaseFns
FX-80% Printer% Support Filebrowser Font% Samples
GCHax GraphZoom Grapher Hash Hash-File
Image% Object% Interface Kermit Masterscope% Browser
MatMult Press% Printer% Support SameDir Sketch
SysEdit/EXPORTS.ALL Tablebrowser Virtual% Keyboards
Where-Is 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)
(Release% Note: 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 {ERINYES}<LISPARS>AR.INDEX)
(RPAQQ AR.INFO.FILE.NAME {ERINYES}<LISPARS>LISPARS.TDS)
(RPAQQ AR.SUBMIT.NUM.FILE.NAME {ERINYES}<LISPARS>LISPARS.NUM)
(RPAQQ AR.SUBMIT.FILE.NAME {ERINYES}<LISPARS>LISPARS.SUBMIT)
(RPAQQ AR.DIRECTORY {ERINYES}<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)
)
(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 1987 1988))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5663 69345 (AR.BUTTON.GET.MENU 5673 . 6085) (AR.BUTTON.GET.SUBMENU 6087 . 6980) (
AR.BUTTON.OBJ.CREATE 6982 . 9366) (AR.BUTTONFN.DOMENU 9368 . 10316) (AR.BUTTONFN.DOSUBMENU 10318 .
10897) (AR.BUTTONFN.SELFIELD 10899 . 11481) (AR.CHECK.FIELDS 11483 . 12637) (AR.CHECK.MENU 12639 .
13511) (AR.CHECK.SHORTSTRING 13513 . 13824) (AR.CHECK.SUBMENU 13826 . 14908) (AR.CONFIRM 14910 . 15111
) (AR.COPY.AND.INDEX.AR 15113 . 16269) (AR.DELETE.FIELD.VAL 16271 . 17056) (AR.DISCONNECT.WINDOW 17058
. 17300) (AR.FIND.BUTTON 17302 . 17731) (AR.FIND.EDIT.CHANGES 17733 . 21035) (AR.FIND.UNPROTECTED.CH#
21037 . 21667) (AR.FORM 21669 . 21894) (AR.FORM.CLEAR 21896 . 22463) (AR.FORM.CREATE 22465 . 27240) (
AR.FORM.FILL.INS 27242 . 28004) (AR.FORM.FILL.INS.DEFAULT 28006 . 28614) (AR.FORM.GROUP.CREATE 28616
. 31608) (AR.FORM.MENU.TITLEMENUFN 31610 . 33386) (AR.JUST.GET.SUBMIT.NUM 33388 . 34756) (
AR.JUST.PRINT.AR.NUM 34758 . 35490) (AR.KILL.ATTACHED.TEDIT.CLOSEFN 35492 . 35971) (
AR.FORM.MENU.ACTIONFN 35973 . 39229) (AR.FORM.MENU.BUTTONFN 39231 . 39493) (AR.FORM.SAVE 39495 . 42312
) (AR.GET.AR 42314 . 44533) (AR.GET.ASSOCIATED.MENU.VAL 44535 . 45016) (AR.GET.BUTTON.FIELD.AS.TEXT
45018 . 45623) (AR.GET.MENU.FROM.MAIN.WINDOW 45625 . 46020) (AR.GET.NEXT 46022 . 47451) (
AR.GET.SUBMIT.NUM 47453 . 48765) (AR.GET.BUTTON.FIELD.AS.LIST 48767 . 49076) (AR.GET.FILENAME 49078 .
49664) (AR.MARK.ACTIVE 49666 . 49869) (AR.MENU.CR.FN 49871 . 50095) (AR.MENU.FN.CLEAR 50097 . 50689) (
AR.MENU.FN.GET 50691 . 51821) (AR.MENU.FN.PUT 51823 . 57041) (AR.PROMPT 57043 . 57363) (
AR.PROTECT.WARNING 57365 . 57613) (AR.PUT.FAILED 57615 . 57907) (AR.RECONNECT.WINDOW 57909 . 58487) (
AR.REPLACE.FIELD.VAL 58489 . 60193) (AR.REPLACE.FILL.INS 60195 . 60599) (AR.RESET.SEL 60601 . 61192) (
AR.SCRATCH.LOAD 61194 . 61823) (AR.SEND.MESSAGE 61825 . 63627) (AR.TEXTSTREAM.LOAD 63629 . 65972) (
AR.TOBJ.ACTIVEP 65974 . 66190) (AR.UPDATE.AR.INFO 66192 . 68755) (AR.USERNAME 68757 . 69010) (
IMAGEOBJPROPS.MACRO 69012 . 69343)) (69377 128240 (AR.ENTRY.LIST.AND 69387 . 69644) (AR.ENTRY.LIST.OR
69646 . 69966) (AR.ENTRY.LIST.WINDOW.REPAINTFN 69968 . 72399) (AR.ENTRY.LIST.WINDOW.BUTTONEVENTFN
72401 . 75404) (AR.EDIT.USING.CORRESPONDING.FORM 75406 . 76829) (AR.GATHER.NEW.AR.DATA 76831 . 78797)
(AR.GET.ENTRY.NUM 78799 . 79053) (AR.GET.FIELD.VAL.DATA 79055 . 79768) (AR.GET.FIELD.VAL.LENGTH 79770
. 81029) (AR.GET.FIELD.VAL.PTR 81031 . 81751) (AR.GET.FIELD.VAL 81753 . 82945) (AR.INDEX.CREATE 82947
. 84542) (AR.GET.ENUMERATED.FIELD.KEYS 84544 . 85271) (AR.INDEX.DATA.UNPACK 85273 . 85715) (
AR.INDEX.FIND.ENTRY.PTR 85717 . 86854) (AR.INDEX.OPEN 86856 . 87681) (AR.INDEX.FILE.REOPEN 87683 .
88146) (AR.INDEX.PRINT 88148 . 91545) (AR.INDEX.REWRITE.ENTRY.DATA 91547 . 95042) (
AR.INDEX.REWRITE.FIELD.DATA 95044 . 98058) (AR.INDEX.SEARCH.HAS 98060 . 100564) (AR.INDEX.SEARCH.IS
100566 . 102875) (AR.GET.ENTRY.PTRS.FROM.FIELD.PTRS 102877 . 104695) (AR.INDEX.UPDATE 104697 . 107764)
(AR.QFORM.ACTIONFN 107766 . 109007) (AR.QFORM.PROMPT.LIST.FN 109009 . 110138) (
AR.GET.QLIST.PROMPT.MENU 110140 . 111640) (AR.GET.SLIST.PROMPT.MENU 111642 . 112418) (
AR.QFORM.BUTTONFN 112420 . 112706) (AR.QFORM.CREATE 112708 . 112987) (AR.QFORM.FN.PRINT 112989 .
113641) (AR.QFORM.FN.QUERY 113643 . 114381) (AR.QFORM.FN.UPDATE 114383 . 114740) (
AR.QFORM.GROUP.CREATE 114742 . 118008) (AR.QUERY 118010 . 118536) (AR.QUERY.EVAL.QLIST 118538 . 120675
) (AR.PRINT 120677 . 123928) (AR.SORT 123930 . 126689) (AR.QFORM.DISPLAY.DISCONNECT 126691 . 127111) (
AR.QFORM.DISPLAY.CONNECT 127113 . 128238)) (135947 145043 (AR.SHOW 135957 . 138485) (AR.SHOW3 138487
. 140268) (AR.SHOW2 140270 . 142014) (AR.PARSE 142016 . 143181) (AR.SHOWFIELD 143183 . 143916) (
AR.SUMMARY 143918 . 144504) (AR.LAYOUT.WINDOW 144506 . 144850) (AR.FILENAME 144852 . 145041)))))
STOP