Changeset 9951


Ignore:
Timestamp:
09/09/05 02:40:08 (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

    r9946 r9951  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: pathnames.lisp,v 1.10 2005-09-08 16:05:46 piso Exp $
     4;;; $Id: pathnames.lisp,v 1.11 2005-09-09 02:40:08 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    3838  (%wild-pathname-p pathname field-key))
    3939
    40 (defun translate-pathname (&rest args)
    41   (declare (ignore args)) ; FIXME
    42   (error "TRANSLATE-PATHNAME is not implemented."))
     40(defun wild-p (component)
     41  (or (eq component :wild)
     42      (and (stringp component)
     43           (position #\* component))))
     44
     45(defun translate-component (source from to)
     46  (cond ((or (eq to :wild) (null to))
     47         ;; "If the piece in TO-WILDCARD is :WILD or NIL, the piece in source
     48         ;; is copied into the result."
     49         source)
     50        ((and to (not (wild-p to)))
     51        ;; "If the piece in TO-WILDCARD is present and not wild, it is copied
     52        ;; into the result."
     53         to)
     54        (t
     55         ;; "Otherwise, the piece in TO-WILDCARD might be a complex wildcard
     56         ;; such as "foo*bar" and the piece in FROM-WILDCARD should be wild;
     57         ;; the portion of the piece in SOURCE that matches the wildcard
     58         ;; portion of the piece in FROM-WILDCARD replaces the wildcard portion
     59         ;; of the piece in TO-WILDCARD and the value produced is used in the
     60         ;; result."
     61         ;; FIXME
     62         (error "Unsupported TO-WILDCARD pattern: ~S" to))))
     63
     64;; "The resulting pathname is TO-WILDCARD with each wildcard or missing field
     65;; replaced by a portion of SOURCE."
     66(defun translate-pathname (source from-wildcard to-wildcard &key)
     67  (let ((source (pathname source))
     68        (from   (pathname from-wildcard))
     69        (to     (pathname to-wildcard)))
     70    (make-pathname :host     (or (pathname-host to)
     71                                 (pathname-host source))
     72                   :device   (translate-component (pathname-device source)
     73                                                  (pathname-device from)
     74                                                  (pathname-device to))
     75                   ;; FIXME directory
     76                   :name     (translate-component (pathname-name source)
     77                                                  (pathname-name from)
     78                                                  (pathname-name to))
     79                   :type     (translate-component (pathname-type source)
     80                                                  (pathname-type from)
     81                                                  (pathname-type to))
     82                   :version  (if (null (pathname-host from))
     83                                 (if (eq (pathname-version to) :wild)
     84                                     (pathname-version from)
     85                                     (pathname-version to))
     86                                 (translate-component (pathname-version source)
     87                                                      (pathname-version from)
     88                                                      (pathname-version to))))))
    4389
    4490(defun canonicalize-logical-hostname (host)
Note: See TracChangeset for help on using the changeset viewer.