1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: non-ASCII character support
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Feb 2010
10 ;;;; This file, part of UFFI, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
12 ;;;; *************************************************************************
16 #-(or (and lispworks unicode) (and sbcl sb-unicode)
17 (and allegro ics) (and clisp i18n)
18 (and openmcl openmcl-unicode-strings))
19 (pushnew 'no-i18n cl:*features*)
21 (defvar *default-foreign-encoding*
23 "Normalized name of default external character format to use
24 for foreign string conversions. nil means use implementation default
27 (defvar *foreign-encoding-mapping*
28 #+(and lispworks unicode)
29 '((:ascii . :ascii) (:latin-1 . :latin-1) (:ucs-2 . :unicode)
30 (:utf-8 . :utf-8) (:jis . :jis) (:sjis . :sjis) (:gbk . :gbk))
31 #+(and sbcl sb-unicode)
32 '((:ascii . :ascii) (:latin-1 . :latin-1) (:utf-8 . :utf-8)
33 (:ucs-2 . :ucs-2) (:sjis . :sjis) (:gbk . :gbk))
35 '((:ascii . :ascii) (:latin-1 . :latin1) (:utf-8 . :utf-8)
36 (:sjis . :shift-jis) (:euc-jp . :euc) (:gbk . :gb2313)
39 '((:ascii . charset:ascii) (:ucs-2 . charset:ucs-2)
40 (:utf-8 . charset:utf-8) (:latin-1 . charset:iso-8859-1)
41 (:jis . charset:jis_x0201) (:jis . charset:shift-jis)
42 (:gbk . charset:gbk) (:euc-jp . charset:euc-jp))
43 #+(and openmcl openmcl-unicode-strings)
44 '((:ascii . :ascii) (:latin-1 . :iso-8859-1) (:utf-8 . :utf-8)
46 #+nil (:euc-jp . :euc-jp)
48 #-(or (and lispworks unicode) (and sbcl sb-unicode)
49 (and allegro ics) (and clisp unicode)
50 (and openmcl openmcl-unicode-strings))
52 "Mapping between normalized external format name and implementation name.")
54 (defvar *foreign-encodings*
55 (mapcar 'car *foreign-encoding-mapping*)
56 "List of normalized names of external formats support by underlying implementation.")
58 (defun implementation-foreign-encoding (normalized)
59 (cdr (assoc normalized *foreign-encoding-mapping* :test 'eql)))
61 (defun foreign-encoded-string-octets (str &key foreign-encoding)
62 "Returns the octets required to represent the string when passed to a ~
64 ;; AllegroCL, CCL, and Lispworks give correct value without converting
65 ;; to external-format. CLISP, like SBCL, requires conversion with external-
67 (length #+(and sbcl sb-unicode)
68 (sb-ext:string-to-octets
70 :external-format (or foreign-encoding
71 *default-foreign-encoding*
73 #-(and sbcl sb-unicode) str))
75 (defun string-to-octets (str &key foreign-encoding)
76 "Converts a Lisp string to a vector of octets."
77 #-(or allegro lispworks openmcl sbcl)
78 (declare (ignore foreign-encoding))
79 #-(or allegro lispworks openmcl sbcl)
80 (map-into (make-array len :element-type '(unsigned-byte 8))
84 (excl:string-to-native str :external-format foreign-encoding :null-terminate nil)
86 #+(or lispworks openmcl)
87 ;; simply reading each char-code from the LENGTH of string handles multibyte characters
88 ;; just fine in testing LW 6.0 and CCL 1.4
89 (map-into (make-array len :element-type '(unsigned-byte 8))
93 (sb-ext:string-to-native str :external-format foreign-encoding)