ecl/contrib/encodings/generate.lisp
2015-09-01 20:10:10 +00:00

107 lines
4.6 KiB
Common Lisp

;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-
;;;
;;; Copyright (c) 2009, Juan Jose Garcia-Ripoll
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Library General Public
;;; License as published by the Free Software Foundation; either
;;; version 2 of the License, or (at your option) any later version.
;;;
;;; See file '../Copyright' for full details.
(load (merge-pathnames "tools" *load-pathname*))
(defconstant +encodings-root+ (translate-logical-pathname #p"ext:encodings;"))
(loop for entry in +all-mappings+
for name = (first entry)
for orig = (make-pathname :name name :type "BIN"
:defaults +encodings-root+)
for copy = (ensure-directories-exist
(make-pathname :name name :type "BIN"
:defaults "build:encodings;"))
do (progn
(unless (probe-file orig)
(error "Missing mapping")
(let ((mapping (if (equalp name "JISX0208")
(mapcar #'rest (read-mapping name 3))
(read-mapping name))))
(dump-mapping-array mapping orig)))
(copy-encoding-file orig copy)))
(defconstant +aliases+
'((:us-ascii ext::ascii)
(:utf-8 ext::utf8)
(:ucs-2 ext::ucs2 ext::utf-16 ext::utf16 ext::unicode)
(:ucs-2le ext::ucs2le ext::utf-16le)
(:ucs-2be ext::ucs2be ext::utf-16be)
(:ucs-4 ext::ucs4 ext::utf-32 ext::utf32)
(:ucs-4be ext::ucs4be ext::utf-32be)
(:ucs-4le ext::ucs4le ext::utf-32le)
(ext::koi8-r ext::koi8r)
(ext::iso-8859-1 ext::iso8859-1 ext::latin-1 ext::cp819 ext::ibm819)
(ext::iso-8859-2 ext::iso8859-2 ext::latin-2 ext::latin2)
(ext::iso-8859-3 ext::iso8859-3 ext::latin-3 ext::latin3)
(ext::iso-8859-4 ext::iso8859-4 ext::latin-4 ext::latin4)
(ext::iso-8859-5 ext::iso8859-5 ext::cyrillic)
(ext::iso-8859-6 ext::iso8859-6 ext::arabic ext::asmo-708 ext::ecma-114)
(ext::iso-8859-7 ext::iso8859-7 ext::greek8 ext::greek ext::ecma-118)
(ext::iso-8859-8 ext::iso8859-8 ext::hebrew)
(ext::iso-8859-9 ext::iso8859-9 ext::latin-5 ext::latin5)
(ext::iso-8859-10 ext::iso8859-10 ext::latin-6 ext::latin6)
;(:iso-8859-11 :iso8859-11 :thai)
(ext::iso-8859-13 ext::iso8859-13 ext::latin-7 ext::latin7)
(ext::iso-8859-14 ext::iso8859-14 ext::latin-8 ext::latin8)
(ext::iso-8859-15 ext::iso8859-15 ext::latin-9 ext::latin9)
(ext::dos-cp437 ext::ibm437)
(ext::dos-cp850 ext::ibm850 ext::cp850)
(ext::dos-cp852 ext::ibm852)
(ext::dos-cp855 ext::ibm855)
(ext::dos-cp857 ext::ibm857)
(ext::dos-cp860 ext::ibm860)
(ext::dos-cp861 ext::ibm861)
(ext::dos-cp862 ext::ibm862 ext::cp862)
(ext::dos-cp863 ext::ibm863)
(ext::dos-cp864 ext::ibm864)
(ext::dos-cp865 ext::ibm865)
(ext::dos-cp866 ext::ibm866 ext::cp866)
(ext::dos-cp869 ext::ibm869)
(ext::windows-cp932 ext::windows-932 ext::cp932)
(ext::windows-cp936 ext::windows-936 ext::cp936)
(ext::windows-cp949 ext::windows-949 ext::cp949)
(ext::windows-cp950 ext::windows-950 ext::cp950)
(ext::windows-cp1250 ext::windows-1250 ext::ms-ee)
(ext::windows-cp1251 ext::windows-1251 ext::ms-cyrl)
(ext::windows-cp1252 ext::windows-1252 ext::ms-ansi)
(ext::windows-cp1253 ext::windows-1253 ext::ms-greek)
(ext::windows-cp1254 ext::windows-1254 ext::ms-turk)
(ext::windows-cp1255 ext::windows-1255 ext::ms-hebr)
(ext::windows-cp1256 ext::windows-1256 ext::ms-arab)
(ext::windows-cp1257 ext::windows-1257 ext::winbaltrim)
(ext::windows-cp1258 ext::windows-1258)
))
(loop for (name . aliases) in +aliases+
do (loop with *package* = (find-package "CL")
for alias in aliases
for filename0 = (make-pathname :name (symbol-name alias)
:defaults "build:encodings;")
for filename = (ensure-directories-exist filename0)
do (with-open-file (out filename :direction :output :if-exists :supersede
:if-does-not-exist :create :element-type 'base-char)
(format t "~%;;; Creating alias ~A -> ~A, ~A" alias name filename)
(if (keywordp name)
(format out "(defparameter ~S '~S)" alias name)
(format out "(defparameter ~S (ext::make-encoding '~S))" alias name))
)))
(copy-encoding-file "ext:encodings;tools.lisp" "build:encodings;tools.lisp")
(copy-encoding-file (merge-pathnames "ISO-2022-JP" +encodings-root+)
"build:encodings;ISO-2022-JP")
(copy-encoding-file (merge-pathnames "ISO-2022-JP-1" +encodings-root+)
"build:encodings;ISO-2022-JP-1")