[bknr-cvs] r2017 - in branches/xml-class-rework/thirdparty: . iconv
bknr at bknr.net
bknr at bknr.net
Sat Oct 21 13:32:28 UTC 2006
Author: hhubner
Date: 2006-10-21 09:32:27 -0400 (Sat, 21 Oct 2006)
New Revision: 2017
Added:
branches/xml-class-rework/thirdparty/iconv/
branches/xml-class-rework/thirdparty/iconv/ChangeLog
branches/xml-class-rework/thirdparty/iconv/LICENSE
branches/xml-class-rework/thirdparty/iconv/iconv-test.lisp
branches/xml-class-rework/thirdparty/iconv/iconv.asd
branches/xml-class-rework/thirdparty/iconv/iconv.lisp
Log:
Import iconv-0.2
Added: branches/xml-class-rework/thirdparty/iconv/ChangeLog
===================================================================
--- branches/xml-class-rework/thirdparty/iconv/ChangeLog 2006-10-20 21:39:18 UTC (rev 2016)
+++ branches/xml-class-rework/thirdparty/iconv/ChangeLog 2006-10-21 13:32:27 UTC (rev 2017)
@@ -0,0 +1,5 @@
+2006-03-26 Yoshinori Tahara <read.eval.print at gmail.com>
+
+ * iconv.lisp (iconv): fix errno problem(only sbcl)
+ Thanks Dmitry Petukhov.
+
Added: branches/xml-class-rework/thirdparty/iconv/LICENSE
===================================================================
--- branches/xml-class-rework/thirdparty/iconv/LICENSE 2006-10-20 21:39:18 UTC (rev 2016)
+++ branches/xml-class-rework/thirdparty/iconv/LICENSE 2006-10-21 13:32:27 UTC (rev 2017)
@@ -0,0 +1,26 @@
+Copyright (c) 2005 Yoshinori Tahara and contributors
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+3. The names of the authors and contributors may not be used to endorse
+ or promote products derived from this software without specific prior
+ written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGE.
Added: branches/xml-class-rework/thirdparty/iconv/iconv-test.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/iconv/iconv-test.lisp 2006-10-20 21:39:18 UTC (rev 2016)
+++ branches/xml-class-rework/thirdparty/iconv/iconv-test.lisp 2006-10-21 13:32:27 UTC (rev 2017)
@@ -0,0 +1,25 @@
+(in-package :cl)
+(require :iconv)
+(use-package :iconv)
+(require :ptester)
+(use-package :ptester)
+
+(with-tests ()
+ (test
+ (list #(164 162 164 164 164 166) #())
+ (iconv:iconv "UTF-8" "EUC-JP"
+ (coerce #(227 129 130 227 129 132 227 129 134)
+ '(vector (unsigned-byte 8))))
+ :test #'equalp
+ :multiple-values t)
+
+ (test
+ (list #(0 63 63 164 164 164 166) #())
+ (iconv:iconv "UTF-8" "EUC-JP"
+ (coerce #(0 129 130 227 129 132 227 129 134)
+ '(vector (unsigned-byte 8))))
+ :test #'equalp
+ :multiple-values t)
+)
+
+
Added: branches/xml-class-rework/thirdparty/iconv/iconv.asd
===================================================================
--- branches/xml-class-rework/thirdparty/iconv/iconv.asd 2006-10-20 21:39:18 UTC (rev 2016)
+++ branches/xml-class-rework/thirdparty/iconv/iconv.asd 2006-10-21 13:32:27 UTC (rev 2017)
@@ -0,0 +1,7 @@
+;;;; -*- lisp -*-
+(defsystem iconv
+ :name "iconv"
+ :author "Yoshinori Tahara <read.eval.print at gmail.com>"
+ :version "0.2"
+ :components ((:file "iconv"))
+ :depends-on (uffi))
Added: branches/xml-class-rework/thirdparty/iconv/iconv.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/iconv/iconv.lisp 2006-10-20 21:39:18 UTC (rev 2016)
+++ branches/xml-class-rework/thirdparty/iconv/iconv.lisp 2006-10-21 13:32:27 UTC (rev 2017)
@@ -0,0 +1,116 @@
+(defpackage :koto.iconv
+ (:nicknames :iconv)
+ (:use :cl :uffi)
+ (:export
+ :iconv
+ :EILSEQ
+ :EINVAL
+ :E2BIG))
+
+(in-package :iconv)
+
+#-:sbcl
+(uffi:def-foreign-var ("errno" errno) :int "iconv")
+
+(defun get-errno ()
+ #-:sbcl
+ errno
+ #+:sbcl
+ (sb-alien:get-errno)
+ )
+
+(uffi:def-constant EILSEQ 84) ;invalid multibyte
+(uffi:def-constant EINVAL 22) ;imcomplete multibyte
+(uffi:def-constant E2BIG 7) ;not enough outbuf
+
+(uffi:def-foreign-type iconv-t '(* :void))
+
+(uffi:def-function ("iconv_open" iconv-open)
+ ((tocode :cstring)
+ (fromcode :cstring))
+ :returning iconv-t)
+
+(uffi:def-function ("iconv_close" iconv-close)
+ ((cd iconv-t))
+ :returning :int)
+
+(uffi:def-function ("iconv" %iconv)
+ ((cd iconv-t)
+ (inbuf (* :unsigned-long))
+ (inbytesleft (* :unsigned-int))
+ (outbuf (* :unsigned-long))
+ (outbytesleft (* :unsigned-int)))
+ :returning :unsigned-int)
+
+(defmacro with-iconv-cd ((cd from to) &body body)
+ `(uffi:with-cstrings ((fromcode ,from)
+ (tocode ,to))
+ (let ((,cd (iconv-open tocode fromcode)))
+ (unwind-protect
+ (progn , at body)
+ (iconv-close ,cd)))))
+
+(defun iconv (from-code to-code from-vector
+ &optional error-p (error-value #.(char-code #\?)))
+ (declare (type (vector (unsigned-byte 8)) from-vector))
+ (with-iconv-cd (cd from-code to-code)
+ (let* ((from-len (length from-vector))
+ (to-len (* from-len 2))
+ (out (make-array to-len
+ :element-type '(unsigned-byte 8)
+ :fill-pointer 0
+ :adjustable t))
+ (remain (make-array 3
+ :element-type '(unsigned-byte 8)
+ :fill-pointer 0
+ :adjustable t))
+ (inbuffer (uffi:allocate-foreign-object :unsigned-byte from-len))
+ (outbuffer (uffi:allocate-foreign-object :unsigned-byte to-len))
+ (in-ptr (uffi:allocate-foreign-object :unsigned-long))
+ (out-ptr (uffi:allocate-foreign-object :unsigned-long))
+ (inbytesleft (uffi:allocate-foreign-object :unsigned-int))
+ (outbytesleft (uffi:allocate-foreign-object :unsigned-int)))
+ (unwind-protect
+ (progn
+ (loop for i from 0 below from-len
+ do (setf (uffi:deref-array inbuffer :unsigned-byte i)
+ (aref from-vector i)))
+ (setf (uffi:deref-pointer in-ptr :unsigned-long)
+ (uffi:pointer-address inbuffer)
+ (uffi:deref-pointer out-ptr :unsigned-long)
+ (uffi:pointer-address outbuffer)
+ (uffi:deref-pointer inbytesleft :unsigned-int) from-len
+ (uffi:deref-pointer outbytesleft :unsigned-int) to-len)
+ (labels ((current ()
+ (- from-len (uffi:deref-pointer
+ inbytesleft :unsigned-int)))
+ (self ()
+ (if (= (%iconv cd in-ptr inbytesleft out-ptr
+ outbytesleft)
+ #xffffffff)
+ (if (= (get-errno) EILSEQ)
+ (if error-p
+ (error "invalid multibyte(~X)."
+ (uffi:deref-array
+ inbuffer :unsigned-byte (current)))
+ (progn
+ (setf (uffi:deref-array
+ inbuffer :unsigned-byte (current))
+ error-value)
+ (self)))
+ (loop for i from (current)
+ below from-len
+ do (vector-push-extend
+ (aref from-vector i) remain))))))
+ (self))
+ (loop for i from 0
+ below (- to-len
+ (uffi:deref-pointer outbytesleft :unsigned-int))
+ do (vector-push-extend
+ (uffi:deref-array outbuffer :unsigned-byte i)
+ out)))
+ (progn (uffi:free-foreign-object outbytesleft)
+ (uffi:free-foreign-object inbytesleft)
+ (uffi:free-foreign-object outbuffer)
+ (uffi:free-foreign-object inbuffer)))
+ (values out remain))))
More information about the Bknr-cvs
mailing list