Ignore:
Timestamp:
Oct 17, 2006, 8:02:20 PM (13 years ago)
Author:
gb
Message:

FILE-STRING-LENGTH actually does something.

Clear the pending-bom flag when seeking.

File:
1 edited

Legend:

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

    r5352 r5361  
    205205      curpos
    206206      (progn
     207        (unless (= newpos 0)
     208          (setf (ioblock-pending-byte-order-mark file-ioblock) nil))
    207209        (if (and (>= newpos element-base)
    208210                 (<= newpos maxpos))
     
    247249        curpos)
    248250      (let* ((incount (io-buffer-count outbuf)))
     251        (unless (= newpos 0)
     252          (setf (ioblock-pending-byte-order-mark file-ioblock) nil))       
    249253        (when (file-ioblock-untyi-char file-ioblock)
    250254          (setf (file-ioblock-untyi-char file-ioblock) nil)
     
    840844                  fstream)))))))))
    841845
    842 (defmethod stream-external-format ((s fundamental-file-stream))
    843   (file-stream-external-format s))
    844 
    845 (defmethod stream-external-format ((s basic-file-stream))
    846   (basic-file-stream.external-format s))
    847 
    848 (defmethod file-stream-external-format ((s basic-file-stream))
    849   (basic-file-stream.external-format s))
    850 
    851 (defmethod (setf file-stream-external-format) (new (s basic-file-stream))
    852   (setf (basic-file-stream.external-format s) new))
     846
     847
     848
    853849
    854850
     
    877873                         (subtypep eltype 'character))))
    878874        (error "~S is not a file stream capable of character output" stream))
    879       (etypecase object
    880         (character 1)
    881         (string (length object))))))
     875      (if (typep object 'character)
     876        (setq object (make-string 1 :initial-element object))
     877        (progn
     878          (require-type object 'string)))
     879      (let* ((start 0)
     880             (end (length object)))
     881        (multiple-value-bind (data offset) (array-data-and-offset object)
     882          (unless (eq data object)
     883            (setq object data)
     884            (incf start offset)
     885            (incf end offset)))
     886        (let* ((external-format (stream-external-format stream))
     887               (encoding (get-character-encoding (external-format-character-encoding external-format)))
     888               (line-termination (external-format-line-termination external-format)))
     889          (-
     890           (+ (funcall (character-encoding-octets-in-string-function encoding)
     891                       object
     892                       start
     893                       end)
     894              (if (eq line-termination :crlf)
     895                (* (count #\Newline object :start start :end end)
     896                   (file-string-length stream #\Return))
     897                0))
     898           (if (eql (file-position stream) 0)
     899             0
     900             (length (character-encoding-bom-encoding encoding)))))))))
    882901 
Note: See TracChangeset for help on using the changeset viewer.