(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "10-Feb-88 18:46:08" {ERINYES}<LISP>LYRIC>INTERNAL>LIBRARY>AREDIT.;4 206162
changes to%: (VARS AR.FORM.ICON AR.QFORM.ICON)
(FNS AR.BUTTON.GET.MENU AR.BUTTON.GET.SUBMENU AR.BUTTON.OBJ.CREATE
AR.BUTTONFN.DOMENU AR.BUTTONFN.DOSUBMENU AR.BUTTONFN.SELFIELD
AR.CHECK.FIELDS AR.CHECK.MENU AR.CHECK.SHORTSTRING AR.CHECK.SUBMENU
AR.CONFIRM AR.COPY.AND.INDEX.AR AR.DELETE.FIELD.VAL AR.DISCONNECT.WINDOW
AR.FIND.BUTTON AR.FIND.EDIT.CHANGES AR.FIND.UNPROTECTED.CH# AR.FORM
AR.FORM.CLEAR AR.FORM.CREATE AR.FORM.FILL.INS AR.FORM.FILL.INS.DEFAULT
AR.FORM.GROUP.CREATE AR.FORM.MENU.TITLEMENUFN AR.JUST.GET.SUBMIT.NUM
AR.JUST.PRINT.AR.NUM AR.KILL.ATTACHED.TEDIT.CLOSEFN AR.NOTE.FIELD.CHANGED
AR.FORM.MENU.ACTIONFN AR.FORM.MENU.BUTTONFN AR.FORM.SAVE AR.GET.AR
AR.GET.ASSOCIATED.MENU.VAL AR.GET.BUTTON.FIELD.AS.TEXT
AR.GET.MENU.FROM.MAIN.WINDOW AR.GET.NEXT AR.GET.SUBMIT.NUM
AR.GET.BUTTON.FIELD.AS.LIST AR.GET.FILENAME AR.MARK.ACTIVE AR.MENU.CR.FN
AR.MENU.FN.CLEAR AR.MENU.FN.GET AR.MENU.FN.PUT AR.PRINT.PADDED AR.PROMPT
AR.PROTECT.WARNING AR.PUT.FAILED AR.RECONNECT.WINDOW AR.REPLACE.FIELD.VAL
AR.REPLACE.FILL.INS AR.RESET.SEL AR.SCRATCH.LOAD AR.SEND.MESSAGE
AR.TEXTSTREAM.LOAD AR.TOBJ.ACTIVEP AR.UPDATE.AR.INFO AR.USERNAME
IMAGEOBJPROPS.MACRO AR.QUERY AR.QUERY.EVAL.QLIST AR.ENTRY.LIST.AND
AR.ENTRY.LIST.OR AR.ENTRY.LIST.NOT AR.INDEX.SEARCH.HAS AR.INDEX.SEARCH.IS
AR.QFORM.DISPLAY.CONNECT AR.QFORM.DISPLAY.DISCONNECT AR.QFORM.GROUP.CREATE
AR.QFORM.FN.UPDATE AR.QFORM.FN.QUERY AR.QFORM.FN.PRINT AR.QFORM.CREATE
AR.QFORM.BUTTONFN AR.QFORM.ACTIONFN AR.GET.QLIST.PROMPT.MENU
AR.QFORM.PROMPT.LIST.FN AR.GET.SLIST.PROMPT.MENU
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.GET.ENTRY.PTRS.FROM.FIELD.PTRS
AR.INDEX.UPDATE AR.PRINT AR.SORT AR.SHOW AR.PARSE AR.SHOWFIELD AR.SUMMARY
AR.LAYOUT.WINDOW AR.FILENAME)
previous date%: " 8-Feb-88 14:22:49" {ERINYES}<LISP>LYRIC>INTERNAL>LIBRARY>AREDIT.;3)
(* "
Copyright (c) 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT AREDITCOMS)
(RPAQQ AREDITCOMS
((FILES TEDIT READNUMBER)
(* ;;; "AR.FORM functions and variables")
(FNS AR.BUTTON.GET.MENU AR.BUTTON.GET.SUBMENU AR.BUTTON.OBJ.CREATE AR.BUTTONFN.DOMENU
AR.BUTTONFN.DOSUBMENU AR.BUTTONFN.SELFIELD AR.CHECK.FIELDS AR.CHECK.MENU
AR.CHECK.SHORTSTRING AR.CHECK.SUBMENU AR.CONFIRM AR.COPY.AND.INDEX.AR
AR.DELETE.FIELD.VAL AR.DISCONNECT.WINDOW AR.FIND.BUTTON AR.FIND.EDIT.CHANGES
AR.FIND.UNPROTECTED.CH# AR.FORM AR.FORM.CLEAR AR.FORM.CREATE AR.FORM.FILL.INS
AR.FORM.FILL.INS.DEFAULT AR.FORM.GROUP.CREATE AR.FORM.MENU.TITLEMENUFN
AR.JUST.GET.SUBMIT.NUM AR.JUST.PRINT.AR.NUM AR.KILL.ATTACHED.TEDIT.CLOSEFN
AR.NOTE.FIELD.CHANGED AR.FORM.MENU.ACTIONFN AR.FORM.MENU.BUTTONFN AR.FORM.SAVE AR.GET.AR
AR.GET.ASSOCIATED.MENU.VAL AR.GET.BUTTON.FIELD.AS.TEXT AR.GET.MENU.FROM.MAIN.WINDOW
AR.GET.NEXT AR.GET.SUBMIT.NUM AR.GET.BUTTON.FIELD.AS.LIST AR.GET.FILENAME AR.MARK.ACTIVE
AR.MENU.CR.FN AR.MENU.FN.CLEAR AR.MENU.FN.GET AR.MENU.FN.PUT AR.PRINT.PADDED AR.PROMPT
AR.PROTECT.WARNING AR.PUT.FAILED AR.RECONNECT.WINDOW AR.REPLACE.FIELD.VAL
AR.REPLACE.FILL.INS AR.RESET.SEL AR.SCRATCH.LOAD AR.SEND.MESSAGE AR.TEXTSTREAM.LOAD
AR.TOBJ.ACTIVEP AR.UPDATE.AR.INFO AR.USERNAME IMAGEOBJPROPS.MACRO)
(* ;;; "AR INDEX functions")
(COMS
(* ;; "Functions for evaluating AR queries:")
(FNS AR.QUERY AR.QUERY.EVAL.QLIST AR.ENTRY.LIST.AND AR.ENTRY.LIST.OR AR.ENTRY.LIST.NOT
AR.INDEX.SEARCH.HAS AR.INDEX.SEARCH.IS)
(* ;; "Creating AR Query windows")
(FNS AR.QFORM.DISPLAY.CONNECT AR.QFORM.DISPLAY.DISCONNECT AR.QFORM.GROUP.CREATE
AR.QFORM.FN.UPDATE AR.QFORM.FN.QUERY AR.QFORM.FN.PRINT AR.QFORM.CREATE
AR.QFORM.BUTTONFN AR.QFORM.ACTIONFN AR.GET.QLIST.PROMPT.MENU
AR.QFORM.PROMPT.LIST.FN AR.GET.SLIST.PROMPT.MENU AR.ENTRY.LIST.WINDOW.REPAINTFN
AR.ENTRY.LIST.WINDOW.BUTTONEVENTFN))
(FNS 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.GET.ENTRY.PTRS.FROM.FIELD.PTRS AR.INDEX.UPDATE AR.PRINT AR.SORT)
(VARS AR.FORM.FORMAT AR.FORM.SPECS)
(INITVARS [AR.ENTRY.LIST.WINDOW.FIELDS '((Number%: 5)
(Status%: 5)
(Subject%: 45)
(Attn%: 15)
(System%: 15)
(Subsystem%: 15)
(Source%: 15]
[AR.ENTRY.LIST.PRINT.FIELDS '((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 '(Subject%: Source%: Date%: Submitter%: |Assigned To:| Attn%:
Status%: In/By%: |Problem Type:| Impact%:
Difficulty%: Frequency%: Priority%: System%:
Subsystem%: Machine%: Disk%: |Lisp Version:|
|Source Files:| |Microcode Version:| |Memory Size:|
|File Server:| |Server Software Version:| Edit-By%:
Edit-Date%:))
(AR.NO.MESSAGE.FLG NIL))
(VARS (AR.INDEX.DEFAULT.FILE.NAME '{ERINYES}<LISPARS>AR.INDEX)
(AR.INFO.FILE.NAME '{ERINYES}<LISPARS>LISPARS.TDS)
(AR.SUBMIT.NUM.FILE.NAME '{ERINYES}<LISPARS>LISPARS.NUM)
(AR.SUBMIT.FILE.NAME '{ERINYES}<LISPARS>LISPARS.SUBMIT)
(AR.DIRECTORY '{ERINYES}<LISPARS>))
[INITVARS (ARBUTTONFONT (FONTCREATE 'HELVETICA 12 'BOLD))
(ARFONT (FONTCREATE 'TIMESROMAN 10))
(ARBOLDFONT (FONTCREATE 'HELVETICA 10 'BOLD]
(* ;;; "old vars and fns for AR.SHOW")
(FNS AR.SHOW 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 ARPARALEADING AR.MAP AR.SUMMARY.MAP AR.THIN.SUMMARY.MAP
AR.INDEX.MONITORLOCK AR.FORM.ICON AR.QFORM.ICON AR.INDEX.DEFAULT.FIELDS)
(SPECVARS AR.INDEX.DEFAULT.FILE.NAME AR.INFO.FILE.NAME AR.SUBMIT.NUM.FILE.NAME AR.DIRECTORY
AR.ENTRY.LIST.PRINT.MULTILINE.FLAG AR.ENTRY.LIST.WINDOW.FIELDS
AR.ENTRY.LIST.PRINT.FIELDS AR.NO.MESSAGE.FLG ARBUTTONFONT ARFONT ARBOLDFONT
AR.FORM.FORMAT AR.FORM.SPECS)
[ADDVARS (BackgroundMenuCommands ("AR Edit" '(AR.FORM)
"Create an AR.FORM editor for the Lisp AR database"
(SUBITEMS ("New AR form" '(AR.FORM)
"Creates new AR.FORM editor, initially cleared"
)
("Load AR form" '(AR.FORM (RNUMBER))
"Creates new AR.FORM editor, initally loaded with a specified AR"
)
("AR.SHOW" '(AR.SHOW (RNUMBER))
"Calls the old AR.SHOW bug-report displayer to quickly display a specified AR"
)
("AR Query Form" '(AR.QFORM.CREATE)
"Creates an AR Query Form"]
(VARS (BackgroundMenu))
[VARS (AR.INDEX.MONITORLOCK (CREATE.MONITORLOCK 'AR.INDEX.LOCK]
(MACROS AR.ENTRY.PTR.TO.KEY.VAL.PTR AR.ENTRY.TO.NUM AR.INDEX.DATA.CONTEXT
AR.KEY.VAL.PTR.TO.ENTRY.PTR ARSPECGET ARSPECPUT IMAGEOBJPROPS)
(RECORDS AR.INDEX.DATA)
(UGLYVARS AR.FORM.ICON AR.QFORM.ICON)
(RESOURCES SCRATCHSTRING)))
(FILESLOAD TEDIT READNUMBER)
(* ;;; "AR.FORM functions and variables")
(DEFINEQ
(AR.BUTTON.GET.MENU
[LAMBDA (OBJ) (* mjs "20-Apr-84 15:02")
(if (IMAGEOBJPROP OBJ 'AR.MENU)
else [IMAGEOBJPROP OBJ 'AR.MENU (create MENU
ITEMS ← [APPEND (IMAGEOBJPROP OBJ 'AR.MENU.LIST)
(LIST (LIST NIL (KWOTE (PACKC]
TITLE ← (IMAGEOBJPROP OBJ 'MBTEXT]
(IMAGEOBJPROP OBJ 'AR.MENU])
(AR.BUTTON.GET.SUBMENU
[LAMBDA (OBJ ASSOCIATED.MENU.VAL) (* mjs "20-Apr-84 15:02")
(if (LISTGET (IMAGEOBJPROP OBJ 'AR.SUBMENUS)
ASSOCIATED.MENU.VAL)
else (PROG ((CORRESPONDING.SUBMENU.LIST (LISTGET (IMAGEOBJPROP OBJ '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 'MBTEXT]
(if (IMAGEOBJPROP OBJ 'AR.SUBMENUS)
then (LISTPUT (IMAGEOBJPROP OBJ 'AR.SUBMENUS)
ASSOCIATED.MENU.VAL CORRESPONDING.SUBMENU)
else (IMAGEOBJPROP OBJ '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 'FIELDTYPE))
BUTTON.FN OBJ)
(if (AND (EQ BUTTON.TYPE 'STRING)
(ARSPECGET AR.SPECS BUTTON.NAME 'MAXCHARS))
then
(* if a string has a max length given, treat it as a SHORTSTRING)
(SETQ BUTTON.TYPE 'SHORTSTRING))
[SETQ BUTTON.FN (if (ARSPECGET AR.SPECS BUTTON.NAME 'FN)
else (SELECTQ BUTTON.TYPE
(BUTTON (ARSPECGET AR.SPECS BUTTON.NAME '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 'FONT)
else BUTTON.FONT))
(SETQ OBJ (MBUTTON.CREATE BUTTON.NAME BUTTON.FN BUTTON.FONT))
(IMAGEOBJPROPS OBJ 'AR.PRE.FIELD (SELECTQ BUTTON.TYPE
(BUTTON "")
((MENU SUBMENU)
" {")
" ")
'AR.POST.FIELD
(SELECTQ BUTTON.TYPE
((MENU SUBMENU)
"}")
"")
'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))
'AR.PROTECTED.FLG
(SELECTQ BUTTON.TYPE
((BUTTON PROTECTEDSTRING MENU SUBMENU)
T)
NIL))
(SELECTQ BUTTON.TYPE
(SHORTSTRING (IMAGEOBJPROP OBJ 'AR.MAX.LEN (ARSPECGET AR.SPECS BUTTON.NAME 'MAXCHARS)))
(MENU (IMAGEOBJPROPS OBJ 'AR.ASSOCIATED.SUBMENU (ARSPECGET AR.SPECS BUTTON.NAME
'ASSOCSUBMENU)
'AR.MENU.LIST
(ARSPECGET AR.SPECS BUTTON.NAME 'MENULIST)))
(SUBMENU (IMAGEOBJPROPS OBJ 'AR.ASSOCIATED.MENU (ARSPECGET AR.SPECS BUTTON.NAME
'ASSOCMENU)
'AR.SUBMENU.LIST
(ARSPECGET AR.SPECS BUTTON.NAME 'SUBMENULIST)))
NIL)
(RETURN OBJ])
(AR.BUTTONFN.DOMENU
[LAMBDA (OBJ SEL WINDOW) (* edited%: "30-Aug-84 09:57")
(PROG [(STREAM (WINDOWPROP WINDOW 'TEXTSTREAM))
(NEWVAL (MENU (AR.BUTTON.GET.MENU OBJ)))
(ASSOC.SUBMENU (IMAGEOBJPROP OBJ 'AR.ASSOCIATED.SUBMENU]
[if [AND NEWVAL (NOT (EQUAL NEWVAL (IMAGEOBJPROP OBJ '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)
'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 '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 '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 'LEFT T])
(AR.CHECK.FIELDS
[LAMBDA (FORMWINDOW) (* edited%: "27-Jul-84 10:49")
(PROG ([TOBJ (TEXTOBJ (WINDOWPROP FORMWINDOW '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 'AR.PROTECTED.FLG)
then (SETQ FIELD.CH# (IPLUS (IMAGEOBJPROP OBJ 'AR.FIELD.START)
CH#))
(SETQ FIELD.LEN (IMAGEOBJPROP OBJ '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 'AR.CHECK.FN)
FORMWINDOW OBJ CH# FIELD.CH# FIELD.LEN)))
(if CHECK.VALUE
then (RETURN (APPEND (LIST "Bad value for field [" (IMAGEOBJPROP OBJ '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 'AR.MENU.LIST))
then (RETURN NIL)
else (IMAGEOBJPROP OBJ '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 'AR.MAX.LEN))
then NIL
else (LIST "max length= " (IMAGEOBJPROP OBJ '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 '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 'AR.SUBMENU.LIST)
(AR.GET.ASSOCIATED.MENU.VAL OBJ FORMWINDOW)))
then (RETURN NIL)
else (IMAGEOBJPROP OBJ 'AR.SUBMENUS NIL)
(IMAGEOBJPROP OBJ '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) (* jds " 7-Nov-86 11:05")
(* ;; "Read thru an AR file, copying its contents to the scratch file, and building an index of where each field's data appears in the scratch file. The index is a list of entries:")
(* ;; " (Field-Name Starting-Fileptr Length)")
(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)
(* ;;
"FIELD.NAME now contains the name of the field, e.g. %"Subject:%" -- yes, including the colon.")
(COND
[(OR (NLISTP INDEX.FIELDS)
(MEMB FIELD.NAME INDEX.FIELDS))(* ;
"Only gather fields that the caller asked about.")
(bind CHAR
do
(* ;; "Copy the field's CONTENTS to the scratch file -- everything up to the next CR.")
(BOUT SCRATCH.STREAM (SELCHARQ (SETQ CHAR (BIN ARSTREAM))
(%'
(* ;
"' is used to escape special characters.")
(BLOCK)
(BIN ARSTREAM))
(CR
(* ;
"There best be TWO CR's at the end of the field")
(RETURN (OR (EQ (BIN ARSTREAM)
(CHARCODE CR))
(ERROR!))))
CHAR)))
(* ;; "INDEX is a list of entries like (FieldName StartingLoc Length) for each field.")
(push INDEX (LIST FIELD.NAME PTR (IDIFFERENCE (GETFILEPTR SCRATCH.STREAM)
PTR]
(T (* ;
"Otherwise, skip over this field -- it's of no interest.")
(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 13-Jan-88 11:15 by ckj")
(* ;; " Delete the value associated with the AR form menu button OBJ.")
(PROG ((STREAM (WINDOWPROP WINDOW 'TEXTSTREAM))
SEL)
(if (IMAGEOBJPROP OBJ 'AR.PROTECTED.FLG)
then (TEDIT.DELETE STREAM (IPLUS (IMAGEOBJPROP OBJ 'AR.FIELD.START)
CH#)
(IMAGEOBJPROP OBJ 'AR.FIELD.LEN)
T)
(IMAGEOBJPROP OBJ 'AR.FIELD.LEN 0)
(IMAGEOBJPROP OBJ '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)
T])
(AR.DISCONNECT.WINDOW
[LAMBDA (FORMWINDOW) (* mjs "17-Feb-85 16:03")
(replace (TEXTOBJ \WINDOW) of (TEXTOBJ (WINDOWPROP FORMWINDOW '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 'MBTEXT]
(RETURN BUTTON])
(AR.FIND.EDIT.CHANGES
[LAMBDA (FORMWINDOW) (* ; "Edited 21-Jan-88 15:59 by ckj")
(PROG ((SCRATCH.STREAM (WINDOWPROP FORMWINDOW 'AR.FORM.SCRATCH.STREAM))
(SCRATCH.MAP (WINDOWPROP FORMWINDOW 'AR.FORM.SCRATCH.MAP))
(FORMSTREAM (WINDOWPROP FORMWINDOW 'TEXTSTREAM))
(CH# 0)
OBJ BUTTON BUTTON.NAME 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 'MBTEXT))
[if (IMAGEOBJPROP OBJ 'AR.PROTECTED.FLG)
then (SETQ FIELD.CH# (IPLUS (IMAGEOBJPROP OBJ 'AR.FIELD.START)
CH#))
(SETQ FIELD.LEN (IMAGEOBJPROP OBJ '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 (OR (CADR SCRATCH.MAP.SPEC)
0))
(SETQ SCRATCH.FIELD.LEN (OR (CADDR SCRATCH.MAP.SPEC)
0))
(if [OR (NOT (= 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 'FIELDTYPE)
'(MENU SUBMENU))
then (push EDIT.CHANGES
(LIST (CONCATCODES (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]
(if (NEQ BUTTON.NAME 'Description%:)
then (* ; "Note the field's new contents for next time around. Don't bother for Description, since that could be long.")
(AR.NOTE.FIELD.CHANGED FORMWINDOW BUTTON FIELD.CH# FIELD.LEN]
(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 '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))
'NAME
'AR.FORM.TEMP])
(AR.FORM.CLEAR
[LAMBDA (FORMWINDOW FILL.INS) (* jds " 7-Nov-86 11:07")
(* ;;; "Create a clean, fresh AR editing window with no data in it.")
(PROG ([TOBJ (TEXTOBJ (WINDOWPROP FORMWINDOW '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 'TEXTSTREAM)
T])
(AR.FORM.CREATE
[LAMBDA (FORMWINDOW BUTTONFONT FORM.SPECS FORM.FORMAT) (* ; "Edited 19-Jan-88 11:39 by ckj")
(PROG [(FORMSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (LIST 'FONT ARFONT 'TEDIT.TENTATIVE NIL)))
(TABS 0)
(TAB.CH# NIL)
(AR.PARALOOKS NIL)
(AR.CHARLOOKS NIL)
(FORMWINDOW.WIDTH (WINDOWPROP FORMWINDOW 'WIDTH]
(WINDOWPROP FORMWINDOW 'AR.FORM.NUMBER NIL)
(WINDOWPROP FORMWINDOW 'AR.FORM.SCRATCH.STREAM NIL)
[for FIELD.OR.SPACE in FORM.FORMAT
do
(BLOCK)
(if (EQ FIELD.OR.SPACE 'TAB)
then (SETQ TAB.CH# (ADD1 (GETFILEPTR FORMSTREAM)))
(BOUT FORMSTREAM (CHARCODE TAB))
(add TABS 1)
elseif (EQ FIELD.OR.SPACE 'CR)
then (if (IGREATERP TABS 0)
then (push AR.PARALOOKS
[LIST 'TABS (CONS NIL (for I from 1 to TABS
bind (TABWIDTH ← (IQUOTIENT
FORMWINDOW.WIDTH
(ADD1 TABS)))
collect (CONS (ITIMES I TABWIDTH)
'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 '(PROTECTED OFF) CH# 1)
(add CH# 1)
(SETFILEPTR FORMSTREAM (SUB1 CH#))
(PRIN1 (IMAGEOBJPROP BUTTON.OBJ 'AR.PRE.FIELD)
FORMSTREAM)
(SETQ PRE.FIELD.NCHARS (IDIFFERENCE (ADD1 (GETFILEPTR FORMSTREAM))
CH#))
(IMAGEOBJPROP BUTTON.OBJ 'AR.FIELD.START (ADD1 PRE.FIELD.NCHARS))
(IMAGEOBJPROP BUTTON.OBJ 'AR.FIELD.LEN 0)
(if (NOT (IMAGEOBJPROP BUTTON.OBJ 'AR.PROTECTED.FLG))
then (push AR.CHARLOOKS '(PROTECTED ON SELECTPOINT ON)
(IPLUS CH# (SUB1 PRE.FIELD.NCHARS))
1))
(PRIN1 (IMAGEOBJPROP BUTTON.OBJ 'AR.POST.FIELD)
FORMSTREAM]
(TEDIT.PARALOOKS FORMSTREAM (LIST 'PARALEADING 2)
1
(GETEOFPTR FORMSTREAM)) (* default char looks%: PROTECTED ON)
(TEDIT.LOOKS FORMSTREAM '(PROTECTED ON) 1 (GETEOFPTR FORMSTREAM))
(while AR.CHARLOOKS bind (LOOKS CH# LEN) do (BLOCK)
(SETQ LOOKS (pop AR.CHARLOOKS))
(SETQ CH# (pop AR.CHARLOOKS))
(SETQ LEN (pop AR.CHARLOOKS))
(TEDIT.LOOKS FORMSTREAM LOOKS CH# LEN))
(while AR.PARALOOKS bind (LOOKS CH# LEN) do (BLOCK)
(SETQ LOOKS (pop AR.PARALOOKS))
(SETQ CH# (pop AR.PARALOOKS))
(SETQ LEN (pop AR.PARALOOKS))
(TEDIT.PARALOOKS FORMSTREAM LOOKS CH# LEN))
(TEDIT.STREAMCHANGEDP FORMSTREAM T)
(PROG ((FORMWINDOW.PROC (WINDOWPROP FORMWINDOW 'PROCESS))
(FORMWINDOW.PROC.NAME (WINDOWPROP FORMWINDOW '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 'SEL SAFE.CH# 'LEAVETTY T 'FONT ARFONT 'TEDIT.TENTATIVE NIL))
[if (WINDOWPROP FORMWINDOW 'AR.TEDIT.READTABLE)
then (push TEDIT.PROCS 'READTABLE (WINDOWPROP FORMWINDOW 'AR.TEDIT.READTABLE]
[if (WINDOWPROP FORMWINDOW 'AR.TEDIT.TITLEMENUFN)
then (push TEDIT.PROCS 'TITLEMENUFN (WINDOWPROP FORMWINDOW 'AR.TEDIT.TITLEMENUFN]
(SETQ NEWPROC (TEDIT FORMSTREAM FORMWINDOW NIL TEDIT.PROCS))
(if FORMWINDOW.PROC.NAME
then (PROCESSPROP NEWPROC 'NAME FORMWINDOW.PROC.NAME])
(AR.FORM.FILL.INS
[LAMBDA NIL (* ckj " 7-Nov-86 18:24")
(PROG ((CURRENT.USER (AR.USERNAME)))
(RETURN (LIST '(Status%: New) (LIST 'Source%: CURRENT.USER)
(LIST 'Submitter%: CURRENT.USER])
(AR.FORM.FILL.INS.DEFAULT
[LAMBDA NIL (* ; "Edited 21-Jan-88 12:23 by ckj")
(PROG NIL
(RETURN (LIST (LIST '|Microcode Version:| (MICROCODEVERSION))
(LIST 'Machine%: (SELECTQ (MACHINETYPE)
(DANDELION 1108)
(DOLPHIN 1100)
(DORADO 1132)
(DOVE 1186)
(PACKC)))
(LIST '|Lisp Version:| (CONCAT MAKESYSNAME " " MAKESYSDATE))
(LIST '|Memory Size:| (REALMEMORYSIZE])
(AR.FORM.GROUP.CREATE
[LAMBDA (INITIAL.NUM) (* ; "Edited 19-Jan-88 13:21 by ckj")
(PROG ((FORMWINDOW (CREATEW (GETREGION 450 60)
"New Bug Report"))
MENUW WREG)
(* * set up main window)
(WINDOWADDPROP FORMWINDOW 'CLOSEFN (FUNCTION AR.KILL.ATTACHED.TEDIT.CLOSEFN))
(WINDOWPROP FORMWINDOW 'MINSIZE (CONS 450 60))
(WINDOWPROP FORMWINDOW 'AR.WINDOW.PROC.NAME 'AR.FORM)
(WINDOWPROP FORMWINDOW 'ICON AR.FORM.ICON)
(* * set up menu window)
(SETQ WREG (WINDOWPROP FORMWINDOW '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 'TOP 'JUSTIFY NIL)
(WINDOWPROP MENUW 'MAXSIZE (CONS 0 40))
(WINDOWPROP MENUW 'MINSIZE (CONS 0 40))
(WINDOWPROP MENUW 'ICON AR.FORM.ICON)
(WINDOWPROP MENUW 'AR.WINDOW.PROC.NAME 'AR.FORM.MENU)
(if (NOT (AND (BOUNDP '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 'AR.TEDIT.READTABLE AR.MENU.READTABLE)
(WINDOWPROP MENUW '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 '((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))
'(New TAB Get TAB Put TAB Number%: TAB CR))
(until (AND (WINDOWPROP FORMWINDOW 'LINES)
(WINDOWPROP MENUW 'LINES)) do (* wait until the two Tedit windows
are totally initialized)
(BLOCK 1000))
(replace (TEXTOBJ MENUFLG) of (TEXTOBJ MENUW) with T)
(REMOVEPROMPTWINDOW MENUW)
(if INITIAL.NUM
then (AR.FORM.MENU.ACTIONFN MENUW 'Get INITIAL.NUM)
else (AR.FORM.MENU.ACTIONFN MENUW 'New])
(AR.FORM.MENU.TITLEMENUFN
[LAMBDA (TEXTSTREAM) (* ckj " 7-Nov-86 18:19")
(PROG (OP)
(if (NOT (AND (BOUNDP 'AR.FORM.MENU.TITLEMENU)
AR.FORM.MENU.TITLEMENU))
then (SETQ AR.FORM.MENU.TITLEMENU (create MENU
ITEMS ← '((Clear 'Clear
"Clears all the fields of the AR"
)
(New 'New
"Clears all fields of the AR, and substitutes default values for some fields"
)
(Get 'Get
"Retrieves the AR whose number is given in the %"Number:%" field"
)
(GetNext 'GetNext
"Gets the next existing AR")
(Put 'Put
"Saves an edited of an AR, or submits a new AR"
)
(Put&GetNext 'Put&GetNext
"Stores the current AR, and Gets the next existing AR"
)
(Put&Get 'Put&Get
"Stores the current AR, and Gets another"
)
(|Get From File| '|Get From File|
"Retrieves AR from named file"
)
(|Put To File| '|Put To File|
"Stores AR into named file")
(FillInDefaults 'FillInDefaults
"Fills in default values for Microcode Version, Machine Type, Lisp Version, and Memory Size"
))
TITLE ← "AR Ops")))
(SETQ OP (MENU AR.FORM.MENU.TITLEMENU))
(if OP
then (AR.FORM.MENU.ACTIONFN (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ TEXTSTREAM)))
OP])
(AR.JUST.GET.SUBMIT.NUM
[LAMBDA (FORMWINDOW) (* ckj "20-Nov-86 12:09")
(* ;; "returns number of next new AR to be submitted or NIL")
(PROG ((SUBMIT.NUM.FILE NIL)
VAL CURR.NEXT.NUM)
(COND
((NOT (INFILEP AR.SUBMIT.NUM.FILE.NAME))
(RETURN NIL)))
(for X from 1 to 10 until [PROGN
(* ;; "Try 10 times to open the %"next-AR-#%" file and read the number.")
(AND (NOT (OPENP AR.SUBMIT.NUM.FILE.NAME))
(SETQ SUBMIT.NUM.FILE
(CAR (NLSETQ (OPENSTREAM AR.SUBMIT.NUM.FILE.NAME
'BOTH
'OLD
'((DON'T.CACHE T)
(DON'TCACHE T]
do (AR.PROMPT (LIST "submit number file busy: " AR.SUBMIT.NUM.FILE.NAME
"- - - please wait")
FORMWINDOW)
(DISMISS 5000))
(COND
((NULL SUBMIT.NUM.FILE) (* ;
"Didn't succeed at opening the file. Punt.")
(RETURN NIL)))
[SETQ VAL (NLSETQ (PROGN (SETFILEPTR SUBMIT.NUM.FILE 0)
(SETQ CURR.NEXT.NUM (READ SUBMIT.NUM.FILE FILERDTBL))
(COND
((NOT (FIXP CURR.NEXT.NUM))
(ERROR!]
(CLOSEF SUBMIT.NUM.FILE)
(COND
(VAL (RETURN CURR.NEXT.NUM))
(T (RETURN NIL])
(AR.JUST.PRINT.AR.NUM
[LAMBDA (WINDOW CURR.NUM) (* ckj " 5-May-86 14:04")
(PROG ([TOBJ (TEXTOBJ (WINDOWPROP WINDOW 'TEXTSTREAM]
(CH# 0)
(BUTTON.NAME 'Number%:)
OBJ BUTTON SEL)
[while (PROGN (add CH# 1)
(SETQ BUTTON (MBUTTON.FIND.NEXT.BUTTON TOBJ CH#)))
do (SETQ OBJ (CAR BUTTON))
(SETQ CH# (CDR BUTTON)) repeatuntil (EQ BUTTON.NAME (IMAGEOBJPROP OBJ 'MBTEXT]
(RETURN (if BUTTON
then (MBUTTON.SET.FIELD TOBJ 'Number%: CURR.NUM)
else (ERROR "Can't find named button" BUTTON.NAME])
(AR.KILL.ATTACHED.TEDIT.CLOSEFN
[LAMBDA (WINDOW) (* edited%: "30-Aug-84 09:58")
(for AW in (ATTACHEDWINDOWS WINDOW) bind TSTREAM when (SETQ TSTREAM (WINDOWPROP AW 'TEXTSTREAM))
do (DETACHWINDOW AW)
(TEDIT.KILL (TEXTOBJ TSTREAM))
(CLOSEW AW) finally (if (SETQ TSTREAM (WINDOWPROP WINDOW 'TEXTSTREAM))
then (TEDIT.KILL (TEXTOBJ TSTREAM])
(AR.NOTE.FIELD.CHANGED
[LAMBDA (FORMWINDOW BUTTON FIELD.CH# FIELD.LEN) (* ; "Edited 21-Jan-88 16:08 by ckj")
(* ;; "Updates FORMWINDOW's %"original%" AR scratch stream with the contents of the new field, so that if we put again, we don't get the field looking changed twice. If FIELD.CH# is NIL, we'll compute it from the button, which must be an unprotected button.")
(LET ((SCRATCH.STREAM (WINDOWPROP FORMWINDOW 'AR.FORM.SCRATCH.STREAM))
(SCRATCH.MAP (WINDOWPROP FORMWINDOW 'AR.FORM.SCRATCH.MAP))
(FORMSTREAM (WINDOWPROP FORMWINDOW 'TEXTSTREAM))
(OBJ (CAR BUTTON))
SEL)
[if (NOT FIELD.CH#)
then (if (IMAGEOBJPROP OBJ 'AR.PROTECTED.FLG)
then (SETQ FIELD.CH# (IPLUS (IMAGEOBJPROP OBJ 'AR.FIELD.START)
(CDR BUTTON)))
(SETQ FIELD.LEN (IMAGEOBJPROP OBJ 'AR.FIELD.LEN))
else (SETQ SEL (MBUTTON.FIND.NEXT.FIELD (TEXTOBJ FORMSTREAM)
(CDR BUTTON)))
(SETQ FIELD.CH# (fetch (SELECTION CH#) of SEL))
(SETQ FIELD.LEN (fetch (SELECTION DCH) of SEL]
(SETFILEPTR SCRATCH.STREAM -1)
(NLSETQ (* ;
"Wrap in NLSETQ in case the COPYBYTES complains about non-ascii in the text stream")
(PUTASSOC (IMAGEOBJPROP OBJ 'MBTEXT)
(PROG1 (LIST (GETFILEPTR SCRATCH.STREAM)
FIELD.LEN)
(SETFILEPTR FORMSTREAM (SUB1 FIELD.CH#))
(COPYBYTES FORMSTREAM SCRATCH.STREAM FIELD.LEN))
SCRATCH.MAP])
(AR.FORM.MENU.ACTIONFN
[LAMBDA (MENUWINDOW OPERATION NUM.FOR.GET) (* ; "Edited 21-Jan-88 19:22 by ckj")
(ALLOW.BUTTON.EVENTS)
(PROG ((MENUWINDOW.TEXTOBJ (WINDOWPROP MENUWINDOW 'TEXTOBJ))
(FORMWINDOW (WINDOWPROP MENUWINDOW 'MAINWINDOW))
FORMWINDOW.TEXTOBJ)
(DECLARE (SPECVARS MENUWINDOW.TEXTOBJ FORMWINDOW FORMWINDOW.TEXTOBJ))
(SETQ FORMWINDOW.TEXTOBJ (WINDOWPROP FORMWINDOW 'TEXTOBJ))
(if (OR (NOT (WINDOWPROP FORMWINDOW '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 'PAINT MENUWINDOW)
(CLEARW FORMWINDOW)
(AR.DISCONNECT.WINDOW FORMWINDOW)
(AR.PROMPT (LIST OPERATION " initiated...")
FORMWINDOW)
(NLSETQ (SELECTQ OPERATION
(Clear (AR.MENU.FN.CLEAR FORMWINDOW))
(New (AR.MENU.FN.CLEAR FORMWINDOW (AR.FORM.FILL.INS)))
(GetNext (AR.GET.NEXT FORMWINDOW))
(Get [AR.MENU.FN.GET FORMWINDOW (if NUM.FOR.GET
else (MKATOM (AR.GET.BUTTON.FIELD.AS.TEXT
MENUWINDOW
'Number%:])
(Put (AR.MENU.FN.PUT FORMWINDOW))
(Put&GetNext (PROGN (AR.MENU.FN.PUT FORMWINDOW)
(AR.GET.NEXT FORMWINDOW)))
(Put&Get (PROG ((NUM (RNUMBER)))
(AR.MENU.FN.PUT FORMWINDOW)
(AR.MENU.FN.GET FORMWINDOW NUM)))
((|Get From File| |Put To File|)
(AR.PROMPT "" FORMWINDOW)
(PROG [(FILE (MKATOM (PROMPTFORWORD (if (EQ OPERATION '|Get From File|)
then "Get File: "
else "Put File: ")
(WINDOWPROP FORMWINDOW 'AR.GET/PUT.FILE.NAME)
NIL
(GETPROMPTWINDOW FORMWINDOW]
(if (NULL FILE)
then (RETURN))
(WINDOWPROP FORMWINDOW 'AR.GET/PUT.FILE.NAME FILE)
(if (EQ OPERATION '|Get From File|)
then (AR.GET.AR FORMWINDOW FILE)
else (AR.FORM.SAVE FORMWINDOW FILE))))
(FillInDefaults
(AR.REPLACE.FILL.INS FORMWINDOW (AR.FORM.FILL.INS.DEFAULT))
(AR.PROMPT (LIST OPERATION " completed")
FORMWINDOW))
(AR.PROMPT "Unknown AR.FORM button name!" FORMWINDOW)))
(AR.MARK.ACTIVE MENUWINDOW.TEXTOBJ NIL)
(AR.MARK.ACTIVE FORMWINDOW.TEXTOBJ NIL)
(REDISPLAYW MENUWINDOW)
(AR.RECONNECT.WINDOW FORMWINDOW)
(SCROLLW FORMWINDOW 0.0 0.0])
(AR.FORM.MENU.BUTTONFN
[LAMBDA (OBJ SEL WINDOW) (* jds "14-Feb-85 10:43")
(AR.FORM.MENU.ACTIONFN (\TEDIT.PRIMARYW (fetch (SELECTION \TEXTOBJ) of SEL))
(IMAGEOBJPROP OBJ 'MBTEXT])
(AR.FORM.SAVE
[LAMBDA (FORMWINDOW FILENAME) (* ; "Edited 14-Jan-88 15:03 by ckj")
(* ;; "Save the contents of an AR window into an AR file.")
(PROG ((OUTSTREAM (OPENSTREAM FILENAME 'OUTPUT 'NEW))
OUTSTREAMNAME)
(DECLARE (SPECVARS OUTSTREAM OUTSTREAMNAME))
(SETQ OUTSTREAMNAME (FULLNAME OUTSTREAM))
(RESETLST [RESETSAVE NIL (LIST (FUNCTION (LAMBDA NIL
(COND
(RESETSTATE (COND
((OPENP OUTSTREAM)
(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#)))
(COND
((NULL CH#)
(CLOSEF OUTSTREAM)
(RETURN)))
(SETFILEPTR FORMSTREAM (SUB1 CH#))
(SETQ BUTTON.OBJ (BIN FORMSTREAM))
(* ;; "Print out the name of the field:")
(PRIN1 (IMAGEOBJPROP BUTTON.OBJ 'MBTEXT)
OUTSTREAM) (* ; "Because the ARFile->WIndow code does its own char-by-char reading, we DON'T want a readtable-driven print here.")
(BOUT OUTSTREAM (CHARCODE SPACE))
[COND
[(IMAGEOBJPROP BUTTON.OBJ 'AR.PROTECTED.FLG)
(SETQ FIELD.START (IPLUS (IMAGEOBJPROP BUTTON.OBJ 'AR.FIELD.START)
CH#))
(SETQ FIELD.LEN (IMAGEOBJPROP BUTTON.OBJ 'AR.FIELD.LEN]
(T (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))
(COND
((NOT (FIXP C))
(AR.PROMPT (LIST "non-char found in " (IMAGEOBJPROP BUTTON.OBJ
'MBTEXT)
" field -- ignored")
FORMWINDOW))
((FMEMB C (CHARCODE (CR %: "'")))
(BLOCK)
(BOUT OUTSTREAM (CHARCODE "'"))
(BOUT OUTSTREAM C))
(T (BOUT OUTSTREAM C]
(TERPRI OUTSTREAM)
(TERPRI OUTSTREAM)
(SETQ CH# (ADD1 CH#))
(GO loop)))
(RETURN OUTSTREAMNAME])
(AR.GET.AR
[LAMBDA (FORMWINDOW NUM/OR/FILE) (* ; "Edited 14-Jan-88 09:39 by ckj")
(* ;; "Get an AR into the AR editing window.")
(PROG (LOAD.ERROR FILE ARSTREAM)
[SETQ FILE (COND
((NUMBERP NUM/OR/FILE)
(AR.GET.FILENAME NUM/OR/FILE NIL))
(T (FULLNAME NUM/OR/FILE] (* ;
"The file to be loading the AR from")
[COND
((NULL FILE)
(AR.PROMPT (LIST "Bad file number: " NUM/OR/FILE " --- Get aborted")
FORMWINDOW)
(RETURN 'NO.FILE]
(SETQ LOAD.ERROR (COND
((OPENP FILE)
(LET ((*PRINT-BASE* 10))
(LIST "The file for AR " NUM/OR/FILE
" is already open --- Get aborted")))
([NULL (NLSETQ (SETQ ARSTREAM (OPENSTREAM FILE 'INPUT 'OLD]
(LET ((*PRINT-BASE* 10))
(LIST "AR " NUM/OR/FILE " doesn't exist -- Get aborted")))
((NULL (NLSETQ (AR.SCRATCH.LOAD FORMWINDOW ARSTREAM)))
(LIST "UNKNOWN LOAD ERROR --- Get aborted"))
(T NIL)))
(COND
((AND ARSTREAM (OPENP ARSTREAM))
(CLOSEF ARSTREAM)))
(COND
(LOAD.ERROR (AR.PROMPT LOAD.ERROR FORMWINDOW)
(RETURN LOAD.ERROR)))
(* ;; "Now try filling in the AR from from the info we've cached.")
(COND
([OR (NULL (NLSETQ (AR.FORM.CLEAR FORMWINDOW)))
(NULL (NLSETQ (AR.TEXTSTREAM.LOAD FORMWINDOW]
(AR.PROMPT "UNKNOWN SCRATCH COPY ERROR --- form in inconsistant state --- Get aborted"
FORMWINDOW)
(LET ((*PRINT-BASE* 10))
(WINDOWPROP FORMWINDOW 'AR.FORM.NUMBER NIL))
(WINDOWPROP FORMWINDOW 'TITLE "--- form inconsistant --- Please GET or NEW"))
(T [LET ((*PRINT-BASE* 10))
(WINDOWPROP FORMWINDOW 'AR.FORM.NUMBER (COND
((NUMBERP NUM/OR/FILE)
NUM/OR/FILE)
(T NIL]
(LET ((*PRINT-BASE* 10))
(WINDOWPROP FORMWINDOW '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 'TEXTSTREAM)
(IMAGEOBJPROP OBJ 'AR.ASSOCIATED.MENU]
[if (NULL BUTTON)
then (ERROR "Can't find associated menu value" (IMAGEOBJPROP OBJ 'AR.ASSOCIATED.MENU]
(RETURN (IMAGEOBJPROP (CAR BUTTON)
'AR.FIELD.VALUE])
(AR.GET.BUTTON.FIELD.AS.TEXT
[LAMBDA (WINDOW BUTTON.NAME) (* ; "Edited 5-Feb-88 19:40 by ckj")
(* ;; "Given a button name and an AR form window, grab the value of the named button and return it as a string or symbol.")
(PROG ([TOBJ (TEXTOBJ (WINDOWPROP WINDOW '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 'MBTEXT]
(RETURN (COND
[BUTTON (COND
((OR (IMAGEOBJPROP OBJ 'AR.MENU.LIST)
(IMAGEOBJPROP OBJ 'AR.SUBMENU.LIST))
(* ;
"This is a multiple-choice button. Extract the value from the button itself. ")
(IMAGEOBJPROP OBJ 'AR.FIELD.VALUE))
(T (* ;
"This is a text button. Go looking for the next field and grab it from there.")
(MBUTTON.NEXT.FIELD.AS.TEXT TOBJ CH#]
(T (ERROR "Can't find named button" BUTTON.NAME])
(AR.GET.MENU.FROM.MAIN.WINDOW
[LAMBDA (FORMWINDOW) (* ckj " 1-May-86 17:10")
(PROG* ((ATTACHEDWINDOWS (ALLATTACHEDWINDOWS FORMWINDOW))
(NUMWINDOWS (LENGTH ATTACHEDWINDOWS)))
(if (EQ NUMWINDOWS 2)
then (SETQ ATTACHEDWINDOWS (CAR ATTACHEDWINDOWS)))
(RETURN ATTACHEDWINDOWS])
(AR.GET.NEXT
[LAMBDA (FORMWINDOW) (* ; "Edited 14-Jan-88 09:39 by ckj")
(* ;; "Gets the next (existing) AR in numeric order after the one now in the window.")
(PROG ((AR.LIMIT (AR.JUST.GET.SUBMIT.NUM FORMWINDOW))
(AR.NEXT.NUM (WINDOWPROP FORMWINDOW 'AR.FORM.NUMBER))
ARDONEFLG ARSTREAM)
(* ;; "AR.LIMIT is the highest-known AR number so far.")
(do
(* ;; "Keep going until we find a real AR.")
(SETQ AR.NEXT.NUM (ADD1 AR.NEXT.NUM))
(COND
((EQP AR.NEXT.NUM AR.LIMIT) (* ;
"next AR number is equal to the number to be assigned to the next AR submitted")
(AR.PROMPT "Next AR hasn't been submitted yet" FORMWINDOW)
(SETQ ARDONEFLG T)))
(COND
([NLSETQ (SETQ ARSTREAM (OPENSTREAM (AR.FILENAME AR.NEXT.NUM)
'INPUT
'OLD] (* ; "ar exists. Get it.")
(CLOSEF ARSTREAM)
(AR.MENU.FN.GET FORMWINDOW AR.NEXT.NUM)
(RETURN NIL)))
[COND
((NULL ARDONEFLG) (* ;
"AR doesn't exist, increment next AR number and try again")
(LET ((*PRINT-BASE 10))
(AR.PROMPT (LIST "ar #" AR.NEXT.NUM " doesn't exist, checking next ar")
FORMWINDOW)
(PRINTOUT NIL "ar #" AR.NEXT.NUM " doesn't exist, checking next ar" T]
until (OR ARDONEFLG])
(AR.GET.SUBMIT.NUM
[LAMBDA (FORMWINDOW) (* ckj "20-Oct-86 18:06")
(PROG ((SUBMIT.NUM.FILE NIL)
VAL CURR.NEXT.NUM)
(if (NOT (INFILEP AR.SUBMIT.NUM.FILE.NAME))
then (RETURN NIL))
(for X from 1 to 10 until [AND (NOT (OPENP AR.SUBMIT.NUM.FILE.NAME))
(SETQ SUBMIT.NUM.FILE
(CAR (NLSETQ (OPENSTREAM AR.SUBMIT.NUM.FILE.NAME
'BOTH
'OLD
'((DON'T.CACHE T)
(DON'TCACHE T]
do (AR.PROMPT (LIST "submit number file busy: " AR.SUBMIT.NUM.FILE.NAME
" --- please wait")
FORMWINDOW)
(DISMISS 5000))
(if (NULL SUBMIT.NUM.FILE)
then (RETURN NIL))
[SETQ VAL (NLSETQ (PROGN (SETFILEPTR SUBMIT.NUM.FILE 0)
(SETQ CURR.NEXT.NUM (READ SUBMIT.NUM.FILE FILERDTBL))
(if (NOT (FIXP CURR.NEXT.NUM))
then (ERROR!))
(SETFILEPTR SUBMIT.NUM.FILE 0)
(PRINT (ADD1 CURR.NEXT.NUM)
SUBMIT.NUM.FILE FILERDTBL]
(CLOSEF SUBMIT.NUM.FILE)
(if VAL
then (RETURN CURR.NEXT.NUM)
else (RETURN NIL])
(AR.GET.BUTTON.FIELD.AS.LIST
[LAMBDA (FORMWINDOW FIELD.NAME) (* ; "Edited 21-Jan-88 16:50 by ckj")
(bind READ.VAL (STR ← (OPENSTRINGSTREAM (AR.GET.BUTTON.FIELD.AS.TEXT FORMWINDOW FIELD.NAME)))
while (SETQ READ.VAL (NLSETQ (READ STR FILERDTBL))) collect (CAR READ.VAL])
(AR.GET.FILENAME
[LAMBDA (NUM PUTFLG) (* jds " 7-Nov-86 10:48")
(* ;; "Convert from an AR number to the corresponding file name")
(* ;;; "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))")
(COND
((FIXP NUM)
(AR.FILENAME NUM))
(T 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)
'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 'AR.FORM.NUMBER NIL)
(AR.FORM.CLEAR FORMWINDOW FILL.INS)
(WINDOWPROP FORMWINDOW 'TITLE "New Bug Report")
(AR.PROMPT "New form cleared" FORMWINDOW])
(AR.MENU.FN.GET
[LAMBDA (FORMWINDOW CURR.NUM) (* ; "Edited 21-Jan-88 11:20 by ckj")
(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)))
(LET ((*PRINT-BASE* 10))
(AR.PROMPT (LIST "Retrieving AR " CURR.NUM " ...")
FORMWINDOW))
(if (AR.GET.AR FORMWINDOW CURR.NUM)
then (SETQ BAD.GET T))
else (LET ((*PRINT-BASE* 10))
(AR.PROMPT (LIST "Bad number %"" CURR.NUM "%" -- Get aborted")
FORMWINDOW))
(SETQ BAD.GET T))
(if (NOT BAD.GET)
then (LET ((*PRINT-BASE* 10))
(AR.PROMPT (LIST "AR " CURR.NUM " retrieved")
FORMWINDOW)
(AR.JUST.PRINT.AR.NUM (AR.GET.MENU.FROM.MAIN.WINDOW FORMWINDOW)
CURR.NUM])
(AR.MENU.FN.PUT
[LAMBDA (FORMWINDOW) (* ; "Edited 21-Jan-88 15:59 by ckj")
(PROG ((*PRINT-BASE* 10)
(CURR.NUM (WINDOWPROP FORMWINDOW 'AR.FORM.NUMBER))
FILE CHECK.VALUE SAVE.VALUE EDIT.CHANGES.LIST EDIT.CHANGES.STRING SUBMIT.NUM)
(if (NOT (TEDIT.STREAMCHANGEDP FORMWINDOW))
then (if (NULL (AR.CONFIRM "Form has NOT been changed --- confirm PUT" FORMWINDOW))
then (AR.PROMPT "Put aborted" FORMWINDOW)
(RETURN)))
[if CURR.NUM
then (SETQ EDIT.CHANGES.LIST (LIST* (AR.USERNAME)
(DATE)
(AR.FIND.EDIT.CHANGES FORMWINDOW)))
(LET ((TSTREAM (TEXTSTREAM FORMWINDOW))
(BUTTON (AR.FIND.BUTTON FORMWINDOW 'Disposition%:))
SEL)
(if (OR (NULL BUTTON)
(IMAGEOBJPROP (CAR BUTTON)
'AR.PROTECTED.FLG))
then (SHOULDNT "Bad Disposition field -- can't insert edit marks"))
(SETQ SEL (MBUTTON.FIND.NEXT.FIELD (TEXTOBJ TSTREAM)
(CDR BUTTON)))
(SETQ EDIT.CHANGES.STRING
(CONCAT "
[" [CONCATLIST (for X on EDIT.CHANGES.LIST join (CONS (CAR X)
(AND (CDR X)
(NLISTP (CADR X))
(LIST " "]
"]")) (* ;
"EDIT.CHANGES.LIST has atoms, strings, and lists, the latter denoting a menu item change")
(TEDIT.INSERT TSTREAM EDIT.CHANGES.STRING (IPLUS (fetch (SELECTION CH#)
of SEL)
(fetch (SELECTION DCH)
of SEL))
NIL T)
(AR.NOTE.FIELD.CHANGED FORMWINDOW BUTTON))
[AR.REPLACE.FILL.INS FORMWINDOW (LIST (LIST 'Edit-By%: (AR.USERNAME))
(LIST 'Edit-Date%: (DATE]
(AR.NOTE.FIELD.CHANGED FORMWINDOW (AR.FIND.BUTTON FORMWINDOW 'Edit-By%:))
(AR.NOTE.FIELD.CHANGED FORMWINDOW (AR.FIND.BUTTON FORMWINDOW 'Edit-Date%:))
else (AR.PROMPT "Getting Submit number..." FORMWINDOW)
(SETQ SUBMIT.NUM (AR.GET.SUBMIT.NUM FORMWINDOW))
(if SUBMIT.NUM
then (AR.REPLACE.FILL.INS FORMWINDOW (LIST (LIST 'Number%: SUBMIT.NUM)))
else (AR.PUT.FAILED "Can't get AR submit number --- Put Aborted --- Try again"
FORMWINDOW)
(RETURN))
(AR.REPLACE.FILL.INS FORMWINDOW (LIST (LIST 'Date%: (DATE]
(if (SETQ CHECK.VALUE (AR.CHECK.FIELDS FORMWINDOW))
then (AR.PUT.FAILED (CONCAT "Bad bug report form: " CHECK.VALUE " --- Put Aborted")
FORMWINDOW)
(RETURN))
(AR.PROMPT "Updating TDS file..." FORMWINDOW)
(if [NULL (NLSETQ (if CURR.NUM
then (AR.UPDATE.AR.INFO FORMWINDOW 'EDIT CURR.NUM EDIT.CHANGES.LIST)
else (AR.UPDATE.AR.INFO FORMWINDOW 'SUBMIT SUBMIT.NUM (LIST (
AR.USERNAME
)
(DATE]
then (AR.PUT.FAILED "Cannot update TDS file --- Put aborted -- try again" FORMWINDOW)
(RETURN))
(CLEARW FORMWINDOW)
[if CURR.NUM
then (AR.PROMPT (LIST "Saving AR " CURR.NUM " ...")
FORMWINDOW)
(SETQ SAVE.VALUE (AR.FORM.SAVE FORMWINDOW (AR.GET.FILENAME CURR.NUM T)))
else (AR.PROMPT "Submitting AR ..." FORMWINDOW)
(SETQ SAVE.VALUE (AR.FORM.SAVE FORMWINDOW (AR.GET.FILENAME SUBMIT.NUM T]
(TEDIT.STREAMCHANGEDP FORMWINDOW T)
(if SAVE.VALUE
then (if CURR.NUM
then (AR.PROMPT (LIST "Saved AR " CURR.NUM)
FORMWINDOW)
(WINDOWPROP FORMWINDOW 'TITLE (CONCAT "Editing AR " CURR.NUM
" --- saved"))
(AR.JUST.PRINT.AR.NUM (AR.GET.MENU.FROM.MAIN.WINDOW FORMWINDOW)
CURR.NUM)
(AR.SEND.MESSAGE FORMWINDOW 'EDIT CURR.NUM EDIT.CHANGES.STRING)
else (AR.PROMPT (LIST "Bug Report Submitted -- AR # " SUBMIT.NUM)
FORMWINDOW) (* make sure that noone tries
accessing the scratch stream)
(WINDOWPROP FORMWINDOW 'AR.FORM.SCRATCH.MAP NIL)
(WINDOWPROP FORMWINDOW 'AR.FORM.NUMBER SUBMIT.NUM)
(WINDOWPROP FORMWINDOW 'TITLE (CONCAT "Editing AR " SUBMIT.NUM
" --- saved"))
(AR.JUST.PRINT.AR.NUM (AR.GET.MENU.FROM.MAIN.WINDOW FORMWINDOW)
SUBMIT.NUM)
(AR.SEND.MESSAGE FORMWINDOW 'SUBMIT SUBMIT.NUM))
else (AR.PUT.FAILED "Unknown bug -- AR not saved -- try again" FORMWINDOW))
(REDISPLAYW FORMWINDOW])
(AR.PRINT.PADDED
[LAMBDA (STR STREAM START LEN PRINTWIDTH) (* ; "Edited 21-Jan-88 16:36 by ckj")
(* ;; "Given a string or symbol to print, print characters from it, starting with char START, going for LEN, and trimming to fit PRINTWIDTH, or padding to fit that width with blanks on the right, as needed.")
(LET* [(GOODSTREAM (\GETSTREAM STREAM 'OUTPUT))
[BASE (COND
((STRINGP STR)
(ffetch (STRINGP BASE) of STR))
((LITATOM STR)
(ffetch (LITATOM PNAMEBASE) of STR]
[REALLEN (IMIN LEN PRINTWIDTH (- (COND
((STRINGP STR)
(ffetch (STRINGP LENGTH) of STR))
((LITATOM STR)
(ffetch (PNAMEBASE PNAMELENGTH) of BASE)))
(SUB1 START]
[START-OFFSET (+ (SUB1 START)
(COND
((STRINGP STR)
(ffetch (STRINGP OFFST) of STR))
((LITATOM STR)
1]
(FATP (COND
((STRINGP STR)
(ffetch (STRINGP FATSTRINGP) of STR))
((LITATOM STR)
(ffetch (LITATOM FATPNAMEP) of STR]
(for OFFSET from START-OFFSET to (+ START-OFFSET REALLEN -1)
do
(* ;; "Print the characters")
(\OUTCHAR GOODSTREAM (\GETBASECHAR FATP BASE OFFSET)))
(SPACES (- PRINTWIDTH REALLEN)
GOODSTREAM])
(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 'MBTEXT)
"%" is protected from editing")
WINDOW])
(AR.PUT.FAILED
[LAMBDA (MSG FORMWINDOW) (* ; "Edited 14-Jan-88 12:24 by ckj")
(RINGBELLS)
(FLASHWINDOW FORMWINDOW 1)
(AR.PROMPT (MKLIST MSG)
FORMWINDOW)
(WINDOWPROP FORMWINDOW 'TITLE (MKSTRING MSG])
(AR.RECONNECT.WINDOW
[LAMBDA (FORMWINDOW) (* ; "Edited 20-Jan-88 16:38 by ckj")
(PROG [(TOBJ (TEXTOBJ (WINDOWPROP FORMWINDOW 'TEXTSTREAM]
(replace (TEXTOBJ \WINDOW) of TOBJ with (LIST FORMWINDOW))
(replace (LINEDESCRIPTOR NEXTLINE) of (CAR (fetch (TEXTOBJ LINES) of TOBJ)) with NIL)
[\TEDIT.MARK.LINES.DIRTY TOBJ 1 (ADD1 (GETEOFPTR (WINDOWPROP FORMWINDOW 'TEXTSTREAM]
(TEDIT.UPDATE.SCREEN TOBJ])
(AR.REPLACE.FIELD.VAL
[LAMBDA (OBJ CH# WINDOW NEWVAL) (* ; "Edited 14-Jan-88 09:42 by ckj")
(DECLARE (SPECVARS OBJ CH# WINDOW NEWVAL))
(LET ((*PRINT-BASE* 10))
(PROG ((STREAM (TEXTSTREAM WINDOW))
(NEWVAL.NCHARS (NCHARS NEWVAL))
INSERT.CH# SEL)
(if (IMAGEOBJPROP OBJ 'AR.PROTECTED.FLG)
then (SETQ INSERT.CH# (IPLUS (IMAGEOBJPROP OBJ 'AR.FIELD.START)
CH#))
(TEDIT.DELETE STREAM INSERT.CH# (IMAGEOBJPROP OBJ '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 '(PROTECTED ON) INSERT.CH# NEWVAL.NCHARS))
(IMAGEOBJPROP OBJ 'AR.FIELD.LEN NEWVAL.NCHARS)
(IMAGEOBJPROP OBJ '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 '(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 'TEXTSTREAM)
(AR.FIND.UNPROTECTED.CH# (WINDOWPROP WINDOW 'TEXTSTREAM))
0
'LEFT])
(AR.SCRATCH.LOAD
[LAMBDA (FORMWINDOW ARSTREAM) (* jds " 7-Nov-86 11:06")
(* ;; "Given an open stream on an AR, copy the contents to the scratch file associated with this AR editing window. Save the index of Field name -> filepos on the window.")
(PROG [(SCRATCH.STREAM (WINDOWPROP FORMWINDOW 'AR.FORM.SCRATCH.STREAM]
[COND
((NOT (AND SCRATCH.STREAM (OPENP SCRATCH.STREAM)))
(WINDOWPROP FORMWINDOW 'AR.FORM.SCRATCH.STREAM (SETQ SCRATCH.STREAM (OPENSTREAM
'{NODIRCORE}
'BOTH
'NEW]
(SETFILEPTR SCRATCH.STREAM 0)
(SETFILEPTR ARSTREAM 0)
(WINDOWPROP FORMWINDOW 'AR.FORM.SCRATCH.MAP (AR.COPY.AND.INDEX.AR ARSTREAM SCRATCH.STREAM])
(AR.SEND.MESSAGE
[LAMBDA (FORMWINDOW OPERATION NUM EDIT.CHANGES.STRING) (* ; "Edited 14-Jan-88 18:19 by ckj")
(* ;; "Send a message describing what just got done to this AR.")
(PROG (RECIPIENTS TXT SUBM)
(COND
(AR.NO.MESSAGE.FLG (RETURN)))
(COND
((OR (NOT (GETD 'LAFITEMODE))
(NOT (LAFITEMODE)))
(PROMPTPRINT "Can't send AR message -- LAFITE not turned on")
(RETURN)))
(SETQ RECIPIENTS (AR.GET.BUTTON.FIELD.AS.TEXT FORMWINDOW 'Attn%:))
(SETQ SUBM (AR.GET.BUTTON.FIELD.AS.TEXT FORMWINDOW 'Submitter%:))
(COND
((AND (EQ OPERATION 'EDIT)
(EQUAL RECIPIENTS "")
(NOT (EQUAL SUBM "")))
(SETQ RECIPIENTS SUBM)
(SETQ SUBM "")))
(COND
((EQUAL RECIPIENTS "")
(SETQ RECIPIENTS ">>Recipients<<")))
(SETQ TXT (OPENTEXTSTREAM "" NIL NIL NIL (LIST 'FONT LAFITEEDITORFONT)))
(LINELENGTH MAX.SMALLP TXT)
[LET ((*PRINT-BASE* 10))
(printout TXT "Subject: " (COND
((EQ OPERATION 'SUBMIT)
"Submitted AR ")
(T "Edited AR "))
(COND
(NUM)
(T "<unknown number>"]
(printout TXT ": " (AR.GET.BUTTON.FIELD.AS.TEXT FORMWINDOW 'Subject%:)
T "To: " RECIPIENTS T)
(COND
((AND (EQ OPERATION 'EDIT)
(NOT (EQUAL SUBM ""))) (* ; "CC the submitter on edits.")
(PRINTOUT TXT "CC: " SUBM T)))
(printout TXT T (COND
((EQ OPERATION 'SUBMIT)
(AR.GET.BUTTON.FIELD.AS.TEXT FORMWINDOW 'Description%:))
(T EDIT.CHANGES.STRING))
T T)
(ADD.PROCESS [LIST (FUNCTION \SENDMESSAGE)
(KWOTE TXT)
''(LEAVETTY T]
'NAME
'MESSAGESENDER])
(AR.TEXTSTREAM.LOAD
[LAMBDA (FORMWINDOW FILL.INS) (* ; "Edited 13-Jan-88 11:20 by ckj")
(PROG ((SCRATCH.STREAM (WINDOWPROP FORMWINDOW 'AR.FORM.SCRATCH.STREAM))
(SCRATCH.MAP (WINDOWPROP FORMWINDOW 'AR.FORM.SCRATCH.MAP))
(FORMSTREAM (WINDOWPROP FORMWINDOW '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
(* ;; "Run thru the buttons in the AR form, filling in data for each one.")
(BLOCK)
(SETQ OBJ (CAR BUTTON))
(SETQ CH# (CDR BUTTON))
(SETQ PROTECT.FIELD.FLG (IMAGEOBJPROP OBJ 'AR.PROTECTED.FLG))
[COND
(PROTECT.FIELD.FLG (SETQ FIELD.CH# (IPLUS (IMAGEOBJPROP OBJ 'AR.FIELD.START)
CH#)))
(T (SETQ SEL (MBUTTON.FIND.NEXT.FIELD TOBJ CH#))
(COND
((NULL SEL)
(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 'MBTEXT)
SCRATCH.MAP))
(COND
((NULL SCRATCH.MAP.SPEC)
(HELP "Null scratch map spec")
(IMAGEOBJPROP OBJ 'AR.FIELD.VALUE NIL))
(T (* ;
"Copy the field's contents from the scratch file into the form.")
(SETQ SCRATCH.PTR (CADR SCRATCH.MAP.SPEC))
(SETQ FIELD.LEN (CADDR SCRATCH.MAP.SPEC))
(TEDIT.SETSEL FORMSTREAM FIELD.CH# 0 'LEFT NIL T)
[COND
((IGREATERP FIELD.LEN 0)
(TEDIT.RAW.INCLUDE FORMSTREAM SCRATCH.STREAM SCRATCH.PTR (IPLUS SCRATCH.PTR
FIELD.LEN]
[COND
(PROTECT.FIELD.FLG (IMAGEOBJPROP OBJ 'AR.FIELD.LEN FIELD.LEN)
(IMAGEOBJPROP OBJ 'AR.FIELD.VALUE
(PROGN (SETFILEPTR SCRATCH.STREAM SCRATCH.PTR)
(PACKC (for X from 1 to FIELD.LEN
collect (BIN SCRATCH.STREAM]
(COND
((NOT (EQP FIELD.LEN 0)) (* ;
"And protect the contents from tampering")
(TEDIT.LOOKS FORMSTREAM [COND
(PROTECT.FIELD.FLG '(PROTECTED ON))
(T '(PROTECTED OFF]
FIELD.CH# FIELD.LEN]
(AR.REPLACE.FILL.INS FORMWINDOW FILL.INS)
(TEDIT.STREAMCHANGEDP (WINDOWPROP FORMWINDOW '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-Jan-88 15:03 by ckj")
(* ;; "Write into the TDS file a description of what happened to this AR.")
(PROG ((INFO.FILE NIL))
(for X from 1 to 10 until [SETQ INFO.FILE (CAR (NLSETQ (OPENSTREAM AR.INFO.FILE.NAME
'APPEND
'OLD/NEW
'((DON'T.CACHE T)
(DON'TCACHE T]
do (AR.PROMPT (LIST "info file busy: " AR.INFO.FILE.NAME " --- please wait")
FORMWINDOW)
(DISMISS 5000))
(COND
((NULL INFO.FILE)
(ERROR)))
(RESETLST (RESETSAVE NIL (LIST (FUNCTION CLOSEF)
INFO.FILE))
(LET ((*PRINT-BASE* 10))
(LINELENGTH MAX.SMALLP INFO.FILE)
(printout INFO.FILE " -- " (LIST OP AR.INFO USER.INFO)
T])
(AR.USERNAME
[LAMBDA NIL (* mjs "21-Jun-85 14:10")
(PROG ((NAM (FULLUSERNAME)))
(RETURN (if (U-CASEP NAM)
then (L-CASE NAM T)
else NAM])
(IMAGEOBJPROPS.MACRO
[LAMBDA (X) (* edited%: "21-Aug-84 14:22")
`(PROG ((OBJ %, (CAR X)))
%,@ (for XX on (CDR X) by (CDDR XX) collect (LIST 'IMAGEOBJPROP 'OBJ (CAR XX)
(CADR XX)))
(RETURN OBJ])
)
(* ;;; "AR INDEX functions")
(* ;; "Functions for evaluating AR queries:")
(DEFINEQ
(AR.QUERY
[LAMBDA (QFORMWINDOW QLIST) (* ; "Edited 25-Feb-87 17:01 by jds")
(* ;; "Given a query window, and a query in the form of a list of items, run the query.")
(AR.INDEX.DATA.CONTEXT QFORMWINDOW (AR.QFORM.DISPLAY.DISCONNECT QFORMWINDOW)
(WINDOWPROP QFORMWINDOW 'AR.ENTRY.ALIST (for X in (AR.QUERY.EVAL.QLIST QFORMWINDOW QLIST)
collect (CONS X)))
(WINDOWPROP QFORMWINDOW 'AR.ENTRY.ALIST.QLIST QLIST)
(WINDOWPROP QFORMWINDOW 'AR.ENTRY.ALIST.SLIST NIL])
(AR.QUERY.EVAL.QLIST
[LAMBDA (QFORMWINDOW QLIST) (* ; "Edited 26-Feb-87 10:48 by jds")
(* ;; "Given a query spec in QLIST, evaluate it and return a list of index pointers (??) that meet the criteria.")
(COND
((NULL QLIST)
NIL)
((EQ QLIST T)
(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))
((NLISTP QLIST)
(* ;; "The spec wasn't a list, so it isn't valid.")
(AR.PROMPT (LIST "Bad Query Spec: " QLIST)
QFORMWINDOW)
(ERROR!))
[(EQ (CAR QLIST)
'NOT)
(* ;;
"He said anything that is NOT so-and-so. Compute so-and-so, then find its complement.")
(AR.ENTRY.LIST.NOT (AR.QUERY.EVAL.QLIST QFORMWINDOW (CADR QLIST]
[(EQ (CAR QLIST)
'AND)
(COND
((NULL (CADR QLIST))
NIL)
((NULL (CDDR QLIST))
(AR.QUERY.EVAL.QLIST QFORMWINDOW (CADR QLIST)))
(T (AR.ENTRY.LIST.AND (AR.QUERY.EVAL.QLIST QFORMWINDOW (CADR QLIST))
(AR.QUERY.EVAL.QLIST QFORMWINDOW (CONS 'AND (CDDR QLIST]
[(EQ (CAR QLIST)
'OR)
(COND
((NULL (CADR QLIST))
NIL)
((NULL (CDDR QLIST))
(AR.QUERY.EVAL.QLIST QFORMWINDOW (CADR QLIST)))
(T (AR.ENTRY.LIST.OR (AR.QUERY.EVAL.QLIST QFORMWINDOW (CADR QLIST))
(AR.QUERY.EVAL.QLIST QFORMWINDOW (CONS 'OR (CDDR QLIST]
((EQ (CADR QLIST)
'HAS)
(AR.INDEX.SEARCH.HAS QFORMWINDOW (CAR QLIST)
(CADDR QLIST)))
((EQ (CADR QLIST)
'IS)
(AR.INDEX.SEARCH.IS QFORMWINDOW (CAR QLIST)
(CADDR QLIST)))
(T (AR.PROMPT (LIST "Bad Query Spec: " QLIST)
QFORMWINDOW)
(ERROR!])
(AR.ENTRY.LIST.AND
[LAMBDA (A B) (* ; "Edited 21-Jan-88 16:37 by ckj")
(* ;;; "Given two lists of AR numbers (or monotonic surrogates for them), generate the intersection of the lists. Either list may be the atom T, which is the identity element. NB that the elements of the lists must be sorted in numeric order!")
(COND
((EQ A T) (* ; "A is identity, so return B")
B)
((EQ B T) (* ; "and vice-versa.")
A)
(T (* ;; "Have to do it the hard way:")
(while (AND A B) bind ITEM when (COND
((IEQP (CAR A)
(CAR B)) (* ; "Found a match. Save it.")
(SETQ ITEM (pop A))
(pop B)
T)
((< (CAR A)
(CAR B)) (* ;
"A<B, so take one off A, and don't collect anything.")
(pop A)
NIL)
(T (* ;
"B<A, so take one off B, and don't collect anything.")
(pop B)
NIL)) collect ITEM])
(AR.ENTRY.LIST.OR
[LAMBDA (A B) (* ; "Edited 5-Dec-86 21:33 by jds")
(* ;;; "Given two lists of AR numbers (or monotonic surrogates for them), generate the union of the lists. Either list may be the atom T, in which case the result is T. NB that the elements of the lists must be sorted in numeric order!")
(COND
((OR (EQ A T)
(EQ B T))
T)
(T (while (OR A B) collect (COND
((NOT B) (* ;
"None left on B, so take one from A")
(pop A))
((NOT A) (* ;
"None left on A, so take one from B.")
(pop B))
((IEQP (CAR A)
(CAR B)) (* ;
"A=B, so take one off both and save one of them.")
(pop A)
(pop B))
((ILESSP (CAR A)
(CAR B)) (* ; "A<B, so take one off A.")
(pop A))
(T (* ; "B<A, so take one off B")
(pop B])
(AR.ENTRY.LIST.NOT
[LAMBDA (ARS-TO-AVOID) (* ; "Edited 2-Mar-87 15:03 by jds")
(* ;;; "Given a list of AR numbers (or monotonic surrogates for them), generate the the list of all ARs EXCEPT those listed. The list may be the symbol T, in which case NO ARs are returned.")
(COND
((EQ ARS-TO-AVOID T) (* ;
"ARS-TO-AVOID is %"everything%", so return nothing.")
NIL)
(T (* ;; "Have to do it the hard way:")
(for X from AR.INDEX.ENTRY.BEGIN.PTR to AR.INDEX.ENTRY.END.PTR by AR.INDEX.ENTRY.SIZE
when (COND
((NULL ARS-TO-AVOID) (* ;
"Nothing left to avoid. Accept everything.")
T)
((ILESSP X (CAR ARS-TO-AVOID)) (* ;
"Haven't hit the next one to avoid yet.")
T)
((IEQP X (CAR ARS-TO-AVOID)) (* ;
"Avoid this one (and pop it off the avoidance list).")
(pop ARS-TO-AVOID)
NIL)
(T (* ; "Since candidates are dense, we should never get to the state where the next candidate AR is PAST the next one to avoid.")
(SHOULDNT))) collect X])
(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 'FIELD.OFFSET))
(FIELD.VAL.BEGIN.PTR (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME 'FIELD.BEGIN.PTR))
(FIELD.VAL.END.PTR (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME '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 'AR.SEARCH.HAS.HARRAY))
(SETQ HAS.HARRAY.INDEX (PACK* FIELD.NAME '/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 'NONE)
then (RETURN NIL)
elseif FOUND.ENTRY.PTRS
then (RETURN FOUND.ENTRY.PTRS))
else (WINDOWPROP QFORMWINDOW '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 '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 'ENUMERATED.FIELD.KEYLIST))
(FIELD.VAL.BEGIN.PTR (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME 'FIELD.BEGIN.PTR))
(FIELD.VAL.END.PTR (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME '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
'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])
)
(* ;; "Creating AR Query windows")
(DEFINEQ
(AR.QFORM.DISPLAY.CONNECT
[LAMBDA (QFORMWINDOW) (* edited%: "13-Aug-84 16:40")
(PROG ((QFORM.ENTRY.WINDOW (WINDOWPROP QFORMWINDOW 'QFORM.ENTRY.WINDOW))
(QUERY.ENTRIES (WINDOWPROP QFORMWINDOW 'AR.ENTRY.ALIST))
ENTRY.LIST.HEIGHT)
(SETQ ENTRY.LIST.HEIGHT (ITIMES (ABS (DSPLINEFEED NIL QFORM.ENTRY.WINDOW))
(LENGTH QUERY.ENTRIES)))
(WINDOWPROP QFORM.ENTRY.WINDOW 'EXTENT (CREATEREGION 0 (IMINUS ENTRY.LIST.HEIGHT)
2000 ENTRY.LIST.HEIGHT))
(WINDOWPROP QFORM.ENTRY.WINDOW 'REPAINTFN (FUNCTION AR.ENTRY.LIST.WINDOW.REPAINTFN))
(WINDOWPROP QFORM.ENTRY.WINDOW 'BUTTONEVENTFN (FUNCTION AR.ENTRY.LIST.WINDOW.BUTTONEVENTFN)
)
(WINDOWPROP QFORM.ENTRY.WINDOW 'SCROLLFN (FUNCTION SCROLLBYREPAINTFN))
(WINDOWPROP QFORM.ENTRY.WINDOW 'RESHAPEFN (FUNCTION RESHAPEBYREPAINTFN))
(DSPRIGHTMARGIN MAX.SMALLP QFORM.ENTRY.WINDOW)
(SCROLLW QFORM.ENTRY.WINDOW 0.0 0.0)
(REDISPLAYW QFORM.ENTRY.WINDOW])
(AR.QFORM.DISPLAY.DISCONNECT
[LAMBDA (QFORMWINDOW) (* edited%: "13-Aug-84 16:40")
(PROG [(QFORM.ENTRY.WINDOW (WINDOWPROP QFORMWINDOW 'QFORM.ENTRY.WINDOW]
(WINDOWPROP QFORM.ENTRY.WINDOW 'REPAINTFN (FUNCTION NILL))
(WINDOWPROP QFORM.ENTRY.WINDOW 'BUTTONEVENTFN (FUNCTION NILL))
(CLEARW QFORM.ENTRY.WINDOW])
(AR.QFORM.GROUP.CREATE
[LAMBDA (AR.INDEX.FILE.NAME WINDOW) (* ; "Edited 25-Feb-87 10:43 by jds")
(* ;;; "Set up a query-window group (main window, summary browser, and prompt window). Queries will be done against AR.INDEX.FILE.NAME. WINDOW, if supplied, will be used as the query window.")
(PROG ((QFORMWINDOW (if WINDOW
else (CREATEW (GETREGION 400 100)
"AR Query Window")))
QFORMWINDOW.REGION QFORM.ENTRY.WINDOW)
(* ;; "set up main window")
(WINDOWPROP QFORMWINDOW 'AR.WINDOW.PROC.NAME 'AR.QUERY.FORM)
(WINDOWPROP QFORMWINDOW 'MINSIZE (CONS 200 100))
(WINDOWPROP QFORMWINDOW 'MAXSIZE (CONS 99999 100))
(WINDOWPROP QFORMWINDOW 'ICON AR.QFORM.ICON)
(WINDOWADDPROP QFORMWINDOW 'CLOSEFN (FUNCTION AR.KILL.ATTACHED.TEDIT.CLOSEFN))
[WINDOWADDPROP QFORMWINDOW 'CLOSEFN (FUNCTION (LAMBDA (WINDOW)
(PROG [(INDEX.FILE
(fetch (AR.INDEX.DATA AR.INDEX.FILE
)
of (WINDOWPROP WINDOW
'AR.INDEX.DATA]
(if (OPENP INDEX.FILE)
then (CLOSEF INDEX.FILE]
(WINDOWPROP QFORMWINDOW 'AR.TEDIT.TITLEMENUFN (FUNCTION NILL))
(* ;; "set up entry-browser window")
(SETQ QFORMWINDOW.REGION (WINDOWPROP QFORMWINDOW '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 'TOP 'JUSTIFY NIL)
(WINDOWPROP QFORMWINDOW 'QFORM.ENTRY.WINDOW QFORM.ENTRY.WINDOW)
(WINDOWPROP QFORM.ENTRY.WINDOW 'MINSIZE (CONS 10 100))
(if (NULL AR.INDEX.FILE.NAME)
then (SETQ AR.INDEX.FILE.NAME AR.INDEX.DEFAULT.FILE.NAME))
(WINDOWPROP QFORMWINDOW '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 `((|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))
'(|Query List:| CR |Sort List:| CR Query CR CR |Print File:| CR Print CR])
(AR.QFORM.FN.UPDATE
[LAMBDA (QFORMWINDOW) (* mjs " 8-Aug-84 15:18")
(PROG ((ULIST (AR.GET.BUTTON.FIELD.AS.LIST QFORMWINDOW '|Update List:|))
VAL)
(SETQ VAL (AR.INDEX.UPDATE QFORMWINDOW ULIST))
(AR.PROMPT (LIST "Update done --- new file: " VAL)
QFORMWINDOW])
(AR.QFORM.FN.QUERY
[LAMBDA (QFORMWINDOW) (* ; "Edited 14-Jan-88 09:43 by ckj")
(PROG [[QLIST (CONS 'AND (AR.GET.BUTTON.FIELD.AS.LIST QFORMWINDOW '|Query List:|]
(SLIST (AR.GET.BUTTON.FIELD.AS.LIST QFORMWINDOW '|Sort List:|]
(AR.QFORM.DISPLAY.DISCONNECT QFORMWINDOW)
(AR.QUERY QFORMWINDOW QLIST)
(AR.PROMPT (LET ((*PRINT-BASE* 10))
(LIST "Total: " (LENGTH (WINDOWPROP QFORMWINDOW 'AR.ENTRY.ALIST))
" entries found"))
QFORMWINDOW)
(AR.SORT QFORMWINDOW SLIST)
(AR.QFORM.DISPLAY.CONNECT QFORMWINDOW])
(AR.QFORM.FN.PRINT
[LAMBDA (QFORMWINDOW) (* mjs " 8-Aug-84 17:44")
(PROG ([PRINT.FILE.NAME (CAR (AR.GET.BUTTON.FIELD.AS.LIST QFORMWINDOW '|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 'OUTPUT 'NEW]
else (AR.PROMPT (LIST "Bad Print file: " PRINT.FILE.NAME)
QFORMWINDOW)
(RETURN))
(AR.PRINT QFORMWINDOW FILE)
(NLSETQ (CLOSEF FILE])
(AR.QFORM.CREATE
[LAMBDA (AR.INDEX.FILE.NAME WINDOW DONTSPAWN) (* ; "Edited 25-Feb-87 10:47 by jds")
(* ;; "Create an AR query form. Queries will be done against AR.INDEX.FILE.NAME. WINDOW, if supplied, will be used as the main query window. If DONTSPAWN is T, this'll be completed before the function returns; otherwise it'll be spawned as an asynchronous process.")
(COND
(DONTSPAWN (* ;
"Want the window created before returning.")
(AR.QFORM.GROUP.CREATE AR.INDEX.FILE.NAME WINDOW))
(T (* ;
"Let the caller go ahead, while we make the window on our own time.")
(ADD.PROCESS (LIST (FUNCTION AR.QFORM.GROUP.CREATE)
(KWOTE AR.INDEX.FILE.NAME)
(KWOTE WINDOW))
'NAME
'AR.QUERY.FORM.TEMP])
(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 'MBTEXT])
(AR.QFORM.ACTIONFN
[LAMBDA (QFORMWINDOW OPERATION) (* mjs " 8-Aug-84 17:47")
(ALLOW.BUTTON.EVENTS)
(PROCESSPROP (THIS.PROCESS)
'NAME
'AR.QFORM.TEMP)
(PROG [(TOBJ (WINDOWPROP QFORMWINDOW 'TEXTOBJ]
(AR.MARK.ACTIVE TOBJ OPERATION)
(DSPFILL NIL 72 '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.GET.QLIST.PROMPT.MENU
[LAMBDA (QFORMWINDOW) (* ; "Edited 21-Jan-88 16:58 by ckj")
(PROG [(VAL (WINDOWPROP QFORMWINDOW 'AR.QLIST.PROMPT.MENU]
[if (NULL VAL)
then
(WINDOWPROP
QFORMWINDOW
'AR.QLIST.PROMPT.MENU
(SETQ VAL
(AR.INDEX.DATA.CONTEXT
QFORMWINDOW
(create
MENU
TITLE ← "Query Options"
ITEMS ←
(LET ((*READTABLE* FILERDTBL))
(APPEND '("(NOT" "(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
'ENUMERATED.FIELD.KEYLIST))
collect (SETQ FIELD.PROMPT.STRING (MKSTRING (LIST FIELD.NAME
'IS
'|...|)
T))
(LIST FIELD.PROMPT.STRING (KWOTE FIELD.PROMPT.STRING)
NIL
(CONS 'SUBITEMS (for KEY.VAL in FIELD.KEYLIST
by (CDDR KEY.VAL)
collect (MKSTRING (LIST FIELD.NAME
'IS KEY.VAL)
T]
(for FIELD.NAME in AR.INDEX.FIELD.LIST unless (ARSPECGET
AR.INDEX.FIELD.SPECS
FIELD.NAME
'
ENUMERATED.FIELD.KEYLIST
)
collect (MKSTRING (LIST FIELD.NAME 'HAS '>><<)
T]
(RETURN VAL])
(AR.QFORM.PROMPT.LIST.FN
[LAMBDA (OBJ SEL WINDOW) (* ; "Edited 21-Jan-88 17:31 by ckj")
(PROG ((TOBJ (fetch (SELECTION \TEXTOBJ) of SEL))
[WINDOW (CAR (fetch (TEXTOBJ \WINDOW) of (fetch (SELECTION \TEXTOBJ) of SEL]
(BUTTON (IMAGEOBJPROP OBJ '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)))
(COND
((STRPOS ">><<" STRING.TO.ADD)
(TEDIT.SETSEL (TEXTSTREAM WINDOW)
FIELD.END.CH# 0)
(TEDIT.NEXT (TEXTSTREAM WINDOW]
(CURSORPOSITION (create POSITION
XCOORD ← (DSPXPOSITION NIL WINDOW)
YCOORD ← (DSPYPOSITION NIL WINDOW))
WINDOW])
(AR.GET.SLIST.PROMPT.MENU
[LAMBDA (QFORMWINDOW) (* mjs "19-Aug-84 09:57")
(PROG [(VAL (WINDOWPROP QFORMWINDOW 'AR.SLIST.PROMPT.MENU]
[if (NULL VAL)
then (WINDOWPROP QFORMWINDOW '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 '
ENUMERATED.FIELD.KEYLIST)
collect (MKSTRING FIELD.NAME T]
(RETURN VAL])
(AR.ENTRY.LIST.WINDOW.REPAINTFN
[LAMBDA (WINDOW REGION) (* ; "Edited 15-Jan-88 19:21 by ckj")
(* ;; "Repaint the Query sub-window that has the listing of ARs we found.")
(AR.INDEX.DATA.CONTEXT (WINDOWPROP WINDOW 'MAINWINDOW)
(PROG ((ENTRY.ALIST (WINDOWPROP (WINDOWPROP WINDOW 'MAINWINDOW)
'AR.ENTRY.ALIST))
(LINE.HEIGHT (IMINUS (DSPLINEFEED NIL WINDOW)))
ENTRIES.TO.PRINT LINENUM %#LINES)
(WINDOWPROP WINDOW 'RESHAPEFN 'DON'T)
(WINDOWPROP WINDOW 'MOVEFN 'DON'T)
(WINDOWPROP (WINDOWPROP WINDOW 'MAINWINDOW)
'MOVEFN
'DON'T)
(WINDOWPROP (WINDOWPROP WINDOW 'MAINWINDOW)
'RESHAPEFN
'DON'T)
(PROMPTPRINT
"You will not be able to reshape or move the AR Query Windows until the redisplay completes "
)
(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 (COND
((ILEQ LINENUM 0)
NIL)
(T (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))
[COND
((NULL (CDR ENTRY.DATA))
(* make sure that there is at least one prop-val pair, so future LISTPUTs will
work)
(RPLACD ENTRY.DATA (LIST 'Number%: (AR.GET.FIELD.VAL ENTRY '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))
(COND
((NOT FIELD.VAL)
(SETQ FIELD.VAL (AR.GET.FIELD.VAL ENTRY FIELD.NAME))
(LISTPUT (CDR ENTRY.DATA)
FIELD.NAME FIELD.VAL)))
[COND
((ILEQ (NCHARS FIELD.VAL)
FIELD.WIDTH)
(PRIN1 FIELD.VAL WINDOW)
(SPACES (IDIFFERENCE FIELD.WIDTH (NCHARS FIELD.VAL))
WINDOW))
(T (for X from 1 to FIELD.WIDTH do (PRIN1 (NTHCHAR FIELD.VAL X)
WINDOW]
(PRIN1 " " WINDOW))
(TERPRI WINDOW))
(WINDOWPROP WINDOW 'RESHAPEFN (FUNCTION RESHAPEBYREPAINTFN))
(WINDOWPROP (WINDOWPROP WINDOW 'MAINWINDOW)
'RESHAPEFN
'(\TEDIT.RESHAPEFN))
(WINDOWPROP (WINDOWPROP WINDOW 'MAINWINDOW)
'MOVEFN
'(MOVEATTACHEDWINDOWS))
(WINDOWPROP WINDOW 'MOVEFN 'NIL)
(PROMPTPRINT "Reshaping and moving properties restored"])
(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 'MAINWINDOW)
'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 '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
'INVERT WINDOW))
(if (NUMBERP NEWLINENUM)
then (DSPFILL (CREATEREGION CREG.LEFT (IMINUS (ITIMES
NEWLINENUM
LINE.HEIGHT
))
CREG.WIDTH LINE.HEIGHT)
BLACKSHADE
'INVERT WINDOW))
(SETQ LINENUM NEWLINENUM)))
(AR.PROMPT "" (WINDOWPROP WINDOW 'MAINWINDOW))
(if (NULL SELECTED.LINENUM)
then (RETURN 'NotInsideWindow))
(ALLOW.BUTTON.EVENTS)
(if (ILEQ SELECTED.LINENUM 0)
then (RETURN (LIST 'BadLineNum LINENUM))
elseif [NULL (SETQ SELECTED.ENTRY.DATA (CAR (NTH ENTRY.ALIST SELECTED.LINENUM]
then (RETURN 'NoNumOnLine))
[SETQ SELECTED.ENTRY.NUMBER (if (LISTGET (CDR SELECTED.ENTRY.DATA)
'Number%:)
else (AR.INDEX.DATA.CONTEXT (WINDOWPROP WINDOW
'MAINWINDOW)
(AR.GET.FIELD.VAL (CAR
SELECTED.ENTRY.DATA
)
'Number%:]
(if SELECTED.WITH.MIDDLE.BUTTON.FLG
then (AR.EDIT.USING.CORRESPONDING.FORM WINDOW SELECTED.ENTRY.NUMBER)
else (AR.SHOW SELECTED.ENTRY.NUMBER])
)
(DEFINEQ
(AR.EDIT.USING.CORRESPONDING.FORM
[LAMBDA (WINDOW NUM) (* edited%: "30-Aug-84 09:56")
(PROG [(MENU.WINDOW (WINDOWPROP WINDOW 'AR.ASSOCIATED.AREDIT.MENU.WINDOW]
(if [NOT (AND MENU.WINDOW (WINDOWP MENU.WINDOW)
(OPENWP MENU.WINDOW)
(EQ (WINDOWPROP MENU.WINDOW 'AR.WINDOW.PROC.NAME)
'AR.FORM.MENU]
then (AR.PROMPT "Please button the AR Edit window you wish to use" (WINDOWPROP
WINDOW
'MAINWINDOW))
(SETQ MENU.WINDOW (WHICHW (GETPOSITION)))
(AR.PROMPT "" (WINDOWPROP WINDOW 'MAINWINDOW))
(if (NULL MENU.WINDOW)
then (RETURN))
[SETQ MENU.WINDOW (for POSSIBLE.WINDOW
in (APPEND MENU.WINDOW
(ALLATTACHEDWINDOWS
(if (WINDOWPROP MENU.WINDOW 'MAINWINDOW)
else MENU.WINDOW)))
thereis (AND (OPENWP POSSIBLE.WINDOW)
(EQ (WINDOWPROP POSSIBLE.WINDOW '
AR.WINDOW.PROC.NAME)
'AR.FORM.MENU]
(if (NULL MENU.WINDOW)
then (AR.PROMPT "Bad AR edit window selected" (WINDOWPROP WINDOW 'MAINWINDOW))
(RETURN))
(WINDOWPROP WINDOW 'AR.ASSOCIATED.AREDIT.MENU.WINDOW MENU.WINDOW))
(if MENU.WINDOW
then (AR.FORM.MENU.ACTIONFN MENU.WINDOW 'Get NUM])
(AR.GATHER.NEW.AR.DATA
[LAMBDA (FORMWINDOW AR.NUM.LIST AR.SCRATCH.FILE) (* ; "Edited 14-Jan-88 09:44 by ckj")
(* * 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 'INPUT '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 (LET ((*PRINT-BASE* 10))
(AR.PROMPT (LIST "analyzed AR # " AR.NUM)
FORMWINDOW))
(SETQ AR.NUM.DATA (CONS (CONS AR.NUM (CONS NIL INDEX.INFO))
AR.NUM.DATA))
else (LET ((*PRINT-BASE* 10))
(AR.PROMPT (LIST "Can't get AR info for AR # " AR.NUM)
FORMWINDOW))
(SETQ AR.NUM.DATA (CONS (CONS AR.NUM (CONS NIL '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 'FIELD.OFFSET]
[if (NULL FIELD.VAL.BEGIN.PTR)
then (SETQ FIELD.VAL.BEGIN.PTR (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME '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
'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 'FIELD.END.PTR))
(if FIELD.VAL.BEGIN.PTR
else (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME
'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 'FIELD.OFFSET]
(IPLUS (if FIELD.VAL.BEGIN.PTR
else (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME 'FIELD.BEGIN.PTR))
(\DWIN AR.INDEX.FILE))
else (if FIELD.VAL.END.PTR
else (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME 'FIELD.END.PTR])
(AR.GET.FIELD.VAL
[LAMBDA (ENTRY.PTR FIELD.NAME) (* ; "Edited 13-Jan-88 12:18 by ckj")
(if (EQ FIELD.NAME 'Number%:)
then (AR.ENTRY.TO.NUM ENTRY.PTR)
elseif (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME 'FIELD.OFFSET)
then (LET ((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)
VAL.STRING)
else
(* ;; "This is an enumerated value item (i.e., there's a fixed list of choices, and what's in the database is a choice number")
(LET ((FIELD.KEYLIST (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME 'ENUMERATED.FIELD.KEYLIST)
)
[KEY.VAL.PTR (AR.ENTRY.PTR.TO.KEY.VAL.PTR ENTRY.PTR (ARSPECGET AR.INDEX.FIELD.SPECS
FIELD.NAME '
FIELD.BEGIN.PTR]
KEY.VAL)
(SETFILEPTR AR.INDEX.FILE KEY.VAL.PTR)
(SETQ KEY.VAL (BIN AR.INDEX.FILE))
(COND
((EQP 0 KEY.VAL)
"")
[(CAR (for X on FIELD.KEYLIST by (CDDR X) when (EQP KEY.VAL (CADR X))
collect (CAR X]
(T ""])
(AR.INDEX.CREATE
[LAMBDA (FILENAME FIELD.LIST FORM.SPECS) (* ckj "20-Oct-86 18:11")
(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 'OUTPUT '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 'FIELD.BEGIN.PTR 0 '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 'ENUMERATED.FIELD.KEYLIST
(for FIELD.KEY in ENUMERATED.FIELD.KEYS as NUM from 1
join (LIST FIELD.KEY NUM)))
else (ARSPECPUT FIELD.SPECS FIELD '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 FILERDTBL) (* 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 'FIELDTYPE)
(MENU (APPEND (ARSPECGET FORM.SPECS FIELD 'MENULIST)))
(SUBMENU (for X in (CDR (ARSPECGET FORM.SPECS FIELD '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 'AR.INDEX.DATA) bind (DEC ← (RECLOOK 'AR.INDEX.DATA))
do (SET FIELD (RECORDACCESS FIELD INDEX.DATA DEC '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-Jan-88 12:26 by ckj")
(PROG (INDEX.DATA)
(COND
([NULL (NLSETQ (SETQ AR.INDEX.FILE (OPENSTREAM FILENAME 'INPUT 'OLD]
(AR.PROMPT "Can't open AR index file" FORMWINDOW)
(RETURN)))
(replace (STREAM MAXBUFFERS) of AR.INDEX.FILE with 40)
(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 FILERDTBL))
(COND
((NOT (type? AR.INDEX.DATA INDEX.DATA))
(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 13-Jan-88 12:28 by ckj")
(if (NOT (OPENP AR.INDEX.FILE))
then (AR.PROMPT "Re-opening index file" QFORMWINDOW)
(SETQ AR.INDEX.FILE (OPENSTREAM (FULLNAME AR.INDEX.FILE)
'INPUT
'OLD))
(replace (STREAM MAXBUFFERS) of AR.INDEX.FILE with 40)
(replace (AR.INDEX.DATA AR.INDEX.FILE) of (WINDOWPROP QFORMWINDOW 'AR.INDEX.DATA)
with AR.INDEX.FILE])
(AR.INDEX.PRINT
[LAMBDA (FILE PRINT.ENTRY.DATA.FLG) (* ; "Edited 14-Jan-88 09:46 by ckj")
(LET ((*PRINT-BASE* 10))
(printout FILE "Total file size: " (GETEOFPTR AR.INDEX.FILE)
" bytes" T T))
(LET ((*PRINT-BASE* 10))
(printout FILE "Total Field Space: " .TAB 20 AR.INDEX.ENTRY.BEGIN.PTR " bytes" T))
(for FIELD.NAME in AR.INDEX.FIELD.LIST bind FIELD.BYTES
do [SETQ FIELD.BYTES (IDIFFERENCE (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME 'FIELD.END.PTR)
(ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME 'FIELD.BEGIN.PTR]
(LET ((*PRINT-BASE* 10))
(printout FILE FIELD.NAME .TAB 20 FIELD.BYTES T)))
(LET ((*PRINT-BASE* 10))
(printout FILE T "Total Entry Space: " (IDIFFERENCE AR.INDEX.ENTRY.END.PTR
AR.INDEX.ENTRY.BEGIN.PTR)
" bytes" T))
(LET ((*PRINT-BASE* 10))
(printout T (IQUOTIENT (IDIFFERENCE AR.INDEX.ENTRY.END.PTR AR.INDEX.ENTRY.BEGIN.PTR)
AR.INDEX.ENTRY.SIZE)
" entries of " AR.INDEX.ENTRY.SIZE " bytes" T))
(if (EQ '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 (LET ((*PRINT-BASE* 10))
(printout FILE "Entry # " (PROGN (SETFILEPTR AR.INDEX.FILE ENTRY.PTR)
(\DWIN AR.INDEX.FILE))
T))
(for FIELD.NAME in AR.INDEX.FIELD.LIST bind VAL.DATA FIELD.OFFSET FIELD.KEYLIST
FIELD.BEGIN.PTR VAL.NUM
do (SETQ FIELD.BEGIN.PTR (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME 'FIELD.BEGIN.PTR
))
(SETQ FIELD.OFFSET (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME '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
'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 '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)
'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 '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 'ENUMERATED.FIELD.KEYLIST))
(FIELD.OFFSET (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME 'FIELD.OFFSET))
(FIELD.DATA.BEGIN.PTR (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME 'FIELD.BEGIN.PTR))
(FIELD.DATA.END.PTR (ARSPECGET AR.INDEX.FIELD.SPECS FIELD.NAME '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)
'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.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) (* ckj "20-Oct-86 18:15")
(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 'VERSION NIL 'BODY 'AR.TEMP
'BODY
(FULLNAME AR.INDEX.FILE))
'BOTH
'NEW))
(SETQ AR.NUM.DATA (AR.GATHER.NEW.AR.DATA FORMWINDOW AR.NUM.LIST AR.SCRATCH.FILE))
(SETQ NEW.AR.INDEX.FILE (OPENSTREAM (PACKFILENAME 'VERSION NIL 'BODY 'ARINDEX.NEW
'BODY
(FULLNAME AR.INDEX.FILE))
'OUTPUT
'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
'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
'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 FILERDTBL)
(\DWOUT NEW.AR.INDEX.FILE NEW.AR.INDEX.DATA.PTR)
(CLOSEF NEW.AR.INDEX.FILE)
(RETURN (RENAMEFILE (FULLNAME NEW.AR.INDEX.FILE)
(PACKFILENAME 'VERSION NIL 'BODY (FULLNAME AR.INDEX.FILE])
(AR.PRINT
[LAMBDA (QFORMWINDOW FILE FIELDS-TO-PRINT) (* ; "Edited 13-Jan-88 12:50 by ckj")
(* ;; "Print an AR summary. List in it the ARs selected in QFORMWINDOW. Put the summary on FILE. Include in the summary all the fields listed in FIELDS-TO-PRINT, or if that's nil, then AR.ENTRY.LIST.PRINT.FIELDS.")
(* ;; "The FIELDS list is a list of pairs")
(AR.INDEX.DATA.CONTEXT QFORMWINDOW (LINELENGTH MAX.SMALLP FILE)
(printout FILE "AR Summary generated on " (DATE)
T)
(printout FILE "Generated with Query Spec: " (WINDOWPROP QFORMWINDOW 'AR.ENTRY.ALIST.QLIST
)
T)
(printout FILE "Sorted with Sort Spec: " (WINDOWPROP QFORMWINDOW 'AR.ENTRY.ALIST.SLIST)
T T)
(for FIELD.SPEC in (OR FIELDS-TO-PRINT 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))
(AR.PRINT.PADDED FIELD.NAME FILE 1 FIELD.WIDTH FIELD.WIDTH)
(\OUTCHAR FILE (CHARCODE SPACE))
(\OUTCHAR FILE (CHARCODE SPACE)))
(printout FILE T T)
(for ENTRY.DATA in (WINDOWPROP QFORMWINDOW '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 (OR FIELDS-TO-PRINT
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 (COND
((LISTGET (CDR ENTRY.DATA)
FIELD.NAME))
(T (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 (OR FIELDS-TO-PRINT 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))
[COND
((STRINGP FIELD.VAL))
((LITATOM FIELD.VAL))
(T (SETQ FIELD.VAL (MKSTRING FIELD.VAL]
(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))
[COND
((IGREATERP FIELD.START.CHAR VAL.NCHARS)
(SPACES FIELD.WIDTH FILE))
(T (AR.PRINT.PADDED FIELD.VAL FILE FIELD.START.CHAR
FIELD.WIDTH FIELD.WIDTH)
(COND
((IGREATERP VAL.NCHARS FIELD.END.CHAR)
(SETQ OVERFLOW.FIELD.FLG T]
(\OUTCHAR FILE (CHARCODE SPACE))
(\OUTCHAR FILE (CHARCODE SPACE)))
(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 '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 '
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 'AR.SORT.NUM 0))
else (LISTPUT (CDR ENTRY)
'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 '
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)
'AR.SORT.NUM
(IPLUS (LISTGET (CDR ENTRY)
'AR.SORT.NUM)
(ITIMES FIELD.VAL MULT]
[SORT ENTRY.ALIST (FUNCTION (LAMBDA (A B)
(PROG [(ASORTNUM (LISTGET (CDR A)
'AR.SORT.NUM))
(BSORTNUM (LISTGET (CDR B)
'AR.SORT.NUM]
(RETURN (if (EQP ASORTNUM BSORTNUM)
then (ILESSP (CAR A)
(CAR B))
else (ILESSP ASORTNUM BSORTNUM]
(WINDOWPROP QFORMWINDOW 'AR.ENTRY.ALIST.SLIST SLIST])
)
(RPAQQ AR.FORM.FORMAT
(Number%: TAB Date%: CR Submitter%: TAB Source%: CR CR Subject%: CR CR |Assigned To:| TAB
Attn%: CR CR Status%: TAB In/By%: CR |Problem Type:| TAB Impact%: CR Difficulty%: TAB
Frequency%: CR TAB Priority%: CR CR System%: TAB Subsystem%: CR CR Machine%: TAB Disk%:
CR |Lisp Version:| TAB |Source Files:| CR |Microcode Version:| TAB |Memory Size:| CR
|File Server:| TAB |Server Software Version:| CR CR Disposition%: CR CR |Release Note:|
CR CR Description%: CR CR Workaround%: CR |Test Case:| CR CR Edit-By%: TAB Edit-Date%:
CR))
(RPAQQ AR.FORM.SPECS
((Number%: FIELDTYPE PROTECTEDSTRING)
(Date%: FIELDTYPE PROTECTEDSTRING)
(Submitter%: FIELDTYPE STRING)
(Source%: FIELDTYPE STRING)
(Subject%: FIELDTYPE STRING)
(|Assigned To:| FIELDTYPE STRING)
(Attn%: FIELDTYPE STRING)
(Status%: FIELDTYPE MENU MENULIST (New Open Open/Unreleased Fixed Closed Declined Superseded
Obsolete Incomplete Internal Wish))
(In/By%: FIELDTYPE STRING)
(|Problem Type:| FIELDTYPE MENU MENULIST (Bug |Design - Impl| Feature |Design - UI|
Documentation Performance))
(Impact%: FIELDTYPE MENU MENULIST (Fatal Serious Moderate Annoying Minor))
(Difficulty%: FIELDTYPE MENU MENULIST (Easy Moderate Hard Very% Hard Impossible))
(Frequency%: FIELDTYPE MENU MENULIST (Everytime Intermittent Once))
(Priority%: FIELDTYPE MENU MENULIST (Absolutely Hopefully Perhaps Unlikely))
(System%: FIELDTYPE MENU ASSOCSUBMENU Subsystem%: MENULIST
(Communications |Windows and Graphics| Operating% System Language% Support
Programming% Environment Text Common% Lisp CLOS Port Maiko LOOPS PCE PROLOG
4045 Rooms Library BusMaster Documentation Other% Software))
(Subsystem%: FIELDTYPE SUBMENU ASSOCMENU System%: SUBMENULIST
(Communications (NS% Protocols NS% Filing NS% Printing PUP% Protocols PUP% FTP
Grapevine Leaf RS232 VAX% Server DEI EVMS/RPC Lisp% Servers
Clearinghouse TCP/IP Centronics TTYPort Chat Chat% Interface
|Pup Chat Driver| |NS Chat Driver| |RS232 Chat Driver|
|TTYPort Chat Driver| |Chat DM2500 Emulator|
|Chat VT100 Emulator| NSMaintain Other)
|Windows and Graphics|
(Window% System Library Fonts Printing Color Bitmaps Demos Menus Other)
Operating% System
(Virtual% Memory |Generic File Operations| DLion% Disk Daybreak% Disk
DLion% Floppy Daybreak% Floppy Dolphin/Dorado% Disk Processes Streams
Keyboard Mouse Other)
Language% Support
(Arithmetic |Compiler, Code Format| For/If Microcode Storage% Formats/Mgt
Garbage% Collection |Read and Print| |Stack and Interpreter|
|Bootstrapping and Teleraid| Diagnostics Other)
Programming% Environment
(Break% Package Code% Editor DWIM Inspector File% Package History Masterscope
PSW Record% Package Performance% Tools Edit% Interface Exec
Presentations Stepper Other)
Text
(TEdit TTYIN Lafite AR% Database Other)
Common% Lisp
(Type% System Declarations Macros Control% Structure Evaluator Symbols/Packages
Arithmetic Characters/Strings Sequences Lists Arrays Structures
Hash% Tables |Streams and I/O| |File System Interface| Error% System
Compiler Tamarin% Support Microcoded% Operations Common% Loops Other)
CLOS
(Language Browsers Methods Classes Meta% Classes Other)
Port
(Other)
Maiko
(Bytecode% Emulation Native% Code I/O% System Host% Integration
|Host User Interface| |Foreign Fn Interface| Installation% Procedure
Documentation Other)
LOOPS
(Active% Values Composite% Objects Objects Browsers User% Interface
Virtual% Copy Other)
PCE
(Monochrome% Display Color% Display Keyboard |Emulated Rigid Disk| Floppy% Disk
Printer% Port User% Interface Programmatic% Interface
|File System Interface| Memory Ethernet Configuration% Tools Other)
PROLOG
(Arithmetic Dinfo Microcode Editor% Interface Compiler Interpreter I/O
Debugging Prolog-Lisp% Interface Other)
4045
(XLPStream Remoteserver HQStream PSO Other)
Rooms
(Window% Types Overview Suites Buttons Documentation Other)
Library
(Cash-File CharCodeTables Copyfiles DEdit DatabaseFns |FX-80 Printer Support|
Filebrowser Font% Samples GCHax GraphZoom Grapher Hash Hash-File
|Image Object Interface| Kermit Masterscope% Browser MatMult
|Press Printer Support| SameDir Sketch SysEdit/EXPORTS.ALL Tablebrowser
Virtual% Keyboards Where-Is Other)
BusMaster
(Speech Color Other)
Documentation
(Tools |1108 Users Guide| |1186 Users Guide| Primer
|Product Descr/Tech Summary| |Hardware Installation Guide|
Programmers% Introduction |Interlisp Reference Manual|
|Library Package Manual| |Internal System Documentation| Other)
Other% Software
(Installation% Utility Release% Procedure Other)))
(Machine%: FIELDTYPE MENU ASSOCSUBMENU Disk%: MENULIST (1100 1108 1132 1186))
(Disk%: FIELDTYPE SUBMENU ASSOCMENU Machine%: SUBMENULIST
(1100 NIL 1108 (|SA1000 (10MB)| |SA4000 (29MB)| |Q2040 (43MB)| |Q2080 (80MB)|
|T80 (80MB)| |T300 (300MB)| Other)
1132
(|T80 (80MB)| Century315 Other)
1186
(|ST212 (10MB)| |TM703 (20MB)| |TM702 (20MB)| |ST4026 (20MB)| |Q530 (20MB)|
|Q540 (40MB)| |Micropolis 1303 (40MB)| |Micropolis 1325 (80MB)|)))
(|Lisp Version:| FIELDTYPE STRING)
(|Source Files:| FIELDTYPE STRING)
(|Microcode Version:| FIELDTYPE STRING)
(|Memory Size:| FIELDTYPE STRING)
(|File Server:| FIELDTYPE MENU MENULIST (8037 IFS NS |VAX/VMS - 3Mb| |VAX/VMS - 10Mb|
VAX/UNIX Micro% VAX/VMS Other))
(|Server Software Version:| FIELDTYPE STRING)
(Disposition%: FIELDTYPE STRING)
(|Release Note:| FIELDTYPE STRING)
(Description%: FIELDTYPE STRING)
(Workaround%: FIELDTYPE STRING)
(|Test Case:| FIELDTYPE STRING)
(Edit-By%: FIELDTYPE STRING)
(Edit-Date%: FIELDTYPE PROTECTEDSTRING)))
(RPAQ? AR.ENTRY.LIST.WINDOW.FIELDS '((Number%: 5)
(Status%: 5)
(Subject%: 45)
(Attn%: 15)
(System%: 15)
(Subsystem%: 15)
(Source%: 15)))
(RPAQ? AR.ENTRY.LIST.PRINT.FIELDS '((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
'(Subject%: Source%: Date%: Submitter%: |Assigned To:| Attn%: Status%: In/By%: |Problem Type:|
Impact%: Difficulty%: Frequency%: Priority%: System%: Subsystem%: Machine%: Disk%:
|Lisp Version:| |Source Files:| |Microcode Version:| |Memory Size:| |File Server:|
|Server Software Version:| Edit-By%: Edit-Date%:))
(RPAQ? AR.NO.MESSAGE.FLG NIL)
(RPAQQ AR.INDEX.DEFAULT.FILE.NAME {ERINYES}<LISPARS>AR.INDEX)
(RPAQQ AR.INFO.FILE.NAME {ERINYES}<LISPARS>LISPARS.TDS)
(RPAQQ AR.SUBMIT.NUM.FILE.NAME {ERINYES}<LISPARS>LISPARS.NUM)
(RPAQQ AR.SUBMIT.FILE.NAME {ERINYES}<LISPARS>LISPARS.SUBMIT)
(RPAQQ AR.DIRECTORY {ERINYES}<LISPARS>)
(RPAQ? ARBUTTONFONT (FONTCREATE 'HELVETICA 12 'BOLD))
(RPAQ? ARFONT (FONTCREATE 'TIMESROMAN 10))
(RPAQ? ARBOLDFONT (FONTCREATE 'HELVETICA 10 'BOLD))
(* ;;; "old vars and fns for AR.SHOW")
(DEFINEQ
(AR.SHOW
[LAMBDA (ARN WINDOW MAP) (* lmm "24-May-85 11:21")
(RESETLST
(PROG (ARSTREAM)
(OR ARN [FIXP (SETQ ARN (COND
(AR.READ.WITH.RNUMBERFLG (RNUMBER "Enter AR number:"))
(T (CAR (PROCESS.READ PROMPTWINDOW "AR number: " T]
(RETURN))
[OR WINDOW (SETQ WINDOW (AR.LAYOUT.WINDOW (CONCAT "AR " ARN]
[RESETSAVE NIL (LIST 'CLOSEF (SETQ ARSTREAM (OPENSTREAM (AR.FILENAME ARN)
'INPUT
'OLD]
(* Buffer whole file, since we're going to read it twice)
(OR MAP (SETQ MAP AR.MAP))
[LET ((PARSE (AR.PARSE ARSTREAM)))
(CLEARW WINDOW)
(PROG ((WIDTH (WINDOWPROP WINDOW 'WIDTH))
(TEXTSTREAM (OPENSTREAM '{NODIRCORE} 'BOTH))
(BOLD (LIST 'FONT ARBOLDFONT))
HEADINGS TABS LASTLINE LASTDESCENT THESETABS N)
[for ME in MAP do [push HEADINGS (LIST (ADD1 (GETFILEPTR TEXTSTREAM))
(NCHARS (CAR ME]
(PRIN3 (CAR ME)
TEXTSTREAM)
(PRIN3 [CADR (OR (ASSOC (CAR ME)
PARSE)
(ERROR "Field does not have spec"
(CAR ME]
TEXTSTREAM)
(COND
((CADR ME) (* Staying on same line)
(push THESETABS (ADD1 (GETFILEPTR TEXTSTREAM)))
(BOUT TEXTSTREAM (CHARCODE TAB)))
(T (COND
(THESETABS (push TABS THESETABS)
(SETQ THESETABS)))
(BOUT TEXTSTREAM (CHARCODE CR]
(SETQ TEXTSTREAM (OPENTEXTSTREAM TEXTSTREAM NIL NIL NIL (LIST '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 'TABS (CONS NIL (for I from 1 to (SUB1 N)
collect (CONS (ITIMES I (IQUOTIENT WIDTH
N))
'LEFT]
(CAR TB)
1))
(TEDIT.PARALOOKS TEXTSTREAM (LIST 'PARALEADING ARPARALEADING)
1
(GETEOFPTR TEXTSTREAM))
(TEDIT.SETSEL TEXTSTREAM 1 0)
(OPENTEXTSTREAM TEXTSTREAM WINDOW NIL NIL '(READONLY T]
(FULLNAME ARSTREAM])
(AR.PARSE
[LAMBDA (STREAM) (* lmm "24-May-85 11:34")
(* Reads an AR file, and parses it into a list of
(FIELD STRING))
(bind CHAR collect [LIST [PACKC (collect (SETQ CHAR (BIN STREAM))
repeatuntil (EQ CHAR (CHARCODE %:]
(LET ((BUFFER (GETRESOURCE SCRATCHSTRING))
RESULTS
(CHN 0))
(until (SELCHARQ (SETQ CHAR (BIN STREAM))
(%' (SETQ CHAR (BIN STREAM))
NIL)
(CR (OR (EQ (BIN STREAM)
(CHARCODE CR))
(SHOULDNT "Bad char after CR in parsed file")))
NIL) do (if (IGEQ CHN (NCHARS BUFFER))
then (push RESULTS BUFFER)
(SETQ BUFFER (GETRESOURCE
SCRATCHSTRING))
(SETQ CHN 0))
(RPLCHARCODE BUFFER (add CHN 1)
CHAR))
(PROG1 [CONCATLIST (SETQ RESULTS
(REVERSE (CONS (SUBSTRING BUFFER 1 CHN)
RESULTS]
(MAPC RESULTS (FUNCTION (LAMBDA (X)
(FREERESOURCE SCRATCHSTRING X]
until (EOFP STREAM])
(AR.SHOWFIELD
[LAMBDA (OUTFILE FIELDNAME ARFILE PARSE MAXCHARS) (* edited%: "21-Aug-84 14:38")
(PROG ((ARSPEC (ASSOC FIELDNAME PARSE))
ARFIELDCOUNT CHAR)
(COND
((NULL ARSPEC)
(ERROR "Field does not have spec" FIELDNAME)))
(SETFILEPTR ARFILE (CADR ARSPEC))
(COND
(MAXCHARS (while (IGREATERP MAXCHARS 0)
do (BOUT OUTFILE (SELCHARQ (SETQ CHAR (BIN ARFILE))
(%' (BIN ARFILE))
(CR (RPTQ MAXCHARS (BOUT OUTFILE (CHARCODE SPACE)))
(RETURN))
CHAR))
(add MAXCHARS -1)))
(T (do (BOUT OUTFILE (SELCHARQ (SETQ CHAR (BIN ARFILE))
(%' (BIN ARFILE))
(CR (RETURN))
CHAR])
(AR.SUMMARY
[LAMBDA (TOFILE MAP) (* mjs "19-Mar-84 09:33")
(OR MAP (SETQ MAP AR.SUMMARY.MAP))
(PROG [(STR (OPENSTREAM TOFILE 'OUTPUT]
[ERSETQ (for I from 1 do (PROG [(ARSTREAM (OPENSTREAM (AR.FILENAME I)
'INPUT
'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 'TITLE TITLE))
AR.LAYOUT.WINDOW)
(T (SETQ AR.LAYOUT.WINDOW (CREATEW NIL (OR TITLE "AR Layout"])
(AR.FILENAME
[LAMBDA (ARN) (* mjs " 7-May-84 14:59")
(PACK* AR.DIRECTORY (SUBSTRING (IPLUS 10000000 ARN)
-5 -1)
".AR"])
)
(RPAQQ AR.MAP ((Number%: T)
(Date%: T)
(Submitter%:)
(Source%:)
(System%: T)
(Machine%:)
(Subsystem%: T)
(Disk%:)
(|Problem Type:| T)
(|Memory Size:|)
(Subject%:)
(|Source Files:|)
(Impact%: T)
(Frequency%:)
(Status%: T)
(In/By%: T)
(Attn%:)
(|Assigned To:| T)
(Priority%: T)
(Difficulty%:)
(Disposition%:)
(|Lisp Version:| T)
(|Microcode Version:|)
(|File Server:| T)
(|Server Software Version:|)
(Description%:)
(|Release Note:|)
(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 ARPARALEADING AR.MAP AR.SUMMARY.MAP AR.THIN.SUMMARY.MAP
AR.INDEX.MONITORLOCK AR.FORM.ICON AR.QFORM.ICON AR.INDEX.DEFAULT.FIELDS)
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(SPECVARS AR.INDEX.DEFAULT.FILE.NAME AR.INFO.FILE.NAME AR.SUBMIT.NUM.FILE.NAME AR.DIRECTORY
AR.ENTRY.LIST.PRINT.MULTILINE.FLAG AR.ENTRY.LIST.WINDOW.FIELDS AR.ENTRY.LIST.PRINT.FIELDS
AR.NO.MESSAGE.FLG ARBUTTONFONT ARFONT ARBOLDFONT AR.FORM.FORMAT AR.FORM.SPECS)
)
(ADDTOVAR BackgroundMenuCommands ("AR Edit" '(AR.FORM)
"Create an AR.FORM editor for the Lisp AR database"
(SUBITEMS ("New AR form" '(AR.FORM)
"Creates new AR.FORM editor, initially cleared"
)
("Load AR form" '(AR.FORM (RNUMBER))
"Creates new AR.FORM editor, initally loaded with a specified AR"
)
("AR.SHOW" '(AR.SHOW (RNUMBER))
"Calls the old AR.SHOW bug-report displayer to quickly display a specified AR"
)
("AR Query Form" '(AR.QFORM.CREATE)
"Creates an AR Query Form"))))
(RPAQQ BackgroundMenu NIL)
(RPAQ AR.INDEX.MONITORLOCK (CREATE.MONITORLOCK 'AR.INDEX.LOCK))
(DECLARE%: EVAL@COMPILE
[PUTPROPS AR.ENTRY.PTR.TO.KEY.VAL.PTR MACRO (X `(IPLUS %, (CADR X)
(IQUOTIENT (IDIFFERENCE %, (CAR X)
AR.INDEX.ENTRY.BEGIN.PTR)
AR.INDEX.ENTRY.SIZE]
[PUTPROPS AR.ENTRY.TO.NUM MACRO (X `(PROGN (SETFILEPTR AR.INDEX.FILE %, (CAR X))
(\DWIN AR.INDEX.FILE]
[PUTPROPS AR.INDEX.DATA.CONTEXT MACRO
(X `(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)
'AR.INDEX.DATA))
(AR.INDEX.FILE.REOPEN %, (CAR X))
(RETURN (PROGN %,@ (CDR X]
[PUTPROPS AR.KEY.VAL.PTR.TO.ENTRY.PTR MACRO (X `(IPLUS (ITIMES AR.INDEX.ENTRY.SIZE
(IDIFFERENCE %, (CAR X)
%,
(CADR X)))
AR.INDEX.ENTRY.BEGIN.PTR]
[PUTPROPS ARSPECGET MACRO (X `(LISTGET (CDR (ASSOC %, (CADR X)
%,
(CAR X)))
%,
(CADDR X]
[PUTPROPS ARSPECPUT MACRO (X `(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))
)
(READVAR-FROM-STRING 'AR.FORM.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@%")}
")
(READVAR-FROM-STRING 'AR.QFORM.ICON "{(READBITMAP)(60 110
%"OOOOOOOOOOOOOOO@%"
%"OOOOOOOOOOOOOOO@%"
%"L@@@@@@@@@@@@@C@%"
%"L@@@@@@@@@@@@@C@%"
%"L@@@@@@@@@@@@@C@%"
%"L@@@@@@@@@@@@@C@%"
%"L@@@@@@@@@@@@@C@%"
%"L@@@@EMML@@@@@C@%"
%"L@@@@GGGF@@@@@C@%"
%"L@@@AMMMML@@@@C@%"
%"L@@@CGGGGF@@@@C@%"
%"L@@@MMMMMM@@@@C@%"
%"L@@AGGGGGG@@@@C@%"
%"L@@AMMMMMMH@@@C@%"
%"L@@CGGGGGG@@@@C@%"
%"L@@AMMMMMML@@@C@%"
%"L@@CGGGGGGF@@@C@%"
%"L@@AMMHAMML@@@C@%"
%"L@@CGF@AGGF@@@C@%"
%"L@@AML@@MML@@@C@%"
%"L@@CGD@@GGF@@@C@%"
%"L@@AML@@EML@@@C@%"
%"L@@CGF@@GGF@@@C@%"
%"L@@AML@@EML@@@C@%"
%"L@@CGF@@GGD@@@C@%"
%"L@@AML@@MML@@@C@%"
%"L@@@GD@AGGD@@@C@%"
%"L@@@EH@AMMH@@@C@%"
%"L@@@@@@GGG@@@@C@%"
%"L@@@@@AMMM@@@@C@%"
%"L@@@@@CGGF@@@@C@%"
%"L@@@@@EMML@@@@C@%"
%"L@@@@@GGG@@@@@C@%"
%"L@@@@@EMM@@@@@C@%"
%"L@@@@@GGD@@@@@C@%"
%"L@@@@@EML@@@@@C@%"
%"L@@@@@GGD@@@@@C@%"
%"L@@@@@EML@@@@@C@%"
%"L@@@@@GGD@@@@@C@%"
%"L@@@@@EML@@@@@C@%"
%"L@@@@@GGD@@@@@C@%"
%"L@@@@@EML@@@@@C@%"
%"L@@@@@GGD@@@@@C@%"
%"L@@@@@EML@@@@@C@%"
%"L@@@@@GGD@@@@@C@%"
%"L@@@@@EML@@@@@C@%"
%"L@@@@@GGD@@@@@C@%"
%"L@@@@@EML@@@@@C@%"
%"L@@@@@GGD@@@@@C@%"
%"L@@@@@AMH@@@@@C@%"
%"L@@@@@AG@@@@@@C@%"
%"L@@@@@@@@@@@@@C@%"
%"L@@@@@@@@@@@@@C@%"
%"L@@@@@@@@@@@@@C@%"
%"L@@@@@@@@@@@@@C@%"
%"L@@@@@GO@@@@@@C@%"
%"L@@@@@OGH@@@@@C@%"
%"L@@@@@MML@@@@@C@%"
%"L@@CH@OGF@@@@@C@%"
%"L@@OL@MMN@CN@@C@%"
%"L@ALL@OGF@CO@@C@%"
%"L@GHN@MMN@GCH@C@%"
%"L@N@F@OGF@FAL@C@%"
%"LCH@F@MMN@F@G@C@%"
%"LC@@BCOOO@L@CHC@%"
%"L@@@CGOOOIL@ALC@%"
%"L@@@CO@@CMH@@NC@%"
%"L@@@CL@@@O@@@FC@%"
%"L@@@CH@@@G@@@@C@%"
%"L@@@O@@@@CH@@@C@%"
%"L@@@LCOCO@L@@@C@%"
%"L@@@LGOCOHN@@@C@%"
%"L@GAHNCCALF@@@C@%"
%"L@GMHLCC@LF@@@C@%"
%"L@MOHLCC@LGOL@C@%"
%"LAHC@LCC@LCON@C@%"
%"LAHC@LCC@LC@N@C@%"
%"LC@C@OOCOLC@C@C@%"
%"LC@C@OOCOLC@C@C@%"
%"LF@C@LCCG@C@AHC@%"
%"LF@C@LCCCHC@AHC@%"
%"LF@C@LCCALC@@LC@%"
%"LF@CHLCC@LF@@NC@%"
%"L@@AHLCC@LF@@FC@%"
%"L@@AHLCC@LF@@FC@%"
%"L@@@LLCC@LL@@@C@%"
%"L@AOLLCC@LON@@C@%"
%"L@AOLLCC@LON@@C@%"
%"L@AHN@CC@ALF@@C@%"
%"L@AHF@CC@AHC@@C@%"
%"L@CHF@CC@AHC@@C@%"
%"L@C@C@CC@C@AH@C@%"
%"L@C@CHCC@G@AH@C@%"
%"L@C@AHCC@F@AH@C@%"
%"L@B@@N@@AN@AL@C@%"
%"L@F@@G@@CL@@L@C@%"
%"L@F@@CNCOH@@N@C@%"
%"L@N@@AOON@@@F@C@%"
%"L@L@@@CN@@@@C@C@%"
%"LAH@@@@@@@@@CHC@%"
%"LAH@@@@@@@@@ALC@%"
%"LC@@@@@@@@@@ALC@%"
%"LF@@@@@@@@@@@NC@%"
%"LF@@@@@@@@@@@FC@%"
%"L@@@@@@@@@@@@BC@%"
%"L@@@@@@@@@@@@@C@%"
%"L@@@@@@@@@@@@@C@%"
%"L@@@@@@@@@@@@@C@%"
%"OOOOOOOOOOOOOOO@%"
%"OOOOOOOOOOOOOOO@%")}
")
(DECLARE%: EVAL@COMPILE
[PUTDEF 'SCRATCHSTRING 'RESOURCES '(NEW (ALLOCSTRING 100]
)
(PUTPROPS AREDIT COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (10748 93127 (AR.BUTTON.GET.MENU 10758 . 11280) (AR.BUTTON.GET.SUBMENU 11282 . 12470) (
AR.BUTTON.OBJ.CREATE 12472 . 15700) (AR.BUTTONFN.DOMENU 15702 . 16962) (AR.BUTTONFN.DOSUBMENU 16964 .
17576) (AR.BUTTONFN.SELFIELD 17578 . 18162) (AR.CHECK.FIELDS 18164 . 19616) (AR.CHECK.MENU 19618 .
20541) (AR.CHECK.SHORTSTRING 20543 . 20866) (AR.CHECK.SUBMENU 20868 . 22014) (AR.CONFIRM 22016 . 22221
) (AR.COPY.AND.INDEX.AR 22223 . 25686) (AR.DELETE.FIELD.VAL 25688 . 26771) (AR.DISCONNECT.WINDOW 26773
. 26996) (AR.FIND.BUTTON 26998 . 27476) (AR.FIND.EDIT.CHANGES 27478 . 31587) (AR.FIND.UNPROTECTED.CH#
31589 . 32274) (AR.FORM 32276 . 32523) (AR.FORM.CLEAR 32525 . 33252) (AR.FORM.CREATE 33254 . 38647) (
AR.FORM.FILL.INS 38649 . 38938) (AR.FORM.FILL.INS.DEFAULT 38940 . 39669) (AR.FORM.GROUP.CREATE 39671
. 42740) (AR.FORM.MENU.TITLEMENUFN 42742 . 45818) (AR.JUST.GET.SUBMIT.NUM 45820 . 47800) (
AR.JUST.PRINT.AR.NUM 47802 . 48507) (AR.KILL.ATTACHED.TEDIT.CLOSEFN 48509 . 48997) (
AR.NOTE.FIELD.CHANGED 48999 . 50870) (AR.FORM.MENU.ACTIONFN 50872 . 54872) (AR.FORM.MENU.BUTTONFN
54874 . 55127) (AR.FORM.SAVE 55129 . 59249) (AR.GET.AR 59251 . 61985) (AR.GET.ASSOCIATED.MENU.VAL
61987 . 62478) (AR.GET.BUTTON.FIELD.AS.TEXT 62480 . 63909) (AR.GET.MENU.FROM.MAIN.WINDOW 63911 . 64296
) (AR.GET.NEXT 64298 . 66133) (AR.GET.SUBMIT.NUM 66135 . 67864) (AR.GET.BUTTON.FIELD.AS.LIST 67866 .
68203) (AR.GET.FILENAME 68205 . 68856) (AR.MARK.ACTIVE 68858 . 69073) (AR.MENU.CR.FN 69075 . 69294) (
AR.MENU.FN.CLEAR 69296 . 69884) (AR.MENU.FN.GET 69886 . 71257) (AR.MENU.FN.PUT 71259 . 77675) (
AR.PRINT.PADDED 77677 . 79532) (AR.PROMPT 79534 . 79872) (AR.PROTECT.WARNING 79874 . 80137) (
AR.PUT.FAILED 80139 . 80417) (AR.RECONNECT.WINDOW 80419 . 80943) (AR.REPLACE.FIELD.VAL 80945 . 83008)
(AR.REPLACE.FILL.INS 83010 . 83500) (AR.RESET.SEL 83502 . 84229) (AR.SCRATCH.LOAD 84231 . 85249) (
AR.SEND.MESSAGE 85251 . 87506) (AR.TEXTSTREAM.LOAD 87508 . 91007) (AR.TOBJ.ACTIVEP 91009 . 91237) (
AR.UPDATE.AR.INFO 91239 . 92507) (AR.USERNAME 92509 . 92774) (IMAGEOBJPROPS.MACRO 92776 . 93125)) (
93219 106707 (AR.QUERY 93229 . 93867) (AR.QUERY.EVAL.QLIST 93869 . 95953) (AR.ENTRY.LIST.AND 95955 .
97665) (AR.ENTRY.LIST.OR 97667 . 99291) (AR.ENTRY.LIST.NOT 99293 . 100921) (AR.INDEX.SEARCH.HAS 100923
. 103564) (AR.INDEX.SEARCH.IS 103566 . 106705)) (106751 133129 (AR.QFORM.DISPLAY.CONNECT 106761 .
107916) (AR.QFORM.DISPLAY.DISCONNECT 107918 . 108307) (AR.QFORM.GROUP.CREATE 108309 . 113016) (
AR.QFORM.FN.UPDATE 113018 . 113390) (AR.QFORM.FN.QUERY 113392 . 114108) (AR.QFORM.FN.PRINT 114110 .
114827) (AR.QFORM.CREATE 114829 . 115915) (AR.QFORM.BUTTONFN 115917 . 116187) (AR.QFORM.ACTIONFN
116189 . 118498) (AR.GET.QLIST.PROMPT.MENU 118500 . 121246) (AR.QFORM.PROMPT.LIST.FN 121248 . 123033)
(AR.GET.SLIST.PROMPT.MENU 123035 . 124038) (AR.ENTRY.LIST.WINDOW.REPAINTFN 124040 . 128400) (
AR.ENTRY.LIST.WINDOW.BUTTONEVENTFN 128402 . 133127)) (133130 178248 (AR.EDIT.USING.CORRESPONDING.FORM
133140 . 135165) (AR.GATHER.NEW.AR.DATA 135167 . 137824) (AR.GET.ENTRY.NUM 137826 . 138099) (
AR.GET.FIELD.VAL.DATA 138101 . 138838) (AR.GET.FIELD.VAL.LENGTH 138840 . 140579) (AR.GET.FIELD.VAL.PTR
140581 . 141428) (AR.GET.FIELD.VAL 141430 . 143051) (AR.INDEX.CREATE 143053 . 144788) (
AR.GET.ENUMERATED.FIELD.KEYS 144790 . 145812) (AR.INDEX.DATA.UNPACK 145814 . 146234) (
AR.INDEX.FIND.ENTRY.PTR 146236 . 147618) (AR.INDEX.OPEN 147620 . 148606) (AR.INDEX.FILE.REOPEN 148608
. 149238) (AR.INDEX.PRINT 149240 . 153180) (AR.INDEX.REWRITE.ENTRY.DATA 153182 . 158277) (
AR.INDEX.REWRITE.FIELD.DATA 158279 . 162104) (AR.GET.ENTRY.PTRS.FROM.FIELD.PTRS 162106 . 164564) (
AR.INDEX.UPDATE 164566 . 168842) (AR.PRINT 168844 . 174091) (AR.SORT 174093 . 178246)) (188041 196315
(AR.SHOW 188051 . 191785) (AR.PARSE 191787 . 193832) (AR.SHOWFIELD 193834 . 194894) (AR.SUMMARY 194896
. 195731) (AR.LAYOUT.WINDOW 195733 . 196087) (AR.FILENAME 196089 . 196313)))))
STOP