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

Diff of /src/code/pathname.lisp

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

revision 1.36 by dtc, Sat Jan 9 11:20:30 1999 UTC revision 1.37 by dtc, Thu Feb 11 12:24:30 1999 UTC
# Line 1156  a host-structure or string." Line 1156  a host-structure or string."
1156  ;;;  ;;;
1157  (defun translate-directories (source from to diddle-case)  (defun translate-directories (source from to diddle-case)
1158    (if (not (and source to from))    (if (not (and source to from))
1159        (or (and to (null source) (remove :wild-inferiors to))        (let ((source (mapcar #'(lambda (x) (maybe-diddle-case x diddle-case))
1160            (mapcar #'(lambda (x) (maybe-diddle-case x diddle-case)) source))                              source)))
1161            (if (null to)
1162                source
1163                (collect ((res))
1164                  (res (cond ((null source) (first to))
1165                             ((eq (first to) :absolute) :absolute)
1166                             (t (first source))))
1167                  (let ((match (rest source)))
1168                    (dolist (to-part (rest to))
1169                      (cond ((eq to-part :wild)
1170                             (when match
1171                               (res (first match))
1172                               (setf match nil)))
1173                            ((eq to-part :wild-inferiors)
1174                             (when match
1175                               (dolist (src-part match)
1176                                 (res src-part))
1177                               (setf match nil)))
1178                            (t
1179                             (res to-part)))))
1180                  (res))))
1181        (collect ((res))        (collect ((res))
1182          (res (if (eq (first to) :absolute)          (res (if (eq (first to) :absolute)
1183                   :absolute                   :absolute

Legend:
Removed from v.1.36  
changed lines
  Added in v.1.37

  ViewVC Help
Powered by ViewVC 1.1.5