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 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(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 @@
;;; search-list := [^:/]*:
;;; file := [^/]*
;;; 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
;;; version. Therefore, we use the following rules when confronted with
;;; an ambiguous file.type.version string:
......@@ -170,44 +170,41 @@
(t
(make-pattern (pattern)))))))
;;; extract-name-type-and-version -- Internal.
;;;
(defun extract-name-type-and-version (namestr start end)
(declare (type simple-base-string namestr)
(type index start end))
(let* ((last-dot (position #\. namestr :start (1+ start) :end end
:from-end t))
(second-to-last-dot (and last-dot
(position #\. namestr :start (1+ start)
:end last-dot :from-end t)))
(version :newest))
;; If there is a second-to-last dot, check to see if there is a valid
;; version after the last dot.
(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)))
(multiple-value-bind (version vstart)
(cond ((or (< (- end start) 5)
(char/= (schar namestr (1- end)) #\~))
(values :newest end))
((and (char= (schar namestr (- end 2)) #\*)
(char= (schar namestr (- end 3)) #\~)
(char= (schar namestr (- end 4)) #\.))
(values :wild (- end 4)))
(t
(setf second-to-last-dot nil))))
(cond (second-to-last-dot
(values (maybe-make-pattern namestr start second-to-last-dot)
(maybe-make-pattern namestr
(1+ second-to-last-dot)
last-dot)
version))
(last-dot
(values (maybe-make-pattern namestr start last-dot)
(maybe-make-pattern namestr (1+ last-dot) end)
version))
(t
(values (maybe-make-pattern namestr start end)
nil
version)))))
(do ((i (- end 2) (1- i)))
((< i (+ start 2)) (values :newest nil))
(let ((char (schar namestr i)))
(when (eql char #\~)
(return (and (char= (schar namestr (1- i)) #\.)
(values (parse-integer namestr
:start (1+ i)
:end (1- end))
(1- i)))))
(unless (char<= #\0 char #\9)
(return nil))))))
(let ((last-dot (position #\. namestr :start (1+ start) :end vstart
:from-end t)))
(cond (last-dot
(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
;;; separated subseq. The first value t if absolute directories location.
......@@ -407,11 +404,9 @@
(strings ".")
(strings (unparse-unix-piece type)))
(when version-supplied
(unless type-supplied
(error "Cannot specify the version without a type: ~S" pathname))
(strings (if (eq version :wild)
".*"
(format nil ".~D" version)))))
".~~*~~"
(format nil ".~~~D~~" version)))))
(and (strings) (apply #'concatenate 'simple-string (strings)))))
(defun unparse-unix-namestring (pathname)
......@@ -469,9 +464,9 @@
(when version-needed
(typecase pathname-version
((member :wild)
(strings ".*"))
(strings ".~~*~~"))
(integer
(strings (format nil ".~D" pathname-version)))
(strings (format nil ".~~~D~~" pathname-version)))
(t
(lose)))))
(apply #'concatenate 'simple-string (strings)))))
......@@ -514,9 +509,6 @@
(when (pathname-type pathname)
(unless (pathname-name 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)))
(if 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