Introduction
Introduction Statistics Contact Development Disclaimer Help
tenc-cp1251.lisp - clic - Clic is an command line interactive client for gopher…
git clone git://bitreich.org/clic/ git://hg6vgqziawt5s4dj.onion/clic/
Log
Files
Refs
Tags
LICENSE
---
tenc-cp1251.lisp (5196B)
---
1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
2 ;;;
3 ;;; enc-cp1251.lisp --- Implementation of the CP1251 character encoding.
4 ;;;
5 ;;; Copyright (C) 2009, Andrey Moskvitin
6 ;;;
7 ;;; Permission is hereby granted, free of charge, to any person
8 ;;; obtaining a copy of this software and associated documentation
9 ;;; files (the "Software"), to deal in the Software without
10 ;;; restriction, including without limitation the rights to use, copy,
11 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
12 ;;; of the Software, and to permit persons to whom the Software is
13 ;;; furnished to do so, subject to the following conditions:
14 ;;;
15 ;;; The above copyright notice and this permission notice shall be
16 ;;; included in all copies or substantial portions of the Software.
17 ;;;
18 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
19 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
20 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
21 ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
22 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
23 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
24 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
25 ;;; DEALINGS IN THE SOFTWARE.
26
27 (in-package #:babel-encodings)
28
29 (define-character-encoding :cp1251
30 "An 8-bit, fixed-width character Russian encoding from Windows."
31 :aliases '(:windows-1251)
32 :literal-char-code-limit #x80)
33
34 (define-constant +cp1251-to-unicode+
35 #(;; #x80
36 #x0402 #x0403 #x201a #x0453 #x201e #x2026 #x2020 #x2021
37 #x20ac #x2030 #x0409 #x2039 #x040a #x040c #x040b #x040f
38 ;; #x90
39 #x0452 #x2018 #x2019 #x201c #x201d #x2022 #x2013 #x2014
40 #xfffd #x2122 #x0459 #x203a #x045a #x045c #x045b #x045f
41 ;; #xa0
42 #x00a0 #x040e #x045e #x0408 #x00a4 #x0490 #x00a6 #x00a7
43 #x0401 #x00a9 #x0404 #x00ab #x00ac #x00ad #x00ae #x0407
44 ;; #xb0
45 #x00b0 #x00b1 #x0406 #x0456 #x0491 #x00b5 #x00b6 #x00b7
46 #x0451 #x2116 #x0454 #x00bb #x0458 #x0405 #x0455 #x0457
47 ;; #xc0
48 #x0410 #x0411 #x0412 #x0413 #x0414 #x0415 #x0416 #x0417
49 #x0418 #x0419 #x041a #x041b #x041c #x041d #x041e #x041f
50 ;; #xd0
51 #x0420 #x0421 #x0422 #x0423 #x0424 #x0425 #x0426 #x0427
52 #x0428 #x0429 #x042a #x042b #x042c #x042d #x042e #x042f
53 ;; #xe0
54 #x0430 #x0431 #x0432 #x0433 #x0434 #x0435 #x0436 #x0437
55 #x0438 #x0439 #x043a #x043b #x043c #x043d #x043e #x043f
56 ;; #xf0
57 #x0440 #x0441 #x0442 #x0443 #x0444 #x0445 #x0446 #x0447
58 #x0448 #x0449 #x044a #x044b #x044c #x044d #x044e #x044f)
59 :test #'equalp)
60
61 (define-unibyte-decoder :cp1251 (octet)
62 (if (< octet #x80)
63 octet
64 (svref +cp1251-to-unicode+ (the ub8 (- octet #x80)))))
65
66 (define-constant +unicode-a0-bf-to-cp1251+
67 #(#xa0 #x00 #x00 #x00 #xa4 #x00 #xa6 #xa7 ; #xa0-#xa7
68 #x00 #xa9 #x00 #xab #xac #xad #xae #x00 ; #xa8-#xaf
69 #xb0 #xb1 #x00 #x00 #x00 #xb5 #xb6 #xb7 ; #xb0-#xb7
70 #x00 #x00 #x00 #xbb #x00 #x00 #x00 #x00) ; #xb8-#xbf
71 :test #'equalp)
72
73 (define-constant +unicode-0-97-to-cp1251+
74 #(#x00 #xa8 #x80 #x81 #xaa #xbd #xb2 #xaf ; #x00-#x07
75 #xa3 #x8a #x8c #x8e #x8d #x00 #xa1 #x8f ; #x08-#x0f
76 #xc0 #xc1 #xc2 #xc3 #xc4 #xc5 #xc6 #xc7 ; #x10-#x17
77 #xc8 #xc9 #xca #xcb #xcc #xcd #xce #xcf ; #x18-#x1f
78 #xd0 #xd1 #xd2 #xd3 #xd4 #xd5 #xd6 #xd7 ; #x20-#x27
79 #xd8 #xd9 #xda #xdb #xdc #xdd #xde #xdf ; #x28-#x2f
80 #xe0 #xe1 #xe2 #xe3 #xe4 #xe5 #xe6 #xe7 ; #x30-#x37
81 #xe8 #xe9 #xea #xeb #xec #xed #xee #xef ; #x38-#x3f
82 #xf0 #xf1 #xf2 #xf3 #xf4 #xf5 #xf6 #xf7 ; #x40-#x47
83 #xf8 #xf9 #xfa #xfb #xfc #xfd #xfe #xff ; #x48-#x4f
84 #x00 #xb8 #x90 #x83 #xba #xbe #xb3 #xbf ; #x50-#x57
85 #xbc #x9a #x9c #x9e #x9d #x00 #xa2 #x9f ; #x58-#x5f
86 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 ; #x60-#x67
87 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 ; #x68-#x6f
88 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 ; #x70-#x77
89 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 ; #x78-#x7f
90 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 ; #x80-#x87
91 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 ; #x88-#x8f
92 #xa5 #xb4 #x00 #x00 #x00 #x00 #x00 #x00) ; #x90-#x97
93 :test #'equalp)
94
95 (define-constant +unicode-10-3f-to-cp1251+
96 #(#x00 #x00 #x00 #x96 #x97 #x00 #x00 #x00 ; #x10-#x17
97 #x91 #x92 #x82 #x00 #x93 #x94 #x84 #x00 ; #x18-#x1f
98 #x86 #x87 #x95 #x00 #x00 #x00 #x85 #x00 ; #x20-#x27
99 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 ; #x28-#x2f
100 #x89 #x00 #x00 #x00 #x00 #x00 #x00 #x00 ; #x30-#x37
101 #x00 #x8b #x9b #x00 #x00 #x00 #x00 #x00) ; #x38-#x3f
102 :test #'equalp)
103
104 (define-unibyte-encoder :cp1251 (code)
105 (cond
106 ((< code #x80) code)
107 ((and (>= code #xa0) (< code #xc0))
108 (svref +unicode-a0-bf-to-cp1251+
109 (the ub8 (- code #xa0))))
110 ((and (>= code #x400) (< code #x498))
111 (svref +unicode-0-97-to-cp1251+
112 (the ub8 (- code #x400))))
113 ((and (>= code #x2010) (< code #x2040))
114 (svref +unicode-10-3f-to-cp1251+
115 (the ub8 (- code #x2010))))
116 ((= code #x20ac) #x88)
117 ((= code #x2116) #xb9)
118 ((= code #x2122) #x99)
119 (t (handle-error))))
You are viewing proxied material from bitreich.org. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.