Changeset 9954


Ignore:
Timestamp:
09/11/05 20:51:20 (16 years ago)
Author:
piso
Message:

Work in progress (tested).

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/pathnames.lisp

    r9953 r9954  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: pathnames.lisp,v 1.12 2005-09-09 19:36:55 piso Exp $
     4;;; $Id: pathnames.lisp,v 1.13 2005-09-11 20:51:20 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    5050(defun directory-match-components (thing wild ignore-case)
    5151  (loop
     52    (cond ((endp thing)
     53           (return (endp wild)))
     54          ((endp wild)
     55           (return nil)))
    5256    (let ((x (car thing))
    5357          (y (car wild)))
     58      (when (eq y :wild-inferiors)
     59        (return t))
    5460      (unless (component-match-p x y ignore-case)
    5561        (return nil))
    5662      (setf thing (cdr thing)
    57             wild  (cdr wild))
    58       (cond ((endp thing)
    59              (return (endp wild)))
    60             ((endp wild)
    61              (return nil))))))
     63            wild  (cdr wild)))))
    6264
    6365(defun directory-match-p (thing wild ignore-case)
     
    7173         t)
    7274        ((and (consp thing) (consp wild))
    73          (directory-match-components thing wild ignore-case))
     75         (if (eq (%car thing) (%car wild))
     76             (directory-match-components (%cdr thing) (%cdr wild) ignore-case)
     77             nil))
    7478        (t
    7579         nil)))
     
    126130         (error "Unsupported TO-WILDCARD pattern: ~S" to))))
    127131
     132(defun translate-directory (source from to)
     133  ;; FIXME The IGNORE-CASE argument to DIRECTORY-MATCH-P should not be nil on
     134  ;; Windows or if the source pathname is a logical pathname.
     135  (unless (directory-match-p source from nil)
     136    (error "~S and ~S do not match." source from))
     137  (translate-component source from to))
     138
    128139;; "The resulting pathname is TO-WILDCARD with each wildcard or missing field
    129140;; replaced by a portion of SOURCE."
     
    137148                                                   (pathname-device from)
    138149                                                   (pathname-device to))
    139                    :directory (translate-component (pathname-device source)
    140                                                    (pathname-device from)
    141                                                    (pathname-device to))
     150                   :directory (translate-directory (pathname-directory source)
     151                                                   (pathname-directory from)
     152                                                   (pathname-directory to))
    142153                   :name      (translate-component (pathname-name source)
    143154                                                   (pathname-name from)
Note: See TracChangeset for help on using the changeset viewer.