Skip to content
Snippets Groups Projects
Commit c7af4e8f authored by dtc's avatar dtc
Browse files

o Rework the unix namestrings format, using the suffix .~#~ for the file

  version, reducing the risk of confusion with commonly used unix filenames.
parent 82b4c127
No related branches found
No related tags found
No related merge requests found
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.58 2000/08/24 14:22:56 dtc Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.59 2001/02/22 19:35:01 dtc Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -38,9 +38,9 @@ ...@@ -38,9 +38,9 @@
;;; search-list := [^:/]*: ;;; search-list := [^:/]*:
;;; file := [^/]* ;;; file := [^/]*
;;; type := "." [^/.]* ;;; type := "." [^/.]*
;;; version := "." ([0-9]+ | "*") ;;; version := ".~" ([0-9]+ | "*") "~"
;;; ;;;
;;; Note: this grammer is ambiguous. The string foo.bar.5 can be parsed ;;; Note: this grammer is ambiguous. The string foo.bar.~5~ can be parsed
;;; as either just the file specified or as specifying the file, type, and ;;; as either just the file specified or as specifying the file, type, and
;;; version. Therefore, we use the following rules when confronted with ;;; version. Therefore, we use the following rules when confronted with
;;; an ambiguous file.type.version string: ;;; an ambiguous file.type.version string:
...@@ -170,44 +170,41 @@ ...@@ -170,44 +170,41 @@
(t (t
(make-pattern (pattern))))))) (make-pattern (pattern)))))))
;;; extract-name-type-and-version -- Internal.
;;;
(defun extract-name-type-and-version (namestr start end) (defun extract-name-type-and-version (namestr start end)
(declare (type simple-base-string namestr) (declare (type simple-base-string namestr)
(type index start end)) (type index start end))
(let* ((last-dot (position #\. namestr :start (1+ start) :end end (multiple-value-bind (version vstart)
:from-end t)) (cond ((or (< (- end start) 5)
(second-to-last-dot (and last-dot (char/= (schar namestr (1- end)) #\~))
(position #\. namestr :start (1+ start) (values :newest end))
:end last-dot :from-end t))) ((and (char= (schar namestr (- end 2)) #\*)
(version :newest)) (char= (schar namestr (- end 3)) #\~)
;; If there is a second-to-last dot, check to see if there is a valid (char= (schar namestr (- end 4)) #\.))
;; version after the last dot. (values :wild (- end 4)))
(when second-to-last-dot
(cond ((and (= (+ last-dot 2) end)
(char= (schar namestr (1+ last-dot)) #\*))
(setf version :wild))
((and (< (1+ last-dot) end)
(do ((index (1+ last-dot) (1+ index)))
((= index end) t)
(unless (char<= #\0 (schar namestr index) #\9)
(return nil))))
(setf version
(parse-integer namestr :start (1+ last-dot) :end end)))
(t (t
(setf second-to-last-dot nil)))) (do ((i (- end 2) (1- i)))
(cond (second-to-last-dot ((< i (+ start 2)) (values :newest nil))
(values (maybe-make-pattern namestr start second-to-last-dot) (let ((char (schar namestr i)))
(maybe-make-pattern namestr (when (eql char #\~)
(1+ second-to-last-dot) (return (and (char= (schar namestr (1- i)) #\.)
last-dot) (values (parse-integer namestr
version)) :start (1+ i)
(last-dot :end (1- end))
(values (maybe-make-pattern namestr start last-dot) (1- i)))))
(maybe-make-pattern namestr (1+ last-dot) end) (unless (char<= #\0 char #\9)
version)) (return nil))))))
(t (let ((last-dot (position #\. namestr :start (1+ start) :end vstart
(values (maybe-make-pattern namestr start end) :from-end t)))
nil (cond (last-dot
version))))) (values (maybe-make-pattern namestr start last-dot)
(maybe-make-pattern namestr (1+ last-dot) vstart)
version))
(t
(values (maybe-make-pattern namestr start vstart)
nil
version))))))
;;; Take a string and return a list of cons cells that mark the char ;;; Take a string and return a list of cons cells that mark the char
;;; separated subseq. The first value t if absolute directories location. ;;; separated subseq. The first value t if absolute directories location.
...@@ -407,11 +404,9 @@ ...@@ -407,11 +404,9 @@
(strings ".") (strings ".")
(strings (unparse-unix-piece type))) (strings (unparse-unix-piece type)))
(when version-supplied (when version-supplied
(unless type-supplied
(error "Cannot specify the version without a type: ~S" pathname))
(strings (if (eq version :wild) (strings (if (eq version :wild)
".*" ".~~*~~"
(format nil ".~D" version))))) (format nil ".~~~D~~" version)))))
(and (strings) (apply #'concatenate 'simple-string (strings))))) (and (strings) (apply #'concatenate 'simple-string (strings)))))
(defun unparse-unix-namestring (pathname) (defun unparse-unix-namestring (pathname)
...@@ -469,9 +464,9 @@ ...@@ -469,9 +464,9 @@
(when version-needed (when version-needed
(typecase pathname-version (typecase pathname-version
((member :wild) ((member :wild)
(strings ".*")) (strings ".~~*~~"))
(integer (integer
(strings (format nil ".~D" pathname-version))) (strings (format nil ".~~~D~~" pathname-version)))
(t (t
(lose))))) (lose)))))
(apply #'concatenate 'simple-string (strings))))) (apply #'concatenate 'simple-string (strings)))))
...@@ -514,9 +509,6 @@ ...@@ -514,9 +509,6 @@
(when (pathname-type pathname) (when (pathname-type pathname)
(unless (pathname-name pathname) (unless (pathname-name pathname)
(error "Cannot supply a type without a name:~% ~S" pathname))) (error "Cannot supply a type without a name:~% ~S" pathname)))
(when (and (integerp (pathname-version pathname))
(member (pathname-type pathname) '(nil :unspecific)))
(error "Cannot supply a version without a type:~% ~S" pathname))
(let ((directory (pathname-directory pathname))) (let ((directory (pathname-directory pathname)))
(if directory (if directory
(ecase (car directory) (ecase (car directory)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment