From ed89a3df2a51a80c4c0ebe4e5d90e60826f870ec Mon Sep 17 00:00:00 2001 From: Rudi Schlatte Date: Tue, 28 Jun 2005 09:09:40 +0000 Subject: [PATCH] 0.9.2.1 Support for koi8-r external format (thanks to Ivan Boldyrev) --- NEWS | 3 + build-order.lisp-expr | 2 + src/code/koi8-r.lisp | 178 +++++++++++++++++++++++++++++++++++++++++++++++++ version.lisp-expr | 2 +- 4 files changed, 184 insertions(+), 1 deletion(-) create mode 100644 src/code/koi8-r.lisp diff --git a/NEWS b/NEWS index 0cfbe46..8865378 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,6 @@ +changes in sbcl-0.9.3 relative to sbcl-0.9.2: + * Support for the koi8-r external format. (thanks to Ivan Boldyrev) + changes in sbcl-0.9.2 relative to sbcl-0.9.1: * numerous signal handling fixes to increase stability * Support for EUC-JP external format. (thanks to NIIMI Satoshi) diff --git a/build-order.lisp-expr b/build-order.lisp-expr index 73e8444..7205266 100644 --- a/build-order.lisp-expr +++ b/build-order.lisp-expr @@ -655,6 +655,8 @@ ("src/code/octets" :not-host) #!+sb-unicode ("src/code/eucjp" :not-host) + #!+sb-unicode + ("src/code/koi8-r" :not-host) ;; The code here can't be compiled until CONDITION and ;; DEFINE-CONDITION are defined and SB!DEBUG:*STACK-TOP-HINT* is diff --git a/src/code/koi8-r.lisp b/src/code/koi8-r.lisp new file mode 100644 index 0000000..ef91310 --- /dev/null +++ b/src/code/koi8-r.lisp @@ -0,0 +1,178 @@ +;;;; Support for koi8-r encoding. + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +(in-package "SB!IMPL") + +(define-unibyte-mapper + koi8-r->code-mapper + code->koi8-r-mapper + (#x80 #x2500) ; BOX DRAWINGS LIGHT HORIZONTAL + (#x81 #x2502) ; BOX DRAWINGS LIGHT VERTICAL + (#x82 #x250C) ; BOX DRAWINGS LIGHT DOWN AND RIGHT + (#x83 #x2510) ; BOX DRAWINGS LIGHT DOWN AND LEFT + (#x84 #x2514) ; BOX DRAWINGS LIGHT UP AND RIGHT + (#x85 #x2518) ; BOX DRAWINGS LIGHT UP AND LEFT + (#x86 #x251C) ; BOX DRAWINGS LIGHT VERTICAL AND RIGHT + (#x87 #x2524) ; BOX DRAWINGS LIGHT VERTICAL AND LEFT + (#x88 #x252C) ; BOX DRAWINGS LIGHT DOWN AND HORIZONTAL + (#x89 #x2534) ; BOX DRAWINGS LIGHT UP AND HORIZONTAL + (#x8a #x253C) ; BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL + (#x8b #x2580) ; UPPER HALF BLOCK + (#x8c #x2584) ; LOWER HALF BLOCK + (#x8d #x2588) ; FULL BLOCK + (#x8e #x258C) ; LEFT HALF BLOCK + (#x8f #x2590) ; RIGHT HALF BLOCK + (#x90 #x2591) ; LIGHT SHADE + (#x91 #x2592) ; MEDIUM SHADE + (#x92 #x2593) ; DARK SHADE + (#x93 #x2320) ; TOP HALF INTEGRAL + (#x94 #x25A0) ; BLACK SQUARE + (#x95 #x2219) ; BULLET OPERATOR + (#x96 #x221A) ; SQUARE ROOT + (#x97 #x2248) ; ALMOST EQUAL TO + (#x98 #x2264) ; LESS-THAN OR EQUAL TO + (#x99 #x2265) ; GREATER-THAN OR EQUAL TO + (#x9a #x00A0) ; NO-BREAK SPACE + (#x9b #x2321) ; BOTTOM HALF INTEGRAL + (#x9c #x00B0) ; DEGREE SIGN + (#x9d #x00B2) ; SUPERSCRIPT TWO + (#x9e #x00B7) ; MIDDLE DOT + (#x9f #x00F7) ; DIVISION SIGN + (#xa0 #x2550) ; BOX DRAWINGS DOUBLE HORIZONTAL + (#xa1 #x2551) ; BOX DRAWINGS DOUBLE VERTICAL + (#xa2 #x2552) ; BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE + (#xa3 #x0451) ; CYRILLIC SMALL LETTER IO + (#xa4 #x2553) ; BOX DRAWINGS DOWN DOUBLE AND RIGHT SINGLE + (#xa5 #x2554) ; BOX DRAWINGS DOUBLE DOWN AND RIGHT + (#xa6 #x2555) ; BOX DRAWINGS DOWN SINGLE AND LEFT DOUBLE + (#xa7 #x2556) ; BOX DRAWINGS DOWN DOUBLE AND LEFT SINGLE + (#xa8 #x2557) ; BOX DRAWINGS DOUBLE DOWN AND LEFT + (#xa9 #x2558) ; BOX DRAWINGS UP SINGLE AND RIGHT DOUBLE + (#xaa #x2559) ; BOX DRAWINGS UP DOUBLE AND RIGHT SINGLE + (#xab #x255A) ; BOX DRAWINGS DOUBLE UP AND RIGHT + (#xac #x255B) ; BOX DRAWINGS UP SINGLE AND LEFT DOUBLE + (#xad #x255C) ; BOX DRAWINGS UP DOUBLE AND LEFT SINGLE + (#xae #x255D) ; BOX DRAWINGS DOUBLE UP AND LEFT + (#xaf #x255E) ; BOX DRAWINGS VERTICAL SINGLE AND RIGHT DOUBLE + (#xb0 #x255F) ; BOX DRAWINGS VERTICAL DOUBLE AND RIGHT SINGLE + (#xb1 #x2560) ; BOX DRAWINGS DOUBLE VERTICAL AND RIGHT + (#xb2 #x2561) ; BOX DRAWINGS VERTICAL SINGLE AND LEFT DOUBLE + (#xb3 #x0401) ; CYRILLIC CAPITAL LETTER IO + (#xb4 #x2562) ; BOX DRAWINGS VERTICAL DOUBLE AND LEFT SINGLE + (#xb5 #x2563) ; BOX DRAWINGS DOUBLE VERTICAL AND LEFT + (#xb6 #x2564) ; BOX DRAWINGS DOWN SINGLE AND HORIZONTAL DOUBLE + (#xb7 #x2565) ; BOX DRAWINGS DOWN DOUBLE AND HORIZONTAL SINGLE + (#xb8 #x2566) ; BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL + (#xb9 #x2567) ; BOX DRAWINGS UP SINGLE AND HORIZONTAL DOUBLE + (#xba #x2568) ; BOX DRAWINGS UP DOUBLE AND HORIZONTAL SINGLE + (#xbb #x2569) ; BOX DRAWINGS DOUBLE UP AND HORIZONTAL + (#xbc #x256A) ; BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE + (#xbd #x256B) ; BOX DRAWINGS VERTICAL DOUBLE AND HORIZONTAL SINGLE + (#xbe #x256C) ; BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL + (#xbf #x00A9) ; COPYRIGHT SIGN + (#xc0 #x044E) ; CYRILLIC SMALL LETTER YU + (#xc1 #x0430) ; CYRILLIC SMALL LETTER A + (#xc2 #x0431) ; CYRILLIC SMALL LETTER BE + (#xc3 #x0446) ; CYRILLIC SMALL LETTER TSE + (#xc4 #x0434) ; CYRILLIC SMALL LETTER DE + (#xc5 #x0435) ; CYRILLIC SMALL LETTER IE + (#xc6 #x0444) ; CYRILLIC SMALL LETTER EF + (#xc7 #x0433) ; CYRILLIC SMALL LETTER GHE + (#xc8 #x0445) ; CYRILLIC SMALL LETTER HA + (#xc9 #x0438) ; CYRILLIC SMALL LETTER I + (#xca #x0439) ; CYRILLIC SMALL LETTER SHORT I + (#xcb #x043A) ; CYRILLIC SMALL LETTER KA + (#xcc #x043B) ; CYRILLIC SMALL LETTER EL + (#xcd #x043C) ; CYRILLIC SMALL LETTER EM + (#xce #x043D) ; CYRILLIC SMALL LETTER EN + (#xcf #x043E) ; CYRILLIC SMALL LETTER O + (#xd0 #x043F) ; CYRILLIC SMALL LETTER PE + (#xd1 #x044F) ; CYRILLIC SMALL LETTER YA + (#xd2 #x0440) ; CYRILLIC SMALL LETTER ER + (#xd3 #x0441) ; CYRILLIC SMALL LETTER ES + (#xd4 #x0442) ; CYRILLIC SMALL LETTER TE + (#xd5 #x0443) ; CYRILLIC SMALL LETTER U + (#xd6 #x0436) ; CYRILLIC SMALL LETTER ZHE + (#xd7 #x0432) ; CYRILLIC SMALL LETTER VE + (#xd8 #x044C) ; CYRILLIC SMALL LETTER SOFT SIGN + (#xd9 #x044B) ; CYRILLIC SMALL LETTER YERU + (#xda #x0437) ; CYRILLIC SMALL LETTER ZE + (#xdb #x0448) ; CYRILLIC SMALL LETTER SHA + (#xdc #x044D) ; CYRILLIC SMALL LETTER E + (#xdd #x0449) ; CYRILLIC SMALL LETTER SHCHA + (#xde #x0447) ; CYRILLIC SMALL LETTER CHE + (#xdf #x044A) ; CYRILLIC SMALL LETTER HARD SIGN + (#xe0 #x042E) ; CYRILLIC CAPITAL LETTER YU + (#xe1 #x0410) ; CYRILLIC CAPITAL LETTER A + (#xe2 #x0411) ; CYRILLIC CAPITAL LETTER BE + (#xe3 #x0426) ; CYRILLIC CAPITAL LETTER TSE + (#xe4 #x0414) ; CYRILLIC CAPITAL LETTER DE + (#xe5 #x0415) ; CYRILLIC CAPITAL LETTER IE + (#xe6 #x0424) ; CYRILLIC CAPITAL LETTER EF + (#xe7 #x0413) ; CYRILLIC CAPITAL LETTER GHE + (#xe8 #x0425) ; CYRILLIC CAPITAL LETTER HA + (#xe9 #x0418) ; CYRILLIC CAPITAL LETTER I + (#xea #x0419) ; CYRILLIC CAPITAL LETTER SHORT I + (#xeb #x041A) ; CYRILLIC CAPITAL LETTER KA + (#xec #x041B) ; CYRILLIC CAPITAL LETTER EL + (#xed #x041C) ; CYRILLIC CAPITAL LETTER EM + (#xee #x041D) ; CYRILLIC CAPITAL LETTER EN + (#xef #x041E) ; CYRILLIC CAPITAL LETTER O + (#xf0 #x041F) ; CYRILLIC CAPITAL LETTER PE + (#xf1 #x042F) ; CYRILLIC CAPITAL LETTER YA + (#xf2 #x0420) ; CYRILLIC CAPITAL LETTER ER + (#xf3 #x0421) ; CYRILLIC CAPITAL LETTER ES + (#xf4 #x0422) ; CYRILLIC CAPITAL LETTER TE + (#xf5 #x0423) ; CYRILLIC CAPITAL LETTER U + (#xf6 #x0416) ; CYRILLIC CAPITAL LETTER ZHE + (#xf7 #x0412) ; CYRILLIC CAPITAL LETTER VE + (#xf8 #x042C) ; CYRILLIC CAPITAL LETTER SOFT SIGN + (#xf9 #x042B) ; CYRILLIC CAPITAL LETTER YERU + (#xfa #x0417) ; CYRILLIC CAPITAL LETTER ZE + (#xfb #x0428) ; CYRILLIC CAPITAL LETTER SHA + (#xfc #x042D) ; CYRILLIC CAPITAL LETTER E + (#xfd #x0429) ; CYRILLIC CAPITAL LETTER SHCHA + (#xfe #x0427) ; CYRILLIC CAPITAL LETTER CHE + (#xff #x042A)) ; CYRILLIC CAPITAL LETTER HARD SIGN + +(declaim (inline get-koi8-r-bytes)) +(defun get-koi8-r-bytes (string pos end) + (declare (optimize speed (safety 0)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'identity :koi8-r string pos end)) + +(defun string->koi8-r (string sstart send null-padding) + (declare (optimize speed (safety 0)) + (type simple-string string) + (type array-range sstart send)) + (values (string->latin% string sstart send #'get-koi8-r-bytes null-padding))) + +(defmacro define-koi8-r->string* (accessor type) + (declare (ignore type)) + (let ((name (make-od-name 'koi8-r->string* accessor))) + `(progn + (defun ,name (string sstart send array astart aend) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) +(instantiate-octets-definition define-koi8-r->string*) + +(defmacro define-koi8-r->string (accessor type) + (declare (ignore type)) + `(defun ,(make-od-name 'koi8-r->string accessor) (array astart aend) + (,(make-od-name 'latin->string accessor) array astart aend #'identity))) +(instantiate-octets-definition define-koi8-r->string) + +(pushnew '((:koi8-r :|koi8-r| :koi8r) + koi8-r->string-aref string->koi8-r) + *external-format-functions* :test #'equal) + +;;; for fd-stream.lisp + +(define-external-format (:koi8-r :|koi8-r|) + 1 t + (let ((koi8-r-byte (code->koi8-r-mapper bits))) + (if koi8-r-byte + (setf (sap-ref-8 sap tail) koi8-r-byte) + (stream-encoding-error-and-handle stream bits))) + (code-char (koi8-r->code-mapper byte))) diff --git a/version.lisp-expr b/version.lisp-expr index 456c69a..d5ce43f 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.2" +"0.9.2.1" -- 1.7.10.4