Ignore:
Timestamp:
Jul 29, 2006, 12:26:35 PM (13 years ago)
Author:
gb
Message:

MAKE-FILE-STREAM: support for BASIC-STREAMs.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/level-1/l1-sysio.lisp

    r4925 r4929  
    606606          'fundamental-file-stream)))))
    607607
     608(defmethod map-to-basic-stream-class-name ((name (eql 'fundamental-file-stream)))
     609  'basic-file-stream)
     610
     611(defmethod select-stream-class ((class (eql 'basic-file-stream)) in-p out-p char-p)
     612  (if char-p
     613    (if (and in-p out-p)
     614      'basic-file-character-io-stream
     615      (if in-p
     616        'basic-file-character-input-stream
     617        (if out-p
     618          'basic-file-character-output-stream
     619          'basic-file-stream)))
     620    (if (and in-p out-p)
     621      'basic-file-binary-io-stream
     622      (if in-p
     623        'basic-file-binary-input-stream
     624        (if out-p
     625          'basic-file-binary-output-stream
     626          'basic-file-stream)))))
     627
    608628(defun make-file-stream (filename
    609629                         direction
     
    614634                         class
    615635                         external-format
    616                          sharing)
     636                         sharing
     637                         basic)
    617638
    618639  (let* ((temp-name nil)
    619640         (dir (pathname-directory filename))
    620641         (filename (if (eq (car dir) :relative)
    621                        (full-pathname filename)
    622                        filename))
     642                     (full-pathname filename)
     643                     filename))
    623644         (pathname (pathname filename)))
    624645    (block open
     
    650671                   (setq native-truename (%create-file filename)))
    651672                  ((memq direction '(:output :io))
    652                    #| ;;
     673                   #|;;
    653674                   ;; this prevents us from writing a file that is open for anything           
    654675                   ;;l but does not protect against reading a file that is open for :output
     
    675696                              :element-type element-type
    676697                              :elements-per-buffer elements-per-buffer
    677                               :sharing sharing)
    678               (let* ((in-p (member direction '(:io :input)))
     698                              :sharing sharing
     699                              :basic basic)
     700              (progn
     701                (when basic
     702                  (setq class (map-to-basic-stream-class-name class))
     703                  (setq basic (subtypep (find-class class) 'basic-stream)))
     704                (let* ((in-p (member direction '(:io :input)))
    679705                     (out-p (member direction '(:io :output)))
    680706                     (io-p (eq direction :io))
     
    737763                  (close fstream)
    738764                  (push fstream *open-file-streams*))
    739                 fstream))))))))
     765                fstream)))))))))
    740766
    741767(defmethod stream-external-format ((s fundamental-file-stream))
Note: See TracChangeset for help on using the changeset viewer.