[bknr-cvs] r2017 - in branches/xml-class-rework/thirdparty: . iconv

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@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@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 ,@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))))