(FILECREATED "11-Feb-86 23:03:28" {QV}<IDL>SOURCES>DATAENTRY.;11 26909
changes to: (VARS DATAENTRYCOMS)
(FNS PRINTROW READROW)
previous date: " 3-Sep-85 17:23:24" {QV}<IDL>SOURCES>DATAENTRY.;10)
(* Copyright (c) 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT DATAENTRYCOMS)
(RPAQQ DATAENTRYCOMS [(* Defines utility function for converting labeled lists to IDL matrices)
(FNS CONVERT DUMPIDLARRAY DUMPIDLARRAY1 IDLARRAY IDLMATRIX LISTARRAY
LISTMATRIX PRINTIDLARRAY PRINTROW READIDLARRAY READIDLARRAY1 READROW)
(FILEPKGCOMS IDLARRAYS)
(ADDVARS (HPRINTMACROS (ARRAYFRAME . PRINTIDLARRAY)))
(ADDVARS (HPRINTMACROS (ROWHEADER . PRINTROW])
(* Defines utility function for converting labeled lists to IDL matrices)
(DEFINEQ
(CONVERT
[ULAMBDA ((DATA (ONEOF SCALAR ARRAY) (MSG "DATA can't be converted to scalar or array: " .P2 UARG))
(RETURNS (ONEOF SCALAR ARRAY)))
(* rmk: "10-MAR-80 10:02")
DATA])
(DUMPIDLARRAY
[ULAMBDA ((A ARRAY)
(FILE (ONEOF LITATOM STREAM)))
(* jop: " 2-Sep-85 16:33" posted: "23-MAY-78 22:11")
(* Dumps A on FILE in format that can be read by
READIDLARRAY)
(DUMPIDLARRAY1 A FILE)])
(DUMPIDLARRAY1
[DLAMBDA ((A ARRAY)
(FILE (ONEOF LITATOM STREAM)))
(* jop: " 2-Sep-85 16:33" posted: "10-JAN-79 17:30")
(* Dumps A on FILE in format that can be read by READIDLARRAY. A subfunction so that it can be called by two user
entries, DUMPIDLARRAY and LISTARRAY)
(RESETLST [if (NULL FILE)
elseif (OPENP FILE (QUOTE OUTPUT))
then (RESETSAVE (OUTPUT FILE))
else (RESETSAVE (OUTFILE FILE)
(QUOTE (PROGN (CLOSEF (OUTPUT OLDVALUE]
(RESETSAVE FONTCHANGEFLG NIL)
(DPROG (TEMP
(VALDIM (GETVALDIM A) (ONEOF NIL INTEGER))
(OLD= (GETSYNTAX (CHARCODE =))))
[RESETSAVE (PROGN OLD=)
(QUOTE (PROGN (SETSYNTAX (QUOTE =)
OLDVALUE]
(PRIN1 "(")
(if (SETQ TEMP (GETTITLE A T))
then (DPROG ((ACTION [FUNCTION (LAMBDA NARGS
(for I from 1 to NARGS
do (PRIN3 (ARG NARGS I] FUNCTION (USEDIN
TRAVERSE.TITLE)))
(PRIN3 (QUOTE %"))
(TRAVERSE.TITLE TEMP)
(PRIN3 (QUOTE %")) (* The TERPRI gets POSITION going again)
(TERPRI)))
(PRIN1 "(")
(for DIM VDFLAG NLEVS (SH ←(fetch SHAPE of A)) from 1
to (fetch NDIMS of A)
declare (NLEVS IJK)
(SH ROWINT)
do (SETQ VDFLAG (EQ DIM VALDIM))
(SETQ NLEVS (GETRELT SH DIM))
(SETSYNTAX (CHARCODE =)
(QUOTE BREAK))
(printout NIL .TAB0 1 "(" .P2 (OR (GETDIMLAB A DIM)
DIM)
"=" NLEVS)
(SETSYNTAX (CHARCODE =)
OLD=)
(for L LAB OUTOFSTEP CFLAG CODES from 1 to NLEVS
do (if [AND VDFLAG (OR (SETQ CODES (GETCODES A L))
(AND (NULL CFLAG)
(IEQP L NLEVS]
then (SETQ CFLAG T) (* The valdim has at last one listed label entry)
(if OUTOFSTEP
then (SETQ OUTOFSTEP NIL)
(printout NIL , (SUB1 L)))
(printout NIL " (" .P2 (OR (GETLEVLAB A DIM L)
L)
, .PARA2 -3 0 (for C in CODES
collect (LIST (fetch CODE
of C)
(fetch CODELAB
of C)))
")" 5)
elseif (SETQ LAB (GETLEVLAB A DIM L))
then (if OUTOFSTEP
then (SETQ OUTOFSTEP NIL)
(printout NIL , (SUB1 L)))
(printout NIL , LAB)
else (SETQ OUTOFSTEP T)))
(PRIN1 ")"))
(printout NIL " )" T) (* Closeoff the labels)
(if (fetch KEEPS of A)
then (PRIN1 "(kept")
(for K in (fetch KEEPS of A) do (printout NIL , (OR (GETDIMLAB A K)
K)))
(printout NIL ")" T))
(for P POS (NONE ← T) in (fetch SLOT5 of A)
when [AND (NEQ (CAR P)
(QUOTE KEEPS))
(CDR P)
(EQ P (FASSOC (CAR P)
(fetch SLOT5 of A]
do (if NONE
then (PRIN1 "(properties ")
(SETQ POS (POSITION))
(SETQ NONE NIL))
(printout NIL .TAB0 POS .P2 (CAR P)
, .PPV (CDR P))
finally (if (NOT NONE)
then (printout NIL ")" T)))
(bind [GSB ←(SETUP A (if (EQ (fetch FORMAT of A)
(QUOTE SYMMETRIC))
then (PRINT (QUOTE SYMMETRIC))
else (QUOTE ROWMAJOR]
first (PRIN1 "(") until (fetch DONE of GSB)
do (PRIN1 (GETAELT A (NEXT GSB)))
(SPACES 1))
(printout NIL "))" T) (* The end of the array)))
A])
(IDLARRAY
[ULAMBDA ((DATA LISTP)
(RETURNS SIMARRAY))
(* rmk: "10-JAN-79 17:47" posted: "10-JAN-79 17:30")
(* Converts DATA to an IDL array)
[PROG (FILE)
(RETURN (RESETLST [RESETSAVE (SETQ FILE (OPENFILE (CONSTANT (PACKFILENAME (QUOTE NAME)
(QUOTE SCRATCH)
(QUOTE EXTENSION)
(QUOTE IDL)
(QUOTE TEMPORARY)
T))
(QUOTE BOTH)
(QUOTE NEW)))
(QUOTE (PROGN (CLOSEF? OLDVALUE)
(DELFILE OLDVALUE]
(PRIN2 DATA FILE FILERDTBL)
(SETFILEPTR FILE 0)
(READIDLARRAY1 FILE]])
(IDLMATRIX
[ULAMBDA ((DATA LISTP [SATISFIES (for X on DATA always (LISTP (CAR X))
finally (RETURN (AND $$VAL (NULL X] (MSG
"DATA not a list of lists: "
.P2 UARG)
(* A proper list of lists)))
(* bas: "11-FEB-83 11:23")
(* Constructs a rows X columns IDL matrix out of DATA, a list of row-lists. Each row-list consists of a row ID
followed by its column values (missing values are represented by NIL). The first row-list may optionally be preceded
with dummy rows that provide the title and labels for the matrix: -
If the first "row" has row ID=TITLES, then its CDR is taken as (TITLE ROWLABEL COLLABEL) -
If the second row has ID='LABELS, then its CDR is a list each element of which represents one column
(in the order in which they appear in the row-lists). A given label may be an atom (which, if non-NIL, becomes the
IDL selector and there are no value labels) or a list (the first element is the selector, and the remaining elements
are value or category labels.))
(DPROG ((TITLE NIL USERTITLE)
(ROWLABEL NIL LABEL)
(COLLABEL NIL LABEL)
(LABELS NIL ANY)
(LABELFLAG NIL BOOL (* T if LABELS list present.
Causes row-labels to be sought))
(VALDIM NIL (ONEOF NIL INTEGER))
TEMP)
(if (FMEMB (U-CASE (CAAR DATA))
(QUOTE (TITLES TITLE TIT)))
then [SETQ TEMP (coerce (CDAR DATA)
LISTP
(MSG "Invalid TITLE list: " .P2 (CAR DATA]
(SETQ TITLE (coerce (CADAR DATA)
USERTITLE
(MSG "Bad title: " .P2 UARG)))
[SETQ TEMP (coerce (CDR TEMP)
LISTP
(MSG "Invalid TITLE list: " .P2 (CAR DATA]
(SETQ ROWLABEL (coerce (CADDR (CAR DATA))
(ONEOF NIL LABEL)
(MSG "Bad dimension label: " .P2 UARG)))
[SETQ TEMP (coerce (CDR TEMP)
LISTP
(MSG "Invalid TITLE list: " .P2 (CAR DATA]
(SETQ COLLABEL (coerce (CADDDR (CAR DATA))
(ONEOF NIL LABEL)
(MSG "Bad dimension label: " .P2 UARG)))
(SETQ DATA (CDR DATA)))
[if (FMEMB (U-CASE (CAAR DATA))
(QUOTE (LABELS LABEL LAB)))
then (SETQ LABELFLAG T)
(SETQ LABELS (CDR (pop DATA]
(RETURN (DPROG ((NROWS (LENGTH DATA) INTEGER)
(NCOLS (LENGTH (if LABELFLAG
then (CDAR DATA)
else (CAR DATA))) INTEGER)
(MATRIX NIL MATRIX)) (* First some consistency checking.)
(if (ILESSP NCOLS (LENGTH LABELS))
then (UERROR "List of column labels is too long"))
(* Now to the business at hand.)
(SETQ MATRIX (ALLOC.SARRAY (ROWINTOF NROWS NCOLS)
(QUOTE FULL)))
(for R (N ← 0)
(FIXFLG ← T)
(GSBM ←(SETUP MATRIX (QUOTE ROWMAJOR))) in DATA as R# from 1
do (for VAL in (if LABELFLAG
then (CDR R)
else R)
as C# from 1
do (if (IGREATERP C# NCOLS)
then (UERROR "Row# " R# # (if LABELFLAG
then (printout NIL ", label " .P2
(CAR R)
","))
" has too "
(if (IGREATERP C# NCOLS)
then "many"
else "few")
" columns"))
(SETQ VAL (coerce VAL SCALAR))
(if FIXFLG
then (if (type? FLOATING VAL)
then (SETQ FIXFLG NIL)
(FLOATROW (fetch ELEMENTBLOCK of MATRIX)
N)
else (add N 1)))
(SETAELT MATRIX (NEXT GSBM)
VAL)))
(SETTITLE MATRIX TITLE)
(SETDIMLAB MATRIX 1 ROWLABEL)
(SETDIMLAB MATRIX 2 COLLABEL)
[if LABELFLAG
then (for R ID in DATA as R# from 1 when (SETQ ID (CAR R))
do (if (type? INTEGER ID)
elseif (type? LABEL ID)
then (ASSIGN.LABEL MATRIX (LABEL 1 R#)
ID)
elseif (LISTP ID)
then (ASSIGN.LABEL MATRIX (LABEL 1 R#)
(CAR ID))
(if (NULL VALDIM)
then (SETVALDIM MATRIX (SETQ VALDIM 1)))
(if (EQ VALDIM 1)
then (ASSIGN.CODE MATRIX (CODE R#)
(CDR ID))
else (UERROR
"Can't have codebooks on both dimensions"))
else (UERROR "Invalid label specification: " .P2 ID]
(for L in LABELS as C# from 1 to NCOLS when L
do (if (type? INTEGER L)
elseif (type? LABEL L)
then (ASSIGN.LABEL MATRIX (LABEL 2 C#)
L)
elseif (LISTP L)
then (* Now put out value labels.)
(ASSIGN.LABEL MATRIX (LABEL 2 C#)
(CAR L))
(if (NULL VALDIM)
then (SETVALDIM MATRIX (SETQ VALDIM 2)))
(if (EQ VALDIM 2)
then (ASSIGN.CODE MATRIX (CODE C#)
(CDR L))
else (UERROR "Can't have codebooks on both dimensions"))
else (UERROR "Invalid label specification: " .P2 L)))
(RETURN MATRIX))))])
(LISTARRAY
[ULAMBDA ((A ARRAY)
(RETURNS LISTP))
(* rmk: "10-JAN-79 17:40" posted: "10-JAN-79 17:33")
(* Converts A into list structure)
[PROG (FILE)
(RETURN (RESETLST [RESETSAVE (SETQ FILE (OPENFILE (CONSTANT (PACKFILENAME (QUOTE NAME)
(QUOTE SCRATCH)
(QUOTE EXTENSION)
(QUOTE IDL)
(QUOTE TEMPORARY)
T))
(QUOTE BOTH)
(QUOTE NEW)))
(QUOTE (PROGN (CLOSEF? OLDVALUE)
(DELFILE OLDVALUE]
(DUMPIDLARRAY1 A FILE)
(SETFILEPTR FILE 0)
(READ FILE FILERDTBL]])
(LISTMATRIX
[ULAMBDA ((M MATRIX (MSG "M not a matrix: " .P2 M)))
(* edited: "15-Aug-85 23:02" posted: "23-MAY-78 22:12")
(* Converts an IDL matrix into a list structure from
which IDLMATRIX can reconstruct the original.)
(DPROG ((VD (GETVALDIM M) (ONEOF NIL INTEGER))
(NVARS (GETRELT (fetch SHAPE of M)
2) INTEGER))
[RETURN (CONS (LIST (QUOTE TITLES)
(MAKEUSERTITLE M)
(GETDIMLAB M 1)
(GETDIMLAB M 2))
(CONS [CONS (QUOTE LABELS)
(for I CODES (VD2 ←(EQ VD 2)) from 1 to NVARS
collect (if (AND VD2 (SETQ CODES (GETCODES M I)))
then (SETQQ VD2 DONE)
[CONS (OR (GETLEVLAB M 2 I)
I)
(for C in CODES
collect (LIST (fetch CODE
of C)
(fetch CODELAB
of C]
else (OR (GETLEVLAB M 2 I)
I))
finally (if (AND (EQ VD2 T)
$$VAL)
then (FRPLACA $$VAL (LIST (CAR $$VAL]
(for R CODES (VD1 ←(EQ VD 1)) from 1 bind (GSB ←(SETUP M (QUOTE ROWMAJOR)
))
until (fetch DONE of GSB)
collect [CONS (if (AND VD1 (SETQ CODES (GETCODES M R)))
then (SETQQ VD1 DONE)
[CONS (OR (GETLEVLAB M 1 R)
R)
(for C in CODES
collect (LIST (fetch CODE
of C)
(fetch CODELAB
of C]
else (OR (GETLEVLAB M 1 R)
R))
(for I from 1 to NVARS collect (COPYAELT M
(NEXT GSB]
finally (if (AND (EQ VD1 T)
$$VAL)
then (FRPLACA (CAR $$VAL)
(LIST (CAAR $$VAL])])
(PRINTIDLARRAY
[DLAMBDA ((ARRAY ARRAY)
(STREAM (ONEOF STREAM LITATOM)))
(* jop: " 2-Sep-85 16:17")
(PRINTOUT STREAM "(READIDLARRAY) ")
(DUMPIDLARRAY ARRAY STREAM)])
(PRINTROW
[DLAMBDA ((R ROW)
(STREAM (ONEOF LITATOM STREAM)))
(* jop: " 2-Sep-85 17:04")
(* * PRINTFN FOR ROWS)
(if (EQ (fetch RELTTYPE of R)
(QUOTE POINTER))
then (HELP "DUMPING A POINTER ROW?" R))
(PRINTOUT STREAM "(READROW)(")
(PRINTOUT STREAM "NELTS" , (fetch NELTS of R)
, "RELTTYPE" , (fetch RELTTYPE of R)
, "MAYHAVENIL" , (fetch MAYHAVENIL of R)
, "ELEMENTS" ,)
(PRINTOUT STREAM "(")
(for I from 1 to (fetch NELTS of R)
do (PRIN2 (GETRELT R I)
STREAM)
(SPACES 1 STREAM))
(PRINTOUT STREAM "))")])
(READIDLARRAY
[ULAMBDA ((FILE (ONEOF LITATOM STREAM))
(RETURNS SIMARRAY))
(* jop: " 2-Sep-85 16:30" posted: "23-MAY-78 22:12")
(* User entry for reading User entry for READIDLARRAY1. The two are separate so that IDLARRAY can call the internal
function through a different entry)
(READIDLARRAY1 FILE)])
(READIDLARRAY1
[DLAMBDA ((FILE (ONEOF LITATOM STREAM))
(RETURNS SIMARRAY))
(* jop: " 2-Sep-85 16:30" posted: "10-JAN-79 17:30")
(* Reads an array description from FILE and constructs
the correspnding IDL array)
(RESETLST [if (NULL FILE)
elseif (OPENP FILE (QUOTE INPUT))
then (RESETSAVE (INPUT FILE))
else (RESETSAVE (INFILE FILE)
(QUOTE (PROGN (CLOSEF (INPUT OLDVALUE]
(SETQ FILE (INPUT))
(DPROG ((TITLE NIL (ONEOF NIL STRINGP))
(DIMSPECS NIL)
(NLEVS NIL (LST OF INTEGER))
(KEEPS NIL LST)
(PROPS NIL LST)
(VALDIM NIL (ONEOF NIL INTEGER))
(SH NIL ROWINT)
(A NIL SIMARRAY)
(OLD= (GETSYNTAX (CHARCODE =)))
(FORMAT NIL)
(RETURNS SIMARRAY))
(if [NOT (FMEMB (RATOM)
(QUOTE (%( %[]
then (UERROR "Invalid file format: " .P2 FILE))
(* Skip the opening paren)
(if (EQ (SKIPSEPRS)
(QUOTE %"))
then (SETQ TITLE (READ))) (* If a string, assume its the title)
(if [NOT (FMEMB (RATOM)
(QUOTE (%( %[]
then (UERROR "Invalid file format: " .P2 FILE))
(* The paren that groups the dimspecs)
[RESETSAVE (PROGN OLD=)
(QUOTE (PROGN (SETSYNTAX (QUOTE =)
OLDVALUE]
(* This makes sure that = will be set back on exit)
(SETQ DIMSPECS (for DIM LAB TEMP from 1 while (FMEMB (RATOM)
(QUOTE (%( %[)))
collect (SETSYNTAX (CHARCODE =)
(QUOTE BREAK))
(if (type? LABEL (SETQ LAB (RATOM)))
else (coerce LAB INTEGER (SATISFIES (EQ LAB DIM))
(MSG "Invalid label for dimension " DIM
": "
.P2 UARG))
(* Label can be the dimension number)
(SETQ LAB NIL))
(if (LISTP (SETQ TEMP (READ)))
then (if [thereis X in TEMP
suchthat (FMEMB (L-CASE X)
(QUOTE (kept keeps keep]
then (push KEEPS DIM))
(if [thereis X in TEMP
suchthat (FMEMB (L-CASE X)
(QUOTE (code codes
codebook
codebooks]
then (if (NULL VALDIM)
then (SETQ VALDIM DIM)
else (UERROR
"Two code-book dimensions: "
VALDIM " and " DIM)))
(SETQ TEMP (READ)))
(if (NEQ TEMP (QUOTE =))
then (UERROR "Missing %"=%" in dimension " DIM
" specification"))
(push NLEVS (coerce (RATOM)
INTEGER
(MSG
"Number of levels for dimension "
DIM " not an integer: " .P2
UARG)))
(SETSYNTAX (CHARCODE =)
OLD=)
(SETQ TEMP
(for LEV# LEV from 1
until (PROG1 (FMEMB (SKIPSEPRS)
(QUOTE (%) %])))
(SETQ LEV (READ)))
collect (SELTYPEQ
LEV
[LISTP (if (NULL VALDIM)
then (SETQ VALDIM DIM)
elseif (NEQ VALDIM DIM)
then (UERROR
"Two code-book dimensions: "
VALDIM " and "
DIM))
(if (type? ARITH (CAR LEV))
then (SETQ LEV#
(change (CAR LEV)
(FIXR DATUM]
(LABEL)
[ARITH (SETQ LEV# (change LEV
(FIXR DATUM]
(UERROR
"Invalid label specification for level "
LEV# ", dimension " DIM))
(if (IGREATERP LEV# (CAR NLEVS))
then (UERROR
"Too many level specifications for dimension "
DIM ": " LEV#))
LEV))
(CONS LAB TEMP)))
(SETQ KEEPS (DREVERSE KEEPS)) (* If keeps were found associated with dimensions
(old-style))
FMT (SETQ FORMAT (U-CASE (RATOM))) (* The opening paren of the keeps or properties, the
format, or the opening paren of the valuelist)
(SELECTQ (if (FMEMB FORMAT (QUOTE (FULL SYMMETRIC)))
then (RATOM)
else (PROG1 FORMAT (SETQQ FORMAT FULL)))
((%( %[)
(SELECTQ (SKIPSEPRS)
((k K) (* If KEEPS weren't earlier, then they could be here)
(if (NULL KEEPS)
then (SETQ KEEPS
(bind K first (OR (EQ (L-CASE (SETQ K (RATOM)))
(QUOTE kept))
(UERROR
"Bad keeps list or illegal value: "
.P2 K))
until (FMEMB (SETQ K (RATOM))
(QUOTE (%) %])))
collect K))
(GO FMT)))
((p P) (* properties list)
[SETQ PROPS (bind P first (OR (EQ (L-CASE (SETQ P (RATOM)))
(QUOTE properties))
(UERROR
"Bad property list or illegal value: "
.P2 P))
until (FMEMB (SETQ P (RATOM))
(QUOTE (%) %])))
collect (CONS P (READ]
(GO FMT))
NIL))
((%) %])
(SETQQ FORMAT EMPTY))
(UERROR "Missing paren around value list"))
(SETQ SH (ROWINTOF1 (DREVERSE NLEVS)))
(SETQ A (ALLOC.SARRAY SH (if (EQ FORMAT (QUOTE EMPTY))
then (QUOTE FULL)
else FORMAT)))
(SETTITLE A TITLE)
(if VALDIM
then (SETVALDIM A VALDIM))
[if (NEQ FORMAT (QUOTE EMPTY))
then (bind VAL (N ← 0)
(FIXFLG ← T)
[GSB ←(SETUP A (if (EQ FORMAT (QUOTE FULL))
then (QUOTE ROWMAJOR)
else (QUOTE SYMMETRIC]
declare (N IJK) until (fetch DONE of GSB)
do (if (FMEMB (SETQ VAL (RATOM))
(QUOTE (%) %])))
then (RETURN)) (* Ran out of values)
(SETQ VAL (coerce VAL SCALAR))
(if FIXFLG
then (if (type? FLOATING VAL)
then (SETQ FIXFLG NIL)
(FLOATROW (fetch ELEMENTBLOCK of A)
N)
else (add N 1)))
(SETAELT A (NEXT GSB)
VAL)
finally (OR (FMEMB (SETQ VAL (RATOM))
(QUOTE (%) %])))
(UERROR "Too many values"]
(if [NOT (FMEMB (RATOM)
(QUOTE (%) %]]
then (UERROR "Final parenthesis missing"))
[for DIM from 1 as D in DIMSPECS
do (SETDIMLAB A DIM (CAR D)) (* Do labels after elements so that codes get coerced
to the right element type)
(for L from 1 to (GETRELT SH DIM) as LSPEC in (CDR D)
do (SELTYPEQ LSPEC
(LISTP (if (type? INTEGER (CAR LSPEC))
then (SETQ L (CAR LSPEC))
else (SETLEVLAB A DIM L (CAR LSPEC)))
(ASSIGN.CODE A (CODE L)
(CDR LSPEC)))
(INTEGER (SETQ L LSPEC))
(LABEL (SETLEVLAB A DIM L LSPEC))
(SHOULDNT]
(replace SLOT5 of A with PROPS) (* Do props before keeps, cause keeps are currently
stored as a prop)
(if KEEPS
then [for K on KEEPS do (FRPLACA K (MAKE1DIMSPEC A (CAR K]
(replace KEEPS of A with KEEPS))
(RETURN A)))])
(READROW
[DLAMBDA ((STREAM (ONEOF LITATOM STREAM))
(RETURNS ROW))
(* jop: " 2-Sep-85 17:10")
(* * READFN FOR ROWS)
(DPROG ((PROPLST (HREAD STREAM) LST)
(ROW NIL ROW))
[SETQ ROW (create ROW
NELTS ←(LISTGET PROPLST (QUOTE NELTS))
RELTTYPE ←(LISTGET PROPLST (QUOTE RELTTYPE))
MAYHAVENIL ←(LISTGET PROPLST (QUOTE MAYHAVENIL]
(for I from 1 to (fetch NELTS of ROW) as ELT in (LISTGET PROPLST
(QUOTE ELEMENTS))
do (SETRELT ROW I ELT))
(RETURN ROW))])
)
(PUTDEF (QUOTE IDLARRAYS) (QUOTE FILEPKGCOMS) [QUOTE ((COM MACRO (X (HORRIBLEVARS . X])
(ADDTOVAR HPRINTMACROS (ARRAYFRAME . PRINTIDLARRAY))
(ADDTOVAR HPRINTMACROS (ROWHEADER . PRINTROW))
(PUTPROPS DATAENTRY COPYRIGHT ("Xerox Corporation" 1983 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (809 26616 (CONVERT 819 . 1081) (DUMPIDLARRAY 1083 . 1461) (DUMPIDLARRAY1 1463 . 5757) (
IDLARRAY 5759 . 6605) (IDLMATRIX 6607 . 12587) (LISTARRAY 12589 . 13427) (LISTMATRIX 13429 . 15556) (
PRINTIDLARRAY 15558 . 15817) (PRINTROW 15819 . 16576) (READIDLARRAY 16578 . 16995) (READIDLARRAY1
16997 . 25895) (READROW 25897 . 26614)))))
STOP