cl-rw

Layered streams for Common Lisp
git clone https://logand.com/git/cl-rw.git/
Log | Files | Refs

string.lisp (2975B)

      1 ;;; Copyright (C) 2014 Tomas Hlavaty <tom@logand.com>
      2 ;;;
      3 ;;; Permission is hereby granted, free of charge, to any person
      4 ;;; obtaining a copy of this software and associated documentation
      5 ;;; files (the "Software"), to deal in the Software without
      6 ;;; restriction, including without limitation the rights to use, copy,
      7 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
      8 ;;; of the Software, and to permit persons to whom the Software is
      9 ;;; furnished to do so, subject to the following conditions:
     10 ;;;
     11 ;;; The above copyright notice and this permission notice shall be
     12 ;;; included in all copies or substantial portions of the Software.
     13 ;;;
     14 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
     15 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
     16 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
     17 ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
     18 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
     19 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
     20 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
     21 ;;; DEALINGS IN THE SOFTWARE.
     22 
     23 (defpackage :rw.string
     24   (:use :cl)
     25   (:export :octets-to-string
     26            :string-to-octets))
     27 
     28 (in-package :rw.string)
     29 
     30 (defun octets-to-string (x encoding)
     31   #-(or mkcl allegro clisp ecl ccl sbcl cmucl allegro)
     32   (error "RW.STRING:OCTETS-TO-STRING not ported")
     33   #+mkcl
     34   (progn
     35     (assert (member encoding '(nil :utf-8)))
     36     (string (si:utf-8 x)))
     37   #+clisp
     38   (ext:convert-string-from-bytes
     39    x (intern (string encoding) (find-package :charset)))
     40   #+ecl
     41   (let ((s (ext:make-sequence-input-stream x :external-format encoding)))
     42     (coerce (rw:till (rw:peek-reader (rw:char-reader s)) nil nil nil) 'string))
     43   #+ccl
     44   (ccl:decode-string-from-octets x :external-format encoding)
     45   #+sbcl
     46   (sb-ext:octets-to-string x :external-format encoding)
     47   #+cmucl
     48   (ext:octets-to-string x :external-format encoding)
     49   #+allegro
     50   (excl:octets-to-string x :external-format encoding))
     51 
     52 (defun string-to-octets (x encoding)
     53   #-(or mkcl allegro clisp ecl ccl sbcl cmucl allegro)
     54   (error "RW.STRING:STRING-TO-OCTETS not ported")
     55   #+mkcl
     56   (progn
     57     (assert (member encoding '(nil :utf-8)))
     58     (mkcl:octets (si:utf-8 x)))
     59   #+clisp
     60   (ext:convert-string-to-bytes
     61    x (intern (string encoding) (find-package :charset)))
     62   #+ecl
     63   (let ((z (make-array 42
     64                        :adjustable t
     65                        :fill-pointer 0
     66                        :element-type '(unsigned-byte 8)
     67                        :initial-element 0)))
     68     (write-string x
     69                   (ext:make-sequence-output-stream z :external-format encoding))
     70     z)
     71   #+ccl
     72   (ccl:encode-string-to-octets x :external-format encoding)
     73   #+sbcl
     74   (sb-ext:string-to-octets x :external-format encoding)
     75   #+cmucl
     76   (ext:string-to-octets x :external-format encoding)
     77   #+allegro
     78   (excl:string-to-octets x :external-format encoding :null-terminate nil))