Ignore:
Timestamp:
Oct 6, 2006, 10:39:23 AM (13 years ago)
Author:
gb
Message:

Real, live EXTERNAL-FORMAT structures.

File:
1 edited

Legend:

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

    r5293 r5304  
    159159is :UNIX.")
    160160
     161(defstruct external-format
     162  (character-encoding :default)
     163  (line-termination :default))
     164
     165
    161166(defun normalize-external-format (domain external-format)
    162167  (cond ((listp external-format)
    163168         (unless (plistp external-format)
    164169           (error "External-format ~s is not a property list." external-format))
    165          (let* ((character-encoding (getf external-format :character-encoding :default))
    166                 (line-termination (getf external-format :line-termination :default)))
     170         (normalize-external-format domain (apply #'make-external-format external-format)))
     171        ((typep external-format 'external-format)
     172         (let* ((character-encoding (external-format-character-encoding external-format))
     173                (line-termination (external-format-line-termination external-format)))
    167174           (when (or (eq character-encoding :default)
    168175                     (eq line-termination :default))
    169              (setq external-format (copy-list external-format))
     176             (setq external-format (copy-external-format external-format))
    170177             (if (eq line-termination :default)
    171                (setf (getf external-format :line-termination)
     178               (setf (external-format-line-termination external-format)
    172179                     (setq line-termination *default-line-termination*)))
    173180             (unless (member line-termination *known-line-termination-formats*)
    174181               (error "~S is not a known line-termination format." line-termination))
    175182             (if (eq character-encoding :default)
    176                (setf (getf external-format :character-encoding)
     183               (setf (external-format-character-encoding external-format)
    177184                     (setq character-encoding
    178185                           (default-character-encoding domain))))
     
    844851                        (if char-p
    845852                          (normalize-external-format :file external-format)
    846                           '(:binary :t)))
    847                        (line-termination (getf real-external-format :line-termination))
    848                        (encoding (getf real-external-format :character-encoding))
     853                          ))
     854                       (line-termination (if char-p (external-format-line-termination real-external-format)))
     855                       (encoding (if char-p (external-format-character-encoding real-external-format)))
    849856                       (class-name (select-stream-class class in-p out-p char-p))
    850857                       (class (find-class class-name))
     
    868875                                 :device fd
    869876                                 :encoding encoding
    870                                  :external-format real-external-format
     877                                 :external-format (or real-external-format :binary)
    871878                                 :sharing sharing
    872879                                 :character-p (or (eq element-type 'character)
Note: See TracChangeset for help on using the changeset viewer.