/[pg]/pg/sysdep.lisp
ViewVC logotype

Diff of /pg/sysdep.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.12 by emarsden, Mon Dec 19 22:21:50 2005 UTC revision 1.13 by emarsden, Fri Jan 27 18:03:39 2006 UTC
# Line 1  Line 1 
1  ;;; sysdep.lisp -- system-dependent parts of pg-dot-lisp  ;;; sysdep.lisp -- system-dependent parts of pg-dot-lisp
2  ;;;  ;;;
3  ;;; Author: Eric Marsden <eric.marsden@free.fr>  ;;; Author: Eric Marsden <eric.marsden@free.fr>
4  ;;; Time-stamp: <2005-12-09 emarsden>  ;;; Time-stamp: <2006-01-27 emarsden>
5  ;;  ;;
6  ;;  ;;
7    
# Line 327  Line 327 
327  (defun implementation-name-for-encoding (encoding)  (defun implementation-name-for-encoding (encoding)
328    (%sysdep "client encoding to external format name"    (%sysdep "client encoding to external format name"
329       #+(and clisp unicode)       #+(and clisp unicode)
330       (cond ((string= encoding "SQL_ASCII") :ascii)       (cond ((string= encoding "SQL_ASCII") charset:ascii)
331             ((string= encoding "LATIN1") :latin1)             ((string= encoding "LATIN1") charset:iso-8859-1)
332             ((string= encoding "LATIN9") :latin9)             ((string= encoding "LATIN9") charset:iso-8859-9)
333             ((string= encoding "UNICODE") :utf8)             ((string= encoding "UTF8") charset:utf-8)
334             (t (error "unknown encoding ~A" encoding)))             (t (error "unknown encoding ~A" encoding)))
335       #+(and allegro ics)       #+(and allegro ics)
336       (cond ((string= encoding "SQL_ASCII") :ascii)       (cond ((string= encoding "SQL_ASCII") :ascii)
337             ((string= encoding "LATIN1") :latin1)             ((string= encoding "LATIN1") :latin1)
338             ((string= encoding "LATIN9") :latin9)             ((string= encoding "LATIN9") :latin9)
339             ((string= encoding "UNICODE") :utf8)             ((string= encoding "UTF8") :utf8)
340             (t (error "unknown encoding ~A" encoding)))             (t (error "unknown encoding ~A" encoding)))
341       #+(and sbcl sb-unicode)       #+(and sbcl sb-unicode)
342       (cond ((string= encoding "SQL_ASCII") :ascii)       (cond ((string= encoding "SQL_ASCII") :ascii)
343             ((string= encoding  "LATIN1") :latin1)             ((string= encoding  "LATIN1") :latin1)
344             ((string= encoding "LATIN9") :latin9)             ((string= encoding "LATIN9") :latin9)
345             ((string= encoding "UNICODE") :utf8)             ((string= encoding "UTF8") :utf8)
346             (t (error "unknown encoding ~A" encoding)))             (t (error "unknown encoding ~A" encoding)))
347       #+(or cmu gcl ecl abcl)       #+(or cmu gcl ecl abcl openmcl)
348       (cond ((string= encoding "SQL_ASCII") :ascii)       nil))
            ((string= encoding "LATIN1") :latin1)  
            ((string= encoding "LATIN9") :latin9))))  
349    
350  (defun convert-string-to-bytes (string &optional (encoding *pg-client-encoding*))  (defun convert-string-to-bytes (string &optional (encoding *pg-client-encoding*))
351    (declare (type string string))    (declare (type string string))
# Line 360  Line 358 
358       #+(and :sbcl :sb-unicode)       #+(and :sbcl :sb-unicode)
359       (sb-ext:string-to-octets string       (sb-ext:string-to-octets string
360                                :external-format (implementation-name-for-encoding encoding))                                :external-format (implementation-name-for-encoding encoding))
361       #+(or cmu gcl ecl abcl)       #+(or cmu gcl ecl abcl openmcl)
362       (if (member encoding '("SQL_ASCII" "LATIN1" "LATIN9") :test #'string-equal)       (if (member encoding '("SQL_ASCII" "LATIN1" "LATIN9") :test #'string-equal)
363           (let ((octets (make-array (length string) :element-type '(unsigned-byte 8))))           (let ((octets (make-array (length string) :element-type '(unsigned-byte 8))))
364             (map-into octets #'char-code string))             (map-into octets #'char-code string))
# Line 378  Line 376 
376      ;; for implementations that have no support for character      ;; for implementations that have no support for character
377      ;; encoding, we assume that the encoding is an octet-for-octet      ;; encoding, we assume that the encoding is an octet-for-octet
378      ;; encoding, and convert directly      ;; encoding, and convert directly
379      #+(or cmu (and sbcl (not :sb-unicode)) gcl ecl abcl)      #+(or cmu (and sbcl (not :sb-unicode)) gcl ecl abcl openmcl)
380      (let ((string (make-string (length bytes))))      (let ((string (make-string (length bytes))))
381        (map-into string #'code-char bytes))))        (map-into string #'code-char bytes))))
382    

Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13

  ViewVC Help
Powered by ViewVC 1.1.5