mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-04-27 03:40:31 -07:00
Code Issues Projects Releases Packages Wiki Activity

In contrib/encodings, renamed copy-file to copy-encodings-file to avoid name clashes.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2011-04-03 10:04:45 +02:00
parent 853ec3ebc5
commit 76e0f890de
2 changed files with 16 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

12
contrib/encodings/generate.lisp
View file

@ -27,7 +27,7 @@
(mapcar #'rest (read-mapping name 3))
(read-mapping name))))
(dump-mapping-array mapping orig)))
(copy-file orig copy)))
(copy-encoding-file orig copy)))
(defconstant +aliases+
'((:us-ascii :ascii)
@ -94,8 +94,8 @@
(format t "~%;;; Creating alias ~A -> ~A, ~A" alias name filename)
(format out "(defparameter ext::~A (ext::make-encoding 'ext::~A))" alias name))))
(copy-file "ext:encodings;tools.lisp" "build:encodings;tools.lisp")
(copy-file (merge-pathnames "ISO-2022-JP" +encodings-root+)
"build:encodings;ISO-2022-JP")
(copy-file (merge-pathnames "ISO-2022-JP-1" +encodings-root+)
"build:encodings;ISO-2022-JP-1")
(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")

10
contrib/encodings/tools.lisp
View file

@ -164,6 +164,16 @@
(write-byte (length mapping-array) s)
(write-sequence mapping-array s))))
(defun copy-encoding-file (in out)
(let ((buffer (make-array 8192 :element-type '(unsigned-byte 8))))
(format t "~%;;; Copying ~A to ~A" in out)
(with-open-file (sin in :direction :input :element-type '(unsigned-byte 8))
(with-open-file (sout out :direction :output :element-type '(unsigned-byte 8)
:if-exists :supersede :if-does-not-exist :create)
(loop for nbytes = (read-sequence buffer sin)
until (zerop nbytes)
do (write-sequence buffer sout :end nbytes))))))
(defun all-valid-unicode-chars (mapping)
(cond ((consp mapping)
(loop for sublist on mapping