(FILECREATED "13-Aug-85 19:24:24" {ERIS}<LISPCORE>LIBRARY>TCPNAMES.;10 29236
changes to: (FNS REPACKFILENAME.STRING.D REPACKFILENAME.STRING.VMS REPACKFILENAME.STRING.MSDOS
REPACKFILENAME.STRING.3600 REPACKFILENAME.STRING.TOPS20
REPACKFILENAME.STRING.UNIX)
previous date: "21-Jun-85 19:30:24" {ERIS}<LISPCORE>LIBRARY>TCPNAMES.;8)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TCPNAMESCOMS)
(RPAQQ TCPNAMESCOMS ((FNS REPACKFILENAME.STRING REPACKFILENAME.STRING.D REPACKFILENAME.STRING.MSDOS
REPACKFILENAME.STRING.VMS REPACKFILENAME.STRING.3600
REPACKFILENAME.STRING.TOPS20 REPACKFILENAME.STRING.UNIX
\REPACKFILENAME.NEW.TRANSLATION \REPACKFILENAME.NEW.TRANSLATIONS)
(INITVARS (\REPACKFILENAME.OSTYPE.TABLE (HASHARRAY 30 1.1)))
(GLOBALVARS \REPACKFILENAME.OSTYPE.TABLE)
(P (\REPACKFILENAME.NEW.TRANSLATIONS (INTERLISP IFS)
REPACKFILENAME.STRING.D
(TOPS-20 TOPS20)
REPACKFILENAME.STRING.TOPS20
(SYMBOLICS-3600 LISPM)
REPACKFILENAME.STRING.3600 VMS
REPACKFILENAME.STRING.VMS UNIX
REPACKFILENAME.STRING.UNIX MS-DOS
REPACKFILENAME.STRING.MSDOS))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA \REPACKFILENAME.NEW.TRANSLATIONS)
(NLAML)
(LAMA REPACKFILENAME.STRING.UNIX REPACKFILENAME.STRING.TOPS20
REPACKFILENAME.STRING.3600 REPACKFILENAME.STRING.VMS
REPACKFILENAME.STRING.MSDOS REPACKFILENAME.STRING.D)))))
(DEFINEQ
(REPACKFILENAME.STRING
(LAMBDA (NAME FOROSTYPE) (* ejs: "27-Apr-85 13:29")
(DECLARE (GLOBALVARS \REPACKFILENAME.OSTYPE.TABLE))
(LET ((NAMELST (UNPACKFILENAME.STRING NAME))
(REPACKFUNCTION (GETHASH FOROSTYPE \REPACKFILENAME.OSTYPE.TABLE)))
(COND
((NULL REPACKFUNCTION)
NAME)
(T (APPLY REPACKFUNCTION NAMELST))))))
(REPACKFILENAME.STRING.D
(LAMBDA N (* ejs: "13-Aug-85 19:23")
(* * Convert file names to native format)
(if (AND (EQ N 1)
(LISTP (ARG N 1)))
then (* spread argument list)
(APPLY (FUNCTION REPACKFILENAME.STRING.D)
(ARG N 1))
else (PROG ((BLIP "")
(I 1)
HOST DEVICE STRUCTURE DIRECTORY NAME EXTENSION VERSION PACKLIST VAR VAL TEMP)
(DECLARE (SPECVARS HOST DEVICE STRUCTURE DIRECTORY NAME EXTENSION VERSION))
LP (COND
((NOT (IGREATERP I N))
(COND
((LISTP (SETQ VAR (ARG N I)))
(SETQ VAL (CDR VAR))
(SETQ VAR (CAR VAR)))
((NOT (IGREATERP (SETQ I (ADD1 I))
N))
(SETQ VAL (ARG N I)))
(T (SETQ VAL)))
(OR (STRINGP VAL)
(ATOM VAL)
(ERRORX (LIST 27 VAL))) (* fields must be atom)
(SELECTQ VAR
(BODY (MAP (UNPACKFILENAME.STRING (COND
((LISTP VAL)
(* PACKFILENAME.STRING for error checking of fields)
(REPACKFILENAME.STRING.D VAL))
(T VAL)))
(FUNCTION (LAMBDA (X)
(* NIL => not yet seen, BLIP => seen as NIL.)
(OR (EVALV (CAR X))
(SET (CAR X)
(OR (CADR X)
BLIP)))))
(FUNCTION CDDR)))
(HOST (OR HOST (SETQ DIRECTORY
(if VAL
then (SELCHARQ (CHCON1 VAL)
(({ %( %[)
(SUBSTRING VAL 2
(SELCHARQ (NTHCHARCODE
VAL -1)
((} %] %))
-2)
-1)))
VAL)
else BLIP))))
(DIRECTORY (* DIRECTORY really is treated as
{Host}device:<directory>)
(OR (EVALV VAR)
(SET VAR (OR VAL BLIP)))
(* for X on (UNPACKFILENAME.STRING VAL NIL) by (CDDR X) do (COND ((EQ (CAR X) (QUOTE NAME))
(OR (EVALV (QUOTE DIRECTORY)) (SETQ DIRECTORY (OR (CADR X) BLIP)))) (T (OR (EVALV (CAR X)) (SET
(CAR X) (OR (CADR X) BLIP))))))
)
((DEVICE HOST NAME EXTENSION VERSION)
(OR (EVALV VAR)
(SET VAR (OR VAL BLIP))))
(\ILLEGAL.ARG VAR))
(SETQ I (ADD1 I))
(GO LP)))
(RETURN (CONCATLIST
(NCONC (AND HOST (NEQ HOST BLIP)
(LIST "{" HOST "}"))
(AND DEVICE (NEQ DEVICE BLIP)
(SELCHARQ (NTHCHARCODE DEVICE -1)
(: (LIST DEVICE))
(LIST DEVICE (QUOTE :))))
(AND DIRECTORY (NEQ DIRECTORY BLIP)
(PROGN (SETQ DIRECTORY (CONCAT DIRECTORY))
(for C from 1 to (NCHARS DIRECTORY)
do (COND
((FMEMB (NTHCHARCODE DIRECTORY C)
(CONSTANT (LIST (CHARCODE %.)
(CHARCODE \)
(CHARCODE /))))
(RPLCHARCODE DIRECTORY C (CHARCODE >)))))
(LIST "<" DIRECTORY ">")))
(AND NAME (NEQ NAME BLIP)
(LIST NAME))
(AND (OR (AND EXTENSION (NEQ EXTENSION BLIP))
(AND VERSION (NEQ VERSION BLIP)))
(LIST (COND
((AND EXTENSION (EQ (CHCON1 EXTENSION)
(CHARCODE %.)))
BLIP)
(T (QUOTE %.)))
(OR EXTENSION BLIP)))
(AND VERSION (NEQ VERSION BLIP)
(COND
((FIXP VERSION)
(LIST (QUOTE ;)
VERSION))
(T (SELCHARQ (CHCON1 VERSION)
(; (LIST VERSION))
((%. !)
(LIST (QUOTE ;)
(SUBSTRING VERSION 2 -1)))
(LIST (QUOTE ;)
VERSION))))))))))))
(REPACKFILENAME.STRING.MSDOS
(LAMBDA N (* ejs: "13-Aug-85 18:43")
(if (AND (EQ N 1)
(LISTP (ARG N 1)))
then (* spread argument list)
(APPLY (FUNCTION REPACKFILENAME.STRING.MSDOS)
(ARG N 1))
else (PROG ((BLIP "")
(I 1)
HOST DEVICE STRUCTURE DIRECTORY NAME EXTENSION VERSION PACKLIST VAR VAL TEMP)
(DECLARE (SPECVARS HOST DEVICE STRUCTURE DIRECTORY NAME EXTENSION VERSION))
LP (COND
((NOT (IGREATERP I N))
(COND
((LISTP (SETQ VAR (ARG N I)))
(SETQ VAL (CDR VAR))
(SETQ VAR (CAR VAR)))
((NOT (IGREATERP (SETQ I (ADD1 I))
N))
(SETQ VAL (ARG N I)))
(T (SETQ VAL)))
(OR (STRINGP VAL)
(ATOM VAL)
(ERRORX (LIST 27 VAL))) (* fields must be atom)
(SELECTQ VAR
(BODY (MAP (UNPACKFILENAME.STRING (COND
((LISTP VAL)
(* PACKFILENAME.STRING for error checking of fields)
(REPACKFILENAME.STRING.MSDOS
VAL))
(T VAL)))
(FUNCTION (LAMBDA (X)
(* NIL => not yet seen, BLIP => seen as NIL.)
(OR (EVALV (CAR X))
(SET (CAR X)
(OR (CADR X)
BLIP)))))
(FUNCTION CDDR)))
(HOST (OR HOST (SETQ HOST
(if VAL
then (SELCHARQ (CHCON1 VAL)
(({ %[ %()
(SUBSTRING VAL 2
(SELCHARQ (NTHCHARCODE
VAL -1)
((} %] %))
-2)
-1)))
VAL)
else BLIP))))
(DIRECTORY (* DIRECTORY really is treated as
{Host}device:<directory>)
(for X on (UNPACKFILENAME.STRING VAL) by (CDDR X)
do (COND
((EQ (CAR X)
(QUOTE NAME))
(OR (EVALV (QUOTE DIRECTORY))
(SETQ DIRECTORY (OR (CADR X)
BLIP))))
(T (OR (EVALV (CAR X))
(SET (CAR X)
(OR (CADR X)
BLIP)))))))
((DEVICE HOST NAME EXTENSION VERSION)
(OR (EVALV VAR)
(SET VAR (OR VAL BLIP))))
(\ILLEGAL.ARG VAR))
(SETQ I (ADD1 I))
(GO LP)))
(RETURN (CONCATLIST
(NCONC (AND HOST (NEQ HOST BLIP)
(LIST "{" HOST "}"))
(AND DEVICE (NEQ DEVICE BLIP)
(LIST ":" DEVICE))
(AND DIRECTORY (NEQ DIRECTORY BLIP)
(PROGN (SETQ DIRECTORY (CONCAT DIRECTORY))
(for C from 1 to (NCHARS DIRECTORY)
do (COND
((FMEMB (NTHCHARCODE DIRECTORY C)
(CONSTANT (LIST (CHARCODE >)
(CHARCODE %.)
(CHARCODE /))))
(RPLCHARCODE DIRECTORY C (CHARCODE \)))))
(LIST "\" DIRECTORY "\"))
(LIST "\" DIRECTORY "\"))
(AND NAME (NEQ NAME BLIP)
(LIST NAME))
(AND (OR (AND EXTENSION (NEQ EXTENSION BLIP))
(AND VERSION (NEQ VERSION BLIP)))
(LIST (COND
((OR (AND EXTENSION (EQ (CHCON1 EXTENSION)
(CHARCODE %.)))
(OR (NULL EXTENSION)
(EQ EXTENSION BLIP)
(STREQUAL EXTENSION "")))
BLIP)
(T (QUOTE %.)))
(OR EXTENSION BLIP))))))))))
(REPACKFILENAME.STRING.VMS
(LAMBDA N (* ejs: "13-Aug-85 18:43")
(if (AND (EQ N 1)
(LISTP (ARG N 1)))
then (* spread argument list)
(APPLY (FUNCTION REPACKFILENAME.STRING.VMS)
(ARG N 1))
else (PROG ((BLIP "")
(I 1)
HOST DEVICE STRUCTURE DIRECTORY NAME EXTENSION VERSION TEMPORARY PROTECTION ACCOUNT
PACKLIST VAR VAL TEMP)
(DECLARE (SPECVARS HOST DEVICE STRUCTURE DIRECTORY NAME EXTENSION VERSION TEMPORARY
PROTECTION ACCOUNT))
LP (COND
((NOT (IGREATERP I N))
(COND
((LISTP (SETQ VAR (ARG N I)))
(SETQ VAL (CDR VAR))
(SETQ VAR (CAR VAR)))
((NOT (IGREATERP (SETQ I (ADD1 I))
N))
(SETQ VAL (ARG N I)))
(T (SETQ VAL)))
(OR (STRINGP VAL)
(ATOM VAL)
(ERRORX (LIST 27 VAL))) (* fields must be atom)
(SELECTQ VAR
(BODY (MAP (UNPACKFILENAME.STRING (COND
((LISTP VAL)
(* PACKFILENAME.STRING for error checking of fields)
(REPACKFILENAME.STRING.VMS VAL))
(T VAL)))
(FUNCTION (LAMBDA (X)
(* NIL => not yet seen, BLIP => seen as NIL.)
(OR (EVALV (CAR X))
(SET (CAR X)
(OR (CADR X)
BLIP)))))
(FUNCTION CDDR)))
(HOST (OR HOST (SETQ HOST
(if VAL
then (SELCHARQ (CHCON1 VAL)
(({ %[ %()
(SUBSTRING VAL 2
(SELCHARQ (NTHCHARCODE
VAL -1)
((} %] %))
-2)
-1)))
VAL)
else BLIP))))
(DIRECTORY (* DIRECTORY really is treated as
{Host}device:<directory>)
(for X on (UNPACKFILENAME.STRING VAL) by (CDDR X)
do (COND
((EQ (CAR X)
(QUOTE NAME))
(OR (EVALV (QUOTE DIRECTORY))
(SETQ DIRECTORY (OR (CADR X)
BLIP))))
(T (OR (EVALV (CAR X))
(SET (CAR X)
(OR (CADR X)
BLIP)))))))
((DEVICE HOST NAME EXTENSION VERSION TEMPORARY)
(OR (EVALV VAR)
(SET VAR (OR VAL BLIP))))
(\ILLEGAL.ARG VAR))
(SETQ I (ADD1 I))
(GO LP)))
(RETURN (CONCATLIST
(NCONC (AND HOST (NEQ HOST BLIP)
(LIST "{" HOST "}"))
(AND DEVICE (NEQ DEVICE BLIP)
(SELCHARQ (NTHCHARCODE DEVICE -1)
(: (LIST DEVICE))
(LIST DEVICE (QUOTE :))))
(AND DIRECTORY (NEQ DIRECTORY BLIP)
(PROGN (SETQ DIRECTORY (CONCAT DIRECTORY))
(for C from 1 to (NCHARS DIRECTORY)
do (COND
((FMEMB (NTHCHARCODE DIRECTORY C)
(CONSTANT (LIST (CHARCODE /)
(CHARCODE >))))
(RPLCHARCODE DIRECTORY C (CHARCODE %.)))))
(LIST "[" DIRECTORY "]")))
(AND NAME (NEQ NAME BLIP)
(LIST NAME))
(AND (OR (AND EXTENSION (NEQ EXTENSION BLIP))
(AND VERSION (NEQ VERSION BLIP)))
(LIST (COND
((AND EXTENSION (EQ (CHCON1 EXTENSION)
(CHARCODE %.)))
BLIP)
(T (QUOTE %.)))
(OR EXTENSION BLIP)))
(AND VERSION (NEQ VERSION BLIP)
(COND
((FIXP VERSION)
(LIST (QUOTE ;)
VERSION))
(T (SELCHARQ (CHCON1 VERSION)
(; (LIST VERSION))
((%. !)
(LIST (QUOTE ;)
(SUBSTRING VERSION 2 -1)))
(LIST (QUOTE ;)
VERSION))))))))))))
(REPACKFILENAME.STRING.3600
(LAMBDA N (* ejs: "13-Aug-85 18:44")
(* * Can you believe this???)
(if (AND (EQ N 1)
(LISTP (ARG N 1)))
then (* spread argument list)
(APPLY (FUNCTION REPACKFILENAME.STRING.3600)
(ARG N 1))
else (PROG ((BLIP "")
(I 1)
HOST DEVICE STRUCTURE DIRECTORY NAME EXTENSION VERSION PACKLIST VAR VAL TEMP)
(DECLARE (SPECVARS HOST DEVICE STRUCTURE DIRECTORY NAME EXTENSION VERSION))
LP (COND
((NOT (IGREATERP I N))
(COND
((LISTP (SETQ VAR (ARG N I)))
(SETQ VAL (CDR VAR))
(SETQ VAR (CAR VAR)))
((NOT (IGREATERP (SETQ I (ADD1 I))
N))
(SETQ VAL (ARG N I)))
(T (SETQ VAL)))
(OR (STRINGP VAL)
(ATOM VAL)
(ERRORX (LIST 27 VAL))) (* fields must be atom)
(SELECTQ VAR
(BODY (MAP (UNPACKFILENAME.STRING (COND
((LISTP VAL)
(* PACKFILENAME.STRING for error checking of fields)
(REPACKFILENAME.STRING.3600
VAL))
(T VAL)))
(FUNCTION (LAMBDA (X)
(* NIL => not yet seen, BLIP => seen as NIL.)
(OR (EVALV (CAR X))
(SET (CAR X)
(OR (CADR X)
BLIP)))))
(FUNCTION CDDR)))
(HOST (OR HOST (SETQ HOST
(if VAL
then (SELCHARQ (CHCON1 VAL)
(({ %[ %()
(SUBSTRING VAL 2
(SELCHARQ (NTHCHARCODE
VAL -1)
((} %] %))
-2)
-1)))
VAL)
else BLIP))))
(DIRECTORY (* DIRECTORY really is treated as
{Host}device:<directory>)
(for X on (UNPACKFILENAME.STRING VAL) by (CDDR X)
do (COND
((EQ (CAR X)
(QUOTE NAME))
(OR (EVALV (QUOTE DIRECTORY))
(SETQ DIRECTORY (OR (CADR X)
BLIP))))
(T (OR (EVALV (CAR X))
(SET (CAR X)
(OR (CADR X)
BLIP)))))))
((DEVICE HOST NAME EXTENSION VERSION)
(OR (EVALV VAR)
(SET VAR (OR VAL BLIP))))
(\ILLEGAL.ARG VAR))
(SETQ I (ADD1 I))
(GO LP)))
(RETURN (CONCATLIST
(NCONC (AND HOST (NEQ HOST BLIP)
(LIST HOST ":"))
(AND DEVICE (NEQ DEVICE BLIP)
(SELCHARQ (NTHCHARCODE DEVICE -1)
(: (LIST DEVICE))
(LIST DEVICE (QUOTE :))))
(AND DIRECTORY (NEQ DIRECTORY BLIP)
(PROGN (SETQ DIRECTORY (CONCAT DIRECTORY))
(for C from 1 to (NCHARS DIRECTORY)
do (COND
((FMEMB (NTHCHARCODE DIRECTORY C)
(CONSTANT (LIST (CHARCODE /)
(CHARCODE %.)
(CHARCODE /)
(CHARCODE \))))
(RPLCHARCODE DIRECTORY C (CHARCODE >)))))
(LIST ">" DIRECTORY ">")))
(AND NAME (NEQ NAME BLIP)
(LIST NAME))
(AND (OR (AND EXTENSION (NEQ EXTENSION BLIP))
(AND VERSION (NEQ VERSION BLIP)))
(LIST (COND
((AND EXTENSION (EQ (CHCON1 EXTENSION)
(CHARCODE %.)))
BLIP)
(T (QUOTE %.)))
(OR EXTENSION BLIP)))
(AND VERSION (NEQ VERSION BLIP)
(COND
((FIXP VERSION)
(LIST (QUOTE %.)
VERSION))
(T (SELCHARQ (CHCON1 VERSION)
(; (LIST VERSION))
((%. !)
(LIST (QUOTE %.)
(SUBSTRING VERSION 2 -1)))
(L (LIST (QUOTE %.)
(QUOTE OLDEST)))
((H 0)
(LIST (QUOTE %.)
(QUOTE NEWEST)))
(LIST (QUOTE %.)
VERSION))))))))))))
(REPACKFILENAME.STRING.TOPS20
(LAMBDA N (* ejs: "13-Aug-85 18:44")
(if (AND (EQ N 1)
(LISTP (ARG N 1)))
then (* spread argument list)
(APPLY (FUNCTION REPACKFILENAME.STRING.TOPS20)
(ARG N 1))
else (PROG ((BLIP "")
(I 1)
HOST DEVICE STRUCTURE DIRECTORY NAME EXTENSION VERSION TEMPORARY PROTECTION ACCOUNT
PACKLIST VAR VAL TEMP)
(DECLARE (SPECVARS HOST DEVICE STRUCTURE DIRECTORY NAME EXTENSION VERSION TEMPORARY
PROTECTION ACCOUNT))
LP (COND
((NOT (IGREATERP I N))
(COND
((LISTP (SETQ VAR (ARG N I)))
(SETQ VAL (CDR VAR))
(SETQ VAR (CAR VAR)))
((NOT (IGREATERP (SETQ I (ADD1 I))
N))
(SETQ VAL (ARG N I)))
(T (SETQ VAL)))
(OR (STRINGP VAL)
(ATOM VAL)
(ERRORX (LIST 27 VAL))) (* fields must be atom)
(SELECTQ VAR
(BODY (MAP (UNPACKFILENAME.STRING (COND
((LISTP VAL)
(* PACKFILENAME.STRING for error checking of fields)
(REPACKFILENAME.STRING.TOPS20
VAL))
(T VAL)))
(FUNCTION (LAMBDA (X)
(* NIL => not yet seen, BLIP => seen as NIL.)
(OR (EVALV (CAR X))
(SET (CAR X)
(OR (CADR X)
BLIP)))))
(FUNCTION CDDR)))
(HOST (OR HOST (SETQ HOST
(if VAL
then (SELCHARQ (CHCON1 VAL)
(({ %[ %()
(SUBSTRING VAL 2
(SELCHARQ (NTHCHARCODE
VAL -1)
((} %] %))
-2)
-1)))
VAL)
else BLIP))))
(DIRECTORY (* DIRECTORY really is treated as
{Host}device:<directory>)
(for X on (UNPACKFILENAME.STRING VAL) by (CDDR X)
do (COND
((EQ (CAR X)
(QUOTE NAME))
(OR (EVALV (QUOTE DIRECTORY))
(SETQ DIRECTORY (OR (CADR X)
BLIP))))
(T (OR (EVALV (CAR X))
(SET (CAR X)
(OR (CADR X)
BLIP)))))))
((DEVICE HOST NAME EXTENSION VERSION TEMPORARY)
(OR (EVALV VAR)
(SET VAR (OR VAL BLIP))))
(\ILLEGAL.ARG VAR))
(SETQ I (ADD1 I))
(GO LP)))
(SELECTQ TEMPORARY
((T S ;S) (* hack for Interlisp-D!)
(OR HOST DEVICE (PROGN (SETQ HOST (QUOTE CORE))
(SETQ TEMPORARY))))
NIL)
(RETURN (CONCATLIST
(NCONC (AND HOST (NEQ HOST BLIP)
(LIST "{" HOST "}"))
(AND DEVICE (NEQ DEVICE BLIP)
(SELCHARQ (NTHCHARCODE DEVICE -1)
(: (LIST DEVICE))
(LIST DEVICE (QUOTE :))))
(AND DIRECTORY (NEQ DIRECTORY BLIP)
(PROGN (SETQ DIRECTORY (CONCAT DIRECTORY))
(for C from 1 to (NCHARS DIRECTORY)
do (COND
((FMEMB (NTHCHARCODE DIRECTORY C)
(CONSTANT (LIST (CHARCODE /)
(CHARCODE >))))
(RPLCHARCODE DIRECTORY C (CHARCODE %.)))))
(LIST "<" DIRECTORY ">")))
(AND NAME (NEQ NAME BLIP)
(LIST NAME))
(AND (OR (AND EXTENSION (NEQ EXTENSION BLIP))
(AND VERSION (NEQ VERSION BLIP)))
(LIST (COND
((AND EXTENSION (EQ (CHCON1 EXTENSION)
(CHARCODE %.)))
BLIP)
(T (QUOTE %.)))
(OR EXTENSION BLIP)))
(AND VERSION (NEQ VERSION BLIP)
(COND
((FIXP VERSION)
(LIST (QUOTE %.)
VERSION))
(T (SELCHARQ (CHCON1 VERSION)
(; (LIST VERSION))
((%. !)
(LIST (QUOTE %.)
(SUBSTRING VERSION 2 -1)))
(L (LIST (QUOTE %.)
-2))
(H (LIST (QUOTE %.)
0))
(LIST (QUOTE %.)
VERSION)))))
(AND TEMPORARY (NEQ TEMPORARY BLIP)
(LIST (QUOTE ;)
(SELECTQ TEMPORARY
((S ;S)
(QUOTE S))
T))))))))))
(REPACKFILENAME.STRING.UNIX
(LAMBDA N (* ejs: "13-Aug-85 18:45")
(if (AND (EQ N 1)
(LISTP (ARG N 1)))
then (* spread argument list)
(APPLY (FUNCTION REPACKFILENAME.STRING.UNIX)
(ARG N 1))
else (PROG ((BLIP "")
(I 1)
HOST DEVICE STRUCTURE DIRECTORY NAME EXTENSION VERSION PACKLIST VAR VAL TEMP)
(DECLARE (SPECVARS HOST DEVICE STRUCTURE DIRECTORY NAME EXTENSION VERSION))
LP (COND
((NOT (IGREATERP I N))
(COND
((LISTP (SETQ VAR (ARG N I)))
(SETQ VAL (CDR VAR))
(SETQ VAR (CAR VAR)))
((NOT (IGREATERP (SETQ I (ADD1 I))
N))
(SETQ VAL (ARG N I)))
(T (SETQ VAL)))
(OR (STRINGP VAL)
(ATOM VAL)
(ERRORX (LIST 27 VAL))) (* fields must be atom)
(SELECTQ VAR
(BODY (MAP (UNPACKFILENAME.STRING (COND
((LISTP VAL)
(* PACKFILENAME.STRING for error checking of fields)
(REPACKFILENAME.STRING.UNIX
VAL))
(T VAL)))
(FUNCTION (LAMBDA (X)
(* NIL => not yet seen, BLIP => seen as NIL.)
(OR (EVALV (CAR X))
(SET (CAR X)
(OR (CADR X)
BLIP)))))
(FUNCTION CDDR)))
(HOST (OR HOST (SETQ HOST
(if VAL
then (SELCHARQ (CHCON1 VAL)
(({ %[ %()
(SUBSTRING VAL 2
(SELCHARQ (NTHCHARCODE
VAL -1)
((} %] %))
-2)
-1)))
VAL)
else BLIP))))
(DIRECTORY (* DIRECTORY really is treated as
{Host}device:<directory>)
(for X on (UNPACKFILENAME.STRING VAL) by (CDDR X)
do (COND
((EQ (CAR X)
(QUOTE NAME))
(OR (EVALV (QUOTE DIRECTORY))
(SETQ DIRECTORY (OR (CADR X)
BLIP))))
(T (OR (EVALV (CAR X))
(SET (CAR X)
(OR (CADR X)
BLIP)))))))
((DEVICE HOST NAME EXTENSION VERSION)
(OR (EVALV VAR)
(SET VAR (OR VAL BLIP))))
(\ILLEGAL.ARG VAR))
(SETQ I (ADD1 I))
(GO LP)))
(RETURN (CONCATLIST
(NCONC (AND HOST (NEQ HOST BLIP)
(LIST "{" HOST "}"))
(AND DEVICE (NEQ DEVICE BLIP)
(LIST "/" DEVICE))
(AND DIRECTORY (NEQ DIRECTORY BLIP)
(PROGN (SETQ DIRECTORY (CONCAT DIRECTORY))
(for C from 1 to (NCHARS DIRECTORY)
do (COND
((FMEMB (NTHCHARCODE DIRECTORY C)
(CONSTANT (LIST (CHARCODE >)
(CHARCODE %.))))
(RPLCHARCODE DIRECTORY C (CHARCODE /)))))
(LIST "/" DIRECTORY "/"))
(LIST "/" DIRECTORY "/"))
(AND NAME (NEQ NAME BLIP)
(LIST NAME))
(AND (OR (AND EXTENSION (NEQ EXTENSION BLIP))
(AND VERSION (NEQ VERSION BLIP)))
(LIST (COND
((OR (AND EXTENSION (EQ (CHCON1 EXTENSION)
(CHARCODE %.)))
(OR (NULL EXTENSION)
(EQ EXTENSION BLIP)
(STREQUAL EXTENSION "")))
BLIP)
(T (QUOTE %.)))
(OR EXTENSION BLIP))))))))))
(\REPACKFILENAME.NEW.TRANSLATION
(LAMBDA (OSTYPE FUNCTION)
(DECLARE (GLOBALVARS \REPACKFILENAME.OSTYPE.TABLE)) (* ejs: "27-Apr-85 13:36")
(PUTHASH OSTYPE FUNCTION \REPACKFILENAME.OSTYPE.TABLE)))
(\REPACKFILENAME.NEW.TRANSLATIONS
(NLAMBDA NAMES (* ejs: "27-Apr-85 13:36")
(* * Supply a property-list format argument of ostypes and translating functions to be added to ostype table)
(for TAIL on NAMES by (CDDR TAIL) do (for OSTYPE inside (CAR TAIL) do (
\REPACKFILENAME.NEW.TRANSLATION OSTYPE (CADR TAIL))))))
)
(RPAQ? \REPACKFILENAME.OSTYPE.TABLE (HASHARRAY 30 1.1))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \REPACKFILENAME.OSTYPE.TABLE)
)
(\REPACKFILENAME.NEW.TRANSLATIONS (INTERLISP IFS)
REPACKFILENAME.STRING.D
(TOPS-20 TOPS20)
REPACKFILENAME.STRING.TOPS20
(SYMBOLICS-3600 LISPM)
REPACKFILENAME.STRING.3600 VMS REPACKFILENAME.STRING.VMS UNIX
REPACKFILENAME.STRING.UNIX MS-DOS REPACKFILENAME.STRING.MSDOS)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA \REPACKFILENAME.NEW.TRANSLATIONS)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA REPACKFILENAME.STRING.UNIX REPACKFILENAME.STRING.TOPS20 REPACKFILENAME.STRING.3600
REPACKFILENAME.STRING.VMS REPACKFILENAME.STRING.MSDOS
REPACKFILENAME.STRING.D)
)
(PUTPROPS TCPNAMES COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1570 28372 (REPACKFILENAME.STRING 1580 . 1990) (REPACKFILENAME.STRING.D 1992 . 6212) (
REPACKFILENAME.STRING.MSDOS 6214 . 10170) (REPACKFILENAME.STRING.VMS 10172 . 14460) (
REPACKFILENAME.STRING.3600 14462 . 18955) (REPACKFILENAME.STRING.TOPS20 18957 . 23782) (
REPACKFILENAME.STRING.UNIX 23784 . 27705) (\REPACKFILENAME.NEW.TRANSLATION 27707 . 27936) (
\REPACKFILENAME.NEW.TRANSLATIONS 27938 . 28370)))))
STOP