;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name:          i18n.lisp
;;;; Purpose:       non-ASCII character support
;;;; Programmer:    Kevin M. Rosenberg
;;;; Date Started:  Feb 2010
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
;;;;
;;;; *************************************************************************

(in-package #:uffi)

#-(or (and lispworks unicode) (and sbcl sb-unicode)
      (and allegro ics) (and clisp i18n)
      (and openmcl openmcl-unicode-strings))
(pushnew 'no-i18n cl:*features*)

(defvar *default-foreign-encoding*
  nil
  "Normalized name of default external character format to use
for foreign string conversions. nil means use implementation default
encoding.")

(defvar *foreign-encoding-mapping*
    #+(and lispworks unicode)
    '((:ascii . :ascii) (:latin-1 . :latin-1) (:ucs-2 . :unicode)
      (:utf-8 . :utf-8) (:jis . :jis) (:sjis . :sjis) (:gbk . :gbk))
    #+(and sbcl sb-unicode)
    '((:ascii . :ascii) (:latin-1 . :latin-1) (:utf-8 . :utf-8)
      (:ucs-2 . :ucs-2) (:sjis . :sjis) (:gbk . :gbk))
    #+(and allegro ics)
    '((:ascii . :ascii) (:latin-1 . :latin1) (:utf-8 . :utf-8)
      (:sjis . :shift-jis) (:euc-jp . :euc) (:gbk . :gb2313)
      (:ucs-2 . :unicode))
    #+(and clisp unicode)
    '((:ascii . charset:ascii) (:ucs-2 . charset:ucs-2)
      (:utf-8 . charset:utf-8) (:latin-1 . charset:iso-8859-1)
      (:jis . charset:jis_x0201) (:jis . charset:shift-jis)
      (:gbk . charset:gbk) (:euc-jp . charset:euc-jp))
    #+(and openmcl openmcl-unicode-strings)
    '((:ascii . :ascii) (:latin-1 . :iso-8859-1) (:utf-8 . :utf-8)
      (:ucs-2 . :ucs-2)
      #+nil (:euc-jp . :euc-jp)
      )
    #-(or (and lispworks unicode) (and sbcl sb-unicode)
          (and allegro ics) (and clisp unicode)
          (and openmcl openmcl-unicode-strings))
    nil
  "Mapping between normalized external format name and implementation name.")

(defvar *foreign-encodings*
  (mapcar 'car *foreign-encoding-mapping*)
  "List of normalized names of external formats support by underlying implementation.")

(defun implementation-foreign-encoding (normalized)
  (cdr (assoc normalized *foreign-encoding-mapping* :test 'eql)))

(defun foreign-encoded-string-octets (str &optional foreign-encoding)
  "Returns the octets required to represent the string when passed to a ~
foreign function."
  ;; AllegroCL, CCL, and Lispworks give correct value without converting
  ;; to external-format. CLISP, like SBCL, requires conversion with external-
  ;; format
  (length #+(and sbcl sb-unicode)
          (sb-ext:string-to-octets
           str
           :external-format (or foreign-encoding
                                *default-foreign-encoding*
                                :utf-8))
          #-(and sbcl sb-unicode) str))