(FILECREATED "28-Feb-85 12:14:28" {ERIS}<LISP>INTERMEZZO>LISPUSERS>AREDIT.;2 132658
changes to: (FNS AR.INDEX.REWRITE.FIELD.DATA)
previous date: "17-Feb-85 16:15:27" {ERIS}<LISP>INTERMEZZO>LISPUSERS>AREDIT.;1)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT AREDITCOMS)
(RPAQQ AREDITCOMS ((* * AR.FORM functions and variables)
(FNS AR.BUTTON.GET.MENU AR.BUTTON.GET.SUBMENU AR.BUTTON.OBJ.CREATE AR.BUTTONFN.DOMENU
AR.BUTTONFN.DOSUBMENU AR.BUTTONFN.SELFIELD AR.CHECK.FIELDS AR.CHECK.MENU
AR.CHECK.SHORTSTRING AR.CHECK.SUBMENU AR.CONFIRM AR.COPY.AND.INDEX.AR
AR.DELETE.FIELD.VAL AR.DISCONNECT.WINDOW AR.FIND.BUTTON AR.FIND.EDIT.CHANGES
AR.FIND.UNPROTECTED.CH# AR.FORM AR.FORM.CLEAR AR.FORM.CREATE AR.FORM.FILL.INS
AR.FORM.GROUP.CREATE AR.FORM.MENU.TITLEMENUFN AR.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.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.RECONNECT.WINDOW AR.REPLACE.FIELD.VAL AR.REPLACE.FILL.INS AR.RESET.SEL
AR.SCRATCH.LOAD 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.INDEX.DEFAULT.FILE.NAME (QUOTE {PHYLUM}<LISPARS>AR.INDEX))
(AR.INFO.FILE.NAME (QUOTE {PHYLUM}<LISPARS>LISPARS.TDS))
(AR.SUBMIT.NUM.FILE.NAME (QUOTE {PHYLUM}<LISPARS>LISPARS.NUM))
(AR.SUBMIT.FILE.NAME (QUOTE {PHYLUM}<LISPARS>LISPARS.SUBMIT))
(AR.DIRECTORY (QUOTE {PHYLUM}<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.SHOW2 AR.PARSE AR.SHOWFIELD AR.SUMMARY AR.LAYOUT.WINDOW AR.FILENAME)
(VARS AR.MAP AR.SUMMARY.MAP AR.THIN.SUMMARY.MAP)
(INITVARS (AR.LAYOUT.WINDOW)
(ARPARALEADING 2)
(AR.READ.WITH.RNUMBERFLG T))
(GLOBALVARS AR.LAYOUT.WINDOW ARFONT ARBOLDFONT ARPARALEADING AR.MAP AR.SUMMARY.MAP
AR.THIN.SUMMARY.MAP)
(FILES READNUMBER)
[ADDVARS (BackgroundMenuCommands ("AR Edit" (QUOTE (AR.FORM))
"Create an AR.FORM editor for the Lisp AR database"
(SUBITEMS ("New AR form" (QUOTE (AR.FORM))
"Creates new AR.FORM editor, initially cleared")
("Load AR form" (QUOTE (AR.FORM
(RNUMBER)))
"Creates new AR.FORM editor, initally loaded with a specified AR")
("AR.SHOW" (QUOTE (AR.SHOW (RNUMBER)))
"Calls the old AR.SHOW bug-report displayer to quickly display a specified AR")
("AR Query Form" (QUOTE (AR.QFORM.CREATE
))
"Creates an AR Query Form"]
(VARS (BackgroundMenu))
[VARS (AR.INDEX.MONITORLOCK (CREATE.MONITORLOCK (QUOTE AR.INDEX.LOCK]
(MACROS AR.ENTRY.PTR.TO.KEY.VAL.PTR AR.ENTRY.TO.NUM AR.INDEX.DATA.CONTEXT
AR.KEY.VAL.PTR.TO.ENTRY.PTR ARSPECGET ARSPECPUT IMAGEOBJPROPS)
(RECORDS AR.INDEX.DATA)
(UGLYVARS AR.FORM.ICON AR.QFORM.ICON)))
(* * AR.FORM functions and variables)
(DEFINEQ
(AR.BUTTON.GET.MENU
[LAMBDA (OBJ) (* mjs "20-Apr-84 15:02")
(if (IMAGEOBJPROP OBJ (QUOTE AR.MENU))
else [IMAGEOBJPROP OBJ (QUOTE AR.MENU)
(create MENU
ITEMS ←[APPEND (IMAGEOBJPROP OBJ (QUOTE AR.MENU.LIST))
(LIST (LIST NIL (KWOTE (PACKC]
TITLE ←(IMAGEOBJPROP OBJ (QUOTE MBTEXT]
(IMAGEOBJPROP OBJ (QUOTE AR.MENU])
(AR.BUTTON.GET.SUBMENU
[LAMBDA (OBJ ASSOCIATED.MENU.VAL) (* mjs "20-Apr-84 15:02")
(if (LISTGET (IMAGEOBJPROP OBJ (QUOTE AR.SUBMENUS))
ASSOCIATED.MENU.VAL)
else (PROG ((CORRESPONDING.SUBMENU.LIST (LISTGET (IMAGEOBJPROP OBJ (QUOTE AR.SUBMENU.LIST))
ASSOCIATED.MENU.VAL))
CORRESPONDING.SUBMENU)
[SETQ CORRESPONDING.SUBMENU (create MENU
ITEMS ←[APPEND CORRESPONDING.SUBMENU.LIST
(LIST (LIST NIL (KWOTE (PACKC]
TITLE ←(IMAGEOBJPROP OBJ (QUOTE MBTEXT]
(if (IMAGEOBJPROP OBJ (QUOTE AR.SUBMENUS))
then (LISTPUT (IMAGEOBJPROP OBJ (QUOTE AR.SUBMENUS))
ASSOCIATED.MENU.VAL CORRESPONDING.SUBMENU)
else (IMAGEOBJPROP OBJ (QUOTE AR.SUBMENUS)
(LIST ASSOCIATED.MENU.VAL CORRESPONDING.SUBMENU)))
(RETURN CORRESPONDING.SUBMENU])
(AR.BUTTON.OBJ.CREATE
[LAMBDA (AR.SPECS BUTTON.NAME BUTTON.FONT) (* edited: "21-Aug-84 14:39")
(PROG ((BUTTON.TYPE (ARSPECGET AR.SPECS BUTTON.NAME (QUOTE FIELDTYPE)))
BUTTON.FN OBJ)
(if (AND (EQ BUTTON.TYPE (QUOTE STRING))
(ARSPECGET AR.SPECS BUTTON.NAME (QUOTE MAXCHARS)))
then (* if a string has a max length given, treat it as a
SHORTSTRING)
(SETQ BUTTON.TYPE (QUOTE SHORTSTRING)))
[SETQ BUTTON.FN (if (ARSPECGET AR.SPECS BUTTON.NAME (QUOTE FN))
else (SELECTQ BUTTON.TYPE
(BUTTON (ARSPECGET AR.SPECS BUTTON.NAME (QUOTE FN)))
(PROTECTEDSTRING (FUNCTION AR.PROTECT.WARNING))
((STRING SHORTSTRING)
(FUNCTION AR.BUTTONFN.SELFIELD))
(MENU (FUNCTION AR.BUTTONFN.DOMENU))
(SUBMENU (FUNCTION AR.BUTTONFN.DOSUBMENU))
(ERROR "Bad Button Type" BUTTON.TYPE]
(SETQ BUTTON.FONT (if (ARSPECGET AR.SPECS BUTTON.NAME (QUOTE FONT))
else BUTTON.FONT))
(SETQ OBJ (MBUTTON.CREATE BUTTON.NAME BUTTON.FN BUTTON.FONT))
(IMAGEOBJPROPS OBJ (QUOTE AR.PRE.FIELD)
(SELECTQ BUTTON.TYPE
(BUTTON "")
((MENU SUBMENU)
" {")
" ")
(QUOTE AR.POST.FIELD)
(SELECTQ BUTTON.TYPE
((MENU SUBMENU)
"}")
"")
(QUOTE AR.CHECK.FN)
(SELECTQ BUTTON.TYPE
((BUTTON PROTECTEDSTRING STRING)
(FUNCTION NILL))
(SHORTSTRING (FUNCTION AR.CHECK.SHORTSTRING))
(MENU (FUNCTION AR.CHECK.MENU))
(SUBMENU (FUNCTION AR.CHECK.SUBMENU))
(ERROR "Bad Button Type" BUTTON.TYPE))
(QUOTE AR.PROTECTED.FLG)
(SELECTQ BUTTON.TYPE
((BUTTON PROTECTEDSTRING MENU SUBMENU)
T)
NIL))
(SELECTQ BUTTON.TYPE
[SHORTSTRING (IMAGEOBJPROP OBJ (QUOTE AR.MAX.LEN)
(ARSPECGET AR.SPECS BUTTON.NAME (QUOTE MAXCHARS]
[MENU (IMAGEOBJPROPS OBJ (QUOTE AR.ASSOCIATED.SUBMENU)
(ARSPECGET AR.SPECS BUTTON.NAME (QUOTE ASSOCSUBMENU))
(QUOTE AR.MENU.LIST)
(ARSPECGET AR.SPECS BUTTON.NAME (QUOTE MENULIST]
[SUBMENU (IMAGEOBJPROPS OBJ (QUOTE AR.ASSOCIATED.MENU)
(ARSPECGET AR.SPECS BUTTON.NAME (QUOTE ASSOCMENU))
(QUOTE AR.SUBMENU.LIST)
(ARSPECGET AR.SPECS BUTTON.NAME (QUOTE SUBMENULIST]
NIL)
(RETURN OBJ])
(AR.BUTTONFN.DOMENU
[LAMBDA (OBJ SEL WINDOW) (* edited: "30-Aug-84 09:57")
(PROG [(STREAM (WINDOWPROP WINDOW (QUOTE TEXTSTREAM)))
(NEWVAL (MENU (AR.BUTTON.GET.MENU OBJ)))
(ASSOC.SUBMENU (IMAGEOBJPROP OBJ (QUOTE AR.ASSOCIATED.SUBMENU]
[if [AND NEWVAL (NOT (EQUAL NEWVAL (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.VALUE]
then (AR.REPLACE.FIELD.VAL OBJ (fetch (SELECTION CH#) of SEL)
STREAM NEWVAL)
(if ASSOC.SUBMENU
then (PROG ((BUTTON (AR.FIND.BUTTON STREAM ASSOC.SUBMENU)))
(if (NULL BUTTON)
then (ERROR "Can't find associated submenu button"
ASSOC.SUBMENU))
(AR.REPLACE.FIELD.VAL (CAR BUTTON)
(CDR BUTTON)
STREAM
(PACKC))
(IMAGEOBJPROP (CAR BUTTON)
(QUOTE AR.ASSOCIATED.MENU.VAL)
NEWVAL]
(AR.RESET.SEL WINDOW])
(AR.BUTTONFN.DOSUBMENU
[LAMBDA (OBJ SEL WINDOW) (* edited: "30-Aug-84 09:57")
(PROG ((STREAM (WINDOWPROP WINDOW (QUOTE TEXTSTREAM)))
(ASSOCIATED.MENU.VAL (AR.GET.ASSOCIATED.MENU.VAL OBJ WINDOW))
NEWVAL)
(SETQ NEWVAL (MENU (AR.BUTTON.GET.SUBMENU OBJ ASSOCIATED.MENU.VAL)))
(if [AND NEWVAL (NOT (EQUAL NEWVAL (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.VALUE]
then (AR.REPLACE.FIELD.VAL OBJ (fetch (SELECTION CH#) of SEL)
STREAM NEWVAL))
(AR.RESET.SEL WINDOW])
(AR.BUTTONFN.SELFIELD
[LAMBDA (OBJ SEL WINDOW) (* edited: "30-Aug-84 09:59")
(PROG ((TOBJ (fetch (SELECTION \TEXTOBJ) of SEL))
FIELD.SEL FIELD.CH# FIELD.LEN)
(MBUTTON.FIND.NEXT.FIELD TOBJ (fetch (SELECTION CH#) of SEL))
(SETQ FIELD.SEL (fetch (TEXTOBJ SCRATCHSEL) of TOBJ))
(SETQ FIELD.CH# (fetch (SELECTION CH#) of FIELD.SEL))
(SETQ FIELD.LEN (fetch (SELECTION DCH) of FIELD.SEL))
(TEDIT.SETSEL TOBJ FIELD.CH# FIELD.LEN (QUOTE LEFT)
T])
(AR.CHECK.FIELDS
[LAMBDA (FORMWINDOW) (* edited: "27-Jul-84 10:49")
(PROG ([TOBJ (TEXTOBJ (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM]
(CH# 0)
(CHECK.VALUE NIL)
OBJ BUTTON SEL FIELD.CH# FIELD.LEN)
(while (PROGN (add CH# 1)
(SETQ BUTTON (MBUTTON.FIND.NEXT.BUTTON TOBJ CH#)))
do (BLOCK)
(SETQ OBJ (CAR BUTTON))
(SETQ CH# (CDR BUTTON))
(if (IMAGEOBJPROP OBJ (QUOTE AR.PROTECTED.FLG))
then (SETQ FIELD.CH# (IPLUS (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.START))
CH#))
(SETQ FIELD.LEN (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.LEN)))
else (SETQ SEL (MBUTTON.FIND.NEXT.FIELD TOBJ CH#))
(SETQ FIELD.CH# (fetch (SELECTION CH#) of SEL))
(SETQ FIELD.LEN (fetch (SELECTION DCH) of SEL)))
repeatuntil (SETQ CHECK.VALUE (APPLY* (IMAGEOBJPROP OBJ (QUOTE AR.CHECK.FN))
FORMWINDOW OBJ CH# FIELD.CH# FIELD.LEN)))
(if CHECK.VALUE
then (RETURN (APPEND (LIST "Bad value for field [" (IMAGEOBJPROP OBJ (QUOTE MBTEXT))
"] --- ")
CHECK.VALUE))
else (RETURN NIL])
(AR.CHECK.MENU
[LAMBDA (FORMWINDOW OBJ CH# FIELD.CH# FIELD.LEN) (* edited: "21-Aug-84 14:42")
(PROG ((CLIST NIL)
(TSTREAM (TEXTSTREAM FORMWINDOW))
VAL)
(SETFILEPTR TSTREAM (SUB1 FIELD.CH#))
(SETQ CLIST (for X from 1 to FIELD.LEN until (EOFP TSTREAM) collect (BIN TSTREAM)))
(if (EOFP TSTREAM)
then (SHOULDNT "Reached end of textstream while retrieving menu value"))
(if (NULL CLIST)
then (* a null menu value of always correct)
(RETURN NIL))
(SETQ VAL (PACKC CLIST))
(if (MEMB VAL (IMAGEOBJPROP OBJ (QUOTE AR.MENU.LIST)))
then (RETURN NIL)
else (IMAGEOBJPROP OBJ (QUOTE AR.MENU)
NIL)
(RETURN (LIST "bad menu value: " VAL " --- please reset"])
(AR.CHECK.SHORTSTRING
[LAMBDA (FORMWINDOW OBJ CH# FIELD.CH# FIELD.LEN) (* edited: "27-Jul-84 10:51")
(if (ILEQ FIELD.LEN (IMAGEOBJPROP OBJ (QUOTE AR.MAX.LEN)))
then NIL
else (LIST "max length= " (IMAGEOBJPROP OBJ (QUOTE AR.MAX.LEN))
"; current length= " FIELD.LEN])
(AR.CHECK.SUBMENU
[LAMBDA (FORMWINDOW OBJ CH# FIELD.CH# FIELD.LEN) (* edited: "21-Aug-84 14:42")
(PROG ((CLIST NIL)
(TSTREAM (TEXTSTREAM FORMWINDOW))
VAL)
(SETFILEPTR TSTREAM (SUB1 FIELD.CH#))
(SETQ CLIST (for X from 1 to FIELD.LEN until (EOFP TSTREAM) collect (BIN TSTREAM)))
(if (EOFP TSTREAM)
then (SHOULDNT "Reached end of textstream while retrieving submenu value"))
(IMAGEOBJPROP OBJ (QUOTE AR.ASSOCIATED.MENU.VAL)
NIL)
(if (NULL CLIST)
then (* a null menu value of always correct)
(RETURN NIL))
(SETQ VAL (PACKC CLIST))
(if (MEMB VAL (LISTGET (IMAGEOBJPROP OBJ (QUOTE AR.SUBMENU.LIST))
(AR.GET.ASSOCIATED.MENU.VAL OBJ FORMWINDOW)))
then (RETURN NIL)
else (IMAGEOBJPROP OBJ (QUOTE AR.SUBMENUS)
NIL)
(IMAGEOBJPROP OBJ (QUOTE AR.ASSOCIATED.MENU.VAL)
NIL)
(RETURN (LIST "bad menu value: " VAL " --- please reset"])
(AR.CONFIRM
[LAMBDA (WORDS FORMWINDOW) (* mjs " 4-May-84 14:51")
(AR.PROMPT WORDS FORMWINDOW)
(MOUSECONFIRM NIL NIL (GETPROMPTWINDOW FORMWINDOW 2])
(AR.COPY.AND.INDEX.AR
[LAMBDA (ARSTREAM SCRATCH.STREAM INDEX.FIELDS) (* mjs " 7-Jul-84 11:29")
(PROG ((INDEX NIL))
[until (EOFP ARSTREAM)
do (BLOCK)
(PROG ([FIELD.NAME (PACKC (bind CHAR collect (SETQ CHAR (BIN ARSTREAM))
repeatuntil (EQ CHAR (CHARCODE :]
(PTR (GETFILEPTR SCRATCH.STREAM))) (* skip extra space after ":")
(BIN ARSTREAM)
(if (OR (NLISTP INDEX.FIELDS)
(MEMB FIELD.NAME INDEX.FIELDS))
then (bind CHAR
do (BOUT SCRATCH.STREAM
(SELCHARQ (SETQ CHAR (BIN ARSTREAM))
(' (BLOCK)
(BIN ARSTREAM))
[CR (RETURN (OR (EQ (BIN ARSTREAM)
(CHARCODE CR))
(ERROR!]
CHAR)))
(push INDEX (LIST FIELD.NAME PTR (IDIFFERENCE (GETFILEPTR
SCRATCH.STREAM)
PTR)))
else (bind CHAR do (SELCHARQ (SETQ CHAR (BIN ARSTREAM))
(' (BLOCK)
(BIN ARSTREAM))
[CR (RETURN (OR (EQ (BIN ARSTREAM)
(CHARCODE CR))
(ERROR!]
CHAR]
(RETURN INDEX])
(AR.DELETE.FIELD.VAL
[LAMBDA (OBJ CH# WINDOW) (* edited: "30-Aug-84 09:57")
(PROG ((STREAM (WINDOWPROP WINDOW (QUOTE TEXTSTREAM)))
SEL)
(if (IMAGEOBJPROP OBJ (QUOTE AR.PROTECTED.FLG))
then (TEDIT.DELETE STREAM (IPLUS (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.START))
CH#)
(IMAGEOBJPROP OBJ (QUOTE AR.FIELD.LEN)))
(IMAGEOBJPROP OBJ (QUOTE AR.FIELD.LEN)
0)
(IMAGEOBJPROP OBJ (QUOTE AR.FIELD.VALUE)
(PACKC))
else (SETQ SEL (MBUTTON.FIND.NEXT.FIELD (TEXTOBJ STREAM)
CH#))
(if (NULL SEL)
then (SHOULDNT "Can't find field for button"))
(TEDIT.DELETE STREAM (fetch (SELECTION CH#) of SEL)
(fetch (SELECTION DCH) of SEL])
(AR.DISCONNECT.WINDOW
[LAMBDA (FORMWINDOW) (* mjs "17-Feb-85 16:03")
(replace (TEXTOBJ \WINDOW) of (TEXTOBJ (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM))) with NIL])
(AR.FIND.BUTTON
[LAMBDA (WINDOW NAME) (* edited: "30-Aug-84 09:57")
(PROG ((TOBJ (TEXTOBJ WINDOW))
(CH# 0)
OBJ BUTTON)
[while (PROGN (add CH# 1)
(SETQ BUTTON (MBUTTON.FIND.NEXT.BUTTON TOBJ CH#)))
do (SETQ OBJ (CAR BUTTON))
(SETQ CH# (CDR BUTTON))
repeatuntil (EQ NAME (IMAGEOBJPROP OBJ (QUOTE MBTEXT]
(RETURN BUTTON])
(AR.FIND.EDIT.CHANGES
[LAMBDA (FORMWINDOW) (* edited: "22-Aug-84 16:09")
(PROG ((SCRATCH.STREAM (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.STREAM)))
(SCRATCH.MAP (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.MAP)))
(FORMSTREAM (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM)))
(CH# 0)
OBJ BUTTON BUTTON.NAME PROTECT.FIELD.FLG FIELD.CH# FIELD.LEN TOBJ SCRATCH.MAP.SPEC
SCRATCH.PTR SCRATCH.FIELD.LEN (EDIT.CHANGES NIL))
(if (NULL SCRATCH.MAP)
then (RETURN NIL))
(SETQ TOBJ (TEXTOBJ FORMSTREAM))
[while (PROGN (add CH# 1)
(SETQ BUTTON (MBUTTON.FIND.NEXT.BUTTON TOBJ CH#)))
do (BLOCK)
(SETQ OBJ (CAR BUTTON))
(SETQ CH# (CDR BUTTON))
(SETQ BUTTON.NAME (IMAGEOBJPROP OBJ (QUOTE MBTEXT)))
(SETQ PROTECT.FIELD.FLG (IMAGEOBJPROP OBJ (QUOTE AR.PROTECTED.FLG)))
[if PROTECT.FIELD.FLG
then (SETQ FIELD.CH# (IPLUS (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.START))
CH#))
(SETQ FIELD.LEN (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.LEN)))
else (PROG ((SEL (MBUTTON.FIND.NEXT.FIELD TOBJ CH#)))
(if (NULL SEL)
then (SHOULDNT "Can't find field for button"))
(SETQ FIELD.CH# (fetch (SELECTION CH#) of SEL))
(SETQ FIELD.LEN (fetch (SELECTION DCH) of SEL]
(SETFILEPTR FORMSTREAM (SUB1 FIELD.CH#))
(SETQ SCRATCH.MAP.SPEC (ASSOC BUTTON.NAME SCRATCH.MAP))
(* note that you default to a zero-length field if it is
not specified in the file)
(SETQ SCRATCH.PTR (if (CADR SCRATCH.MAP.SPEC)
else 0))
(SETQ SCRATCH.FIELD.LEN (if (CADDR SCRATCH.MAP.SPEC)
else 0))
(if [OR (NOT (EQP FIELD.LEN SCRATCH.FIELD.LEN))
(NOT (for X from 1 to FIELD.LEN
first (SETFILEPTR FORMSTREAM (SUB1 FIELD.CH#))
(SETFILEPTR SCRATCH.STREAM SCRATCH.PTR)
always (EQ (BIN FORMSTREAM)
(BIN SCRATCH.STREAM]
then (* we know that the current value of the field is not
equal to the value when loaded)
(push EDIT.CHANGES BUTTON.NAME)
(if (MEMB (ARSPECGET AR.FORM.SPECS BUTTON.NAME (QUOTE FIELDTYPE))
(QUOTE (MENU SUBMENU)))
then (push EDIT.CHANGES
(LIST (PACKC (NCONC (for X from 1 to SCRATCH.FIELD.LEN
first (SETFILEPTR SCRATCH.STREAM
SCRATCH.PTR)
collect (BIN SCRATCH.STREAM))
(APPEND (CHARCODE (- >)))
(NCONC (for X from 1 to FIELD.LEN
first (SETFILEPTR FORMSTREAM
(SUB1
FIELD.CH#))
collect (BIN FORMSTREAM]
(RETURN (DREVERSE EDIT.CHANGES])
(AR.FIND.UNPROTECTED.CH#
[LAMBDA (STREAM) (* edited: "21-Aug-84 14:41")
(PROG ((TOBJ (TEXTOBJ STREAM))
(CH# 0)
OBJ BUTTON SEL)
(while (PROGN (add CH# 1)
(SETQ BUTTON (MBUTTON.FIND.NEXT.BUTTON TOBJ CH#)))
do (SETQ OBJ (CAR BUTTON))
(SETQ CH# (CDR BUTTON))
repeatwhile (IMAGEOBJPROP OBJ (QUOTE AR.PROTECTED.FLG)))
(if (NULL BUTTON)
then (SHOULDNT "Can't find unprotected button field"))
(SETQ SEL (MBUTTON.FIND.NEXT.FIELD TOBJ CH#))
(RETURN (fetch (SELECTION CH#) of SEL])
(AR.FORM
[LAMBDA (NUM) (* edited: " 4-Jul-84 15:19")
(ADD.PROCESS (LIST (FUNCTION AR.FORM.GROUP.CREATE)
(KWOTE NUM))
(QUOTE NAME)
(QUOTE AR.FORM.TEMP])
(AR.FORM.CLEAR
[LAMBDA (FORMWINDOW FILL.INS) (* edited: " 7-Jun-84 14:21")
(PROG ([TOBJ (TEXTOBJ (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM]
(CH# 0)
OBJ BUTTON)
(while (PROGN (add CH# 1)
(SETQ BUTTON (MBUTTON.FIND.NEXT.BUTTON TOBJ CH#)))
do (BLOCK)
(SETQ OBJ (CAR BUTTON))
(SETQ CH# (CDR BUTTON))
(AR.DELETE.FIELD.VAL OBJ CH# FORMWINDOW))
(AR.REPLACE.FILL.INS FORMWINDOW FILL.INS)
(TEDIT.STREAMCHANGEDP (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM))
T])
(AR.FORM.CREATE
[LAMBDA (FORMWINDOW BUTTONFONT FORM.SPECS FORM.FORMAT) (* edited: "12-Jul-84 13:20")
(PROG [(FORMSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (LIST (QUOTE FONT)
ARFONT
(QUOTE TEDIT.TENTATIVE)
NIL)))
(TABS 0)
(TAB.CH# NIL)
(AR.PARALOOKS NIL)
(AR.CHARLOOKS NIL)
(FORMWINDOW.WIDTH (WINDOWPROP FORMWINDOW (QUOTE WIDTH]
(WINDOWPROP FORMWINDOW (QUOTE AR.FORM.NUMBER)
NIL)
(WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.STREAM)
NIL)
[for FIELD.OR.SPACE in FORM.FORMAT
do (BLOCK)
(if (EQ FIELD.OR.SPACE (QUOTE TAB))
then (SETQ TAB.CH# (ADD1 (GETFILEPTR FORMSTREAM)))
(BOUT FORMSTREAM (CHARCODE TAB))
(add TABS 1)
elseif (EQ FIELD.OR.SPACE (QUOTE CR))
then (if (IGREATERP TABS 0)
then (push AR.PARALOOKS
[LIST (QUOTE TABS)
(CONS NIL (for I from 1 to TABS
bind (TABWIDTH ←(IQUOTIENT
FORMWINDOW.WIDTH
(ADD1 TABS)))
collect (CONS (ITIMES I TABWIDTH)
(QUOTE LEFT]
TAB.CH# 1))
(SETQ TABS 0)
(BOUT FORMSTREAM (CHARCODE CR))
elseif (STRINGP FIELD.OR.SPACE)
then (PRIN1 FIELD.OR.SPACE FORMSTREAM)
else (PROG ((BUTTON.OBJ (AR.BUTTON.OBJ.CREATE FORM.SPECS FIELD.OR.SPACE BUTTONFONT))
(CH# (ADD1 (GETFILEPTR FORMSTREAM)))
PRE.FIELD.NCHARS POST.FIELD.NCHARS FIELD.LEN)
(BLOCK)
(TEDIT.INSERT.OBJECT BUTTON.OBJ FORMSTREAM CH#)
(push AR.CHARLOOKS (QUOTE (PROTECTED OFF))
CH# 1)
(add CH# 1)
(SETFILEPTR FORMSTREAM (SUB1 CH#))
(PRIN1 (IMAGEOBJPROP BUTTON.OBJ (QUOTE AR.PRE.FIELD))
FORMSTREAM)
(SETQ PRE.FIELD.NCHARS (IDIFFERENCE (ADD1 (GETFILEPTR FORMSTREAM))
CH#))
(IMAGEOBJPROP BUTTON.OBJ (QUOTE AR.FIELD.START)
(ADD1 PRE.FIELD.NCHARS))
(IMAGEOBJPROP BUTTON.OBJ (QUOTE AR.FIELD.LEN)
0)
(if (NOT (IMAGEOBJPROP BUTTON.OBJ (QUOTE AR.PROTECTED.FLG)))
then (push AR.CHARLOOKS (QUOTE (PROTECTED ON SELECTPOINT ON))
(IPLUS CH# (SUB1 PRE.FIELD.NCHARS))
1))
(PRIN1 (IMAGEOBJPROP BUTTON.OBJ (QUOTE AR.POST.FIELD))
FORMSTREAM]
(TEDIT.PARALOOKS FORMSTREAM (LIST (QUOTE PARALEADING)
2)
1
(GETEOFPTR FORMSTREAM)) (* default char looks: PROTECTED ON)
(TEDIT.LOOKS FORMSTREAM (QUOTE (PROTECTED ON))
1
(GETEOFPTR FORMSTREAM))
(while AR.CHARLOOKS bind (LOOKS CH# LEN)
do (BLOCK)
(SETQ LOOKS (pop AR.CHARLOOKS))
(SETQ CH# (pop AR.CHARLOOKS))
(SETQ LEN (pop AR.CHARLOOKS))
(TEDIT.LOOKS FORMSTREAM LOOKS CH# LEN))
(while AR.PARALOOKS bind (LOOKS CH# LEN)
do (BLOCK)
(SETQ LOOKS (pop AR.PARALOOKS))
(SETQ CH# (pop AR.PARALOOKS))
(SETQ LEN (pop AR.PARALOOKS))
(TEDIT.PARALOOKS FORMSTREAM LOOKS CH# LEN))
(TEDIT.STREAMCHANGEDP FORMSTREAM T)
(replace (TEXTOBJ MENUFLG) of (TEXTOBJ FORMSTREAM) with T)
(PROG ((FORMWINDOW.PROC (WINDOWPROP FORMWINDOW (QUOTE PROCESS)))
(FORMWINDOW.PROC.NAME (WINDOWPROP FORMWINDOW (QUOTE AR.WINDOW.PROC.NAME)))
(SAFE.CH# (AR.FIND.UNPROTECTED.CH# FORMSTREAM))
NEWPROC TEDIT.PROCS)
(COND
((AND FORMWINDOW.PROC (PROCESSP FORMWINDOW.PROC))
(TEDIT.KILL FORMWINDOW)))
(SETQ TEDIT.PROCS (LIST (QUOTE SEL)
SAFE.CH#
(QUOTE LEAVETTY)
T
(QUOTE FONT)
ARFONT
(QUOTE TEDIT.TENTATIVE)
NIL))
[if (WINDOWPROP FORMWINDOW (QUOTE AR.TEDIT.READTABLE))
then (push TEDIT.PROCS (QUOTE READTABLE)
(WINDOWPROP FORMWINDOW (QUOTE AR.TEDIT.READTABLE]
[if (WINDOWPROP FORMWINDOW (QUOTE AR.TEDIT.TITLEMENUFN))
then (push TEDIT.PROCS (QUOTE TITLEMENUFN)
(WINDOWPROP FORMWINDOW (QUOTE AR.TEDIT.TITLEMENUFN]
(SETQ NEWPROC (TEDIT FORMSTREAM FORMWINDOW NIL TEDIT.PROCS))
(if FORMWINDOW.PROC.NAME
then (PROCESSPROP NEWPROC (QUOTE NAME)
FORMWINDOW.PROC.NAME])
(AR.FORM.FILL.INS
[LAMBDA NIL (* edited: " 4-Jul-84 18:17")
(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)
(PACKC)))
(LIST (QUOTE Lisp% Version:)
MAKESYSDATE)
(LIST (QUOTE Memory% Size:)
(REALMEMORYSIZE])
(AR.FORM.GROUP.CREATE
[LAMBDA (INITIAL.NUM) (* edited: "30-Aug-84 11:20")
(PROG ((FORMWINDOW (CREATEW (GETREGION 450 60)
"New Bug Report"))
MENUW WREG)
(* * set up main window)
(WINDOWADDPROP FORMWINDOW (QUOTE CLOSEFN)
(FUNCTION AR.KILL.ATTACHED.TEDIT.CLOSEFN))
(WINDOWPROP FORMWINDOW (QUOTE MINSIZE)
(CONS 450 60))
(WINDOWPROP FORMWINDOW (QUOTE AR.WINDOW.PROC.NAME)
(QUOTE AR.FORM))
(WINDOWPROP FORMWINDOW (QUOTE ICON)
AR.FORM.ICON)
(* * set up menu window)
(SETQ WREG (WINDOWPROP FORMWINDOW (QUOTE REGION)))
(SETQ MENUW (CREATEW (create REGION
LEFT ←(fetch (REGION LEFT) of WREG)
BOTTOM ←(fetch (REGION TOP) of WREG)
WIDTH ←(fetch (REGION WIDTH) of WREG)
HEIGHT ← 40)
"AR Bug Report Editor"))
(ATTACHWINDOW MENUW FORMWINDOW (QUOTE TOP)
(QUOTE JUSTIFY)
NIL)
(WINDOWPROP MENUW (QUOTE MAXSIZE)
(CONS 0 40))
(WINDOWPROP MENUW (QUOTE MINSIZE)
(CONS 0 40))
(WINDOWPROP MENUW (QUOTE ICON)
AR.FORM.ICON)
(WINDOWPROP MENUW (QUOTE AR.WINDOW.PROC.NAME)
(QUOTE AR.FORM.MENU))
(if (NOT (AND (BOUNDP (QUOTE AR.MENU.READTABLE))
(READTABLEP AR.MENU.READTABLE)))
then (SETQ AR.MENU.READTABLE (COPYREADTABLE TEDIT.READTABLE))
(TEDIT.SETFUNCTION (CHARCODE CR)
(FUNCTION AR.MENU.CR.FN)
AR.MENU.READTABLE))
(WINDOWPROP MENUW (QUOTE AR.TEDIT.READTABLE)
AR.MENU.READTABLE)
(WINDOWPROP MENUW (QUOTE AR.TEDIT.TITLEMENUFN)
(FUNCTION AR.FORM.MENU.TITLEMENUFN))
(GETPROMPTWINDOW FORMWINDOW 2)
(* * create AR forms for main and menu windows)
(AR.FORM.CREATE FORMWINDOW ARBOLDFONT AR.FORM.SPECS AR.FORM.FORMAT)
(AR.FORM.CREATE MENUW ARBUTTONFONT (QUOTE ((New FIELDTYPE BUTTON FN AR.FORM.MENU.BUTTONFN)
(Get FIELDTYPE BUTTON FN AR.FORM.MENU.BUTTONFN)
(Put FIELDTYPE BUTTON FN AR.FORM.MENU.BUTTONFN)
(Number: FIELDTYPE STRING)))
(QUOTE (New TAB Get TAB Put TAB Number: TAB CR)))
(until (AND (WINDOWPROP FORMWINDOW (QUOTE LINES))
(WINDOWPROP MENUW (QUOTE LINES)))
do (* wait until the two Tedit windows are totally
initialized)
(BLOCK 1000))
(if INITIAL.NUM
then (AR.FORM.MENU.ACTIONFN MENUW (QUOTE Get)
INITIAL.NUM)
else (AR.FORM.MENU.ACTIONFN MENUW (QUOTE New])
(AR.FORM.MENU.TITLEMENUFN
[LAMBDA (TEXTSTREAM) (* mjs "17-Feb-85 16:03")
(PROG (OP)
(if (NOT (AND (BOUNDP (QUOTE AR.FORM.MENU.TITLEMENU))
AR.FORM.MENU.TITLEMENU))
then (SETQ AR.FORM.MENU.TITLEMENU (create MENU
ITEMS ←(QUOTE ((Clear (QUOTE Clear)
"Clears all the fields of the AR")
(New (QUOTE New)
"Clears all fields of the AR, and substitutes default values for some fields")
(Get (QUOTE Get)
"Retrieves the AR whose number is given in the %"Number:%" field")
(Put (QUOTE Put)
"Saves an edited of an AR, or submits a new AR")
(Put&Get (QUOTE Put&Get)
"Stores the current AR, and Gets another")
(Get% From% File
(QUOTE Get% From% File)
"Retrieves AR from named file")
(Put% To% File (QUOTE
Put% To% File)
"Stores AR into named file")))
TITLE ← "AR Ops")))
(SETQ OP (MENU AR.FORM.MENU.TITLEMENU))
(if OP
then (AR.FORM.MENU.ACTIONFN (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ TEXTSTREAM)))
OP])
(AR.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: "20-Aug-84 10:34")
(ALLOW.BUTTON.EVENTS)
(PROG ((MENUWINDOW.TEXTOBJ (WINDOWPROP MENUWINDOW (QUOTE TEXTOBJ)))
(FORMWINDOW (WINDOWPROP MENUWINDOW (QUOTE MAINWINDOW)))
FORMWINDOW.TEXTOBJ)
(DECLARE (SPECVARS MENUWINDOW.TEXTOBJ FORMWINDOW FORMWINDOW.TEXTOBJ))
(SETQ FORMWINDOW.TEXTOBJ (WINDOWPROP FORMWINDOW (QUOTE TEXTOBJ)))
(if (OR (NOT (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM)))
(NULL MENUWINDOW.TEXTOBJ)
(NULL FORMWINDOW.TEXTOBJ))
then (AR.PROMPT "AR form munged!! --- Close this AR window and create another"
FORMWINDOW)
(RETURN))
(if (OR (AR.TOBJ.ACTIVEP MENUWINDOW.TEXTOBJ)
(AR.TOBJ.ACTIVEP FORMWINDOW.TEXTOBJ))
then (AR.PROMPT "Edit or AR operation in progress -- please wait" FORMWINDOW)
(RETURN))
(AR.MARK.ACTIVE MENUWINDOW.TEXTOBJ OPERATION)
(AR.MARK.ACTIVE FORMWINDOW.TEXTOBJ OPERATION)
(DSPFILL NIL 72 (QUOTE PAINT)
MENUWINDOW)
(CLEARW FORMWINDOW)
(AR.DISCONNECT.WINDOW FORMWINDOW)
(AR.PROMPT (LIST OPERATION " initiated...")
FORMWINDOW)
(NLSETQ (SELECTQ OPERATION
(Clear (AR.MENU.FN.CLEAR FORMWINDOW))
(New (AR.MENU.FN.CLEAR FORMWINDOW (AR.FORM.FILL.INS)))
[Get (AR.MENU.FN.GET FORMWINDOW (if NUM.FOR.GET
else (MKATOM (AR.GET.BUTTON.FIELD.AS.TEXT
MENUWINDOW
(QUOTE Number:]
(Put (AR.MENU.FN.PUT FORMWINDOW))
(Put&Get (PROG ((NUM (RNUMBER)))
(AR.MENU.FN.PUT FORMWINDOW)
(AR.MENU.FN.GET FORMWINDOW NUM)))
[(Get% From% File Put% To% File)
(AR.PROMPT "" FORMWINDOW)
(PROG [(FILE (MKATOM (PROMPTFORWORD (if (EQ OPERATION (QUOTE
Get% From% File))
then "Get File: "
else "Put File: ")
(WINDOWPROP FORMWINDOW (QUOTE
AR.GET/PUT.FILE.NAME))
NIL
(GETPROMPTWINDOW FORMWINDOW]
(if (NULL FILE)
then (RETURN))
(WINDOWPROP FORMWINDOW (QUOTE AR.GET/PUT.FILE.NAME)
FILE)
(if (EQ OPERATION (QUOTE Get% From% File))
then (AR.GET.AR FORMWINDOW FILE)
else (AR.FORM.SAVE FORMWINDOW FILE]
(AR.PROMPT "Unknown AR.FORM button name!" FORMWINDOW)))
(AR.MARK.ACTIVE MENUWINDOW.TEXTOBJ NIL)
(AR.MARK.ACTIVE FORMWINDOW.TEXTOBJ NIL)
(REDISPLAYW MENUWINDOW)
(AR.RECONNECT.WINDOW FORMWINDOW)
(SCROLLW FORMWINDOW 0.0 0.0])
(AR.FORM.MENU.BUTTONFN
[LAMBDA (OBJ SEL WINDOW) (* jds "14-Feb-85 10:43")
(AR.FORM.MENU.ACTIONFN (\TEDIT.PRIMARYW (fetch (SELECTION \TEXTOBJ) of SEL))
(IMAGEOBJPROP OBJ (QUOTE MBTEXT])
(AR.FORM.SAVE
[LAMBDA (FORMWINDOW FILENAME) (* mjs "22-Jul-84 12:45")
(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) (* edited: "22-Aug-84 16:51")
(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 (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 (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)
(WINDOWPROP FORMWINDOW (QUOTE AR.FORM.NUMBER)
NIL)
(WINDOWPROP FORMWINDOW (QUOTE TITLE)
"--- form inconsistant --- Please GET or NEW")
else (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.NUMBER)
(if (NUMBERP NUM/OR/FILE)
then NUM/OR/FILE
else NIL))
(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.SUBMIT.NUM
[LAMBDA (FORMWINDOW) (* edited: "19-Aug-84 11:19")
(PROG (SUBMIT.NUM.FILE VAL CURR.NEXT.NUM)
(if (NOT (INFILEP AR.SUBMIT.NUM.FILE.NAME))
then (RETURN NIL))
(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]
do (AR.PROMPT (LIST "submit number file busy: " AR.SUBMIT.NUM.FILE.NAME
" --- please wait")
FORMWINDOW)
(DISMISS 5000))
[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: "20-Jul-84 16:28")
(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)))
(AR.PROMPT (LIST "Retrieving AR " CURR.NUM " ...")
FORMWINDOW)
(if (AR.GET.AR FORMWINDOW CURR.NUM)
then (SETQ BAD.GET T))
else (AR.PROMPT (LIST "Bad number %"" CURR.NUM "%" --- Get aborted")
FORMWINDOW)
(SETQ BAD.GET T))
(if (NOT BAD.GET)
then (AR.PROMPT (LIST "AR " CURR.NUM " retrieved")
FORMWINDOW])
(AR.MENU.FN.PUT
[LAMBDA (FORMWINDOW) (* edited: "22-Aug-84 16:09")
(PROG ((CURR.NUM (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.NUMBER)))
FILE CHECK.VALUE SAVE.VALUE EDIT.CHANGES.LIST 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)))
(TEDIT.INSERT TSTREAM
[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 " "]
(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 (SETQ SUBMIT.NUM (AR.GET.SUBMIT.NUM FORMWINDOW))
[if SUBMIT.NUM
then (AR.REPLACE.FILL.INS FORMWINDOW (LIST (LIST (QUOTE Number:)
SUBMIT.NUM]
(AR.REPLACE.FILL.INS FORMWINDOW (LIST (LIST (QUOTE Date:)
(DATE]
(if (SETQ CHECK.VALUE (AR.CHECK.FIELDS FORMWINDOW))
then (AR.PROMPT (APPEND "Bad Bug Report Form: " CHECK.VALUE (LIST " --- PUT aborted"))
FORMWINDOW)
(RETURN))
(CLEARW FORMWINDOW)
[if CURR.NUM
then (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 (if SUBMIT.NUM
then (AR.GET.FILENAME SUBMIT.NUM T)
else AR.SUBMIT.FILE.NAME]
(TEDIT.STREAMCHANGEDP FORMWINDOW T)
[if SAVE.VALUE
then (if CURR.NUM
then (AR.UPDATE.AR.INFO FORMWINDOW (QUOTE EDIT)
CURR.NUM EDIT.CHANGES.LIST)
(AR.PROMPT (LIST "Saved AR " CURR.NUM)
FORMWINDOW)
(WINDOWPROP FORMWINDOW (QUOTE TITLE)
(CONCAT "Editing AR " CURR.NUM " --- saved"))
else (AR.UPDATE.AR.INFO FORMWINDOW (QUOTE SUBMIT)
(if SUBMIT.NUM
else SAVE.VALUE)
(LIST (AR.USERNAME)
(DATE)))
(if SUBMIT.NUM
then (AR.PROMPT (LIST "Bug Report Submitted -- AR # " SUBMIT.NUM)
FORMWINDOW) (* make sure that noone tries accessing the scratch
stream)
(WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.MAP)
NIL)
(WINDOWPROP FORMWINDOW (QUOTE AR.FORM.NUMBER)
SUBMIT.NUM)
(WINDOWPROP FORMWINDOW (QUOTE TITLE)
(CONCAT "Editing AR " SUBMIT.NUM " --- saved"))
else (AR.PROMPT "Bug Report Submitted -- no number available" FORMWINDOW)
(WINDOWPROP FORMWINDOW (QUOTE TITLE)
"New Bug Report --- submitted"]
(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.RECONNECT.WINDOW
[LAMBDA (FORMWINDOW) (* mjs "17-Feb-85 16:02")
(PROG [(TOBJ (TEXTOBJ (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM]
(replace (TEXTOBJ \WINDOW) of TOBJ with (LIST FORMWINDOW))
[\TEDIT.MARK.LINES.DIRTY TOBJ 1 (ADD1 (GETEOFPTR (WINDOWPROP FORMWINDOW (QUOTE TEXTSTREAM]
(TEDIT.UPDATE.SCREEN TOBJ])
(AR.REPLACE.FIELD.VAL
[LAMBDA (OBJ CH# WINDOW NEWVAL) (* mjs "25-Oct-84 12:27")
(DECLARE (SPECVARS OBJ CH# WINDOW NEWVAL))
(RESETFORM (RADIX 10)
(PROG ((STREAM (TEXTSTREAM WINDOW))
(NEWVAL.NCHARS (NCHARS NEWVAL))
INSERT.CH# SEL)
(if (IMAGEOBJPROP OBJ (QUOTE AR.PROTECTED.FLG))
then (SETQ INSERT.CH# (IPLUS (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.START))
CH#))
(TEDIT.DELETE STREAM INSERT.CH# (IMAGEOBJPROP OBJ (QUOTE AR.FIELD.LEN)))
(if (IGREATERP NEWVAL.NCHARS 0)
then (TEDIT.INSERT STREAM (if (NUMBERP NEWVAL)
then (MKSTRING NEWVAL)
else NEWVAL)
INSERT.CH#)
(TEDIT.LOOKS STREAM (QUOTE (PROTECTED ON))
INSERT.CH# NEWVAL.NCHARS))
(IMAGEOBJPROP OBJ (QUOTE AR.FIELD.LEN)
NEWVAL.NCHARS)
(IMAGEOBJPROP OBJ (QUOTE AR.FIELD.VALUE)
NEWVAL)
else (SETQ SEL (MBUTTON.FIND.NEXT.FIELD (TEXTOBJ STREAM)
CH#))
(if (NULL SEL)
then (SHOULDNT "Can't find button field"))
(SETQ INSERT.CH# (fetch (SELECTION CH#) of SEL))
(TEDIT.DELETE STREAM INSERT.CH# (fetch (SELECTION DCH) of SEL))
(if (IGREATERP NEWVAL.NCHARS 0)
then (TEDIT.INSERT STREAM (if (NUMBERP NEWVAL)
then (MKSTRING NEWVAL)
else NEWVAL)
INSERT.CH#)
(TEDIT.LOOKS STREAM (QUOTE (PROTECTED OFF))
INSERT.CH# NEWVAL.NCHARS])
(AR.REPLACE.FILL.INS
[LAMBDA (FORMWINDOW FILL.INS) (* mjs " 7-May-84 15:42")
(for X in FILL.INS bind BUTTON (FORMSTREAM ←(TEXTSTREAM FORMWINDOW))
do (BLOCK)
(SETQ BUTTON (AR.FIND.BUTTON FORMSTREAM (CAR X)))
(if BUTTON
then (AR.REPLACE.FIELD.VAL (CAR BUTTON)
(CDR BUTTON)
FORMSTREAM
(CADR X])
(AR.RESET.SEL
[LAMBDA (WINDOW) (* edited: "30-Aug-84 09:58")
(* (TEDIT.SHOWSEL WINDOW) (replace
(SELECTION SET) of TEDIT.SELECTION with NIL))
(* * for now, since I can't figure out how to turn off the selection, just put the selection in the first safe
<i.e. unprotected> place)
(TEDIT.SETSEL (WINDOWPROP WINDOW (QUOTE TEXTSTREAM))
(AR.FIND.UNPROTECTED.CH# (WINDOWPROP WINDOW (QUOTE TEXTSTREAM)))
0
(QUOTE LEFT])
(AR.SCRATCH.LOAD
[LAMBDA (FORMWINDOW ARSTREAM) (* mjs " 5-Jul-84 16:13")
(PROG [(SCRATCH.STREAM (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.STREAM]
[if (NOT (AND SCRATCH.STREAM (OPENP SCRATCH.STREAM)))
then (WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.STREAM)
(SETQ SCRATCH.STREAM (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW]
(SETFILEPTR SCRATCH.STREAM 0)
(SETFILEPTR ARSTREAM 0)
(WINDOWPROP FORMWINDOW (QUOTE AR.FORM.SCRATCH.MAP)
(AR.COPY.AND.INDEX.AR ARSTREAM SCRATCH.STREAM])
(AR.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) (* edited: "21-Aug-84 09:54")
(PROG (INFO.FILE)
(if (NOT (INFILEP AR.INFO.FILE.NAME))
then (SETQ INFO.FILE (OPENSTREAM AR.INFO.FILE.NAME (QUOTE OUTPUT)
(QUOTE NEW)))
else (until [SETQ INFO.FILE (CAR (NLSETQ (OPENSTREAM AR.INFO.FILE.NAME (QUOTE APPEND)
(QUOTE OLD]
do (AR.PROMPT (LIST "info file busy: " AR.INFO.FILE.NAME " --- please wait")
FORMWINDOW)
(DISMISS 5000)))
(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 "26-Apr-84 18:19")
(PROG ((NAM (USERNAME NIL NIL T)))
(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) (* edited: "16-Jul-84 15:50")
(* * 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 (AR.PROMPT (LIST "analyzed AR # " AR.NUM)
FORMWINDOW)
(SETQ AR.NUM.DATA (CONS (CONS AR.NUM (CONS NIL INDEX.INFO))
AR.NUM.DATA))
else (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) (* mjs "22-Jul-84 13:41")
(printout FILE "Total file size: " (GETEOFPTR AR.INDEX.FILE)
" bytes" T T)
(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]
(printout FILE FIELD.NAME .TAB 20 FIELD.BYTES T))
(printout FILE T "Total Entry Space: " (IDIFFERENCE AR.INDEX.ENTRY.END.PTR
AR.INDEX.ENTRY.BEGIN.PTR)
" bytes" T)
(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 (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) (* edited: "13-Aug-84 16:00")
(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 (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) (* edited: "30-Aug-84 09:58")
(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 0 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 0 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 "19-Aug-84 09:37")
(AR.INDEX.DATA.CONTEXT QFORMWINDOW (LINELENGTH MAX.SMALLP FILE)
(printout FILE "AR Summary" T)
(printout FILE "Generated with Query Spec: " (WINDOWPROP QFORMWINDOW
(QUOTE
AR.ENTRY.ALIST.QLIST))
T)
(printout FILE "Sorted with Sort Spec: " (WINDOWPROP QFORMWINDOW
(QUOTE
AR.ENTRY.ALIST.SLIST))
T T)
(for FIELD.SPEC in AR.ENTRY.LIST.PRINT.FIELDS bind FIELD.NAME FIELD.WIDTH
VAL.NCHARS
do (SETQ FIELD.NAME (CAR FIELD.SPEC))
(SETQ FIELD.WIDTH (CADR FIELD.SPEC))
(for X from 1 to FIELD.WIDTH bind (NAME.NCHARS ←(NCHARS FIELD.NAME))
do (if (ILEQ X NAME.NCHARS)
then (PRIN1 (NTHCHAR FIELD.NAME X)
FILE)
else (PRIN1 " " FILE)))
(PRIN1 " " FILE))
(printout FILE T T)
(for ENTRY.DATA in (WINDOWPROP QFORMWINDOW (QUOTE AR.ENTRY.ALIST))
bind ENTRY PRINT.DATA.ALIST
do (* ENTRY.DATA is a plist of form
(<entryptr> <propname> <val> ...))
(SETQ ENTRY (CAR ENTRY.DATA))
[SETQ PRINT.DATA.ALIST (for FIELD.SPEC in AR.ENTRY.LIST.PRINT.FIELDS
bind FIELD.NAME
join
(* grab all of the data needed to print this entry)
(SETQ FIELD.NAME (CAR FIELD.SPEC))
(LIST FIELD.NAME
(if (LISTGET (CDR ENTRY.DATA)
FIELD.NAME)
else (AR.GET.FIELD.VAL ENTRY
FIELD.NAME]
(for OVERFLOW.LINE.NUM from 0 bind OVERFLOW.FIELD.FLG
repeatwhile (AND AR.ENTRY.LIST.PRINT.MULTILINE.FLAG
OVERFLOW.FIELD.FLG)
do (SETQ OVERFLOW.FIELD.FLG NIL)
(for FIELD.SPEC in AR.ENTRY.LIST.PRINT.FIELDS
bind FIELD.NAME FIELD.WIDTH FIELD.VAL FIELD.START.CHAR
FIELD.END.CHAR VAL.NCHARS
do (SETQ FIELD.NAME (CAR FIELD.SPEC))
(SETQ FIELD.WIDTH (CADR FIELD.SPEC))
(SETQ FIELD.VAL (LISTGET PRINT.DATA.ALIST FIELD.NAME))
(SETQ FIELD.START.CHAR (ADD1 (ITIMES FIELD.WIDTH
OVERFLOW.LINE.NUM)))
(SETQ FIELD.END.CHAR (SUB1 (IPLUS FIELD.START.CHAR
FIELD.WIDTH)))
(SETQ VAL.NCHARS (NCHARS FIELD.VAL))
(if (IGREATERP FIELD.START.CHAR VAL.NCHARS)
then (SPACES FIELD.WIDTH FILE)
else (for X from FIELD.START.CHAR to FIELD.END.CHAR
do (if (ILEQ X VAL.NCHARS)
then (PRIN1 (NTHCHAR FIELD.VAL X)
FILE)
else (PRIN1 " " FILE)))
(if (IGREATERP VAL.NCHARS FIELD.END.CHAR)
then (SETQ OVERFLOW.FIELD.FLG T)))
(PRIN1 " " FILE))
(TERPRI FILE])
(AR.SORT
[LAMBDA (QFORMWINDOW SLIST) (* edited: "13-Aug-84 15:59")
(AR.INDEX.DATA.CONTEXT QFORMWINDOW (AR.QFORM.DISPLAY.DISCONNECT QFORMWINDOW)
(PROG ((ENTRY.ALIST (WINDOWPROP QFORMWINDOW (QUOTE AR.ENTRY.ALIST)))
MULTIPLIERS)
(if (NULL SLIST)
then (RETURN))
(* MULTIPLIERS is a list of integers which are multiplied by the enumerated value numbers of the corresponding
fields in SLIST, so that the first field counts the most in sorting.)
[SETQ MULTIPLIERS (REVERSE (for FIELD.NAME in (REVERSE SLIST)
bind (CUMUL ← 1)
NUM KEYLIST
collect (SETQ KEYLIST
(ARSPECGET
AR.INDEX.FIELD.SPECS
FIELD.NAME
(QUOTE
ENUMERATED.FIELD.KEYLIST)))
(if (NULL KEYLIST)
then (RETURN NIL))
(SETQ NUM (IQUOTIENT
(LENGTH KEYLIST)
2))
(PROG1 CUMUL
(SETQ CUMUL
(ITIMES CUMUL
(ADD1 NUM]
(if [OR (NULL MULTIPLIERS)
(for X in MULTIPLIERS thereis (NOT (FIXP X]
then (AR.PROMPT (LIST "Bad Sorting Spec: " SLIST
" -- not sorted")
QFORMWINDOW)
(RETURN))
(for ENTRY in ENTRY.ALIST
do (* initialize sort numbers)
(if (NULL (CDR ENTRY))
then (RPLACD ENTRY (LIST (QUOTE AR.SORT.NUM)
0))
else (LISTPUT (CDR ENTRY)
(QUOTE AR.SORT.NUM)
0)))
[for FIELD.NAME in SLIST as MULT in MULTIPLIERS bind FIELD.BEGIN.PTR
do (SETQ FIELD.BEGIN.PTR (ARSPECGET AR.INDEX.FIELD.SPECS
FIELD.NAME (QUOTE
FIELD.BEGIN.PTR)))
(for ENTRY in ENTRY.ALIST bind FIELD.VAL
do (SETFILEPTR AR.INDEX.FILE (AR.ENTRY.PTR.TO.KEY.VAL.PTR
(CAR ENTRY)
FIELD.BEGIN.PTR))
(SETQ FIELD.VAL (BIN AR.INDEX.FILE))
(LISTPUT (CDR ENTRY)
(QUOTE AR.SORT.NUM)
(IPLUS (LISTGET (CDR ENTRY)
(QUOTE AR.SORT.NUM))
(ITIMES FIELD.VAL MULT]
[SORT ENTRY.ALIST (FUNCTION (LAMBDA (A B)
(PROG [(ASORTNUM (LISTGET (CDR A)
(QUOTE AR.SORT.NUM)))
(BSORTNUM (LISTGET (CDR B)
(QUOTE AR.SORT.NUM]
(RETURN (if (EQP ASORTNUM BSORTNUM)
then (ILESSP (CAR A)
(CAR B))
else (ILESSP ASORTNUM BSORTNUM]
(WINDOWPROP QFORMWINDOW (QUOTE AR.ENTRY.ALIST.SLIST)
SLIST])
(AR.QFORM.DISPLAY.DISCONNECT
[LAMBDA (QFORMWINDOW) (* edited: "13-Aug-84 16:40")
(PROG [(QFORM.ENTRY.WINDOW (WINDOWPROP QFORMWINDOW (QUOTE QFORM.ENTRY.WINDOW]
(WINDOWPROP QFORM.ENTRY.WINDOW (QUOTE REPAINTFN)
(FUNCTION NILL))
(WINDOWPROP QFORM.ENTRY.WINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION NILL))
(CLEARW QFORM.ENTRY.WINDOW])
(AR.QFORM.DISPLAY.CONNECT
[LAMBDA (QFORMWINDOW) (* edited: "13-Aug-84 16:40")
(PROG ((QFORM.ENTRY.WINDOW (WINDOWPROP QFORMWINDOW (QUOTE QFORM.ENTRY.WINDOW)))
(QUERY.ENTRIES (WINDOWPROP QFORMWINDOW (QUOTE AR.ENTRY.ALIST)))
ENTRY.LIST.HEIGHT)
(SETQ ENTRY.LIST.HEIGHT (ITIMES (ABS (DSPLINEFEED NIL QFORM.ENTRY.WINDOW))
(LENGTH QUERY.ENTRIES)))
(WINDOWPROP QFORM.ENTRY.WINDOW (QUOTE EXTENT)
(CREATEREGION 0 (IMINUS ENTRY.LIST.HEIGHT)
2000 ENTRY.LIST.HEIGHT))
(WINDOWPROP QFORM.ENTRY.WINDOW (QUOTE REPAINTFN)
(FUNCTION AR.ENTRY.LIST.WINDOW.REPAINTFN))
(WINDOWPROP QFORM.ENTRY.WINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION AR.ENTRY.LIST.WINDOW.BUTTONEVENTFN))
(WINDOWPROP QFORM.ENTRY.WINDOW (QUOTE SCROLLFN)
(FUNCTION SCROLLBYREPAINTFN))
(WINDOWPROP QFORM.ENTRY.WINDOW (QUOTE RESHAPEFN)
(FUNCTION RESHAPEBYREPAINTFN))
(DSPRIGHTMARGIN MAX.SMALLP QFORM.ENTRY.WINDOW)
(SCROLLW QFORM.ENTRY.WINDOW 0.0 0.0)
(REDISPLAYW QFORM.ENTRY.WINDOW])
)
(RPAQQ AR.FORM.FORMAT (Number: TAB Date: CR Submitter: TAB Source: CR CR Subject: CR CR Assigned% To:
TAB Attn: CR CR Status: TAB In/By: CR Problem% Type: TAB Impact: CR
Difficulty: TAB Frequency: CR TAB Priority: CR CR System: TAB
Subsystem: CR CR Machine: TAB Disk: CR Lisp% Version: TAB
Source% Files: CR Microcode% Version: TAB Memory% Size: CR
File% Server: TAB Server% Software% Version: CR CR Disposition: CR CR
Description: CR CR Workaround: CR Test% Case: CR CR Edit-By: TAB
Edit-Date: CR))
(RPAQQ AR.FORM.SPECS ((Number: FIELDTYPE PROTECTEDSTRING)
(Date: FIELDTYPE PROTECTEDSTRING)
(Submitter: FIELDTYPE STRING)
(Source: FIELDTYPE STRING)
(Subject: FIELDTYPE STRING)
(Assigned% To: FIELDTYPE STRING)
(Attn: FIELDTYPE STRING)
(Status: FIELDTYPE MENU MENULIST
(New Open Fixed Closed Declined Superseded Obsolete Incomplete Wish))
(In/By: FIELDTYPE STRING)
(Problem% Type: FIELDTYPE MENU MENULIST (Bug Design% -% Impl 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
Documentation Other% Software))
(Subsystem: FIELDTYPE SUBMENU ASSOCMENU System: SUBMENULIST
(Communications (NS% Protocols PUP% Protocols RS232 VAX% Server
Lisp% Servers TCP/IP Other)
Windows% and% Graphics
(Window% System Library Fonts Printing Color Demos
Other)
Operating% System
(Virtual% Memory Generic% File% Operations
DLion% Disk DLion% Floppy
Dolphin/Dorado% Disk Processes
Keyboard Other)
Language% Support
(Arithmetic Compiler,% Code% Format Microcode
Storage% Formats/Mgt Read% and% Print
Stack% and% Interpreter
Bootstrapping% and% Teleraid
Diagnostics Other)
Programming% Environment
(Break% Package Code% Editor DWIM File% Package
History Masterscope Record% Package
Performance% Tools Other)
Text
(TEdit TTYIN Lafite Other)
Documentation
(Tools 1108% Users% Guide Primer
Product% Descr/Tech% Summary
Programmers% Introduction
Interlisp% Reference% Manual
Internal% System% Documentation Other)
Other% Software
(Installation% Utility Release% Procedure Other)))
(Machine: FIELDTYPE MENU ASSOCSUBMENU Disk: MENULIST (1100 1108 1132))
(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)))
(Lisp% Version: FIELDTYPE STRING)
(Source% Files: FIELDTYPE STRING)
(Microcode% Version: FIELDTYPE STRING)
(Memory% Size: FIELDTYPE STRING)
(File% Server: FIELDTYPE MENU MENULIST (8037 IFS VAX/VMS% -% 3Mb
VAX/VMS% -% 10Mb VAX/UNIX Other))
(Server% Software% Version: FIELDTYPE STRING)
(Disposition: FIELDTYPE STRING)
(Description: FIELDTYPE STRING)
(Workaround: FIELDTYPE STRING)
(Test% Case: FIELDTYPE STRING)
(Edit-By: FIELDTYPE STRING)
(Edit-Date: FIELDTYPE PROTECTEDSTRING)))
(RPAQ? AR.ENTRY.LIST.WINDOW.FIELDS (QUOTE ((Number: 5)
(Status: 5)
(Subject: 45)
(Attn: 15)
(System: 15)
(Subsystem: 15)
(Source: 15))))
(RPAQ? AR.ENTRY.LIST.PRINT.FIELDS (QUOTE ((Number: 5)
(Date: 9)
(System: 14)
(Subsystem: 14)
(Status: 10)
(Attn: 11)
(Subject: 50)
(Priority: 10)
(Difficulty: 10)
(Impact: 9)
(Problem% Type: 13))))
(RPAQ? AR.ENTRY.LIST.PRINT.MULTILINE.FLAG T)
(RPAQ? AR.INDEX.DEFAULT.FIELDS (QUOTE (Subject: Source: Date: Submitter: Assigned% To: Attn: Status:
In/By: Problem% Type: Impact: Difficulty: Frequency:
Priority: System: Subsystem: Machine: Disk:
Lisp% Version: Source% Files: Microcode% Version:
Memory% Size: File% Server:
Server% Software% Version: Edit-By: Edit-Date:)))
(RPAQ? AR.INDEX.DEFAULT.FILE.NAME (QUOTE {PHYLUM}<LISPARS>AR.INDEX))
(RPAQ? AR.INFO.FILE.NAME (QUOTE {PHYLUM}<LISPARS>LISPARS.TDS))
(RPAQ? AR.SUBMIT.NUM.FILE.NAME (QUOTE {PHYLUM}<LISPARS>LISPARS.NUM))
(RPAQ? AR.SUBMIT.FILE.NAME (QUOTE {PHYLUM}<LISPARS>LISPARS.SUBMIT))
(RPAQ? AR.DIRECTORY (QUOTE {PHYLUM}<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 "12-Apr-84 17:50")
(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]
(SETFILEINFO ARSTREAM (QUOTE BUFFERS)
(IQUOTIENT (IPLUS 511 (GETEOFPTR ARSTREAM))
512)) (* Buffer whole file, since we're going to read it
twice)
(AR.SHOW2 ARSTREAM (AR.PARSE ARSTREAM)
(OR MAP AR.MAP)
WINDOW)
(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) (* edited: "21-Aug-84 14:40")
(* Reads an AR file, and parses it into a list of (Field FilePtr) pairs, where the fileptr is the start of what
follows the field name)
(SETFILEPTR STREAM 0)
(bind CHAR FP collect [LIST [PACKC (collect (SETQ CHAR (BIN STREAM)) repeatuntil
(EQ CHAR (CHARCODE :]
(PROG1 (SETQ FP (GETFILEPTR STREAM))
(do (SELCHARQ (BIN STREAM)
(' (BIN STREAM))
[CR (RETURN (OR (EQ (BIN STREAM)
(CHARCODE CR))
(SHOULDNT
"Bad char after CR in parsed file"]
NIL]
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:)
(Submitter: T)
(Source:)
(System: T)
(Machine:)
(Subsystem: T)
(Disk:)
(Problem% Type: T)
(Memory% Size:)
(Subject:)
(Source% Files:)
(Impact: T)
(Frequency:)
(Status: T)
(In/By: T)
(Attn:)
(Assigned% To: T)
(Priority: T)
(Difficulty:)
(Disposition:)
(Lisp% Version: T)
(Microcode% Version:)
(File% Server: T)
(Server% Software% Version:)
(Description:)
(Workaround:)
(Test% Case:)
(Edit-By: T)
(Edit-Date:)))
(RPAQQ AR.SUMMARY.MAP ((Number: 4)
(System: 15)
(Subsystem: 10)
(Status: 8)
(Problem% Type: 5)
(Impact: 10)
(Frequency: 10)
(Subject: 30)
(Priority: 10)
(Difficulty: 10)
(Attn: 10)))
(RPAQQ AR.THIN.SUMMARY.MAP ((Number: 5)
(Status: 5)
(Attn: 10)
(Problem% Type: 5)
(Priority: 5)
(Subject: 40)))
(RPAQ? AR.LAYOUT.WINDOW )
(RPAQ? ARPARALEADING 2)
(RPAQ? AR.READ.WITH.RNUMBERFLG T)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS AR.LAYOUT.WINDOW ARFONT ARBOLDFONT ARPARALEADING AR.MAP AR.SUMMARY.MAP
AR.THIN.SUMMARY.MAP)
)
(FILESLOAD READNUMBER)
(ADDTOVAR BackgroundMenuCommands ("AR Edit" (QUOTE (AR.FORM))
"Create an AR.FORM editor for the Lisp AR database"
(SUBITEMS ("New AR form" (QUOTE (AR.FORM))
"Creates new AR.FORM editor, initially cleared")
("Load AR form" (QUOTE (AR.FORM (RNUMBER)))
"Creates new AR.FORM editor, initally loaded with a specified AR")
("AR.SHOW" (QUOTE (AR.SHOW (RNUMBER)))
"Calls the old AR.SHOW bug-report displayer to quickly display a specified AR")
("AR Query Form" (QUOTE (AR.QFORM.CREATE))
"Creates an AR Query Form"))))
(RPAQQ BackgroundMenu NIL)
(RPAQ AR.INDEX.MONITORLOCK (CREATE.MONITORLOCK (QUOTE AR.INDEX.LOCK)))
(DECLARE: EVAL@COMPILE
(PUTPROPS AR.ENTRY.PTR.TO.KEY.VAL.PTR MACRO [X (BQUOTE (IPLUS , (CADR X)
(IQUOTIENT (IDIFFERENCE , (CAR X)
AR.INDEX.ENTRY.BEGIN.PTR)
AR.INDEX.ENTRY.SIZE])
(PUTPROPS AR.ENTRY.TO.NUM MACRO [X (BQUOTE (PROGN (SETFILEPTR AR.INDEX.FILE , (CAR X))
(\DWIN AR.INDEX.FILE])
(PUTPROPS AR.INDEX.DATA.CONTEXT MACRO [X (BQUOTE (WITH.MONITOR AR.INDEX.MONITORLOCK
(PROG (AR.INDEX.FILE
AR.INDEX.ENTRY.BEGIN.PTR
AR.INDEX.ENTRY.END.PTR
AR.INDEX.ENTRY.SIZE
AR.INDEX.FIELD.SPECS
AR.INDEX.FIELD.LIST)
(DECLARE (SPECVARS AR.INDEX.FILE
AR.INDEX.ENTRY.BEGIN.PTR
AR.INDEX.ENTRY.END.PTR
AR.INDEX.ENTRY.SIZE
AR.INDEX.FIELD.SPECS
AR.INDEX.FIELD.LIST))
(AR.INDEX.DATA.UNPACK
(WINDOWPROP , (CAR X)
(QUOTE
AR.INDEX.DATA)))
(AR.INDEX.FILE.REOPEN
,
(CAR X))
(RETURN (PROGN ,@(CDR X])
(PUTPROPS AR.KEY.VAL.PTR.TO.ENTRY.PTR MACRO (X (BQUOTE (IPLUS (ITIMES AR.INDEX.ENTRY.SIZE
(IDIFFERENCE , (CAR X)
,
(CADR X)))
AR.INDEX.ENTRY.BEGIN.PTR))))
(PUTPROPS ARSPECGET MACRO [X (BQUOTE (LISTGET (CDR (ASSOC , (CADR X)
,
(CAR X)))
,
(CADDR X])
(PUTPROPS ARSPECPUT MACRO [X (BQUOTE (LISTPUT (CDR (ASSOC , (CADR X)
,
(CAR X)))
,
(CADDR X)
,
(CADDDR X])
(PUTPROPS IMAGEOBJPROPS MACRO (X (IMAGEOBJPROPS.MACRO X)))
)
[DECLARE: EVAL@COMPILE
(TYPERECORD AR.INDEX.DATA (AR.INDEX.FILE AR.INDEX.ENTRY.BEGIN.PTR AR.INDEX.ENTRY.END.PTR
AR.INDEX.ENTRY.SIZE AR.INDEX.FIELD.SPECS AR.INDEX.FIELD.LIST)
)
]
(READVARS AR.FORM.ICON AR.QFORM.ICON)
({(READBITMAP)(60 60
"OOOOOOOOOOOOOOO@"
"OOOOOOOOOOOOOOO@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@CO@@@@@@C@"
"L@@@@@GOH@@@@@C@"
"L@@@@@NAL@@@@@C@"
"L@@CH@L@L@@@@@C@"
"L@@OL@L@L@CN@@C@"
"L@ALL@L@L@CO@@C@"
"L@GHN@L@L@GCH@C@"
"L@N@F@L@L@FAL@C@"
"LGH@F@NAL@F@G@C@"
"LG@@BCOOO@L@CHC@"
"LD@@CGOOOIL@ALC@"
"L@@@CO@@CMH@@NC@"
"L@@@CL@@@O@@@FC@"
"L@@@CH@@@G@@@@C@"
"L@@@O@@@@CH@@@C@"
"L@@@LCOCO@L@@@C@"
"L@@@LGOCOHN@@@C@"
"L@GAHNCCALF@@@C@"
"L@GMHLCC@LF@@@C@"
"L@MOHLCC@LGOL@C@"
"LAHC@LCC@LCON@C@"
"LAHC@LCC@LC@N@C@"
"LC@C@OOCOLC@C@C@"
"LC@C@OOCOLC@C@C@"
"LF@C@LCCG@C@AHC@"
"LF@C@LCCCHC@AHC@"
"LF@C@LCCALC@@LC@"
"LF@CHLCC@LF@@NC@"
"L@@AHLCC@LF@@FC@"
"L@@AHLCC@LF@@FC@"
"L@@@LLCC@LL@@@C@"
"L@AOLLCC@LON@@C@"
"L@AOLLCC@LON@@C@"
"L@AHN@CC@ALF@@C@"
"L@AHF@CC@AHC@@C@"
"L@CHF@CC@AHC@@C@"
"L@C@C@CC@C@AH@C@"
"L@C@CHCC@G@AH@C@"
"L@C@AHCC@F@AH@C@"
"L@C@@N@@AN@AL@C@"
"L@F@@G@@CL@@L@C@"
"L@F@@CNCOH@@N@C@"
"L@N@@AOON@@@F@C@"
"L@L@@@CN@@@@C@C@"
"LAH@@@@@@@@@CHC@"
"LAH@@@@@@@@@ALC@"
"LC@@@@@@@@@@ALC@"
"LF@@@@@@@@@@@NC@"
"LF@@@@@@@@@@@FC@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"OOOOOOOOOOOOOOO@"
"OOOOOOOOOOOOOOO@")} {(READBITMAP)(60 110
"OOOOOOOOOOOOOOO@"
"OOOOOOOOOOOOOOO@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@EMML@@@@@C@"
"L@@@@GGGF@@@@@C@"
"L@@@AMMMML@@@@C@"
"L@@@CGGGGF@@@@C@"
"L@@@MMMMMM@@@@C@"
"L@@AGGGGGG@@@@C@"
"L@@AMMMMMMH@@@C@"
"L@@CGGGGGG@@@@C@"
"L@@AMMMMMML@@@C@"
"L@@CGGGGGGF@@@C@"
"L@@AMMHAMML@@@C@"
"L@@CGF@AGGF@@@C@"
"L@@AML@@MML@@@C@"
"L@@CGD@@GGF@@@C@"
"L@@AML@@EML@@@C@"
"L@@CGF@@GGF@@@C@"
"L@@AML@@EML@@@C@"
"L@@CGF@@GGD@@@C@"
"L@@AML@@MML@@@C@"
"L@@@GD@AGGD@@@C@"
"L@@@EH@AMMH@@@C@"
"L@@@@@@GGG@@@@C@"
"L@@@@@AMMM@@@@C@"
"L@@@@@CGGF@@@@C@"
"L@@@@@EMML@@@@C@"
"L@@@@@GGG@@@@@C@"
"L@@@@@EMM@@@@@C@"
"L@@@@@GGD@@@@@C@"
"L@@@@@EML@@@@@C@"
"L@@@@@GGD@@@@@C@"
"L@@@@@EML@@@@@C@"
"L@@@@@GGD@@@@@C@"
"L@@@@@EML@@@@@C@"
"L@@@@@GGD@@@@@C@"
"L@@@@@EML@@@@@C@"
"L@@@@@GGD@@@@@C@"
"L@@@@@EML@@@@@C@"
"L@@@@@GGD@@@@@C@"
"L@@@@@EML@@@@@C@"
"L@@@@@GGD@@@@@C@"
"L@@@@@EML@@@@@C@"
"L@@@@@GGD@@@@@C@"
"L@@@@@AMH@@@@@C@"
"L@@@@@AG@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@GO@@@@@@C@"
"L@@@@@OGH@@@@@C@"
"L@@@@@MML@@@@@C@"
"L@@CH@OGF@@@@@C@"
"L@@OL@MMN@CN@@C@"
"L@ALL@OGF@CO@@C@"
"L@GHN@MMN@GCH@C@"
"L@N@F@OGF@FAL@C@"
"LCH@F@MMN@F@G@C@"
"LC@@BCOOO@L@CHC@"
"L@@@CGOOOIL@ALC@"
"L@@@CO@@CMH@@NC@"
"L@@@CL@@@O@@@FC@"
"L@@@CH@@@G@@@@C@"
"L@@@O@@@@CH@@@C@"
"L@@@LCOCO@L@@@C@"
"L@@@LGOCOHN@@@C@"
"L@GAHNCCALF@@@C@"
"L@GMHLCC@LF@@@C@"
"L@MOHLCC@LGOL@C@"
"LAHC@LCC@LCON@C@"
"LAHC@LCC@LC@N@C@"
"LC@C@OOCOLC@C@C@"
"LC@C@OOCOLC@C@C@"
"LF@C@LCCG@C@AHC@"
"LF@C@LCCCHC@AHC@"
"LF@C@LCCALC@@LC@"
"LF@CHLCC@LF@@NC@"
"L@@AHLCC@LF@@FC@"
"L@@AHLCC@LF@@FC@"
"L@@@LLCC@LL@@@C@"
"L@AOLLCC@LON@@C@"
"L@AOLLCC@LON@@C@"
"L@AHN@CC@ALF@@C@"
"L@AHF@CC@AHC@@C@"
"L@CHF@CC@AHC@@C@"
"L@C@C@CC@C@AH@C@"
"L@C@CHCC@G@AH@C@"
"L@C@AHCC@F@AH@C@"
"L@B@@N@@AN@AL@C@"
"L@F@@G@@CL@@L@C@"
"L@F@@CNCOH@@N@C@"
"L@N@@AOON@@@F@C@"
"L@L@@@CN@@@@C@C@"
"LAH@@@@@@@@@CHC@"
"LAH@@@@@@@@@ALC@"
"LC@@@@@@@@@@ALC@"
"LF@@@@@@@@@@@NC@"
"LF@@@@@@@@@@@FC@"
"L@@@@@@@@@@@@BC@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"L@@@@@@@@@@@@@C@"
"OOOOOOOOOOOOOOO@"
"OOOOOOOOOOOOOOO@")})
(PUTPROPS AREDIT COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5340 56937 (AR.BUTTON.GET.MENU 5350 . 5762) (AR.BUTTON.GET.SUBMENU 5764 . 6657) (
AR.BUTTON.OBJ.CREATE 6659 . 9043) (AR.BUTTONFN.DOMENU 9045 . 9993) (AR.BUTTONFN.DOSUBMENU 9995 . 10574
) (AR.BUTTONFN.SELFIELD 10576 . 11158) (AR.CHECK.FIELDS 11160 . 12314) (AR.CHECK.MENU 12316 . 13188) (
AR.CHECK.SHORTSTRING 13190 . 13501) (AR.CHECK.SUBMENU 13503 . 14585) (AR.CONFIRM 14587 . 14788) (
AR.COPY.AND.INDEX.AR 14790 . 15946) (AR.DELETE.FIELD.VAL 15948 . 16733) (AR.DISCONNECT.WINDOW 16735 .
16977) (AR.FIND.BUTTON 16979 . 17408) (AR.FIND.EDIT.CHANGES 17410 . 20254) (AR.FIND.UNPROTECTED.CH#
20256 . 20886) (AR.FORM 20888 . 21113) (AR.FORM.CLEAR 21115 . 21682) (AR.FORM.CREATE 21684 . 25932) (
AR.FORM.FILL.INS 25934 . 26576) (AR.FORM.GROUP.CREATE 26578 . 29295) (AR.FORM.MENU.TITLEMENUFN 29297
. 30661) (AR.KILL.ATTACHED.TEDIT.CLOSEFN 30663 . 31142) (AR.FORM.MENU.ACTIONFN 31144 . 33918) (
AR.FORM.MENU.BUTTONFN 33920 . 34182) (AR.FORM.SAVE 34184 . 36665) (AR.GET.AR 36667 . 38473) (
AR.GET.ASSOCIATED.MENU.VAL 38475 . 38956) (AR.GET.BUTTON.FIELD.AS.TEXT 38958 . 39563) (
AR.GET.SUBMIT.NUM 39565 . 40568) (AR.GET.BUTTON.FIELD.AS.LIST 40570 . 40879) (AR.GET.FILENAME 40881 .
41467) (AR.MARK.ACTIVE 41469 . 41672) (AR.MENU.CR.FN 41674 . 41898) (AR.MENU.FN.CLEAR 41900 . 42492) (
AR.MENU.FN.GET 42494 . 43321) (AR.MENU.FN.PUT 43323 . 47298) (AR.PROMPT 47300 . 47620) (
AR.PROTECT.WARNING 47622 . 47870) (AR.RECONNECT.WINDOW 47872 . 48323) (AR.REPLACE.FIELD.VAL 48325 .
50029) (AR.REPLACE.FILL.INS 50031 . 50435) (AR.RESET.SEL 50437 . 51028) (AR.SCRATCH.LOAD 51030 . 51659
) (AR.TEXTSTREAM.LOAD 51661 . 54004) (AR.TOBJ.ACTIVEP 54006 . 54222) (AR.UPDATE.AR.INFO 54224 . 56361)
(AR.USERNAME 56363 . 56602) (IMAGEOBJPROPS.MACRO 56604 . 56935)) (56969 114446 (AR.ENTRY.LIST.AND
56979 . 57236) (AR.ENTRY.LIST.OR 57238 . 57558) (AR.ENTRY.LIST.WINDOW.REPAINTFN 57560 . 59991) (
AR.ENTRY.LIST.WINDOW.BUTTONEVENTFN 59993 . 62996) (AR.EDIT.USING.CORRESPONDING.FORM 62998 . 64421) (
AR.GATHER.NEW.AR.DATA 64423 . 66008) (AR.GET.ENTRY.NUM 66010 . 66264) (AR.GET.FIELD.VAL.DATA 66266 .
66979) (AR.GET.FIELD.VAL.LENGTH 66981 . 68240) (AR.GET.FIELD.VAL.PTR 68242 . 68962) (AR.GET.FIELD.VAL
68964 . 70156) (AR.INDEX.CREATE 70158 . 71753) (AR.GET.ENUMERATED.FIELD.KEYS 71755 . 72482) (
AR.INDEX.DATA.UNPACK 72484 . 72926) (AR.INDEX.FIND.ENTRY.PTR 72928 . 74065) (AR.INDEX.OPEN 74067 .
74892) (AR.INDEX.FILE.REOPEN 74894 . 75357) (AR.INDEX.PRINT 75359 . 78273) (
AR.INDEX.REWRITE.ENTRY.DATA 78275 . 81770) (AR.INDEX.REWRITE.FIELD.DATA 81772 . 84786) (
AR.INDEX.SEARCH.HAS 84788 . 87292) (AR.INDEX.SEARCH.IS 87294 . 89603) (
AR.GET.ENTRY.PTRS.FROM.FIELD.PTRS 89605 . 91423) (AR.INDEX.UPDATE 91425 . 94492) (AR.QFORM.ACTIONFN
94494 . 95735) (AR.QFORM.PROMPT.LIST.FN 95737 . 96866) (AR.GET.QLIST.PROMPT.MENU 96868 . 98368) (
AR.GET.SLIST.PROMPT.MENU 98370 . 99146) (AR.QFORM.BUTTONFN 99148 . 99434) (AR.QFORM.CREATE 99436 .
99715) (AR.QFORM.FN.PRINT 99717 . 100369) (AR.QFORM.FN.QUERY 100371 . 101006) (AR.QFORM.FN.UPDATE
101008 . 101365) (AR.QFORM.GROUP.CREATE 101367 . 104436) (AR.QUERY 104438 . 104964) (
AR.QUERY.EVAL.QLIST 104966 . 107103) (AR.PRINT 107105 . 110134) (AR.SORT 110136 . 112895) (
AR.QFORM.DISPLAY.DISCONNECT 112897 . 113317) (AR.QFORM.DISPLAY.CONNECT 113319 . 114444)) (119836
125035 (AR.SHOW 119846 . 120694) (AR.SHOW2 120696 . 122440) (AR.PARSE 122442 . 123173) (AR.SHOWFIELD
123175 . 123908) (AR.SUMMARY 123910 . 124496) (AR.LAYOUT.WINDOW 124498 . 124842) (AR.FILENAME 124844
. 125033)))))
STOP