(FILECREATED "19-Dec-85 12:43:12" {SAFE}</C/SCHOEN/TCP>TCPNAMES.;1 35035
changes to: (VARS TCPNAMESCOMS)
(FNS REPACKFILENAME.STRING.TI)
previous date: "13-Aug-85 19:24:24" {SAFE}</c/schoen/tcp>TCPNAMES)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TCPNAMESCOMS)
(RPAQQ TCPNAMESCOMS ((FNS REPACKFILENAME.STRING REPACKFILENAME.STRING.D
REPACKFILENAME.STRING.MSDOS
REPACKFILENAME.STRING.TI 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.TI
(LAMBDA N (* cvs "19-Dec-85 12:25")
(* * Can you believe this???)
(if (AND (EQ N 1)
(LISTP (ARG N 1)))
then (* spread argument list)
(APPLY (FUNCTION REPACKFILENAME.STRING.TI)
(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.TI 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)
'NAME)
(OR (EVALV '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 ':)))
(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 '%.))
(OR EXTENSION BLIP)))
(AND VERSION (NEQ VERSION BLIP)
(COND
((FIXP VERSION)
(LIST '#
VERSION))
(T (SELCHARQ (CHCON1 VERSION)
(# (LIST VERSION))
((%. ! ;)
(LIST '#
(SUBSTRING VERSION 2 -1))
)
(L (LIST '#
'OLDEST))
((H 0)
(LIST '#
'>))
(LIST '#
VERSION))))))))))))
(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)
)
(PRETTYCOMPRINT TCPNAMESCOMS)
(RPAQQ TCPNAMESCOMS ((FNS REPACKFILENAME.STRING REPACKFILENAME.STRING.D
REPACKFILENAME.STRING.MSDOS
REPACKFILENAME.STRING.TI 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.TI
REPACKFILENAME.STRING.MSDOS
REPACKFILENAME.STRING.D)))))
(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.TI
REPACKFILENAME.STRING.MSDOS
REPACKFILENAME.STRING.D)
)
(PUTPROPS TCPNAMES COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1490 32513 (REPACKFILENAME.STRING 1500 . 1910) (
REPACKFILENAME.STRING.D 1912 . 6132) (REPACKFILENAME.STRING.MSDOS 6134 . 10090)
(REPACKFILENAME.STRING.TI 10092 . 14311) (REPACKFILENAME.STRING.VMS 14313 .
18601) (REPACKFILENAME.STRING.3600 18603 . 23096) (REPACKFILENAME.STRING.TOPS20
23098 . 27923) (REPACKFILENAME.STRING.UNIX 27925 . 31846) (
\REPACKFILENAME.NEW.TRANSLATION 31848 . 32077) (\REPACKFILENAME.NEW.TRANSLATIONS
32079 . 32511)))))
STOP