git.chise.org Git - chise/xemacs-chise.git.1/blob - lisp/mule/mule-charset.el

   1 ;;; mule-charset.el --- Charset functions for Mule.
   2
   3 ;; Copyright (C) 1992 Free Software Foundation, Inc.
   4 ;; Copyright (C) 1995 Amdahl Corporation.
   5 ;; Copyright (C) 1996 Sun Microsystems.
   6 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007, 2008,
   7 ;;   2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017 MORIOKA Tomohiko
   8
   9 ;; Author: Unknown
  10 ;; Keywords: i18n, mule, internal
  11
  12 ;; This file is part of XEmacs.
  13
  14 ;; XEmacs is free software; you can redistribute it and/or modify it
  15 ;; under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation; either version 2, or (at your option)
  17 ;; any later version.
  18
  19 ;; XEmacs is distributed in the hope that it will be useful, but
  20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 ;; General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with XEmacs; see the file COPYING.  If not, write to the
  26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  27 ;; Boston, MA 02111-1307, USA.
  28
  29 ;;; Synched up with: Not synched.  API at source level synched with FSF 20.3.9.
  30
  31 ;;; Commentary:
  32
  33 ;; These functions are not compatible at the bytecode level with Emacs/Mule,
  34 ;; and they never will be.  -sb [1999-05-26]
  35
  36 ;;; Code:
  37 \f
  38 ;;;; Classifying text according to charsets
  39
  40 (defun charsets-in-region (start end &optional buffer)
  41   "Return a list of the charsets in the region between START and END.
  42 BUFFER defaults to the current buffer if omitted."
  43   (let (list)
  44     (save-excursion
  45       (if buffer
  46           (set-buffer buffer))
  47       (save-restriction
  48         (narrow-to-region start end)
  49         (goto-char (point-min))
  50         (while (not (eobp))
  51           (let* (prev-charset
  52                  (ch (char-after (point)))
  53                  (charset (char-charset ch)))
  54             (if (not (eq prev-charset charset))
  55                 (progn
  56                   (setq prev-charset charset)
  57                   (or (memq charset list)
  58                       (setq list (cons charset list))))))
  59           (forward-char))))
  60     list))
  61
  62 (defun charsets-in-string (string)
  63   "Return a list of the charsets in STRING."
  64   (let ((i 0)
  65         (len (length string))
  66         prev-charset charset list)
  67     (while (< i len)
  68       (setq charset (char-charset (aref string i)))
  69       (if (not (eq prev-charset charset))
  70           (progn
  71             (setq prev-charset charset)
  72             (or (memq charset list)
  73                 (setq list (cons charset list)))))
  74       (setq i (1+ i)))
  75     list))
  76
  77 \f
  78 ;;;; Charset accessors
  79
  80 (defun charset-iso-graphic-plane (charset)
  81   "Return the `graphic' property of CHARSET.
  82 See `make-charset'."
  83   (charset-property charset 'graphic))
  84
  85 (defun charset-iso-final-char (charset)
  86   "Return the final byte of the ISO 2022 escape sequence designating CHARSET."
  87   (charset-property charset 'final))
  88
  89 (defun charset-chars (charset)
  90   "Return the number of characters per dimension of CHARSET."
  91   (charset-property charset 'chars))
  92
  93 (defun charset-width (charset)
  94   "Return the number of display columns per character of CHARSET.
  95 This only applies to TTY mode (under X, the actual display width can
  96 be automatically determined)."
  97   (charset-property charset 'columns))
  98
  99 ;; #### FSFmacs returns 0
 100 (defun charset-direction (charset)
 101   "Return the display direction (0 for `l2r' or 1 for `r2l') of CHARSET.
 102 Only left-to-right is currently implemented."
 103   (if (eq (charset-property charset 'direction) 'l2r)
 104       0
 105     1))
 106
 107 ;; Not in Emacs/Mule
 108 (defun charset-registry (charset)
 109   "Return the registry of CHARSET.
 110 This is a regular expression matching the registry field of fonts
 111 that can display the characters in CHARSET."
 112   (charset-property charset 'registry))
 113
 114 (defun charset-ccl-program (charset)
 115   "Return the CCL program of CHARSET.
 116 See `make-charset'."
 117   (charset-property charset 'ccl-program))
 118
 119 (defun charset-bytes (charset)
 120   "Useless in XEmacs, returns 1."
 121    1)
 122
 123 (define-obsolete-function-alias 'charset-columns 'charset-width) ;; 19990409
 124 (define-obsolete-function-alias 'charset-final 'charset-iso-final-char) ;; 19990409
 125 (define-obsolete-function-alias 'charset-graphic 'charset-iso-graphic-plane) ;; 19990409
 126 (define-obsolete-function-alias 'charset-doc-string 'charset-description) ;; 19990409
 127
 128 ;;;; Define setf methods for all settable Charset properties
 129
 130 (defsetf charset-registry    set-charset-registry)
 131 (defsetf charset-ccl-program set-charset-ccl-program)
 132
 133 ;;; FSF compatibility functions
 134 (defun charset-after (&optional pos)
 135   "Return charset of a character in current buffer at position POS.
 136 If POS is nil, it defauls to the current point.
 137 If POS is out of range, the value is nil."
 138   (when (null pos)
 139     (setq pos (point)))
 140   (check-argument-type 'integerp pos)
 141   (unless (or (< pos (point-min))
 142               (> pos (point-max)))
 143     (char-charset (char-after pos))))
 144
 145 ;; Yuck!
 146 ;; We're not going to support this.
 147 ;(defun charset-info (charset)
 148 ;  "Return a vector of information of CHARSET.
 149 ;The elements of the vector are:
 150 ;        CHARSET-ID, BYTES, DIMENSION, CHARS, WIDTH, DIRECTION,
 151 ;        LEADING-CODE-BASE, LEADING-CODE-EXT,
 152 ;        ISO-FINAL-CHAR, ISO-GRAPHIC-PLANE,
 153 ;        REVERSE-CHARSET, SHORT-NAME, LONG-NAME, DESCRIPTION,
 154 ;        PLIST,
 155 ;where
 156 ;CHARSET-ID (integer) is the identification number of the charset.
 157 ;BYTES (integer) is the length of multi-byte form of a character in
 158 ;  the charset: one of 1, 2, 3, and 4.
 159 ;DIMENSION (integer) is the number of bytes to represent a character of
 160 ;the charset: 1 or 2.
 161 ;CHARS (integer) is the number of characters in a dimension: 94 or 96.
 162 ;WIDTH (integer) is the number of columns a character in the charset
 163 ;  occupies on the screen: one of 0, 1, and 2.
 164 ;DIRECTION (integer) is the rendering direction of characters in the
 165 ;  charset when rendering.  If 0, render from left to right, else
 166 ;  render from right to left.
 167 ;LEADING-CODE-BASE (integer) is the base leading-code for the
 168 ;  charset.
 169 ;LEADING-CODE-EXT (integer) is the extended leading-code for the
 170 ;  charset.  All charsets of less than 0xA0 has the value 0.
 171 ;ISO-FINAL-CHAR (character) is the final character of the
 172 ;  corresponding ISO 2022 charset.
 173 ;ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked
 174 ;  while encoding to variants of ISO 2022 coding system, one of the
 175 ;  following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).
 176 ;REVERSE-CHARSET (integer) is the charset which differs only in
 177 ;  LEFT-TO-RIGHT value from the charset.  If there's no such a
 178 ;  charset, the value is -1.
 179 ;SHORT-NAME (string) is the short name to refer to the charset.
 180 ;LONG-NAME (string) is the long name to refer to the charset
 181 ;DESCRIPTION (string) is the description string of the charset.
 182 ;PLIST (property list) may contain any type of information a user
 183 ;  want to put and get by functions `put-charset-property' and
 184 ;  `get-charset-property' respectively."
 185 ;  (vector
 186 ;   (charset-id charset)
 187 ;   1
 188 ;   (charset-dimension charset)
 189 ;   (charset-chars charset)
 190 ;   (charset-width charset)
 191 ;   (charset-direction charset)
 192 ;   nil ;; (charset-leading-code-base (charset))
 193 ;   nil ;; (charset-leading-code-ext (charset))
 194 ;   (charset-iso-final-char charset)
 195 ;   (charset-iso-graphic-plane charset)
 196 ;   -1
 197 ;   (charset-short-name charset)
 198 ;   (charset-long-name charset)
 199 ;   (charset-description charset)
 200 ;   (charset-plist charset)))
 201
 202 ;(make-compatible 'charset-info "Don't use this if you can help it.")
 203
 204 (defun define-charset (charset-id charset property-vector)
 205   "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.
 206 If CHARSET-ID is nil, it is decided automatically, which means CHARSET is
 207  treated as a private charset.
 208 INFO-VECTOR is a vector of the format:
 209    [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE
 210     SHORT-NAME LONG-NAME DESCRIPTION]
 211 The meanings of each elements is as follows:
 212 DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.
 213 CHARS (integer) is the number of characters in a dimension: 94 or 96.
 214 WIDTH (integer) is the number of columns a character in the charset
 215 occupies on the screen: one of 0, 1, and 2.
 216
 217 DIRECTION (integer) is the rendering direction of characters in the
 218 charset when rendering.  If 0, render from left to right, else
 219 render from right to left.
 220
 221 ISO-FINAL-CHAR (character) is the final character of the
 222 corresponding ISO 2022 charset.
 223
 224 ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked
 225 while encoding to variants of ISO 2022 coding system, one of the
 226 following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).
 227
 228
 229 SHORT-NAME (string) is the short name to refer to the charset.
 230
 231 LONG-NAME (string) is the long name to refer to the charset.
 232
 233 DESCRIPTION (string) is the description string of the charset."
 234   (make-charset charset (aref property-vector 8)
 235                 (list
 236                  'short-name (aref property-vector 6)
 237                  'long-name (aref property-vector 7)
 238                  'dimension (aref property-vector 0)
 239                  'columns (aref property-vector 2)
 240                  'chars (aref property-vector 1)
 241                  'final (aref property-vector 4)
 242                  'graphic (aref property-vector 5)
 243                  'direction (aref property-vector 3))))
 244
 245 (make-compatible 'define-charset "")
 246
 247 ;;; Charset property
 248
 249 (defalias 'get-charset-property 'get)
 250 (defalias 'put-charset-property 'put)
 251 (defalias 'charset-plist 'object-plist)
 252 (defalias 'set-charset-plist 'setplist)
 253
 254 ;; Setup auto-fill-chars for charsets that should invoke auto-filling.
 255 ;; SPACE and NEWLIE are already set.
 256 ;; (let ((l '(katakana-jisx0201
 257 ;;            japanese-jisx0208 japanese-jisx0212
 258 ;;            chinese-gb2312 chinese-big5-1 chinese-big5-2)))
 259 ;;   (while l
 260 ;;     (put-char-table (car l) t auto-fill-chars)
 261 ;;     (setq l (cdr l))))
 262
 263
 264 ;;; @ Coded character set
 265 ;;;
 266
 267 (when (featurep 'utf-2000)
 268   (setq default-coded-charset-priority-list
 269         '(ascii
 270           control-1
 271           latin-iso8859-1
 272           latin-iso8859-2
 273           latin-iso8859-3
 274           latin-iso8859-4
 275           latin-iso8859-9
 276           latin-jisx0201
 277           cyrillic-iso8859-5
 278           greek-iso8859-7
 279           thai-tis620
 280           =jis-x0208
 281           =ucs-radicals
 282           =ucs-radicals@unicode
 283           ;; =ucs-bmp-cjk@JP
 284           =ucs-bmp-cjk@JP/hanazono
 285           =mj-0
 286           =mj-1
 287           =ucs-bmp-cjk@gb
 288           =jis-x0208@1983
 289           chinese-gb2312
 290           =jis-x0208-1990
 291           japanese-jisx0208-1978
 292           =jis-x0212
 293           chinese-cns11643-1
 294           chinese-cns11643-2
 295           chinese-cns11643-3
 296           chinese-cns11643-4
 297           chinese-cns11643-5
 298           chinese-cns11643-6
 299           chinese-cns11643-7
 300           =adobe-japan1-0
 301           =adobe-japan1-1
 302           =adobe-japan1-2
 303           =adobe-japan1-3
 304           =adobe-japan1-4
 305           =adobe-japan1-5
 306           =adobe-japan1-6
 307           =big5-cdp
 308           =hanyo-denshi/ja
 309           =hanyo-denshi/jb
 310           =hanyo-denshi/jc
 311           =hanyo-denshi/jd
 312           =hanyo-denshi/ft
 313           =hanyo-denshi/ia
 314           =hanyo-denshi/ib
 315           =hanyo-denshi/hg
 316           =hanyo-denshi/ip
 317           =hanyo-denshi/jt
 318           =hanyo-denshi/ks/mf
 319           =hanyo-denshi/tk/mf-01
 320           =gt-pj-2
 321           =gt-pj-3
 322           =gt-pj-4
 323           =gt-pj-5
 324           =gt-pj-6
 325           =gt-pj-7
 326           =gt-pj-8
 327           =gt-pj-9
 328           =gt-pj-10
 329           =gt-pj-11
 330           =gt-pj-k1
 331           =gt-pj-k2
 332           chinese-big5-eten-a
 333           chinese-big5-eten-b
 334           chinese-big5
 335           =jis-x0213-1-2000
 336           =jis-x0213-2-2000
 337           ;; chinese-gb12345
 338           =gt-pj-1
 339           =ucs-bmp-cjk
 340           =ucs-sip-ext-b
 341           =ruimoku-v6
 342           =zinbun-oracle
 343           =hanziku-1
 344           =hanziku-2
 345           =hanziku-3
 346           =hanziku-4
 347           =hanziku-5
 348           =hanziku-6
 349           =hanziku-7
 350           =hanziku-8
 351           =hanziku-9
 352           =hanziku-10
 353           =hanziku-11
 354           =hanziku-12
 355           =ucs-sip-ext-b@iso
 356           =ucs-sip@iso
 357           ideograph-daikanwa-2
 358           ideograph-daikanwa
 359           korean-ksc5601
 360           katakana-jisx0201
 361           hebrew-iso8859-8
 362           latin-viscii
 363           latin-viscii-lower
 364           latin-viscii-upper
 365           ipa
 366           lao
 367           ethiopic-ucs
 368           ethiopic
 369           arabic-digit
 370           arabic-1-column
 371           arabic-2-column
 372           arabic-iso8859-6
 373           chinese-big5-1
 374           chinese-big5-2
 375           ;; =zihai-17xx
 376           =ucs-bmp-var-001
 377           =ucs-sip-var-001
 378           =ucs-bmp-var-002
 379           =ucs-sip-var-002
 380           =ucs-bmp-var-003
 381           =ucs-sip-var-003
 382           =ucs-bmp-var-004
 383           =ucs-sip-var-004
 384           =ucs-bmp-var-005
 385           =ucs-bmp-var-006
 386           =ucs-sip-var-006
 387           =ucs-bmp-var-008
 388           =ucs-bmp-var-010
 389           =ucs-bmp-itaiji-001
 390           =ucs-sip-itaiji-001
 391           =ucs-bmp-itaiji-002
 392           =ucs-sip-itaiji-002
 393           =ucs-bmp-itaiji-003
 394           =ucs-sip-itaiji-003
 395           =ucs-bmp-itaiji-004
 396           =ucs-sip-itaiji-004
 397           =ucs-bmp-itaiji-005
 398           =ucs-sip-itaiji-005
 399           =ucs-bmp-itaiji-006
 400           =ucs-bmp-itaiji-007
 401           =ucs-sip-itaiji-007
 402           =ucs-bmp-itaiji-008
 403           =ucs-bmp-itaiji-009
 404           =ucs-bmp-itaiji-010
 405           =ucs-bmp-itaiji-011
 406           =ucs-sip-itaiji-011
 407           =ucs-bmp-itaiji-084
 408           =big5-cdp-itaiji-001
 409           =big5-cdp-itaiji-002
 410           =big5-cdp-itaiji-003
 411           =big5-cdp-var-001
 412           =big5-cdp-var-002
 413           =big5-cdp-var-003
 414           =big5-cdp-var-004
 415           =big5-cdp-var-005
 416           =cbeta
 417           =jef-china3
 418           chinese-isoir165
 419           =ucs-bmp-cjk-compat
 420           =ucs-bmp-cjk-compat@unicode
 421           =ucs-sip@JP/hanazono
 422           ==jis-x0208@1990
 423           ==ucs-radicals@unicode
 424           ==ucs-bmp-cjk@JP/hanazono
 425           ==mj-0
 426           ==mj-1
 427           ==ucs-bmp-cjk@gb
 428           ==ucs-sip-ext-b@iso
 429           ==ucs-sip@JP/hanazono
 430           ==ucs-bmp-itaiji-002
 431           ==ucs-sip-itaiji-002
 432           ==ucs-bmp-itaiji-003
 433           ==ucs-sip-itaiji-003
 434           ==ucs-bmp-itaiji-005
 435           ==ucs-bmp-var-002
 436           ==hanyo-denshi/ja
 437           ==hanyo-denshi/jb
 438           ==hanyo-denshi/jc
 439           ==hanyo-denshi/jd
 440           ==hanyo-denshi/ft
 441           ==hanyo-denshi/ia
 442           ==hanyo-denshi/ib
 443           ==hanyo-denshi/hg
 444           ==hanyo-denshi/ip
 445           ==hanyo-denshi/jt
 446           ==adobe-japan1-6
 447           ==big5-cdp
 448           ==big5-cdp-itaiji-001
 449           ==cns11643-1
 450           ==cns11643-2
 451           ==cns11643-3
 452           ==cns11643-4
 453           ==cns11643-5
 454           ==cns11643-6
 455           ==cns11643-7
 456           ==ucs-sip@iso
 457           ==jis-x0208@1983
 458           ==jis-x0208@1978
 459           ==jis-x0213-1@2000
 460           ==jis-x0213-2
 461           ==jis-x0212
 462           ==ks-x1001
 463           ==ruimoku-v6
 464           ==gt-pj-k1
 465           ==gt-pj-k2
 466           ==daikanwa
 467           ==cbeta
 468           ==jef-china3
 469           ==ucs-bmp-cjk-compat@JP
 470           ==ucs-bmp-cjk-compat@gb
 471           ===mj-0
 472           ===mj-1
 473           ===jis-x0208
 474           ===jis-x0208@1990
 475           ===big5-cdp
 476           ===ucs-bmp-cjk@gb
 477           ===adobe-japan1-6
 478           ===cns11643-1
 479           ===cns11643-2
 480           ===cns11643-3
 481           ===cns11643-4
 482           ===cns11643-5
 483           ===cns11643-6
 484           ===cns11643-7
 485           ;; ===hanyo-denshi/ja
 486           ===hanyo-denshi/jb
 487           ===hanyo-denshi/jc
 488           ===hanyo-denshi/jd
 489           ===hanyo-denshi/ft
 490           ===hanyo-denshi/ia
 491           ===hanyo-denshi/ib
 492           ===hanyo-denshi/hg
 493           ===hanyo-denshi/ip
 494           ===hanyo-denshi/jt
 495           ===jis-x0213-1
 496           ===jis-x0213-1@2004
 497           ===jis-x0213-2
 498           ===jis-x0208@1983
 499           ===jis-x0208@1978
 500           ===jis-x0212
 501           ===ks-x1001
 502           ===daikanwa
 503           ===ucs-sip-ext-b@iso
 504           ===ucs-sip@iso
 505           ===ruimoku-v6
 506           ===hng-jou ; 01
 507           ===hng-keg ; 02
 508           ===hng-dng ; 03
 509           ===hng-mam ; 05
 510           ===hng-drt ; 06
 511           ===hng-kgk ; 07
 512           ===hng-myz ; 08
 513           ===hng-kda ; 09
 514           ===hng-khi ; 10
 515           ===hng-khm ; 11
 516           ===hng-hok ; 13
 517           ===hng-kyd ; 14
 518           ===hng-sok ; 15
 519           ===hng-yhk ; 16
 520           ===hng-kak ; 17
 521           ===hng-kar ; 18
 522           ===hng-kae ; 19
 523           ===hng-sys ; 22
 524           ===hng-tsu ; 24
 525           ===hng-tzj ; 25
 526           ===hng-hos ; 26
 527           ===hng-nak ; 28
 528           ===hng-jhk ; 29
 529           ===hng-hod ; 30
 530           ===hng-gok ; 31
 531           ===hng-ink ; 33
 532           ===hng-nto ; 34
 533           ===hng-nkm ; 36
 534           ===hng-k24 ; 37
 535           ===hng-nkk ; 39
 536           ===hng-kcc ; 41
 537           ===hng-kcj ; 42
 538           ===hng-kbk ; 43
 539           ===hng-sik ; 44
 540           ===hng-skk ; 46
 541           ===hng-kyu ; 47
 542           ===hng-ksk ; 48
 543           ===hng-wan ; 49
 544           ===hng-okd ; 50
 545           ===hng-wad ; 54
 546           ===hng-kmi ; 55
 547           ===hng-zkd ; 56
 548           ===hng-doh ; 57
 549           ===hng-jyu ; 58
 550           ===hng-tzs ; 60
 551           ===hng-kss ; 64
 552           ===hng-kyo ; 66
 553           ===hng-smk ; 74
 554           ===cbeta
 555           ===jef-china3
 556           ===ucs-bmp-cjk-compat@unicode
 557           ;; ucs-sip
 558           =>>big5-cdp
 559           =>>jis-x0208
 560           =>>jis-x0208@1990
 561           =>>jis-x0213-1
 562           =>>jis-x0213-1@2004
 563           =>>jis-x0213-2
 564           =>jis-x0208
 565           =>jis-x0213-1
 566           =>mj-0
 567           =>big5-cdp
 568           =>ruimoku-v6
 569           =>big5-cdp-itaiji-001
 570           =>ucs-bmp-itaiji-001
 571           =>ucs-sip-itaiji-001
 572           =>ucs-bmp-itaiji-002
 573           =>ucs-sip-itaiji-002
 574           =>ucs-bmp-itaiji-003
 575           =>ucs-bmp-itaiji-004
 576           =>ucs-sip-itaiji-004
 577           =>ucs-bmp-itaiji-005
 578           =>ucs-bmp-itaiji-006
 579           =>ucs-bmp-itaiji-007
 580           =>ucs-sip-itaiji-007
 581           =>ucs-bmp-itaiji-009
 582           =>daikanwa
 583           ucs-bmp
 584           ==>ucs-bmp-cjk@bucs
 585           =>ucs-bmp-cjk@unicode
 586           =>ucs-bmp-cjk@cognate
 587           =>ucs-bmp-cjk@component
 588           =>ucs-sip@cognate
 589           =>ucs-sip@component
 590           =>ucs-bmp-cjk@iwds-1
 591           =>ucs-sip@iwds-1
 592           =+>ucs-bmp-cjk@unicode
 593           =+>ucs-bmp-cjk-compat@jis
 594           =+>jis-x0213-2
 595           =+>jis-x0213-1@2004
 596           ;; =>>ucs@unicode
 597           =adobe-japan1-base
 598           =>jis-x0208@1997
 599           =>>hanyo-denshi/ft
 600           =>>hanyo-denshi/jt
 601           =>>gt
 602           =>>adobe-japan1-6
 603           =>>cbeta
 604           =>cns11643-7
 605           =>cbeta
 606           =+>adobe-japan1-6
 607           =+>ucs-bmp-var-003
 608           =+>jis-x0208@1978
 609           )))
 610
 611 ;;; mule-charset.el ends here