(FILECREATED "23-Feb-84 18:01:19" {PHYLUM}<LISPCORE>NEW>DFILE.;2 41678
changes to: (ALISTS (FONTDEFS STANDARD)
(FONTDEFS PARC))
previous date: " 5-Jan-84 17:19:30" {PHYLUM}<LISPCORE>SOURCES>DFILE.;35)
(* Copyright (c) 1982, 1983, 1984 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 DISPLAYFONTSETUP DISPLAYP.D COMPUTEPRETTYPARMS
FONTMAPARRAY)
(ADDVARS (\FONTMAPCACHE))
(ADDVARS (FONTSETUPFNS (2 DISPLAYFONTSETUP DISPLAYFONTPROFILE)))
(ALISTS (FONTDEFS STANDARD PARC))
(DECLARE: DONTEVAL@LOAD DOCOPY
(P (MOVD (QUOTE DISPLAYP.D)
(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 PFOUTCHAR PFTERPRI PFBIN)))
(LOCALVARS . T)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
(* 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: " 4-Dec-83 22:05")
(DECLARE (SPECVARS NAME EXTENSION VERSION SPELLVAL DIRHOSTS HOST)
(GLOBALVARS \FILEDEVICENAMES))
(PROG (SPELLVAL VAL DIRHOSTS HOST DEVICE DIRECTORY NAME EXTENSION VERSION FILEDATES
(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 FILEDATES (GETPROP ROOTNAME (QUOTE FILEDATES)))
(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
([for X in FILEDATES thereis (AND (OR (EQ (CDR X)
SPELLVAL)
(EQ (CDR X)
FILE))
(STREQUAL (CAR X)
(FILEDATE SPELLVAL]
(* 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. This is a rare case; users should LOADFROM! Also, since we
don't know where this fully-qualified name came from, we must ask for correction.)
(SETQ VAL SPELLVAL) (* 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]
(COND
([AND [LISTP (SETQ VAL (GETPROP FILE (QUOTE FILEDATES]
(LITATOM (CDAR VAL))
(SETQ VAL (INFILEP (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
(CDAR VAL]
[SETQ APPFLG (COND
(NOPRINTFLG (QUOTE NO-MESSAGE))
(T (QUOTE NEEDNOTAPPROVE]
(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) (* bvm: " 5-Jan-84 17:18")
(* 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
(OR FG ""))
(QUOTE NAME)
(QUOTE *)
(QUOTE VERSION)
(OR DEFAULTVERS
(QUOTE *))
(QUOTE EXTENSION)
(OR DEFAULTEXT
(QUOTE *]
[for TAIL on (SETQ TEMP (CHCON FG)) when (AND (IGEQ (CAR TAIL)
(CHARCODE a))
(ILEQ (CAR TAIL)
(CHARCODE z)))
do (* Coerce to uppercase)
(RPLACA TAIL (IDIFFERENCE (CAR TAIL)
(CONSTANT (IDIFFERENCE (CHARCODE a)
(CHARCODE A]
TEMP)
[(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 " 5-OCT-83 14:34")
(COND
((NULL PAT)
(NULL LST))
[(NULL LST)
(MEMBER PAT (CHARCODE ( (*)
(; *) (* ; *)
(%. * ; *) (* %. * ; *)
]
(T (SELCHARQ (CAR PAT)
[(?) (* matches any char)
(AND LST (DMATCH1 (CDR PAT)
(CDR LST]
[(ESCAPE *)
(OR (DMATCH1 (SETQ PAT (CDR PAT)))
(while LST
do (COND
((DMATCH1 PAT LST)
(RETURN T)))
(pop LST]
(COND
((OR (EQ (CAR PAT)
(CAR LST))
[AND (IGEQ (CAR LST)
(CHARCODE a))
(ILEQ (CAR LST)
(CHARCODE z))
(EQ (CAR PAT)
(IDIFFERENCE (CAR LST)
(CONSTANT (IDIFFERENCE (CHARCODE a)
(CHARCODE A]
(SELCHARQ (CAR LST)
(({ %[)
(SELCHARQ (CAR PAT)
((%[ {) (* Different delimiters)
T)
NIL))
((; !)
(SELCHARQ (CAR PAT)
((; !) (* Would match except for different delimiter)
T)
NIL))
NIL))
(DMATCH1 (CDR PAT)
(CDR LST)))
(T (SELCHARQ (CAR LST)
(({ %[) (* LST had a device where the pattern didn't)
(AND (SETQ LST (LASTMEMBTAIL (CHARCODE (} %]))
LST))
(DMATCH1 PAT LST)))
NIL])
(DOCOMMANDS
[LAMBDA (COMMANDS FILEGROUP) (* lmm " 5-OCT-83 11:04")
(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 (NCONC1 VALUE (DIRFILENAME FILEGROUP]
((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 " 4-OCT-83 03:27")
(DIRECTORY FILEGROUP])
)
(ADDTOVAR LISPXMACROS (DIR (DODIR LISPXLINE)))
(ADDTOVAR LISPXCOMS DIR)
(RPAQ? UPPERCASEFILENAMES T)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS UPPERCASEFILENAMES DIRCOMMANDS ASKUSERTTBL FILEINFOTYPES)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(PUTDEF (QUOTE \FILDIRSCRATCH)
(QUOTE GLOBALRESOURCES)
(QUOTE (CONS)))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \FILDIRSCRATCH)
)
(RPAQQ \FILDIRSCRATCH NIL)
(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) (* bvm: "14-NOV-83 16:17")
(* 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 ((SSTRM (\INSTREAMARG SRCFIL))
(DSTRM (\OUTSTREAMARG DSTFIL))
(#SPACES 0)
(CHANGECHARCODE (AND CHANGECHAR (CHCON1 CHANGECHAR)))
(COMMENTCHARCODE (AND COMMENTFLG (CHCON1 COMMENTFLG)))
(HPOS 0)
LMAR RMAR FONTARRAY CHARCODE CRFLG STRFLG #CHARS MAXFONT)
(COND
((DISPLAYSTREAMP DSTRM)
(SETQ FONTARRAY (FONTMAPARRAY NIL (QUOTE DISPLAY)))
(SETQ MAXFONT (ARRAYSIZE FONTARRAY))
(RESETSAVE NIL (LIST (QUOTE DSPFONT)
(DSPFONT NIL DSTRM)
DSTRM))
(SETQ HPOS (DSPXPOSITION NIL DSTRM))
(SETQ LMAR (DSPLEFTMARGIN NIL DSTRM))
(SETQ RMAR (DSPRIGHTMARGIN NIL DSTRM)))
((NOT (\OUTTERMP DSTRM))
(ERROR "PFCOPYBYTES FOR TERMINAL ONLY")))
(SETQ #CHARS (COND
(END (SETFILEPTR SSTRM START) (* Doesn't call \SETFILEPTR cause START has to be
checked)
(IDIFFERENCE (COND
((EQ END -1)
(\GETEOFPTR SSTRM))
(T END))
START))
(START (FIX START))
(T (* Stop on end of file)
(RESETSAVE NIL (LIST (FUNCTION [LAMBDA (STREAM FN)
(replace ENDOFSTREAMOP of STREAM with FN])
SSTRM
(fetch ENDOFSTREAMOP of SSTRM)))
(replace ENDOFSTREAMOP of SSTRM with (FUNCTION NILL))
MAX.SMALL.INTEGER)))
LP [COND
((ILEQ #CHARS 0)
(OR (NULL START)
(RETURN T]
(SETQ CHAR (PFBIN))
INTERP
[COND
((NULL CHAR)
(COND
(CRFLG (TERPRI DSTRM)))
(RETURN T))
((EQ CHAR (CHARCODE %%))
(PFPRINCHAR CHAR)
(COND
((EQ (SETQ CHAR (PFBIN))
(CHARCODE CR))
(PFTERPRI))
(T (PFOUTCHAR CHAR)))
(GO LP))
((EQ CHAR (CHARCODE %"))
(SETQ STRFLG (NULL STRFLG)))
((EQ CHAR (CHARCODE SPACE))
(SETQ #SPACES (ADD1 #SPACES))
(GO LP))
((AND (EQ CHAR CHANGECHARCODE)
(NULL STRFLG)
(EQ (\PEEKBIN SSTRM)
(CHARCODE CR))) (* Ignore changechar only when followed by CR;
otherwise, it may be the important BQUOTE character.)
(GO LP))
((EQ CHAR (CHARCODE TAB))
(SETQ #SPACES (IPLUS #SPACES 8))
(GO LP))
((EQ CHAR (CHARCODE CR))
(COND
((OR FLG (NULL **COMMENT**FLG)) (* Be literal, don't shrink)
(PFTERPRI))
(T (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 CHAR (CHARCODE LF)) (* LF after CR is ignored for both Alto and Tenex EOL
conventions)
(AND CRFLG (GO LP)))
((ILEQ CHAR (CHARCODE ↑Z))
[COND
((AND FONTARRAY (EQ CHAR (CHARCODE ↑F)))
(COND
((AND (IGEQ MAXFONT (SETQ CHAR (PFBIN)))
(NEQ CHAR 0))
(DSPFONT (ELT FONTARRAY CHAR)
DSTRM]
(GO LP))
((AND (EQ CHAR (CHARCODE %())
**COMMENT**FLG
(NULL STRFLG))
(COND
((AND (EQ (SETQ CHAR (PFBIN))
COMMENTCHARCODE)
(EQ (\PEEKBIN SSTRM)
(CHARCODE SPACE)))
(SETQ #SPACES 0)
(SETQ CRFLG NIL)
[SETQ #CHARS (IPLUS #CHARS (IDIFFERENCE (\GETFILEPTR SSTRM)
(PROGN (SKREAD SSTRM "(*")
(\GETFILEPTR SSTRM]
(* 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 DSTRM)
(GO LP))
(T (PFPRINCHAR (CHARCODE %()) (* We already read the next character, so just interpret
it)
(GO INTERP]
(PFPRINCHAR CHAR)
(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])
(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])
(DISPLAYP.D
[LAMBDA (STREAM) (* rmk: "31-AUG-83 16:12")
(DISPLAYSTREAMP (\OUTSTREAMARG STREAM T])
(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 )
(ADDTOVAR FONTSETUPFNS (2 DISPLAYFONTSETUP DISPLAYFONTPROFILE))
(ADDTOVAR FONTDEFS [STANDARD (FONTCHANGEFLG . ALL)
(FILELINELENGTH . 102)
(COMMENTLINELENGTH 116 . 126)
(LAMBDAFONTLINELENGTH . 95)
(FIRSTCOL . 60)
(PRETTYLCOM . 25)
(FONTPROFILE (DEFAULTFONT 1 (GACHA 10)
(GACHA 8)
(TERMINAL 8))
(BOLDFONT 2 (HELVETICA 10 BRR)
(HELVETICA 8 BRR)
(MODERN 8 BRR))
(LITTLEFONT 3 (HELVETICA 8)
(HELVETICA 6 MIR)
(MODERN 6 MIR))
(BIGFONT 4 (HELVETICA 12 BRR)
(HELVETICA 10 BRR)
(MODERN 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)
(MODERN 8 BIR))
(FONT6 6 (HELVETICA 10 BRR)
(HELVETICA 8 BRR)
(MODERN 8 BRR))
(FONT7 7 (GACHA 12)
(GACHA 12)
(TERMINAL 12]
[PARC (FONTCHANGEFLG . ALL)
(FILELINELENGTH . 102)
(COMMENTLINELENGTH 116 . 126)
(LAMBDAFONTLINELENGTH . 95)
(FIRSTCOL . 60)
(PRETTYLCOM . 25)
(FONTPROFILE (DEFAULTFONT 1 (GACHA 10)
(GACHA 8)
(TERMINAL 8))
(BOLDFONT 2 (HELVETICA 10 BRR)
(HELVETICA 8 BRR)
(MODERN 8 BRR))
(LITTLEFONT 3 (HELVETICA 8)
(HELVETICA 6 MIR)
(MODERN 8 MIR))
(BIGFONT 4 (HELVETICA 12 BRR)
(HELVETICA 10 BRR)
(MODERN 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)
(MODERN 8 BIR))
(FONT6 6 (HELVETICA 10 BRR)
(HELVETICA 8 BRR)
(MODERN 8 BRR))
(FONT7 7 (GACHA 12)
(GACHA 12)
(TERMINAL 12])
(DECLARE: DONTEVAL@LOAD DOCOPY
(MOVD (QUOTE DISPLAYP.D)
(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 (TERPRI DSTRM)
(SETQ CRFLG NIL)
(SETQ HPOS LMAR)))
(COND
((NOT (ZEROP #SPACES))
(FRPTQ (COND
((OR FLG STRFLG)
#SPACES)
(T (FOLDHI #SPACES 2)))
(PFOUTCHAR (CHARCODE SPACE)))
(SETQ #SPACES 0)))
(PFOUTCHAR CC)))
(PUTPROPS PFOUTCHAR MACRO ((CC)
([LAMBDA (WIDTH)
(COND
((AND WIDTH (IGREATERP (add HPOS WIDTH)
RMAR))
(* past RIGHT margin, force eol)
(TERPRI DSTRM)
(SETQ HPOS WIDTH)))
(\OUTCHAR DSTRM CC]
(\STREAMCHARWIDTH CC DSTRM \PRIMTERMTABLE))))
(PUTPROPS PFTERPRI MACRO (NIL (PROGN (TERPRI DSTRM)
(SETQ HPOS LMAR)
(SETQ CRFLG NIL)
(SETQ #SPACES 0))))
(PUTPROPS PFBIN MACRO (NIL (PROGN (SETQ #CHARS (SUB1 #CHARS))
(\BIN SSTRM))))
)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PUTPROPS DFILE COPYRIGHT ("Xerox Corporation" 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2096 13775 (FINDFILE 2106 . 2950) (SPELLFILE 2952 . 8952) (SPELLFILE.MATCHINGDIRS 8954
. 9867) (SPELLFILE.SPELL 9869 . 11194) (SPELLFILE1 11196 . 12831) (SPELLFILEDIR 12833 . 13773)) (
14230 28919 (DODIR 14240 . 14940) (DIRECTORY 14942 . 18284) (DIR4 18286 . 19712) (DIRCONJ 19714 .
20110) (DPAT 20112 . 20349) (NEXTFILE 20351 . 21248) (DMATCH 21250 . 21752) (LASTMEMBTAIL 21754 .
22011) (DMATCH1 22013 . 23543) (DOCOMMANDS 23545 . 25982) (DIRPRINTNAME 25984 . 27320) (DTAB 27322 .
27457) (DPRIN1 27459 . 27606) (DIRFILENAME 27608 . 28310) (DREAD 28312 . 28782) (FILDIR 28784 . 28917)
) (30302 37883 (PFCOPYBYTES 30312 . 34848) (DISPLAYFONTPROFILE 34850 . 35293) (DISPLAYFONTSETUP 35295
. 35709) (DISPLAYP.D 35711 . 35864) (COMPUTEPRETTYPARMS 35866 . 36463) (FONTMAPARRAY 36465 . 37881)))
))
STOP