(FILECREATED "31-Aug-85 22:10:33" {ERIS}<LISPCORE>LIBRARY>CMLPATHNAME.;3 8800
changes to: (MACROS DEFPATHNAMEPRINTER PATHNAMEP \PATHNAME-DEVICE \PATHNAME-DIRECTORY
\PATHNAME-HOST \PATHNAME-NAME \PATHNAME-OSTYPE \PATHNAME-TYPE
\PATHNAME-VERSION)
(VARS CMLPATHNAMECOMS)
(RECORDS PATHNAME)
previous date: "13-Aug-85 23:55:22" {ERIS}<LISPCORE>LIBRARY>CMLPATHNAME.;2)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT CMLPATHNAMECOMS)
(RPAQQ CMLPATHNAMECOMS ((MACROS DEFPATHNAMEPRINTER PATHNAMEP \PATHNAME-DEVICE \PATHNAME-DIRECTORY
\PATHNAME-HOST \PATHNAME-NAME \PATHNAME-OSTYPE \PATHNAME-TYPE
\PATHNAME-VERSION)
(VARS (*PATHNAME-PRINTER-FUNCTIONS* (HASHARRAY 10 1.1)))
(RECORDS PATHNAME)
(FNS NAMESTRING PATHNAME PATHNAME-DEVICE PATHNAME-DIRECTORY PATHNAME-HOST
PATHNAME-NAME PATHNAME-OSTYPE PATHNAME-TYPE PATHNAME-VERSION TRUENAME
\PATHNAME-COERCE \PATHNAME-DEFAULT-PRINTER \PATHNAME-PRINTER)
(P (DEFPATHNAMEPRINTER INTERLISP { HOST } < DIRECTORY > NAME %. TYPE ;
VERSION)
(DEFPATHNAMEPRINTER UNIX { HOST } / DIRECTORY / NAME %. TYPE ; VERSION)
(DEFPATHNAMEPRINTER VMS { HOST } "[" DIRECTORY "]" NAME %. TYPE ; VERSION)
(DEFPATHNAMEPRINTER TOPS-20 { HOST } < DIRECTORY > NAME %. TYPE %. VERSION)
(DEFPATHNAMEPRINTER NS %( HOST %) DIRECTORY / NAME %. TYPE ! VERSION)
(DEFPATHNAMEPRINTER SYMBOLICS-3600 HOST : > DIRECTORY > NAME %. TYPE %.
VERSION))))
(DECLARE: EVAL@COMPILE
(DEFMACRO DEFPATHNAMEPRINTER (OSTYPE &REST ARGS)
(BQUOTE (PROGN (DEFUN (\, (PACK* (QUOTE \NAMESTRING-)
OSTYPE))
(PATHNAME)
(CONCAT (\,@ (for X in ARGS collect
(COND ((FMEMB X
(QUOTE (HOST DEVICE DIRECTORY NAME
TYPE VERSION)))
(BQUOTE ((\, (PACK* (QUOTE \PATHNAME-)
X))
PATHNAME)))
(T (KWOTE X)))))))
(PUTHASH (QUOTE (\, OSTYPE))
(PACK* (QUOTE \NAMESTRING-)
(QUOTE (\, OSTYPE)))
*PATHNAME-PRINTER-FUNCTIONS*))))
(DEFMACRO PATHNAMEP (X)
(BQUOTE (TYPENAMEP (\, X)
(QUOTE PATHNAME))))
(DEFMACRO \PATHNAME-DEVICE (PATHNAME)
(BQUOTE (fetch (PATHNAME DEVICE)
of
(\, PATHNAME))))
(DEFMACRO \PATHNAME-DIRECTORY (PATHNAME)
(BQUOTE (fetch (PATHNAME DIRECTORY)
of
(\, PATHNAME))))
(DEFMACRO \PATHNAME-HOST (PATHNAME)
(BQUOTE (fetch (PATHNAME HOST)
of
(\, PATHNAME))))
(DEFMACRO \PATHNAME-NAME (PATHNAME)
(BQUOTE (fetch (PATHNAME NAME)
of
(\, PATHNAME))))
(DEFMACRO \PATHNAME-OSTYPE (PATHNAME)
(BQUOTE (fetch (PATHNAME OSTYPE)
of
(\, PATHNAME))))
(DEFMACRO \PATHNAME-TYPE (PATHNAME)
(BQUOTE (fetch (PATHNAME TYPE)
of
(\, PATHNAME))))
(DEFMACRO \PATHNAME-VERSION (PATHNAME)
(BQUOTE (fetch (PATHNAME VERSION)
of
(\, PATHNAME))))
)
(RPAQ *PATHNAME-PRINTER-FUNCTIONS* (HASHARRAY 10 1.1))
[DECLARE: EVAL@COMPILE
(DATATYPE PATHNAME (HOST DEVICE DIRECTORY NAME TYPE VERSION OSTYPE))
]
(/DECLAREDATATYPE (QUOTE PATHNAME)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((PATHNAME 0 POINTER)
(PATHNAME 2 POINTER)
(PATHNAME 4 POINTER)
(PATHNAME 6 POINTER)
(PATHNAME 8 POINTER)
(PATHNAME 10 POINTER)
(PATHNAME 12 POINTER)))
(QUOTE 14))
(DEFINEQ
(NAMESTRING
(LAMBDA (PATHNAME) (* ejs: "13-Aug-85 22:03")
(COND
((STRINGP PATHNAME)
PATHNAME)
((PATHNAMEP PATHNAME)
(LET ((OSTYPE (OR (\PATHNAME-OSTYPE PATHNAME)
(GETOSTYPE (\PATHNAME-HOST PATHNAME)))))
(COND
(OSTYPE (APPLY* (GETHASH OSTYPE *PATHNAME-PRINTER-FUNCTIONS*)
PATHNAME))
(T (\PATHNAME-DEFAULT-PRINTER PATHNAME))))))))
(PATHNAME
(LAMBDA (PATHNAME) (* ejs: "13-Aug-85 23:24")
(* * Coerce an argument to a pathname, somehow)
(COND
((NULL PATHNAME)
NIL)
((PATHNAMEP PATHNAME)
PATHNAME)
((STREAMP PATHNAME)
(PATHNAME (FULLNAME PATHNAME)))
((OR (STRINGP PATHNAME)
(LITATOM PATHNAME))
(\PATHNAME-COERCE PATHNAME))
(T (\ILLEGAL.ARG PATHNAME)))))
(PATHNAME-DEVICE
(LAMBDA (PATHNAME) (* ejs: "13-Aug-85 23:05")
(\PATHNAME-DEVICE (COND
((PATHNAMEP PATHNAME)
PATHNAME)
(T (PATHNAME PATHNAME))))))
(PATHNAME-DIRECTORY
(LAMBDA (PATHNAME) (* ejs: "13-Aug-85 23:05")
(\PATHNAME-DIRECTORY (COND
((PATHNAMEP PATHNAME)
PATHNAME)
(T (PATHNAME PATHNAME))))))
(PATHNAME-HOST
(LAMBDA (PATHNAME) (* ejs: "13-Aug-85 23:06")
(\PATHNAME-HOST (COND
((PATHNAMEP PATHNAME)
PATHNAME)
(T (PATHNAME PATHNAME))))))
(PATHNAME-NAME
(LAMBDA (PATHNAME) (* ejs: "13-Aug-85 23:05")
(\PATHNAME-NAME (COND
((PATHNAMEP PATHNAME)
PATHNAME)
(T (PATHNAME PATHNAME))))))
(PATHNAME-OSTYPE
(LAMBDA (PATHNAME) (* ejs: "13-Aug-85 23:06")
(\PATHNAME-OSTYPE (COND
((PATHNAMEP PATHNAME)
PATHNAME)
(T (PATHNAME PATHNAME))))))
(PATHNAME-TYPE
(LAMBDA (PATHNAME) (* ejs: "13-Aug-85 23:05")
(\PATHNAME-TYPE (COND
((PATHNAMEP PATHNAME)
PATHNAME)
(T (PATHNAME PATHNAME))))))
(PATHNAME-VERSION
(LAMBDA (PATHNAME) (* ejs: "13-Aug-85 23:06")
(\PATHNAME-VERSION (COND
((PATHNAMEP PATHNAME)
PATHNAME)
(T (PATHNAME PATHNAME))))))
(TRUENAME
(LAMBDA (PATHNAME) (* ejs: "13-Aug-85 23:24")
(* * Coerce an argument to a pathname, somehow)
(COND
((NULL PATHNAME)
NIL)
((STREAMP PATHNAME)
(PATHNAME (FULLNAME PATHNAME)))
((OR (STRINGP PATHNAME)
(LITATOM PATHNAME))
(\PATHNAME-COERCE (INFILEP PATHNAME)))
(T (\ILLEGAL.ARG PATHNAME)))))
(\PATHNAME-COERCE
(LAMBDA (NAME) (* ejs: "13-Aug-85 23:15")
(* * Use UNPACKFILENAME for now to figure this mess out)
(LET ((UNPACKED.NAME (UNPACKFILENAME.STRING (MKSTRING NAME)))
(PATHNAME (create PATHNAME)))
(for COMPONENT on UNPACKED.NAME by (CDDR COMPONENT)
do (SELECTQ (CAR COMPONENT)
(HOST (replace (PATHNAME HOST) of PATHNAME with (CADR COMPONENT))
(replace (PATHNAME OSTYPE) of PATHNAME with (GETOSTYPE (CADR COMPONENT))
))
(DEVICE (replace (PATHNAME DEVICE) of PATHNAME with (CADR COMPONENT)))
(DIRECTORY (replace (PATHNAME DIRECTORY) of PATHNAME with (CADR COMPONENT)))
(NAME (replace (PATHNAME NAME) of PATHNAME with (CADR COMPONENT)))
(EXTENSION (replace (PATHNAME TYPE) of PATHNAME with (CADR COMPONENT)))
(VERSION (replace (PATHNAME VERSION) of PATHNAME with (CADR COMPONENT)))
(ERROR "Unexpected pathname component" (CAR COMPONENT))))
PATHNAME)))
(\PATHNAME-DEFAULT-PRINTER
(LAMBDA (PATHNAME) (* ejs: "13-Aug-85 23:18")
(CONCAT "HOST " (\PATHNAME-HOST PATHNAME)
" DEVICE "
(\PATHNAME-DEVICE PATHNAME)
" DIRECTORY "
(\PATHNAME-DIRECTORY PATHNAME)
" NAME "
(\PATHNAME-NAME PATHNAME)
" TYPE "
(\PATHNAME-TYPE PATHNAME)
" VERSION "
(\PATHNAME-VERSION PATHNAME))))
(\PATHNAME-PRINTER
(LAMBDA (PATHNAME) (* ejs: "13-Aug-85 23:00")
(LET ((OSTYPE (\PATHNAME-OSTYPE PATHNAME)))
(CONS (CONCAT \CML.READPREFIX ".(PATHNAME " (NAMESTRING PATHNAME)
")")))))
)
(DEFPATHNAMEPRINTER INTERLISP { HOST } < DIRECTORY > NAME %. TYPE ; VERSION)
(DEFPATHNAMEPRINTER UNIX { HOST } / DIRECTORY / NAME %. TYPE ; VERSION)
(DEFPATHNAMEPRINTER VMS { HOST } "[" DIRECTORY "]" NAME %. TYPE ; VERSION)
(DEFPATHNAMEPRINTER TOPS-20 { HOST } < DIRECTORY > NAME %. TYPE %. VERSION)
(DEFPATHNAMEPRINTER NS %( HOST %) DIRECTORY / NAME %. TYPE ! VERSION)
(DEFPATHNAMEPRINTER SYMBOLICS-3600 HOST : > DIRECTORY > NAME %. TYPE %. VERSION)
(PUTPROPS CMLPATHNAME COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3345 8267 (NAMESTRING 3355 . 3828) (PATHNAME 3830 . 4302) (PATHNAME-DEVICE 4304 . 4527)
(PATHNAME-DIRECTORY 4529 . 4767) (PATHNAME-HOST 4769 . 4996) (PATHNAME-NAME 4998 . 5225) (
PATHNAME-OSTYPE 5227 . 5450) (PATHNAME-TYPE 5452 . 5679) (PATHNAME-VERSION 5681 . 5909) (TRUENAME 5911
. 6358) (\PATHNAME-COERCE 6360 . 7562) (\PATHNAME-DEFAULT-PRINTER 7564 . 7988) (\PATHNAME-PRINTER
7990 . 8265)))))
STOP