Changeset 9964


Ignore:
Timestamp:
09/12/05 23:31:34 (16 years ago)
Author:
piso
Message:

Work in progress (tested).

Location:
trunk/j/src/org/armedbear/lisp
Files:
3 edited

Legend:

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

    r9953 r9964  
    33 *
    44 * Copyright (C) 2004-2005 Peter Graves
    5  * $Id: LogicalPathname.java,v 1.11 2005-09-09 19:36:38 piso Exp $
     5 * $Id: LogicalPathname.java,v 1.12 2005-09-12 23:30:28 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    157157                else if (part == Keyword.WILD)
    158158                    sb.append('*');
     159                else if (part == Keyword.WILD_INFERIORS)
     160                    sb.append("**");
    159161                else if (part == Keyword.UP)
    160162                    sb.append("..");
     
    181183        if (directory != NIL)
    182184            sb.append(getDirectoryNamestring());
    183         sb.append(name.getStringValue());
     185        if (name != NIL) {
     186            if (name == Keyword.WILD)
     187                sb.append('*');
     188            else
     189                sb.append(name.getStringValue());
     190        }
    184191        if (type != NIL) {
    185192            sb.append('.');
     
    197204                sb.append(((Bignum)version).value.toString(base).toUpperCase());
    198205        } else if (version == Keyword.WILD) {
    199             sb.append('*');
     206            sb.append(".*");
    200207        }
    201208        if (printReadably || printEscape)
  • trunk/j/src/org/armedbear/lisp/Pathname.java

    r9953 r9964  
    33 *
    44 * Copyright (C) 2003-2005 Peter Graves
    5  * $Id: Pathname.java,v 1.85 2005-09-09 19:36:31 piso Exp $
     5 * $Id: Pathname.java,v 1.86 2005-09-12 23:30:03 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    276276            else
    277277                Debug.assertTrue(false);
     278        }
     279        if (this instanceof LogicalPathname) {
     280            if (version.integerp()) {
     281                sb.append('.');
     282                int base = Fixnum.getValue(_PRINT_BASE_.symbolValue());
     283                if (version instanceof Fixnum)
     284                    sb.append(Integer.toString(((Fixnum)version).value, base).toUpperCase());
     285                else if (version instanceof Bignum)
     286                    sb.append(((Bignum)version).value.toString(base).toUpperCase());
     287            } else if (version == Keyword.WILD) {
     288                sb.append(".*");
     289            }
    278290        }
    279291        return namestring = sb.toString();
     
    321333                else if (part == Keyword.WILD)
    322334                    sb.append('*');
     335                else if (part == Keyword.WILD_INFERIORS)
     336                    sb.append("**");
    323337                else if (part == Keyword.UP)
    324338                    sb.append("..");
     
    499513    }
    500514
     515    public static Pathname parseNamestring(AbstractString namestring,
     516                                           AbstractString host)
     517        throws ConditionThrowable
     518    {
     519        // Look for a logical pathname host in the namestring.
     520        String s = namestring.getStringValue();
     521        String h = getHostString(s);
     522        if (h != null) {
     523            if (!h.equals(host.getStringValue())) {
     524                signal(new LispError("Host in " + s +
     525                                     " does not match requested host " +
     526                                     host.getStringValue()));
     527                // Not reached.
     528                return null;
     529            }
     530            // Remove host prefix from namestring.
     531            s = s.substring(s.indexOf(':') + 1);
     532        }
     533        if (LOGICAL_PATHNAME_TRANSLATIONS.get(host) != null) {
     534            // A defined logical pathname host.
     535            return new LogicalPathname(host.getStringValue(), s);
     536        }
     537        signal(new LispError(host.writeToString() + " is not defined as a logical pathname host."));
     538        // Not reached.
     539        return null;
     540    }
     541
    501542    // "one or more uppercase letters, digits, and hyphens"
    502543    protected static String getHostString(String s)
     
    636677        {
    637678            return coerceToPathname(arg);
     679        }
     680    };
     681
     682    // ### coerce-to-pathname thing &optional host => pathname
     683    private static final Primitive COERCE_TO_PATHNAME =
     684        new Primitive("coerce-to-pathname", PACKAGE_SYS, true,
     685                      "thing &optional host")
     686    {
     687        public LispObject execute(LispObject arg) throws ConditionThrowable
     688        {
     689            return coerceToPathname(arg);
     690        }
     691        public LispObject execute(LispObject first, LispObject second)
     692            throws ConditionThrowable
     693        {
     694            if (second == NIL)
     695                return coerceToPathname(first);
     696            // FIXME Support other types for first argument (and verify that
     697            // hosts match).
     698            if (first instanceof AbstractString) {
     699                AbstractString namestring = (AbstractString) first;
     700                final AbstractString host;
     701                try {
     702                    host = (AbstractString) second;
     703                }
     704                catch (ClassCastException e) {
     705                    return signalTypeError(second, Symbol.STRING);
     706                }
     707                return parseNamestring(namestring, host);
     708            }
     709            return signal(new LispError("COERCE-TO-PATHNAME: unsupported case."));
    638710        }
    639711    };
  • trunk/j/src/org/armedbear/lisp/pathnames.lisp

    r9954 r9964  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: pathnames.lisp,v 1.13 2005-09-11 20:51:20 piso Exp $
     4;;; $Id: pathnames.lisp,v 1.14 2005-09-12 23:31:34 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    177177        new-translations))
    178178
     179(defun logical-host-p (host)
     180  (multiple-value-bind (translations present)
     181      (gethash (canonicalize-logical-hostname host)
     182               *logical-pathname-translations*)
     183    (declare (ignore translations))
     184    present))
     185
    179186(defsetf logical-pathname-translations %set-logical-pathname-translations)
    180187
     
    182189  (typecase pathname
    183190    (logical-pathname
    184      ;; FIXME
    185      nil)
     191     (let* ((host (pathname-host pathname))
     192            (translations (logical-pathname-translations host)))
     193       (dolist (translation translations
     194                            (error 'file-error
     195                                   :pathname pathname
     196                                   :format-control "No translation for ~S"
     197                                   :format-arguments (list pathname)))
     198         (let ((from-wildcard (car translation))
     199               (to-wildcard (cadr translation)))
     200           (when (pathname-match-p pathname from-wildcard)
     201             (return (translate-logical-pathname
     202                      (translate-pathname pathname from-wildcard to-wildcard))))))))
    186203    (pathname pathname)
    187     (t (translate-logical-pathname (pathname pathname)))))
     204    (t
     205     (translate-logical-pathname (pathname pathname)))))
    188206
    189207(defun load-logical-pathname-translations (host)
     
    216234                         &optional host default-pathname
    217235                         &key (start 0) end junk-allowed)
    218   (declare (ignore host default-pathname junk-allowed)) ; FIXME
     236  (declare (ignore default-pathname junk-allowed)) ; FIXME
     237  (when host
     238    (setf host (canonicalize-logical-hostname host)))
    219239  (typecase thing
    220240    (stream
     
    225245     (unless end
    226246       (setf end (length thing)))
    227      (values (pathname (subseq thing start end))
     247     (values (coerce-to-pathname thing host)
    228248             end))
    229249    (t
Note: See TracChangeset for help on using the changeset viewer.