/[cmucl]/src/code/filesys.lisp
ViewVC logotype

Diff of /src/code/filesys.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.58 by dtc, Thu Aug 24 14:22:56 2000 UTC revision 1.59 by dtc, Thu Feb 22 19:35:01 2001 UTC
# Line 38  Line 38 
38  ;;; search-list := [^:/]*:  ;;; search-list := [^:/]*:
39  ;;; file := [^/]*  ;;; file := [^/]*
40  ;;; type := "." [^/.]*  ;;; type := "." [^/.]*
41  ;;; version := "." ([0-9]+ | "*")  ;;; version := ".~" ([0-9]+ | "*") "~"
42  ;;;  ;;;
43  ;;; 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
44  ;;; 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
45  ;;; version.  Therefore, we use the following rules when confronted with  ;;; version.  Therefore, we use the following rules when confronted with
46  ;;; an ambiguous file.type.version string:  ;;; an ambiguous file.type.version string:
# Line 170  Line 170 
170                (t                (t
171                 (make-pattern (pattern)))))))                 (make-pattern (pattern)))))))
172    
173    ;;; extract-name-type-and-version  --  Internal.
174    ;;;
175  (defun extract-name-type-and-version (namestr start end)  (defun extract-name-type-and-version (namestr start end)
176    (declare (type simple-base-string namestr)    (declare (type simple-base-string namestr)
177             (type index start end))             (type index start end))
178    (let* ((last-dot (position #\. namestr :start (1+ start) :end end    (multiple-value-bind (version vstart)
179                               :from-end t))        (cond ((or (< (- end start) 5)
180           (second-to-last-dot (and last-dot                   (char/= (schar namestr (1- end)) #\~))
181                                    (position #\. namestr :start (1+ start)               (values :newest end))
182                                              :end last-dot :from-end t)))              ((and (char= (schar namestr (- end 2)) #\*)
183           (version :newest))                    (char= (schar namestr (- end 3)) #\~)
184      ;; If there is a second-to-last dot, check to see if there is a valid                    (char= (schar namestr (- end 4)) #\.))
185      ;; 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)))  
186              (t              (t
187               (setf second-to-last-dot nil))))               (do ((i (- end 2) (1- i)))
188      (cond (second-to-last-dot                   ((< i (+ start 2)) (values :newest nil))
189             (values (maybe-make-pattern namestr start second-to-last-dot)                 (let ((char (schar namestr i)))
190                     (maybe-make-pattern namestr                   (when (eql char #\~)
191                                         (1+ second-to-last-dot)                     (return (and (char= (schar namestr (1- i)) #\.)
192                                         last-dot)                                  (values (parse-integer namestr
193                     version))                                                         :start (1+ i)
194            (last-dot                                                         :end (1- end))
195             (values (maybe-make-pattern namestr start last-dot)                                          (1- i)))))
196                     (maybe-make-pattern namestr (1+ last-dot) end)                   (unless (char<= #\0 char #\9)
197                     version))                     (return nil))))))
198            (t      (let ((last-dot (position #\. namestr :start (1+ start) :end vstart
199             (values (maybe-make-pattern namestr start end)                                :from-end t)))
200                     nil        (cond (last-dot
201                     version)))))               (values (maybe-make-pattern namestr start last-dot)
202                         (maybe-make-pattern namestr (1+ last-dot) vstart)
203                         version))
204                (t
205                 (values (maybe-make-pattern namestr start vstart)
206                         nil
207                         version))))))
208    
209  ;;; 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
210  ;;; separated subseq. The first value t if absolute directories location.  ;;; separated subseq. The first value t if absolute directories location.
# Line 407  Line 404 
404          (strings ".")          (strings ".")
405          (strings (unparse-unix-piece type)))          (strings (unparse-unix-piece type)))
406        (when version-supplied        (when version-supplied
         (unless type-supplied  
           (error "Cannot specify the version without a type: ~S" pathname))  
407          (strings (if (eq version :wild)          (strings (if (eq version :wild)
408                       ".*"                       ".~~*~~"
409                       (format nil ".~D" version)))))                       (format nil ".~~~D~~" version)))))
410      (and (strings) (apply #'concatenate 'simple-string (strings)))))      (and (strings) (apply #'concatenate 'simple-string (strings)))))
411    
412  (defun unparse-unix-namestring (pathname)  (defun unparse-unix-namestring (pathname)
# Line 469  Line 464 
464          (when version-needed          (when version-needed
465            (typecase pathname-version            (typecase pathname-version
466              ((member :wild)              ((member :wild)
467               (strings ".*"))               (strings ".~~*~~"))
468              (integer              (integer
469               (strings (format nil ".~D" pathname-version)))               (strings (format nil ".~~~D~~" pathname-version)))
470              (t              (t
471               (lose)))))               (lose)))))
472        (apply #'concatenate 'simple-string (strings)))))        (apply #'concatenate 'simple-string (strings)))))
# Line 514  Line 509 
509    (when (pathname-type pathname)    (when (pathname-type pathname)
510      (unless (pathname-name pathname)      (unless (pathname-name pathname)
511        (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))  
512    (let ((directory (pathname-directory pathname)))    (let ((directory (pathname-directory pathname)))
513      (if directory      (if directory
514          (ecase (car directory)          (ecase (car directory)

Legend:
Removed from v.1.58  
changed lines
  Added in v.1.59

  ViewVC Help
Powered by ViewVC 1.1.5