;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 124.16
;;; Reason:
;;;  Jim O'dell's suggested change to logical pathname parsing - "." parses
;;;  like ";", so logical pathnames support LISPM directory delimiter style
;;;  in addition to the standard style.  I.e., "sys:hardcopy.tiger;" can be
;;;  used instead of "sys:hardcopy;tiger;" - whichever is preferred.  This
;;;  might make some programs work more easily.
;;; Written 1-Jun-88 16:28:26 by keith at site Gigamos Cambridge
;;; while running on Breaking Glass from band 3
;;; with Experimental System 124.15, Experimental Local-File 74.0, Experimental File-Server 23.1, Experimental Unix-Interface 12.0, Experimental ZMail 72.0, Experimental Tape 23.5, Experimental Lambda-Diag 16.0, microcode 1756, SDU Boot Tape 3.14, SDU ROM 103.



; From modified file DJ: L.IO.FILE; PATHST.LISP#216 at 1-Jun-88 16:29:04
#8R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; FILE; PATHST  "


(DEFMETHOD (LOGICAL-PATHNAME :PARSE-NAMESTRING) (IGNORE NAMESTRING &OPTIONAL (START 0) END
						 &aux semicolon-p found-semicolon)
  (OR END (SETQ END (STRING-LENGTH NAMESTRING)))
  (setq semicolon-p (string-search #/; namestring start end))
  (DO ((I START)
       (J START (1+ J))
       CH TEM Q
       DIR NAM NAMP TYP TYPP VERS)
      ((> J END)
       (SETQ DIR (NREVERSE DIR))
       (VALUES :UNSPECIFIC DIR NAM TYP VERS))
    (SETQ CH (IF (= J END) #/SP (AREF NAMESTRING J)))
    (COND ((= CH '#/)
	   (SETQ J (1+ J)))
	  ((MEMQ CH '(#/; #/: #/ #/ #/SP #/TAB #/. #/#))
	   (COND ((OR ( I J) (= CH #/) (= CH #/))
		  (AND (MEM #'= CH '(#/ #/))
		       (OR ( I J)
			   (AND ( (1+ J) END)
				( (AREF NAMESTRING (1+ J)) #/SP)))
		       (PATHNAME-ERROR (1+ J) NAMESTRING
				       "An unquoted ~C must be a component unto itself." CH))
		  (MULTIPLE-VALUE (TEM Q)
		    (SELECTQ CH
		      (#/ (VALUES :UNSPECIFIC NIL))
		      (#/ (VALUES NIL NIL))
		      (T (UNQUOTE-LOGICAL-STRING NAMESTRING I J))))
		  (IF (AND (NOT Q) (STRING= TEM "*"))
		      (SETQ TEM :WILD))
		  (cond ((eq ch #/:) nil)
			((or (eq #/; ch)
			     (and (eq #/. ch)
				  semicolon-p
				  (not found-semicolon)))
			 (if (eq ch #/;)
			     (setq found-semicolon t))
			 (push tem dir))
			('OTHERWISE
			 (COND (VERS)
			       (TYPP (SETQ VERS (COND ((MEMQ TEM '(:UNSPECIFIC :WILD)) TEM)
						      ((AND (NOT Q)
							    (COND ((STRING= TEM ">") :NEWEST)
								  ((STRING= TEM "<") :OLDEST)
								  ((NUMERIC-P TEM)))))
						      (T (PATHNAME-ERROR J NAMESTRING
									 "Version not numeric")))))
			       (NAMP (SETQ TYP TEM TYPP T))
			       (T (SETQ NAM TEM NAMP T)))))))
	   (SETQ I (1+ J))))))

))