(FILECREATED "17-AUG-83 01:29:57" {PHYLUM}<LISPCORE>SOURCES>DFILE.;22 40417
changes to: (FNS DIR4 DPAT DMATCH DMATCH1 LASTMEMBTAIL)
(RECORDS FILEGROUP)
(MACROS PFPRINCHAR)
(VARS DFILECOMS)
previous date: "16-AUG-83 17:25:39" {PHYLUM}<LISPCORE>SOURCES>DFILE.;19)
(* Copyright (c) 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT DFILECOMS)
(RPAQQ DFILECOMS ((COMS (* File name spelling correction)
(FNS FINDFILE SPELLFILE SPELLFILE.MATCHINGDIRS SPELLFILE.SPELL SPELLFILE1
SPELLFILEDIR)
(BLOCKS (NIL FINDFILE SPELLFILE SPELLFILE1 SPELLFILEDIR
SPELLFILE.MATCHINGDIRS SPELLFILE.SPELL (LOCALVARS . T)
(GLOBALVARS DWIMFLG NOSPELLFLG SPELLFILE USERNAME)))
(INITVARS (NOFILESPELLFLG T))
[DECLARE: DONTEVAL@LOAD DOCOPY (VARS (SPELLFILE (ARRAY 2)))
(ADDVARS (ERRORTYPELST (23 (SPELLFILE (CADR ERRORMESS)
NIL NOFILESPELLFLG]
(ADDVARS (DIRECTORIES)))
(COMS (* DIRECTORY)
(FNS DODIR DIRECTORY DIR4 DIRCONJ DPAT NEXTFILE DMATCH LASTMEMBTAIL DMATCH1 DOCOMMANDS
DIRPRINTNAME DTAB DPRIN1 DIRFILENAME DREAD FILDIR)
(LISPXMACROS DIR)
(INITVARS (UPPERCASEFILENAMES T))
(GLOBALVARS UPPERCASEFILENAMES DIRCOMMANDS ASKUSERTTBL FILEINFOTYPES)
(GLOBALRESOURCES (\FILDIRSCRATCH (CONS)))
(VARS DIRCOMMANDS FILEINFOTYPES)
(DECLARE: DONTCOPY (RECORDS FILEGROUP)))
(COMS (FNS PFCOPYBYTES DISPLAYFONTPROFILE DISPLAYOFDP DISPLAYFONTSETUP COMPUTEPRETTYPARMS
FONTMAPARRAY)
(ADDVARS (\FONTMAPCACHE))
[VARS (FONTSETUPFNS (QUOTE (NIL (DISPLAYFONTSETUP DISPLAYFONTPROFILE)
(NILL PRESSFONTPROFILE]
(ALISTS (FONTDEFS STANDARD PARC))
(DECLARE: DONTEVAL@LOAD DOCOPY
(P (MOVD? (QUOTE NILL)
(QUOTE PRESSFONTPROFILE))
(MOVD (QUOTE DISPLAYOFDP)
(QUOTE DISPLAYP))
(FONTSET (QUOTE PARC))
(SETSEPR (QUOTE (%| 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
22 23 24 25 26))
1 FILERDTBL)))
(DECLARE: DONTCOPY (MACROS PFPRINCHAR)))
(LOCALVARS . T)))
(* File name spelling correction)
(DEFINEQ
(FINDFILE
[LAMBDA (FILE NSFLG DIRLST) (* rmk: "27-JUL-82 20:51")
(* If file has an explicit directory on it and that file exists, don't fool around with the directory packing in
SPELLFILE, simply return. When there is no explicit directory list, we do the INFILEP check first, thereby giving
priority to the connected directory. This is really a non-feature because the order of priorities should be as
defined by the appearance of T in DIRECTORIES, but we adjust the priorities here for backward compatibility.
Should be removed when the coast is clear.)
(COND
((AND (FILENAMEFIELD FILE (QUOTE DIRECTORY))
(INFILEP FILE)))
(DIRLST (SPELLFILE FILE T NSFLG DIRLST))
((INFILEP FILE))
((SPELLFILE FILE T NSFLG DIRLST])
(SPELLFILE
[LAMBDA (FILE NOPRINTFLG NSFLG DIRLST) (* bvm: "26-DEC-81 17:09")
(DECLARE (SPECVARS NAME EXTENSION VERSION SPELLVAL DIRHOSTS HOST)
(GLOBALVARS \FILEDEVICENAMES))
(PROG (SPELLVAL VAL DIRHOSTS HOST DEVICE DIRECTORY NAME EXTENSION VERSION (FIELDS (UNPACKFILENAME
FILE))
(DIRS (OR DIRLST DIRECTORIES))
(APPFLG (QUOTE MUST-APPROVE))
(NSFLG (OR NSFLG NOSPELLFLG (NULL DWIMFLG)))
(ROOTNAME FILE))
(OR FILE (RETURN))
FLDLP
(COND
(FIELDS (SELECTQ (CAR FIELDS)
(NAME (SETQ NAME (CADR FIELDS)))
(VERSION (SETQ VERSION (CADR FIELDS)))
(EXTENSION (SETQ EXTENSION (CADR FIELDS)))
(DIRECTORY (SETQ DIRECTORY (CADR FIELDS)))
(HOST (SETQ HOST (CADR FIELDS)))
(DEVICE (* Pseudo-devices FOO: can be used to denote a list of
directories)
(OR [AND (NULL DEVICE)
(NULL DIRECTORY)
(SETQ DIRS (GETPROP (SETQ DEVICE (CADR FIELDS))
(QUOTE DIRECTORIES]
(RETURN)))
(RETURN))
(SETQ FIELDS (CDDR FIELDS))
(GO FLDLP)))
[AND HOST (COND
((HOSTNAMEP HOST))
([AND (NOT NSFLG)
(SETQ HOST (FIXSPELL HOST NIL \FILEDEVICENAMES (QUOTE NO-MESSAGE]
(AND (SETQ VAL (INFILEP (PACKFILENAME (QUOTE HOST)
HOST
(QUOTE BODY)
FILE)))
(GO RET)))
(T (* It is pointless to go on if we don't have a valid
host.)
(RETURN NIL]
[COND
((OR HOST DEVICE DIRECTORY VERSION)
(* ROOTNAME is what fixspell gets called on. important that extra characters get stripped out so that spelling
corrector metric is applied to what is really being corrected, otherwise, e.g. with directory supplied, any two
short names will match)
(SETQ ROOTNAME (PACKFILENAME (QUOTE NAME)
NAME
(QUOTE EXTENSION)
EXTENSION]
[COND
([AND (NEQ ROOTNAME FILE)
(SETQ SPELLVAL (OR (INFILEP ROOTNAME)
(AND VERSION (OR DIRECTORY HOST)
(INFILEP (PACKFILENAME (QUOTE DIRECTORY)
DIRECTORY
(QUOTE HOST)
HOST
(QUOTE NAME)
NAME
(QUOTE EXTENSION)
EXTENSION]
(COND
([SOME (GETPROP ROOTNAME (QUOTE FILEDATES))
(FUNCTION (LAMBDA (X TAIL)
(COND
((AND (EQ (CDR X)
SPELLVAL)
(STREQUAL (CAR X)
(FILEDATE SPELLVAL)))
(* already did this correction)
(SETQ VAL SPELLVAL)
(SETQ APPFLG (QUOTE NO-MESSAGE)))
((AND (EQ (CDR X)
FILE)
(STREQUAL (CAR X)
(FILEDATE SPELLVAL)))
(SETQ VAL SPELLVAL)
(/ATTACH (CONS (CAR X)
VAL)
TAIL)
(SETQ APPFLG (QUOTE NEEDNOTAPPROVE]
(* attacks problem where sombody wants a specific file, e.g. makefile wants the source, the file is around, but with
a different verson number, e.g. was ftped from maxc, and user didnt loadfrom symbolic but instead just started
editing with compiled file having been loaded. something like this might be useful on maxc as well.
however, occurs far less frequently since would require deleting of the original file as well as copying it
somewhere else)
(* works by looking to see if latest verson of rootname
in fact has same filedate as requested file.)
(GO RET]
[COND
[DIRECTORY (COND
((DIRECTORYNAMEP DIRECTORY HOST) (* User supplied directory is valid)
(GO SPELLNAME)))
(* Try to spelling correct directory with hostname stripped off for spelling metric. If HOST, then only consider
directories on that host. Otherwise, keep a list of the hosts associated with the host-free directories.)
(COND
([AND (NOT NSFLG)
(SETQ DIRS (SPELLFILE.MATCHINGDIRS DIRS HOST))
(SETQ VAL (FIXSPELL DIRECTORY NIL DIRS (QUOTE NO-MESSAGE)
NIL
(FUNCTION (LAMBDA (DIR)
(* Check file only for directories that are close
enough)
(AND (SETQ DIR (SPELLFILEDIR DIR))
(RETFROM (QUOTE FIXSPELL)
DIR]
(GO RET))
(T (RETURN]
(T (* Here if directory wasn't specified in the filename.
Search only directories on DIRS which match HOST, if
specified.)
(for DIR in DIRS when [PROGN (SELECTQ DIR
((NIL T)
(SETQ DIR (DIRECTORYNAME DIR T)))
NIL)
(AND [OR (NULL HOST)
(EQ HOST (LISTGET (UNPACKFILENAME DIR)
(QUOTE HOST]
(SETQ VAL (INFILEP (PACKFILENAME (QUOTE DIRECTORY)
DIR
(QUOTE NAME)
NAME
(QUOTE EXTENSION)
EXTENSION
(QUOTE VERSION)
VERSION]
do [SETQ APPFLG (COND
(NOPRINTFLG (QUOTE NO-MESSAGE))
(T (QUOTE NEEDNOTAPPROVE]
(GO RET]
(AND [LISTP (SETQ VAL (GETPROP FILE (QUOTE FILEDATES]
(LITATOM (CDAR VAL))
(SETQ VAL (INFILEP (CDAR VAL)))
(GO RET))
SPELLNAME
(COND
([OR NSFLG (NOT (SETQ VAL (SPELLFILE.SPELL HOST DIRECTORY NAME EXTENSION VERSION ROOTNAME
FILE]
(RETURN))) (* SPELLFILE1 and hence FIXSPELL return name without
host/directory, since matching against ROOTNAME;
hence, the packfilename below)
[COND
((NEQ FILE ROOTNAME)
(SETQ VAL (PACKFILENAME (QUOTE BODY)
VAL
(QUOTE HOST)
HOST
(QUOTE DIRECTORY)
DIRECTORY
(QUOTE VERSION)
VERSION]
RET (RETURN (AND (OR (EQ APPFLG (QUOTE NO-MESSAGE))
(FIXSPELL1 FILE VAL (EQ APPFLG (QUOTE MUST-APPROVE))
NIL APPFLG))
VAL])
(SPELLFILE.MATCHINGDIRS
[LAMBDA (DIRS HOST) (* bvm: "26-DEC-81 17:01")
(COND
[HOST (for DIR DHOST in DIRS when (EQ HOST (LISTGET [SETQ DIR
(OR (LISTP DIR)
(UNPACKFILENAME
(SELECTQ DIR
((NIL T)
(DIRECTORYNAME DIR T))
DIR]
(QUOTE HOST)))
collect (LISTGET DIR (QUOTE DIRECTORY]
(T (for DIR UDIR DHOST in DIRS
unless (PROG1 (MEMB (SETQ DIR (LISTGET [SETQ UDIR
(OR (LISTP DIR)
(UNPACKFILENAME (SELECTQ DIR
((NIL T)
(DIRECTORYNAME
DIR T))
DIR]
(QUOTE DIRECTORY)))
$$VAL)
(AND (SETQ DHOST (LISTGET UDIR (QUOTE HOST)))
(NCONC1 [OR (FASSOC DIR DIRHOSTS)
(CAR (push DIRHOSTS (CONS DIR]
DHOST)))
collect DIR])
(SPELLFILE.SPELL
[LAMBDA (HOST DIRECTORY NAME EXTENSION VERSION ROOTNAME FILE)
(* bvm: "26-DEC-81 17:07")
[SETA SPELLFILE 2 (SELECTQ (SYSTEMTYPE)
[(D ALTO)
(\GENERATEFILES (COND
((NEQ FILE ROOTNAME)
(PACKFILENAME (QUOTE HOST)
HOST
(QUOTE DIRECTORY)
DIRECTORY
(QUOTE NAME)
(QUOTE *)))
(T (QUOTE *]
(PROGN (SETA SPELLFILE 5 (COND
(EXTENSION 150994945)
(T 134217729)))
(LOGAND [SETA SPELLFILE 3 (OR (COND
(EXTENSION
(* extension misspelled)
(LGTJFN
DIRECTORY NAME
(QUOTE *)
VERSION 32833)))
(PROGN
(* name misspelled)
(LGTJFN DIRECTORY
(QUOTE *)
EXTENSION VERSION
32833))
(PROGN
(* Can't have both name and extension misspelled)
(RETURN NIL]
262143]
(SETA SPELLFILE 1 (FUNCTION SPELLFILE1))
(FIXSPELL ROOTNAME NIL SPELLFILE (QUOTE NO-MESSAGE])
(SPELLFILE1
[LAMBDA (ARR) (* rmk: "16-JUL-81 17:45")
(* This generates files for a given host/directory, but
returns names with the host/directory stripped off for
fixspell matching.)
(DECLARE (USEDFREE EXTENSION VERSION))
(GLOBALRESOURCE (\FILDIRSCRATCH)
(PROG (FL FIELDS NAME1 EXT1 VERS#1)
LP (COND
([NULL (SETQ FL (\GENERATENEXTFILE (ELT ARR 2)
\FILDIRSCRATCH
(NULL VERSION]
(RETURN)))
[SETQ FIELDS (UNPACKFILENAME (SETQ FL (PACKC FL]
FIELDLP
(COND
(FIELDS (* Ignore host and directory, assuming we only generate
appropriate ones.)
(SELECTQ (CAR FIELDS)
(NAME (SETQ NAME1 (CADR FIELDS)))
(EXTENSION (SETQ EXT1 (CADR FIELDS)))
(VERSION (SETQ VERS#1 (CADR FIELDS)))
(DIRECTORY)
(SHOULDNT))
(SETQ FIELDS (CDDR FIELDS))
(GO FIELDLP)))
(AND VERSION (NUMBERP VERSION)
(IGREATERP VERSION 0)
(NEQ VERSION VERS#1)
(GO RETRY)) (* Skip if versions mismatch, so fixspell only works on
names)
(OR (EQ (NULL EXTENSION)
(NULL EXT1))
(GO RETRY))
(RETURN (COND
(VERS#1 (* Strip off version)
(PACKFILENAME (QUOTE NAME)
NAME1
(QUOTE EXTENSION)
EXT1))
(T FL)))
RETRY
(SETQ NAME1 NIL)
(SETQ EXT1 NIL)
(SETQ VERS#1 NIL)
(GO LP)))])
(SPELLFILEDIR
[LAMBDA (DIR) (* rmk: "13-NOV-81 22:13")
(* If HOST, returns fullname of file on {HOST}DIR,
otherwise searches the hosts associated with DIR for the
first one with file.)
(DECLARE (USEDFREE HOST DIRHOSTS NAME EXTENSION VERSION))
(COND
(HOST (INFILEP (PACKFILENAME (QUOTE HOST)
HOST
(QUOTE DIRECTORY)
DIR
(QUOTE NAME)
NAME
(QUOTE EXTENSION)
EXTENSION
(QUOTE VERSION)
VERSION)))
(T (for H in (OR (CDR (FASSOC DIR DIRHOSTS))
(QUOTE (NIL)))
when (SETQ H (INFILEP (PACKFILENAME (QUOTE HOST)
H
(QUOTE DIRECTORY)
DIR
(QUOTE NAME)
NAME
(QUOTE EXTENSION)
EXTENSION
(QUOTE VERSION)
VERSION)))
do (RETURN H])
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: NIL FINDFILE SPELLFILE SPELLFILE1 SPELLFILEDIR SPELLFILE.MATCHINGDIRS SPELLFILE.SPELL
(LOCALVARS . T)
(GLOBALVARS DWIMFLG NOSPELLFLG SPELLFILE USERNAME))
]
(RPAQ? NOFILESPELLFLG T)
(DECLARE: DONTEVAL@LOAD DOCOPY
(RPAQ SPELLFILE (ARRAY 2))
(ADDTOVAR ERRORTYPELST (23 (SPELLFILE (CADR ERRORMESS)
NIL NOFILESPELLFLG)))
)
(ADDTOVAR DIRECTORIES )
(* DIRECTORY)
(DEFINEQ
(DODIR
[LAMBDA (LISPXLINE EXTRACOMS DEFAULTEXT DEFAULTVERS NOP) (* rmk: "29-OCT-81 17:01")
(PROG ((FILE (CAR LISPXLINE))
(TAIL (CDR LISPXLINE))
CONJ)
LP (COND
((SETQ CONJ (DIRCONJ (CAR TAIL))) (* The files can be strung out in the line separated by
conjunctions.)
(SETQ FILE (LIST FILE CONJ (CADR TAIL)))
(SETQ TAIL (CDDR TAIL))
(GO LP)))
(AND EXTRACOMS (SETQ TAIL (APPEND TAIL EXTRACOMS)))
(OR NOP (FMEMB (QUOTE P)
TAIL)
(FMEMB (QUOTE PP)
TAIL)
(SETQ TAIL (CONS (QUOTE P)
TAIL)))
(RETURN (DIRECTORY FILE TAIL DEFAULTEXT DEFAULTVERS])
(DIRECTORY
[LAMBDA (FILES COMMANDS DEFAULTEXT DEFAULTVERS)
(DECLARE (SPECVARS COMMANDS DEFAULTEXT DEFAULTVERS)) (* bvm: "27-DEC-81 00:33")
(RESETLST (PROG (VALUE COLUMNS NAMEFLG DELETEDONLY FILEGROUP PRINTFLG OUTFILE PROMPTFLG
LASTHOST/DIR)
(DECLARE (SPECVARS VALUE COLUMNS NAMEFLG FILEGROUP LASTHOST/DIR))
(PROG [(X (SETQ COMMANDS (COND
((LISTP COMMANDS)
(APPEND COMMANDS))
(T (SETQ COMMANDS (LIST (OR COMMANDS (QUOTE COLLECT]
COMLP
[SELECTQ (CAR X)
((PAUSE P PP AUTHOR)
(SETQ PRINTFLG T))
(OLDVERSIONS (ERROR
"OLDVERSIONS directory command not yet implemented")
[OR (FIXP (CADR X))
(RPLACD X (CONS 1 (CDR X]
(pop X))
(TRIMTO (ERROR "TRIMTO directory command not yet implemented")
(SETQ PRINTFLG T)
[OR (FIXP (CADR X))
(RPLACD X (CONS 1 (CDR X]
(pop X))
[BY (RPLACA (SETQ X (CDR X))
(U-CASE (MKSTRING (CAR X]
((DELETE COLLECT))
(COLUMNS [SETQ COLUMNS (CAR (SETQ X (CDR X]
(SETQ PRINTFLG T))
(COUNTSIZE (SETQ VALUE 0))
(PROMPT (SETQ X (CDR X))
(SETQ PROMPTFLG T))
(PRINT (pop X)
(SETQ PRINTFLG T))
(@ (SETQ X (CDR X))
[COND
((FNTYP (CAR X))
(RPLACA X (CONS (CAR X)
(QUOTE (FILENAME]
(AND (FMEMB (QUOTE FILENAME)
(FREEVARS (CAR X)))
(SETQ NAMEFLG T)))
[OUT (SETQ OUTFILE (CAR (SETQ X (CDR X]
((DELETED UNDELETE)
(ERROR "DELETED/UNDELETE directory commands are not supported")
(SETQ DELETEDONLY T))
[OLDERTHAN (RPLACA (SETQ X (CDR X))
(IDIFFERENCE (IDATE)
(ITIMES
(CAR X)
(DEFERREDCONSTANT
(IDIFFERENCE (IDATE
"2-JAN-77 00:00")
(IDATE
"1-JAN-77 00:00"]
(COND
((STRINGP (CAR X))
(SETQ PRINTFLG T))
((FASSOC (CAR X)
FILEINFOTYPES)
(SETQ PRINTFLG T))
((LISTP (CAR X))
(FRPLNODE2 X (APPEND (CAR X)
(CDR X)))
(GO COMLP))
((FIXSPELL (CAR X)
NIL
(NCONC (MAPCAR FILEINFOTYPES (FUNCTION CAR))
DIRCOMMANDS)
NIL X NIL NIL T)
(GO COMLP))
(T (ERROR "invalid DIRECTORY command" (CAR X]
(AND (SETQ X (CDR X))
(GO COMLP)))
(SETQ FILEGROUP (create FILEGROUP
PATTERN ←(DIR4 FILES)
FILEGENERATORS ← FILEGROUP))
(* DIR4 smashes generators on FILEGROUP for each atomic
file specification it finds.)
(COND
((OR PRINTFLG OUTFILE PROMPTFLG)
[COND
(PROMPTFLG (RESETSAVE (SETTERMTABLE ASKUSERTTBL]
(RESETSAVE (OUTPUT T))
[COND
(OUTFILE (COND
((OPENP OUTFILE)
(OUTPUT OUTFILE))
(T (OUTFILE OUTFILE)
(RESETSAVE NIL (QUOTE (PROGN (CLOSEF? (OUTPUT]
(SETQ PRINTFLG T)
(TAB 0 0)))
(GLOBALRESOURCE \FILDIRSCRATCH
(while (SETQ FILEGROUP (NEXTFILE FILEGROUP \FILDIRSCRATCH))
do (DOCOMMANDS COMMANDS FILEGROUP)))
(COND
(PRINTFLG (TAB 0 0)))
(RETURN VALUE])
(DIR4
[LAMBDA (FG) (* lmm "17-AUG-83 01:25")
(* This pushes file generators on FILEGROUP for each of
the atomic filespecifications it comes to.)
(DECLARE (USEDFREE FILEGROUP DEFAULTEXT DEFAULTVERS))
(PROG (TEMP)
(RETURN (COND
((NLISTP FG)
[push FILEGROUP (\GENERATEFILES (SETQ FG (PACKFILENAME (QUOTE BODY)
(\ADD.CONNECTED.DIR
FG)
(QUOTE NAME)
(QUOTE *)
(QUOTE VERSION)
(OR DEFAULTVERS
(QUOTE *))
(QUOTE EXTENSION)
(OR DEFAULTEXT
(QUOTE *]
(CHCON FG))
[(SETQ TEMP (DIRCONJ (CADR FG)))
(CONS TEMP (CONS (DIR4 (CAR FG))
(DIR4 (CADDR FG]
[(SETQ TEMP (DIRCONJ (CAR FG)))
(CONS TEMP (CONS (DIR4 (CADR FG))
(DIR4 (CADDR FG]
(T (ERROR "Bad file-group conjunction" (CADR FG])
(DIRCONJ
[LAMBDA (CONJ) (* rmk: "29-OCT-81 11:01")
(* Returns canonical form of directory conjunction, NIL
if invalid)
(SELECTQ CONJ
((OR +)
(QUOTE OR))
((AND *)
(QUOTE AND))
((- ANDNOT)
(QUOTE ANDNOT))
NIL])
(DPAT
[LAMBDA (CONJ X Y) (* lmm "16-AUG-83 21:04")
(* CONJ is known to be a valid conjunction.)
(CONS CONJ (CONS X Y])
(NEXTFILE
[LAMBDA (FG SCRATCH) (* bvm: "16-AUG-83 16:46")
(PROG (TEM)
LP (COND
[(SETQ TEM (\GENERATENEXTFILE (CAR (fetch FILEGENERATORS of FG))
SCRATCH NIL T)) (* Devices generate a superset of the matching files,
hence the DMATCH filtering with the device-independent
wild-cards.)
(COND
((COND
[(EQ (CAR (fetch PATTERN of FG))
(CHARCODE {))
(DMATCH (CDR (FMEMB (CHARCODE })
(fetch PATTERN of FG)))
(CDR (FMEMB (CHARCODE })
TEM]
(T (DMATCH (fetch PATTERN of FG)
TEM)))
(replace NAMECELL of FG with TEM)
(RETURN FG))
(T (GO LP]
((replace FILEGENERATORS of FG with (CDR (fetch FILEGENERATORS of FG)))
(GO LP))
(T (RETURN])
(DMATCH
[LAMBDA (PAT LST) (* lmm "17-AUG-83 00:17")
(COND
((OR (EQ PAT T)
(NULL PAT))
T)
(T (SELECTQ (CAR PAT)
(OR (OR (DMATCH (CADR PAT)
LST)
(DMATCH (CDDR PAT)
LST)))
(AND (AND (DMATCH (CADR PAT)
LST)
(DMATCH (CDDR PAT)
LST)))
(ANDNOT (AND (NOT (DMATCH (CDDR PAT)
LST))
(DMATCH (CADR PAT)
LST)))
(DMATCH1 PAT LST])
(LASTMEMBTAIL
[LAMBDA (ELTS LST) (* lmm " 6-AUG-83 12:34")
(while LST bind TAIL do (COND
((FMEMB (pop LST)
ELTS)
(SETQ TAIL LST)))
finally (RETURN TAIL])
(DMATCH1
[LAMBDA (PAT LST) (* lmm "17-AUG-83 00:16")
(COND
((NULL PAT)
(OR (NULL LST)
(SELCHARQ (CAR LST)
(%. (SELCHARQ (CADR LST)
((! ;)
T)
NIL))
((; !)
T)
NIL)))
(T (SELECTC (CAR PAT)
[(CHARCODE (?))
(AND LST (DMATCH1 (CDR PAT)
(CDR LST]
[(CHARCODE (ESCAPE *))
(OR (NULL (SETQ PAT (CDR PAT)))
(while LST
do (COND
((DMATCH1 PAT LST)
(RETURN T)))
(pop LST]
(COND
((EQ (CAR PAT)
(CAR LST))
(DMATCH1 (CDR PAT)
(CDR LST)))
(T (SELCHARQ (CAR LST)
[({ %[)
(SELCHARQ (CAR PAT)
((%[ {) (* Different delimiters)
(DMATCH1 (CDR PAT)
(CDR LST)))
(AND (SETQ LST (LASTMEMBTAIL (CHARCODE (} %]))
LST))
(DMATCH1 PAT LST]
[< (SELCHARQ (CAR PAT)
(AND (SETQ LST (LASTMEMBTAIL (CHARCODE (>))
LST))
(DMATCH1 PAT LST]
(/ (AND (SETQ LST (LASTMEMBTAIL (CHARCODE (/))
LST))
(DMATCH1 PAT LST)))
((; !)
(SELCHARQ (CAR PAT)
((; !) (* Would match except for different delimiter)
(DMATCH1 (CDR PAT)
(CDR LST)))
NIL))
(AND (IGEQ (CAR LST)
(CHARCODE a))
(ILEQ (CAR LST)
(CHARCODE z))
(EQ (CAR PAT)
(IDIFFERENCE (CAR LST)
(CONSTANT (IDIFFERENCE (CHARCODE a)
(CHARCODE A])
(DOCOMMANDS
[LAMBDA (COMMANDS FILEGROUP) (* bvm: "28-DEC-81 15:13")
(PROG ((Y COMMANDS)
(I 0)
FILENAME FILE NAMEPRINTED TEM TEM2)
(DECLARE (SPECVARS FILENAME FILE NAMEPRINTED I)
(USEDFREE VALUE))
[AND COLUMNS (COND
((NOT (ILESSP (SETQ I (ITIMES (IQUOTIENT (IPLUS (POSITION)
COLUMNS -1)
COLUMNS)
COLUMNS))
(IDIFFERENCE (LINELENGTH)
30)))
(SETQ I 0]
DOCOM
(COND
(Y [SELECTQ (CAR Y)
(P (DIRPRINTNAME FILEGROUP))
(PP (DIRPRINTNAME FILEGROUP T))
[COUNTSIZE (add VALUE (GETFILEINFO (DIRFILENAME FILEGROUP)
(QUOTE SIZE]
(PAUSE (READC T)
(SETQ I (IPLUS I 2)))
[@ (* Arbitrary predicate -- next thing is form)
(AND NAMEFLG (DIRFILENAME FILEGROUP))
(COND
([NOT (EVAL (CAR (SETQ Y (CDR Y]
(RETURN]
[OLDERTHAN (COND
((OR [IGEQ (GETFILEINFO (DIRFILENAME FILEGROUP)
(QUOTE IREADDATE))
(CAR (SETQ Y (CDR Y]
(IGEQ (GETFILEINFO (DIRFILENAME FILEGROUP)
(QUOTE IWRITEDATE))
(CAR Y)))
(RETURN]
(BY (SETQ Y (CDR Y))
(AND (SETQ TEM (GETFILEINFO (DIRFILENAME FILEGROUP)
(QUOTE AUTHOR)))
(NOT (STREQUAL (U-CASE TEM)
(CAR Y)))
(RETURN)))
[DELETE (DTAB 12)
(PRIN1 (COND
((DELFILE (DIRFILENAME FILEGROUP))
"deleted")
(T "can't delete"]
(PROMPT (OR [DREAD (CAR (SETQ Y (CDR Y]
(RETURN)))
(PRINT (DPRIN1 (CAR Y)))
(COLLECT (SETQ VALUE (CONS (DIRFILENAME FILEGROUP)
VALUE)))
((OUT COLUMNS)
(pop Y))
((TRIMTO OLDVERSIONS) (* Not implemented, but user might continue from error
in DIRECTORY)
(pop Y))
((DELETED UNDELETE) (* Note implemented)
)
(COND
[(STRINGP (CAR Y))
(PRIN1 (CAR Y))
(add I (NCHARS (CAR Y]
[(SETQ TEM (FASSOC (CAR Y)
FILEINFOTYPES))
(DTAB (CADR TEM))
(COND
((SETQ TEM2 (GETFILEINFO (DIRFILENAME FILEGROUP)
(CAR Y)))
(COND
((FIXP TEM2)
(PRINTNUM (OR (CDDR TEM)
(LIST (QUOTE FIX)
(CADR TEM)))
TEM2))
(T (PRIN1 TEM2]
(T (SHOULDNT]
(pop Y)
(GO DOCOM])
(DIRPRINTNAME
[LAMBDA (FILEGROUP FLG) (* bvm: "16-AUG-83 17:21")
(DECLARE (USEDFREE LASTHOST/DIR NAMEPRINTED))
(COND
((NOT NAMEPRINTED)
(PROG [[NAMECHARS (bind [TAIL ←(CDR (FMEMB (CHARCODE })
(fetch NAMECELL of FILEGROUP]
do (SETQ TAIL (CDR (OR (FMEMB (CHARCODE >)
TAIL)
(RETURN TAIL]
(STREAM (GETSTREAM NIL (QUOTE OUTPUT]
[for FTAIL on (fetch NAMECELL of FILEGROUP) as LTAIL on LASTHOST/DIR
while [OR (EQ (CAR LTAIL)
(CAR FTAIL))
(EQ (CAR LTAIL)
(LOGXOR (CAR FTAIL)
(CONSTANT (IDIFFERENCE (CHARCODE a)
(CHARCODE A]
finally (COND
((OR LTAIL (NEQ FTAIL NAMECHARS))
(* The HOST/DIR has changed)
(TAB 0 0)
(TERPRI)
(SPACES 3)
(SETQ LASTHOST/DIR (for FTAIL on (fetch NAMECELL of FILEGROUP)
until (EQ FTAIL NAMECHARS)
collect (\OUTCHAR STREAM (CAR FTAIL))
(CAR FTAIL]
(DTAB 20)
(for X in NAMECHARS
do (COND
((AND FLG (EQ X (CHARCODE ;)))
(RETURN)))
(\OUTCHAR STREAM X))
(SPACES 1)
(SETQ NAMEPRINTED T])
(DTAB
[LAMBDA (N) (* lmm "20-OCT-78 04:31")
(TAB I 0)
(add I N 1])
(DPRIN1
[LAMBDA (STR) (* lmm "20-OCT-78 02:53")
(DTAB (NCHARS STR))
(PRIN1 STR])
(DIRFILENAME
[LAMBDA (FILEGROUP) (* bvm: "16-AUG-83 17:17")
(DECLARE (USEDFREE FILENAME FILE)) (* These might be used freely by user predicates, with @
commands)
(OR FILENAME (PROGN [COND
(UPPERCASEFILENAMES (for TAIL on (fetch NAMECELL of FILEGROUP)
when (AND (IGEQ (CAR TAIL)
(CHARCODE a))
(ILEQ (CAR TAIL)
(CHARCODE z)))
do (RPLACA TAIL (IDIFFERENCE
(CAR TAIL)
(CONSTANT (IDIFFERENCE (CHARCODE a)
(CHARCODE A]
(SETQ FILENAME (SETQ FILE (PACKC (fetch NAMECELL of FILEGROUP])
(DREAD
[LAMBDA (PROMPT) (* lmm "21-OCT-78 01:28")
(PROG1 [PROG NIL
LP (PROGN (TAB I 0)
(PRIN1 PROMPT))
(SELECTQ (READC T)
((Y y)
(PRIN1 (QUOTE "Yes")
T)
(RETURN T))
((N n)
(PRIN1 (QUOTE "No")
T)
(RETURN))
(? (PRIN1 (QUOTE "Y or N: ")
T)
(GO LP))
(PROGN (PRIN1 "" T)
(GO LP]
(add I (NCHARS PROMPT)
5])
(FILDIR
[LAMBDA (FILEGROUP) (* lmm "20-MAY-80 14:22")
(SORT (DIRECTORY FILEGROUP])
)
(ADDTOVAR LISPXMACROS (DIR (DODIR LISPXLINE)))
(ADDTOVAR LISPXCOMS DIR)
(RPAQ? UPPERCASEFILENAMES T)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS UPPERCASEFILENAMES DIRCOMMANDS ASKUSERTTBL FILEINFOTYPES)
)
(RPAQQ \FILDIRSCRATCH NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \FILDIRSCRATCH)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(PUTDEF (QUOTE \FILDIRSCRATCH)
(QUOTE GLOBALRESOURCES)
(QUOTE (CONS)))
)
(RPAQQ DIRCOMMANDS ((- . PAUSE)
(AU . AUTHOR)
BY COLLECT (COLLECT? PROMPT " ? " COLLECT)
COUNTSIZE
(DA . WRITEDATE)
(DATE . WRITEDATE)
(DEL . DELETE)
(DEL? . DELETE?)
DELETE
(DELETE? PROMPT " delete? " DELETE)
DELETED
(LE LENGTH "(" BYTESIZE ")")
(OBS . OLDVERSIONS)
OLDVERSIONS
(OLD OLDERTHAN 90)
OLDERTHAN
(OU . OUT)
OUT P PAUSE (PR . PROTECTION)
PROMPT
(SI . SIZE)
(TI . WRITEDATE)
UNDELETE
(VERBOSE AUTHOR CREATIONDATE SIZE READDATE WRITEDATE)
(KEEP . TRIMTO)))
(RPAQQ FILEINFOTYPES ((WRITEDATE 18)
(READDATE 18)
(CREATIONDATE 18)
(LENGTH 9)
(BYTESIZE 2)
(PROTECTION 6 FIX 6 8)
(SIZE 5)
(AUTHOR 11)
(TYPE 7)))
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD FILEGROUP (NAMECELL PATTERN . FILEGENERATORS))
]
)
(DEFINEQ
(PFCOPYBYTES
[LAMBDA (SRCFIL DSTFIL START END FLG) (* rmk: " 2-APR-82 23:53")
(* Copy bytes from SRCFIL to DSTFIL a la COPYBYTES, but with the following differences: -
(a) CHANGECHAR lines are eliminated -
(b) comments are printed a la **COMMENT**FLG -
(c) spaces at the beginning of the line are reduced by 1/2 unless FLG is set (- This works for both D and Tenex EOL
conventions, assuming that the start and end positions are in terms of true bytes on the file))
(DECLARE (GLOBALVARS CHANGECHAR COMMENTFLG **COMMENT**FLG))
(RESETLST (PROG (STRFLG #CHARS (SOFD (\GETOFD SRCFIL (QUOTE INPUT)))
(DOFD (\GETOFD DSTFIL (QUOTE OUTPUT)))
(#SPACES 0)
CHARCODE CRFLG (CHANGECHARCODE (AND CHANGECHAR (CHCON1 CHANGECHAR)))
(COMMENTCHARCODE (AND COMMENTFLG (CHCON1 COMMENTFLG)))
FONTARRAY MAXFONT DSP)
(COND
((SETQ DSP (DISPLAYOFDP DOFD))
(SETQ FONTARRAY (FONTMAPARRAY NIL (QUOTE DISPLAY)))
(SETQ MAXFONT (ARRAYSIZE FONTARRAY))
(RESETSAVE NIL (LIST (QUOTE DSPFONT)
(DSPFONT NIL DSP)
DSP)))
((NOT (\OUTTERMP DOFD))
(ERROR "PFCOPYBYTES FOR TERMINAL ONLY")))
[SETQ #CHARS (COND
(END (SETFILEPTR SOFD START) (* Doesn't call \SETFILEPTR cause START has to be
checked)
(IDIFFERENCE (COND
((EQ END -1)
(\GETEOFPTR SOFD))
(T END))
START))
(START (FIX START))
(T (IDIFFERENCE (\GETEOFPTR SOFD)
(\GETFILEPTR SOFD]
LP (COND
((ILEQ #CHARS 0)
(RETURN T)))
(SETQ #CHARS (SUB1 #CHARS))
(SETQ CHARCODE (\BIN SOFD))
INTERP
[COND
((EQ CHARCODE (CHARCODE %%))
(PFPRINCHAR CHARCODE)
(PFPRINCHAR (\BIN SOFD))
(SETQ #CHARS (SUB1 #CHARS))
(GO LP))
((EQ CHARCODE (CHARCODE %"))
(SETQ STRFLG (NULL STRFLG)))
(STRFLG)
((EQ CHARCODE (CHARCODE SPACE))
(SETQ #SPACES (ADD1 #SPACES))
(GO LP))
((AND (EQ CHARCODE CHANGECHARCODE)
(EQ (\PEEKBIN SOFD)
(CHARCODE CR))) (* Ignore changechar only when followed by CR;
otherwise, it may be the important BQUOTE character.)
(GO LP))
((EQ CHARCODE (CHARCODE TAB))
(SETQ #SPACES (IPLUS #SPACES 8))
(GO LP))
((EQ CHARCODE (CHARCODE CR))
(SETQ CRFLG T) (* postpone printing c.r.s to handle blank lines such as
occur before comments printed n middle of page)
(SETQ #SPACES 0)
(GO LP))
((EQ CHARCODE (CHARCODE LF)) (* LF after CR is ignored for both Alto and Tenex EOL
conventions)
(AND CRFLG (GO LP)))
((ILEQ CHARCODE (CHARCODE ↑Z))
[COND
((AND FONTARRAY (EQ CHARCODE (CHARCODE ↑F)))
(SETQ #CHARS (SUB1 #CHARS))
(COND
((AND (IGEQ MAXFONT (SETQ CHARCODE (\BIN SOFD)))
(NEQ CHARCODE 0))
(DSPFONT (ELT FONTARRAY CHARCODE)
DSP]
(GO LP))
((AND **COMMENT**FLG (EQ CHARCODE (CHARCODE %()))
(COND
((AND (EQ (SETQ CHARCODE (\BIN SOFD))
COMMENTCHARCODE)
(EQ (\PEEKBIN SOFD)
(CHARCODE SPACE)))
(SETQ #SPACES 0)
(SETQ CRFLG NIL)
[SETQ #CHARS (IPLUS #CHARS (IDIFFERENCE (SUB1 (\GETFILEPTR SOFD))
(PROGN (SKREAD SOFD "(*")
(\GETFILEPTR SOFD]
(* The difference between the file pointer at beginning of comment and that after SKREAD is number of characters in
the comment. However, the file pointer is actually after the *, but the %( has already been counted.
Hence, effectively back up first filepointer by one, compute difference and subtract from #chars)
(PRIN1 **COMMENT**FLG DOFD)
(GO LP))
(T (PFPRINCHAR (CHARCODE %())
(SETQ #CHARS (SUB1 #CHARS)) (* We already read the next character, so just interpret
it)
(GO INTERP]
(PFPRINCHAR CHARCODE)
(GO LP])
(DISPLAYFONTPROFILE
[LAMBDA (CLASSES) (* rmk: "23-NOV-81 16:12")
(* Called via FONTSETUPFNS from FONTPROFILE, with CLASSES a list of (classname font# displayfont pressfont) This
function sets up and caches the number to font mappings for PFCOPYBYTES.)
(FONTMAPARRAY (for C in CLASSES collect (LIST (CADR C)
(CADDR C)))
(QUOTE DISPLAY])
(DISPLAYOFDP
[LAMBDA (STREAM) (* rmk: "18-JUL-83 12:16")
(* Coerces STREAM to a displaystream, if possible)
(OR (type? STREAM STREAM)
(SETQ STREAM (\GETOFD STREAM (QUOTE OUTPUT)
T)))
(COND
([AND STREAM (\DISPLAYSTREAMP (SETQ STREAM (fetch (STREAMOFDISPLAYSTREAM DISPLAYSTREAM)
of STREAM]
STREAM])
(DISPLAYFONTSETUP
[LAMBDA (NAME FONT) (* rmk: "23-NOV-81 12:18")
(* This is called via FONTSETUPFNS from FONTPROFILE1 to associate font descriptors with fontclass names.
The display font array goes the other way, from font numbers found on files to font descriptors.)
(AND NAME (PUT NAME (QUOTE GLOBALVAR)
T))
(FONTCREATE FONT])
(COMPUTEPRETTYPARMS
[LAMBDA (FILE)
(DECLARE (GLOBALVARS COMMENTFONT FIRSTCOL COMMENTLINELENGTH))
(* bvm: "31-MAR-82 17:10")
(PROG ((LEN (LINELENGTH NIL FILE)))
(SETQ FIRSTCOL (FIX (FTIMES LEN .6)))
(COND
(FONTCHANGEFLG
(OR FILEFLG (RESETSAVE NIL
(LIST (QUOTE DSPFONT)
[DSPFONT NIL
(OR FILE
(SETQ FILE
(OUTPUTDSP]
FILE)))
(COND
((LISTP COMMENTFONT)
(SETQ COMMENTLINELENGTH
(CONS (FIX (FTIMES LEN 1.15))
(FIX (FTIMES LEN 1.22])
(FONTMAPARRAY
[LAMBDA (FONTS DEVICE) (* rmk: "23-NOV-81 17:52")
(* Makes a font array for DEVICE from a font-mapping list consisting of (font# fontname) pairs.
The array provides a fast map from font# to font descriptors. -
This function caches the last array for each device)
(DECLARE (GLOBALVARS \FONTMAPCACHE))
(OR DEVICE (SETQQ DEVICE DISPLAY))
(PROG (CACHE FA (MAXFONT 0)
(MINFONT 100))
[COND
[(NULL (SETQ CACHE (CDR (ASSOC DEVICE \FONTMAPCACHE]
[(NULL FONTS)
(RETURN (OR (CDR CACHE)
(ERROR "Device font map not defined" DEVICE]
((EQUAL FONTS (CAR CACHE))
(RETURN (CDR CACHE]
[for F in FONTS do [COND
((IGREATERP (CAR F)
MAXFONT)
(SETQ MAXFONT (CAR F]
(COND
((ILESSP (CAR F)
1)
(ERROR "Invalid font number" F F))
((ILESSP (CAR F)
MINFONT)
(SETQ MINFONT (CAR F]
(SETQ FA (ARRAY MAXFONT))
(for F in FONTS do (SETA FA (CAR F)
(FONTCREATE (CADR F)
NIL NIL NIL DEVICE)))
(for I from 1 to MAXFONT unless (ELT FA I) do (SETA FA I (ELT FA MINFONT)))
(RPLACD [OR (ASSOC DEVICE \FONTMAPCACHE)
(CAR (push \FONTMAPCACHE (CONS DEVICE]
(CONS (COPY FONTS)
FA))
(RETURN FA])
)
(ADDTOVAR \FONTMAPCACHE )
(RPAQQ FONTSETUPFNS (NIL (DISPLAYFONTSETUP DISPLAYFONTPROFILE)
(NILL PRESSFONTPROFILE)))
(ADDTOVAR FONTDEFS [STANDARD (FONTCHANGEFLG . ALL)
(FILELINELENGTH . 102)
(COMMENTLINELENGTH 116 . 126)
(LAMBDAFONTLINELENGTH . 95)
(FIRSTCOL . 60)
(PRETTYLCOM . 25)
(FONTPROFILE (DEFAULTFONT 1 (GACHA 10)
(GACHA 8))
(BOLDFONT 2 (HELVETICA 10 BRR)
(HELVETICA 8 BRR))
(LITTLEFONT 3 (HELVETICA 8)
(HELVETICA 6 MIR))
(BIGFONT 4 (HELVETICA 12 BRR)
(HELVETICA 10 BRR))
(USERFONT BOLDFONT)
(COMMENTFONT LITTLEFONT)
(LAMBDAFONT BIGFONT)
(SYSTEMFONT)
(CLISPFONT BOLDFONT)
(CHANGEFONT)
(PRETTYCOMFONT BOLDFONT)
(FONT1 DEFAULTFONT)
(FONT2 BOLDFONT)
(FONT3 LITTLEFONT)
(FONT4 BIGFONT)
(FONT5 5 (HELVETICA 10 BIR)
(HELVETICA 8 BIR))
(FONT6 6 (HELVETICA 10 BRR)
(HELVETICA 8 BRR))
(FONT7 7 (GACHA 10)
(GACHA 8]
[PARC (FONTCHANGEFLG . ALL)
(FILELINELENGTH . 102)
(COMMENTLINELENGTH 116 . 126)
(LAMBDAFONTLINELENGTH . 95)
(FIRSTCOL . 60)
(PRETTYLCOM . 25)
(FONTPROFILE (DEFAULTFONT 1 (GACHA 10)
(GACHA 8))
(BOLDFONT 2 (HELVETICA 10 BRR)
(HELVETICA 8 BRR))
(LITTLEFONT 3 (HELVETICA 8)
(HELVETICA 6 MIR))
(BIGFONT 4 (HELVETICA 12 BRR)
(HELVETICA 10 BRR))
(USERFONT BOLDFONT)
(COMMENTFONT LITTLEFONT)
(LAMBDAFONT BIGFONT)
(SYSTEMFONT)
(CLISPFONT BOLDFONT)
(CHANGEFONT)
(PRETTYCOMFONT BOLDFONT)
(FONT1 DEFAULTFONT)
(FONT2 BOLDFONT)
(FONT3 LITTLEFONT)
(FONT4 BIGFONT)
(FONT5 5 (HELVETICA 10 BIR)
(HELVETICA 8 BIR))
(FONT6 6 (HELVETICA 10 BRR)
(HELVETICA 8 BRR))
(FONT7 7 (GACHA 10)
(GACHA 8])
(DECLARE: DONTEVAL@LOAD DOCOPY
(MOVD? (QUOTE NILL)
(QUOTE PRESSFONTPROFILE))
(MOVD (QUOTE DISPLAYOFDP)
(QUOTE DISPLAYP))
(FONTSET (QUOTE PARC))
(SETSEPR (QUOTE (%| 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26))
1 FILERDTBL)
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS PFPRINCHAR MACRO ((CC)
(COND
(CRFLG (\OUTCHAR DOFD (CHARCODE CR))
(SETQ CRFLG NIL)))
[COND
((NOT (ZEROP #SPACES))
(FRPTQ (COND
(FLG #SPACES)
(T (FOLDHI #SPACES 2)))
(\OUTCHAR DOFD (CHARCODE SPACE]
(SETQ #SPACES 0)
(\OUTCHAR DOFD CC)))
)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(PUTPROPS DFILE COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2112 14022 (FINDFILE 2122 . 2966) (SPELLFILE 2968 . 9199) (SPELLFILE.MATCHINGDIRS 9201
. 10114) (SPELLFILE.SPELL 10116 . 11441) (SPELLFILE1 11443 . 13078) (SPELLFILEDIR 13080 . 14020)) (
14477 28894 (DODIR 14487 . 15187) (DIRECTORY 15189 . 18531) (DIR4 18533 . 19602) (DIRCONJ 19604 .
20000) (DPAT 20002 . 20239) (NEXTFILE 20241 . 21138) (DMATCH 21140 . 21642) (LASTMEMBTAIL 21644 .
21901) (DMATCH1 21903 . 23501) (DOCOMMANDS 23503 . 25951) (DIRPRINTNAME 25953 . 27289) (DTAB 27291 .
27426) (DPRIN1 27428 . 27575) (DIRFILENAME 27577 . 28279) (DREAD 28281 . 28751) (FILDIR 28753 . 28892)
) (30277 37635 (PFCOPYBYTES 30287 . 34293) (DISPLAYFONTPROFILE 34295 . 34738) (DISPLAYOFDP 34740 .
35200) (DISPLAYFONTSETUP 35202 . 35616) (COMPUTEPRETTYPARMS 35618 . 36215) (FONTMAPARRAY 36217 . 37633
)))))
STOP