(FILECREATED "29-Dec-87 22:11:40" {QV}<BRIGGS>LISP>UNIXFILENAMEPATCH.;2
 2371   

      changes to:  (VARS UNIXFILENAMEPATCHCOMS) (FNS \PARSE.REMOTE.FILENAME)

      previous date: "29-Dec-87 22:09:02" {QV}<BRIGGS>LISP>UNIXFILENAMEPATCH.;1)


(* "
Copyright (c) 1987 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT UNIXFILENAMEPATCHCOMS)

(RPAQQ UNIXFILENAMEPATCHCOMS
 ((DECLARE: EVAL@COMPILE DONTEVAL@LOAD DONTCOPY (FILES (LOADCOMP) LEAF)) (FNS \PARSE.REMOTE.FILENAME))
)
(DECLARE: EVAL@COMPILE DONTEVAL@LOAD DONTCOPY 
(FILESLOAD (LOADCOMP) LEAF)
)
(DEFINEQ

(\PARSE.REMOTE.FILENAME

(LAMBDA (FILENAME NOERROR DEVICE) (* ; "Edited 29-Dec-87 22:03 by Briggs") (* ;; "Parses FILENAME as a dotted pair of host and device-specific name, the latter something we can give to the remote host") (PROG (START HOST REMOTENAME SEMI OSTYPE) (COND ((AND (EQ (NTHCHARCODE FILENAME 1) (CHARCODE {)) (SETQ START (STRPOS (QUOTE }) FILENAME 2))) (SETQ HOST (SUBATOM FILENAME 2 (SUB1 START)))) ((EQ NOERROR T) (RETURN)) (T (LISPERROR "BAD FILE NAME" FILENAME))) (COND ((SETQ HOST (\CANONICAL.HOSTNAME HOST))) (NOERROR (RETURN)) (T (ERROR "Host not found" HOST))) (SETQ REMOTENAME (COND ((EQ (SETQ OSTYPE (fetch (LEAFDEVICE PFSOSTYPE) of DEVICE)) (QUOTE TENEX)) (* ; "Our filenames are already Tenex style") (SUBSTRING FILENAME (ADD1 START))) ((SETQ SEMI (STRPOS (QUOTE ;) FILENAME (ADD1 START))) (* ; "Use ! for version delimiter") (CONCAT (SUBSTRING FILENAME (ADD1 START) (COND ((AND (NEQ OSTYPE (QUOTE TOPS20)) (EQ (NTHCHARCODE FILENAME (SUB1 SEMI)) (CHARCODE %.))) (* ; "Extensionless files have no dot on IFS") (IDIFFERENCE SEMI 2)) (T (SUB1 SEMI)))) (COND ((EQ OSTYPE (QUOTE TOPS20)) (QUOTE %.)) (T (QUOTE !))) (SUBSTRING FILENAME (ADD1 SEMI)))) (T (SUBSTRING FILENAME (ADD1 START) (COND ((EQ (NTHCHARCODE FILENAME -1) (CHARCODE %.)) -2) (T -1)))))) (COND ((EQ OSTYPE (QUOTE UNIX)) (* ; "substitute / for <> in directory") (SETQ REMOTENAME (CONCAT REMOTENAME "")) (* ; "copy because we're being destructive") (if (EQ (NTHCHARCODE REMOTENAME 1) (CHARCODE <)) then (RPLCHARCODE REMOTENAME 1 (CHARCODE /))) (first (SETQ START 0) while (SETQ START (STRPOS ">" REMOTENAME (ADD1 START))) do (RPLCHARCODE REMOTENAME START (CHARCODE /))))) (RETURN (CONS HOST REMOTENAME))))
)
)
(PUTPROPS UNIXFILENAMEPATCH COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (574 2283 (\PARSE.REMOTE.FILENAME 584 . 2281)))))
STOP