Ignore:
Timestamp:
Oct 9, 2006, 2:29:12 AM (13 years ago)
Author:
gb
Message:

Rearrange a few things; pass :line-termination option to MAKE-FD-STREAM.

File:
1 edited

Legend:

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

    r5304 r5320  
    105105                       (get-character-encoding nil)))
    106106         (unit-size (character-encoding-code-unit-size encoding))
    107          (octets-per-unit (ash unit-size -3))
    108          (native-byte-order (file-ioblock-native-byte-order file-ioblock))
    109          (little-endian #+little-endian-target native-byte-order
    110                         #+big-endian-target (not native-byte-order))
    111          (leading-zeros (if little-endian
    112                           0
    113                           (1- octets-per-unit)))
    114          (trailing-zeros (if (not little-endian)
    115                            0
    116                            (1- octets-per-unit)))
    117107         (cr (char-code #\Return))
    118108         (lf (char-code #\linefeed))
     
    120110         (buffer (io-buffer-buffer inbuf))
    121111         (n (io-buffer-count inbuf)))
    122     (if (zerop n)
    123       (setq n (fd-stream-advance (file-ioblock-stream file-ioblock)
    124                                  file-ioblock
    125                                  t)))
    126     (do* ((i 0 (+ i octets-per-unit))
    127           (code))
    128          ((= i n) :unix)
    129       (when (and (dotimes (k leading-zeros t)
    130                    (unless (zerop (the (unsigned-byte 8) (aref buffer (+ i k))))
    131                      (return)))
    132                  (setq code (aref buffer (+ i leading-zeros)))
    133                  (dotimes (k trailing-zeros t)
    134                    (unless (zerop (the (unsigned-byte 8) (aref buffer (+ i 1 leading-zeros k))))
    135                      (return))))
    136         (if (= code cr)
    137           (return :macos)
    138           (if (= code lf)
    139             (return :unix)))))))
     112    (cond ((= unit-size 8)
     113           (if (zerop n)
     114             (setq n (fd-stream-advance (file-ioblock-stream file-ioblock)
     115                                        file-ioblock
     116                                        t)))
     117     
     118     
     119           (do* ((i 0 (+ i 1))
     120                 (code))
     121                ((= i n) :unix)
     122             (setq code (aref buffer i))           
     123             (if (= code cr)
     124               (return :macos)
     125               (if (= code lf)
     126                 (return :unix))))))))
    140127
    141128
     
    152139  "The value of this variable is used when :EXTERNAL-FORMAT is
    153140unspecified or specified as :DEFAULT. It can meaningfully be given any
    154 of the values :UNIX, :MACOS, or :INFERRED, each of which is
     141of the values :UNIX, :MACOS, :MSDOS or :INFERRED, each of which is
    155142interpreted as described in the documentation.
    156143
     
    178165               (setf (external-format-line-termination external-format)
    179166                     (setq line-termination *default-line-termination*)))
    180              (unless (member line-termination *known-line-termination-formats*)
     167             (unless (assq line-termination *canonical-line-termination-conventions*)
    181168               (error "~S is not a known line-termination format." line-termination))
    182169             (if (eq character-encoding :default)
     
    435422(defmethod print-object ((s basic-file-stream) out)
    436423  (print-file-stream s out))
     424
     425
     426(defmethod initialize-basic-stream ((s basic-file-stream) &key element-type external-format &allow-other-keys)
     427  (setf (getf (basic-stream.info s) :element-type) element-type)
     428  (setf (basic-file-stream.external-format s) external-format))
    437429
    438430(defmethod stream-create-ioblock ((stream fundamental-file-stream) &rest args &key)
     
    877869                                 :external-format (or real-external-format :binary)
    878870                                 :sharing sharing
     871                                 :line-termination line-termination
    879872                                 :character-p (or (eq element-type 'character)
    880873                                                  (subtypep element-type 'character))))
Note: See TracChangeset for help on using the changeset viewer.