Changeset 9968


Ignore:
Timestamp:
09/13/05 17:21:23 (16 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

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

    r9967 r9968  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: pathnames.lisp,v 1.16 2005-09-13 14:52:22 piso Exp $
     4;;; $Id: pathnames.lisp,v 1.17 2005-09-13 17:21:23 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    7272        ((equal thing wild)
    7373         t)
     74        ((and (null thing) (equal wild '(:absolute :wild-inferiors)))
     75         t)
    7476        ((and (consp thing) (consp wild))
    7577         (if (eq (%car thing) (%car wild))
     
    135137  ;; FIXME We can canonicalize logical pathnames to upper case, so we only need
    136138  ;; IGNORE-CASE for Windows.
    137   (cond ((and (null source)
    138               (null from))
     139  (cond ((null source)
    139140         to)
    140141        (t
     
    171172                                                       (pathname-version to))))))
    172173
    173 (defun canonicalize-logical-hostname (host)
     174(defun canonicalize-logical-host (host)
    174175  (string-upcase host))
    175176
    176177(defun logical-pathname-translations (host)
    177   (gethash-2op-1ret (canonicalize-logical-hostname host)
     178  (gethash-2op-1ret (canonicalize-logical-host host)
    178179                    *logical-pathname-translations*))
    179180
     181(defun logical-host-p (canonical-host)
     182  (multiple-value-bind (translations present)
     183      (gethash canonical-host *logical-pathname-translations*)
     184    (declare (ignore translations))
     185    present))
     186
    180187(defun canonicalize-logical-pathname-translations (translations host)
    181 ;;   (mapcar (lambda (translation)
    182 ;;             (destructuring-bind (from to) translation
    183 ;;                                 (list (if (typep from 'logical-pathname)
    184 ;;                                           from
    185 ;;                                           (parse-namestring from host))
    186 ;;                                       (pathname to))))
    187 ;;           translation-list))
    188188  (let (result)
    189189    (dolist (translation translations (nreverse result))
     
    197197
    198198(defun %set-logical-pathname-translations (host translations)
    199   (setf (gethash (canonicalize-logical-hostname host)
    200                  *logical-pathname-translations*)
    201 ;;         (canonicalize-logical-pathname-translations translations host)))
    202         translations))
    203 
    204 (defun logical-host-p (host)
    205   (multiple-value-bind (translations present)
    206       (gethash (canonicalize-logical-hostname host)
    207                *logical-pathname-translations*)
    208     (declare (ignore translations))
    209     present))
     199  (setf host (canonicalize-logical-host host))
     200  ;; Avoid undefined host error in CANONICALIZE-LOGICAL-PATHNAME-TRANSLATIONS.
     201  (unless (logical-host-p host)
     202    (setf (gethash host *logical-pathname-translations*) nil))
     203  (setf (gethash host *logical-pathname-translations*)
     204        (canonicalize-logical-pathname-translations translations host)))
    210205
    211206(defsetf logical-pathname-translations %set-logical-pathname-translations)
     
    233228  (declare (type string host))
    234229  (multiple-value-bind (ignore found)
    235       (gethash (canonicalize-logical-hostname host)
     230      (gethash (canonicalize-logical-host host)
    236231               *logical-pathname-translations*)
    237232    (declare (ignore ignore))
     
    261256  (declare (ignore default-pathname junk-allowed)) ; FIXME
    262257  (when host
    263     (setf host (canonicalize-logical-hostname host)))
     258    (setf host (canonicalize-logical-host host)))
    264259  (typecase thing
    265260    (stream
Note: See TracChangeset for help on using the changeset viewer.