src/code/koi8-r.lisp

   1 ;;;; Support for koi8-r encoding.
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 (in-package "SB!IMPL")
   6
   7 (define-unibyte-mapper
   8     koi8-r->code-mapper
   9     code->koi8-r-mapper
  10   (#x80 #x2500)  ;  BOX DRAWINGS LIGHT HORIZONTAL
  11   (#x81 #x2502)  ;  BOX DRAWINGS LIGHT VERTICAL
  12   (#x82 #x250C)  ;  BOX DRAWINGS LIGHT DOWN AND RIGHT
  13   (#x83 #x2510)  ;  BOX DRAWINGS LIGHT DOWN AND LEFT
  14   (#x84 #x2514)  ;  BOX DRAWINGS LIGHT UP AND RIGHT
  15   (#x85 #x2518)  ;  BOX DRAWINGS LIGHT UP AND LEFT
  16   (#x86 #x251C)  ;  BOX DRAWINGS LIGHT VERTICAL AND RIGHT
  17   (#x87 #x2524)  ;  BOX DRAWINGS LIGHT VERTICAL AND LEFT
  18   (#x88 #x252C)  ;  BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
  19   (#x89 #x2534)  ;  BOX DRAWINGS LIGHT UP AND HORIZONTAL
  20   (#x8a #x253C)  ;  BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
  21   (#x8b #x2580)  ;  UPPER HALF BLOCK
  22   (#x8c #x2584)  ;  LOWER HALF BLOCK
  23   (#x8d #x2588)  ;  FULL BLOCK
  24   (#x8e #x258C)  ;  LEFT HALF BLOCK
  25   (#x8f #x2590)  ;  RIGHT HALF BLOCK
  26   (#x90 #x2591)  ;  LIGHT SHADE
  27   (#x91 #x2592)  ;  MEDIUM SHADE
  28   (#x92 #x2593)  ;  DARK SHADE
  29   (#x93 #x2320)  ;  TOP HALF INTEGRAL
  30   (#x94 #x25A0)  ;  BLACK SQUARE
  31   (#x95 #x2219)  ;  BULLET OPERATOR
  32   (#x96 #x221A)  ;  SQUARE ROOT
  33   (#x97 #x2248)  ;  ALMOST EQUAL TO
  34   (#x98 #x2264)  ;  LESS-THAN OR EQUAL TO
  35   (#x99 #x2265)  ;  GREATER-THAN OR EQUAL TO
  36   (#x9a #x00A0)  ;  NO-BREAK SPACE
  37   (#x9b #x2321)  ;  BOTTOM HALF INTEGRAL
  38   (#x9c #x00B0)  ;  DEGREE SIGN
  39   (#x9d #x00B2)  ;  SUPERSCRIPT TWO
  40   (#x9e #x00B7)  ;  MIDDLE DOT
  41   (#x9f #x00F7)  ;  DIVISION SIGN
  42   (#xa0 #x2550)  ;  BOX DRAWINGS DOUBLE HORIZONTAL
  43   (#xa1 #x2551)  ;  BOX DRAWINGS DOUBLE VERTICAL
  44   (#xa2 #x2552)  ;  BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE
  45   (#xa3 #x0451)  ;  CYRILLIC SMALL LETTER IO
  46   (#xa4 #x2553)  ;  BOX DRAWINGS DOWN DOUBLE AND RIGHT SINGLE
  47   (#xa5 #x2554)  ;  BOX DRAWINGS DOUBLE DOWN AND RIGHT
  48   (#xa6 #x2555)  ;  BOX DRAWINGS DOWN SINGLE AND LEFT DOUBLE
  49   (#xa7 #x2556)  ;  BOX DRAWINGS DOWN DOUBLE AND LEFT SINGLE
  50   (#xa8 #x2557)  ;  BOX DRAWINGS DOUBLE DOWN AND LEFT
  51   (#xa9 #x2558)  ;  BOX DRAWINGS UP SINGLE AND RIGHT DOUBLE
  52   (#xaa #x2559)  ;  BOX DRAWINGS UP DOUBLE AND RIGHT SINGLE
  53   (#xab #x255A)  ;  BOX DRAWINGS DOUBLE UP AND RIGHT
  54   (#xac #x255B)  ;  BOX DRAWINGS UP SINGLE AND LEFT DOUBLE
  55   (#xad #x255C)  ;  BOX DRAWINGS UP DOUBLE AND LEFT SINGLE
  56   (#xae #x255D)  ;  BOX DRAWINGS DOUBLE UP AND LEFT
  57   (#xaf #x255E)  ;  BOX DRAWINGS VERTICAL SINGLE AND RIGHT DOUBLE
  58   (#xb0 #x255F)  ;  BOX DRAWINGS VERTICAL DOUBLE AND RIGHT SINGLE
  59   (#xb1 #x2560)  ;  BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
  60   (#xb2 #x2561)  ;  BOX DRAWINGS VERTICAL SINGLE AND LEFT DOUBLE
  61   (#xb3 #x0401)  ;  CYRILLIC CAPITAL LETTER IO
  62   (#xb4 #x2562)  ;  BOX DRAWINGS VERTICAL DOUBLE AND LEFT SINGLE
  63   (#xb5 #x2563)  ;  BOX DRAWINGS DOUBLE VERTICAL AND LEFT
  64   (#xb6 #x2564)  ;  BOX DRAWINGS DOWN SINGLE AND HORIZONTAL DOUBLE
  65   (#xb7 #x2565)  ;  BOX DRAWINGS DOWN DOUBLE AND HORIZONTAL SINGLE
  66   (#xb8 #x2566)  ;  BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
  67   (#xb9 #x2567)  ;  BOX DRAWINGS UP SINGLE AND HORIZONTAL DOUBLE
  68   (#xba #x2568)  ;  BOX DRAWINGS UP DOUBLE AND HORIZONTAL SINGLE
  69   (#xbb #x2569)  ;  BOX DRAWINGS DOUBLE UP AND HORIZONTAL
  70   (#xbc #x256A)  ;  BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE
  71   (#xbd #x256B)  ;  BOX DRAWINGS VERTICAL DOUBLE AND HORIZONTAL SINGLE
  72   (#xbe #x256C)  ;  BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
  73   (#xbf #x00A9)  ;  COPYRIGHT SIGN
  74   (#xc0 #x044E)  ;  CYRILLIC SMALL LETTER YU
  75   (#xc1 #x0430)  ;  CYRILLIC SMALL LETTER A
  76   (#xc2 #x0431)  ;  CYRILLIC SMALL LETTER BE
  77   (#xc3 #x0446)  ;  CYRILLIC SMALL LETTER TSE
  78   (#xc4 #x0434)  ;  CYRILLIC SMALL LETTER DE
  79   (#xc5 #x0435)  ;  CYRILLIC SMALL LETTER IE
  80   (#xc6 #x0444)  ;  CYRILLIC SMALL LETTER EF
  81   (#xc7 #x0433)  ;  CYRILLIC SMALL LETTER GHE
  82   (#xc8 #x0445)  ;  CYRILLIC SMALL LETTER HA
  83   (#xc9 #x0438)  ;  CYRILLIC SMALL LETTER I
  84   (#xca #x0439)  ;  CYRILLIC SMALL LETTER SHORT I
  85   (#xcb #x043A)  ;  CYRILLIC SMALL LETTER KA
  86   (#xcc #x043B)  ;  CYRILLIC SMALL LETTER EL
  87   (#xcd #x043C)  ;  CYRILLIC SMALL LETTER EM
  88   (#xce #x043D)  ;  CYRILLIC SMALL LETTER EN
  89   (#xcf #x043E)  ;  CYRILLIC SMALL LETTER O
  90   (#xd0 #x043F)  ;  CYRILLIC SMALL LETTER PE
  91   (#xd1 #x044F)  ;  CYRILLIC SMALL LETTER YA
  92   (#xd2 #x0440)  ;  CYRILLIC SMALL LETTER ER
  93   (#xd3 #x0441)  ;  CYRILLIC SMALL LETTER ES
  94   (#xd4 #x0442)  ;  CYRILLIC SMALL LETTER TE
  95   (#xd5 #x0443)  ;  CYRILLIC SMALL LETTER U
  96   (#xd6 #x0436)  ;  CYRILLIC SMALL LETTER ZHE
  97   (#xd7 #x0432)  ;  CYRILLIC SMALL LETTER VE
  98   (#xd8 #x044C)  ;  CYRILLIC SMALL LETTER SOFT SIGN
  99   (#xd9 #x044B)  ;  CYRILLIC SMALL LETTER YERU
 100   (#xda #x0437)  ;  CYRILLIC SMALL LETTER ZE
 101   (#xdb #x0448)  ;  CYRILLIC SMALL LETTER SHA
 102   (#xdc #x044D)  ;  CYRILLIC SMALL LETTER E
 103   (#xdd #x0449)  ;  CYRILLIC SMALL LETTER SHCHA
 104   (#xde #x0447)  ;  CYRILLIC SMALL LETTER CHE
 105   (#xdf #x044A)  ;  CYRILLIC SMALL LETTER HARD SIGN
 106   (#xe0 #x042E)  ;  CYRILLIC CAPITAL LETTER YU
 107   (#xe1 #x0410)  ;  CYRILLIC CAPITAL LETTER A
 108   (#xe2 #x0411)  ;  CYRILLIC CAPITAL LETTER BE
 109   (#xe3 #x0426)  ;  CYRILLIC CAPITAL LETTER TSE
 110   (#xe4 #x0414)  ;  CYRILLIC CAPITAL LETTER DE
 111   (#xe5 #x0415)  ;  CYRILLIC CAPITAL LETTER IE
 112   (#xe6 #x0424)  ;  CYRILLIC CAPITAL LETTER EF
 113   (#xe7 #x0413)  ;  CYRILLIC CAPITAL LETTER GHE
 114   (#xe8 #x0425)  ;  CYRILLIC CAPITAL LETTER HA
 115   (#xe9 #x0418)  ;  CYRILLIC CAPITAL LETTER I
 116   (#xea #x0419)  ;  CYRILLIC CAPITAL LETTER SHORT I
 117   (#xeb #x041A)  ;  CYRILLIC CAPITAL LETTER KA
 118   (#xec #x041B)  ;  CYRILLIC CAPITAL LETTER EL
 119   (#xed #x041C)  ;  CYRILLIC CAPITAL LETTER EM
 120   (#xee #x041D)  ;  CYRILLIC CAPITAL LETTER EN
 121   (#xef #x041E)  ;  CYRILLIC CAPITAL LETTER O
 122   (#xf0 #x041F)  ;  CYRILLIC CAPITAL LETTER PE
 123   (#xf1 #x042F)  ;  CYRILLIC CAPITAL LETTER YA
 124   (#xf2 #x0420)  ;  CYRILLIC CAPITAL LETTER ER
 125   (#xf3 #x0421)  ;  CYRILLIC CAPITAL LETTER ES
 126   (#xf4 #x0422)  ;  CYRILLIC CAPITAL LETTER TE
 127   (#xf5 #x0423)  ;  CYRILLIC CAPITAL LETTER U
 128   (#xf6 #x0416)  ;  CYRILLIC CAPITAL LETTER ZHE
 129   (#xf7 #x0412)  ;  CYRILLIC CAPITAL LETTER VE
 130   (#xf8 #x042C)  ;  CYRILLIC CAPITAL LETTER SOFT SIGN
 131   (#xf9 #x042B)  ;  CYRILLIC CAPITAL LETTER YERU
 132   (#xfa #x0417)  ;  CYRILLIC CAPITAL LETTER ZE
 133   (#xfb #x0428)  ;  CYRILLIC CAPITAL LETTER SHA
 134   (#xfc #x042D)  ;  CYRILLIC CAPITAL LETTER E
 135   (#xfd #x0429)  ;  CYRILLIC CAPITAL LETTER SHCHA
 136   (#xfe #x0427)  ;  CYRILLIC CAPITAL LETTER CHE
 137   (#xff #x042A)) ;  CYRILLIC CAPITAL LETTER HARD SIGN
 138
 139 (declaim (inline get-koi8-r-bytes))
 140 (defun get-koi8-r-bytes (string pos end)
 141   (declare (optimize speed (safety 0))
 142            (type simple-string string)
 143            (type array-range pos end))
 144   (get-latin-bytes #'identity :koi8-r string pos end))
 145
 146 (defun string->koi8-r (string sstart send null-padding)
 147   (declare (optimize speed (safety 0))
 148            (type simple-string string)
 149            (type array-range sstart send))
 150   (values (string->latin% string sstart send #'get-koi8-r-bytes null-padding)))
 151
 152 (defmacro define-koi8-r->string* (accessor type)
 153   (declare (ignore type))
 154   (let ((name (make-od-name 'koi8-r->string* accessor)))
 155     `(progn
 156       (defun ,name (string sstart send array astart aend)
 157         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
 158 (instantiate-octets-definition define-koi8-r->string*)
 159
 160 (defmacro define-koi8-r->string (accessor type)
 161   (declare (ignore type))
 162   `(defun ,(make-od-name 'koi8-r->string accessor) (array astart aend)
 163     (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
 164 (instantiate-octets-definition define-koi8-r->string)
 165
 166 (pushnew '((:koi8-r :|koi8-r| :koi8r)
 167            koi8-r->string-aref string->koi8-r)
 168          *external-format-functions* :test #'equal)
 169
 170 ;;; for fd-stream.lisp
 171
 172 (define-external-format (:koi8-r :|koi8-r|)
 173     1 t
 174     (let ((koi8-r-byte (code->koi8-r-mapper bits)))
 175       (if koi8-r-byte
 176           (setf (sap-ref-8 sap tail) koi8-r-byte)
 177           (stream-encoding-error-and-handle stream bits)))
 178     (code-char (koi8-r->code-mapper byte)))