Changeset 9975


Ignore:
Timestamp:
09/14/05 19:59:19 (16 years ago)
Author:
piso
Message:

Logical pathname support.

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

Legend:

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

    r9946 r9975  
    22;;;
    33;;; Copyright (C) 2004-2005 Peter Graves
    4 ;;; $Id: directory.lisp,v 1.3 2005-09-08 16:14:55 piso Exp $
     4;;; $Id: directory.lisp,v 1.4 2005-09-14 19:59:19 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    2121
    2222(defun directory (pathname &key)
    23   (when (typep pathname 'logical-pathname)
    24     (error "Bad place for a logical pathname."))
    2523  (let ((merged-pathname (merge-pathnames pathname)))
     24    (when (typep merged-pathname 'logical-pathname)
     25      (setf merged-pathname (translate-logical-pathname merged-pathname)))
    2626    (if (wild-pathname-p merged-pathname)
    2727        (let ((namestring (directory-namestring merged-pathname)))
  • trunk/j/src/org/armedbear/lisp/open.lisp

    r9971 r9975  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: open.lisp,v 1.26 2005-09-14 13:42:06 piso Exp $
     4;;; $Id: open.lisp,v 1.27 2005-09-14 19:58:53 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    103103                       (t
    104104                        (upgraded-element-type element-type))))
    105   (let ((pathname (merge-pathnames filename)))
    106     (when (typep pathname 'logical-pathname)
    107       (setf pathname (translate-logical-pathname pathname)))
     105  (let* ((pathname (merge-pathnames filename))
     106         (namestring (namestring (if (typep pathname 'logical-pathname)
     107                                     (translate-logical-pathname pathname)
     108                                     pathname))))
    108109    (when (memq direction '(:output :io))
    109110      (unless if-exists-given
     
    130131                   :pathname pathname
    131132                   :format-control "The file ~S does not exist."
    132                    :format-arguments (list (namestring pathname))))))
    133        (make-file-stream pathname element-type :input nil))
     133                   :format-arguments (list namestring)))))
     134       (make-file-stream pathname namestring element-type :input nil))
    134135      (:probe
    135136       (case if-does-not-exist
     
    139140                   :pathname pathname
    140141                   :format-control "The file ~S does not exist."
    141                    :format-arguments (list (namestring pathname)))))
     142                   :format-arguments (list namestring))))
    142143         (:create
    143144          (unless (probe-file pathname)
    144145            (create-new-file pathname))))
    145        (let ((stream (make-file-stream pathname element-type :input nil)))
     146       (let ((stream (make-file-stream pathname namestring element-type :input nil)))
    146147         (when stream
    147148           (close stream))
     
    154155                   :pathname pathname
    155156                   :format-control "The file ~S does not exist."
    156                    :format-arguments (list (namestring pathname)))))
     157                   :format-arguments (list namestring))))
    157158         ((nil)
    158159          (unless (probe-file pathname)
     
    164165                   :pathname pathname
    165166                   :format-control "The file ~S already exists."
    166                    :format-arguments (list (namestring pathname)))))
     167                   :format-arguments (list namestring))))
    167168         ((nil)
    168169          (when (probe-file pathname)
     
    175176                     :pathname pathname
    176177                     :format-control "The file ~S is a directory."
    177                      :format-arguments (list (namestring pathname))))
    178             (let ((backup-name (concatenate 'string (namestring pathname) ".bak")))
     178                     :format-arguments (list namestring)))
     179            (let ((backup-name (concatenate 'string namestring ".bak")))
    179180              (when (probe-file backup-name)
    180181                (when (probe-directory backup-name)
     
    182183                         :pathname pathname
    183184                         :format-control "Unable to rename ~S."
    184                          :format-arguments (list (namestring pathname))))
     185                         :format-arguments (list namestring)))
    185186                (delete-file backup-name))
    186187              (rename-file pathname backup-name))))
     
    190191                 :format-control "Option not supported: ~S."
    191192                 :format-arguments (list if-exists))))
    192        (let ((stream (make-file-stream pathname element-type direction if-exists)))
     193       (let ((stream (make-file-stream pathname namestring element-type direction if-exists)))
    193194         (unless stream
    194195           (error 'file-error
    195196                  :pathname pathname
    196197                  :format-control "Unable to open ~S."
    197                   :format-arguments (list (namestring pathname))))
     198                  :format-arguments (list namestring)))
    198199         stream))
    199200      (t
Note: See TracChangeset for help on using the changeset viewer.