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 MORIOKA Tomohiko
   7
   8 ;; Author: Unknown
   9 ;; Keywords: i18n, mule, internal
  10
  11 ;; This file is part of XEmacs.
  12
  13 ;; XEmacs is free software; you can redistribute it and/or modify it
  14 ;; under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; XEmacs is distributed in the hope that it will be useful, but
  19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 ;; General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with XEmacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Synched up with: Not synched.  API at source level synched with FSF 20.3.9.
  29
  30 ;;; Commentary:
  31
  32 ;; These functions are not compatible at the bytecode level with Emacs/Mule,
  33 ;; and they never will be.  -sb [1999-05-26]
  34
  35 ;;; Code:
  36 \f
  37 ;;;; Classifying text according to charsets
  38
  39 (defun charsets-in-region (start end &optional buffer)
  40   "Return a list of the charsets in the region between START and END.
  41 BUFFER defaults to the current buffer if omitted."
  42   (let (list)
  43     (save-excursion
  44       (if buffer
  45           (set-buffer buffer))
  46       (save-restriction
  47         (narrow-to-region start end)
  48         (goto-char (point-min))
  49         (while (not (eobp))
  50           (let* (prev-charset
  51                  (ch (char-after (point)))
  52                  (charset (char-charset ch)))
  53             (if (not (eq prev-charset charset))
  54                 (progn
  55                   (setq prev-charset charset)
  56                   (or (memq charset list)
  57                       (setq list (cons charset list))))))
  58           (forward-char))))
  59     list))
  60
  61 (defun charsets-in-string (string)
  62   "Return a list of the charsets in STRING."
  63   (let ((i 0)
  64         (len (length string))
  65         prev-charset charset list)
  66     (while (< i len)
  67       (setq charset (char-charset (aref string i)))
  68       (if (not (eq prev-charset charset))
  69           (progn
  70             (setq prev-charset charset)
  71             (or (memq charset list)
  72                 (setq list (cons charset list)))))
  73       (setq i (1+ i)))
  74     list))
  75
  76 \f
  77 ;;;; Charset accessors
  78
  79 (defun charset-iso-graphic-plane (charset)
  80   "Return the `graphic' property of CHARSET.
  81 See `make-charset'."
  82   (charset-property charset 'graphic))
  83
  84 (defun charset-iso-final-char (charset)
  85   "Return the final byte of the ISO 2022 escape sequence designating CHARSET."
  86   (charset-property charset 'final))
  87
  88 (defun charset-chars (charset)
  89   "Return the number of characters per dimension of CHARSET."
  90   (charset-property charset 'chars))
  91
  92 (defun charset-width (charset)
  93   "Return the number of display columns per character of CHARSET.
  94 This only applies to TTY mode (under X, the actual display width can
  95 be automatically determined)."
  96   (charset-property charset 'columns))
  97
  98 ;; #### FSFmacs returns 0
  99 (defun charset-direction (charset)
 100   "Return the display direction (0 for `l2r' or 1 for `r2l') of CHARSET.
 101 Only left-to-right is currently implemented."
 102   (if (eq (charset-property charset 'direction) 'l2r)
 103       0
 104     1))
 105
 106 ;; Not in Emacs/Mule
 107 (defun charset-registry (charset)
 108   "Return the registry of CHARSET.
 109 This is a regular expression matching the registry field of fonts
 110 that can display the characters in CHARSET."
 111   (charset-property charset 'registry))
 112
 113 (defun charset-ccl-program (charset)
 114   "Return the CCL program of CHARSET.
 115 See `make-charset'."
 116   (charset-property charset 'ccl-program))
 117
 118 (defun charset-bytes (charset)
 119   "Useless in XEmacs, returns 1."
 120    1)
 121
 122 (define-obsolete-function-alias 'charset-columns 'charset-width) ;; 19990409
 123 (define-obsolete-function-alias 'charset-final 'charset-iso-final-char) ;; 19990409
 124 (define-obsolete-function-alias 'charset-graphic 'charset-iso-graphic-plane) ;; 19990409
 125 (define-obsolete-function-alias 'charset-doc-string 'charset-description) ;; 19990409
 126
 127 ;;;; Define setf methods for all settable Charset properties
 128
 129 (defsetf charset-registry    set-charset-registry)
 130 (defsetf charset-ccl-program set-charset-ccl-program)
 131
 132 ;;; FSF compatibility functions
 133 (defun charset-after (&optional pos)
 134   "Return charset of a character in current buffer at position POS.
 135 If POS is nil, it defauls to the current point.
 136 If POS is out of range, the value is nil."
 137   (when (null pos)
 138     (setq pos (point)))
 139   (check-argument-type 'integerp pos)
 140   (unless (or (< pos (point-min))
 141               (> pos (point-max)))
 142     (char-charset (char-after pos))))
 143
 144 ;; Yuck!
 145 ;; We're not going to support this.
 146 ;(defun charset-info (charset)
 147 ;  "Return a vector of information of CHARSET.
 148 ;The elements of the vector are:
 149 ;        CHARSET-ID, BYTES, DIMENSION, CHARS, WIDTH, DIRECTION,
 150 ;        LEADING-CODE-BASE, LEADING-CODE-EXT,
 151 ;        ISO-FINAL-CHAR, ISO-GRAPHIC-PLANE,
 152 ;        REVERSE-CHARSET, SHORT-NAME, LONG-NAME, DESCRIPTION,
 153 ;        PLIST,
 154 ;where
 155 ;CHARSET-ID (integer) is the identification number of the charset.
 156 ;BYTES (integer) is the length of multi-byte form of a character in
 157 ;  the charset: one of 1, 2, 3, and 4.
 158 ;DIMENSION (integer) is the number of bytes to represent a character of
 159 ;the charset: 1 or 2.
 160 ;CHARS (integer) is the number of characters in a dimension: 94 or 96.
 161 ;WIDTH (integer) is the number of columns a character in the charset
 162 ;  occupies on the screen: one of 0, 1, and 2.
 163 ;DIRECTION (integer) is the rendering direction of characters in the
 164 ;  charset when rendering.  If 0, render from left to right, else
 165 ;  render from right to left.
 166 ;LEADING-CODE-BASE (integer) is the base leading-code for the
 167 ;  charset.
 168 ;LEADING-CODE-EXT (integer) is the extended leading-code for the
 169 ;  charset.  All charsets of less than 0xA0 has the value 0.
 170 ;ISO-FINAL-CHAR (character) is the final character of the
 171 ;  corresponding ISO 2022 charset.
 172 ;ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked
 173 ;  while encoding to variants of ISO 2022 coding system, one of the
 174 ;  following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).
 175 ;REVERSE-CHARSET (integer) is the charset which differs only in
 176 ;  LEFT-TO-RIGHT value from the charset.  If there's no such a
 177 ;  charset, the value is -1.
 178 ;SHORT-NAME (string) is the short name to refer to the charset.
 179 ;LONG-NAME (string) is the long name to refer to the charset
 180 ;DESCRIPTION (string) is the description string of the charset.
 181 ;PLIST (property list) may contain any type of information a user
 182 ;  want to put and get by functions `put-charset-property' and
 183 ;  `get-charset-property' respectively."
 184 ;  (vector
 185 ;   (charset-id charset)
 186 ;   1
 187 ;   (charset-dimension charset)
 188 ;   (charset-chars charset)
 189 ;   (charset-width charset)
 190 ;   (charset-direction charset)
 191 ;   nil ;; (charset-leading-code-base (charset))
 192 ;   nil ;; (charset-leading-code-ext (charset))
 193 ;   (charset-iso-final-char charset)
 194 ;   (charset-iso-graphic-plane charset)
 195 ;   -1
 196 ;   (charset-short-name charset)
 197 ;   (charset-long-name charset)
 198 ;   (charset-description charset)
 199 ;   (charset-plist charset)))
 200
 201 ;(make-compatible 'charset-info "Don't use this if you can help it.")
 202
 203 (defun define-charset (charset-id charset property-vector)
 204   "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.
 205 If CHARSET-ID is nil, it is decided automatically, which means CHARSET is
 206  treated as a private charset.
 207 INFO-VECTOR is a vector of the format:
 208    [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE
 209     SHORT-NAME LONG-NAME DESCRIPTION]
 210 The meanings of each elements is as follows:
 211 DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.
 212 CHARS (integer) is the number of characters in a dimension: 94 or 96.
 213 WIDTH (integer) is the number of columns a character in the charset
 214 occupies on the screen: one of 0, 1, and 2.
 215
 216 DIRECTION (integer) is the rendering direction of characters in the
 217 charset when rendering.  If 0, render from left to right, else
 218 render from right to left.
 219
 220 ISO-FINAL-CHAR (character) is the final character of the
 221 corresponding ISO 2022 charset.
 222
 223 ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked
 224 while encoding to variants of ISO 2022 coding system, one of the
 225 following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).
 226
 227
 228 SHORT-NAME (string) is the short name to refer to the charset.
 229
 230 LONG-NAME (string) is the long name to refer to the charset.
 231
 232 DESCRIPTION (string) is the description string of the charset."
 233   (make-charset charset (aref property-vector 8)
 234                 (list
 235                  'short-name (aref property-vector 6)
 236                  'long-name (aref property-vector 7)
 237                  'dimension (aref property-vector 0)
 238                  'columns (aref property-vector 2)
 239                  'chars (aref property-vector 1)
 240                  'final (aref property-vector 4)
 241                  'graphic (aref property-vector 5)
 242                  'direction (aref property-vector 3))))
 243
 244 (make-compatible 'define-charset "")
 245
 246 ;;; Charset property
 247
 248 (defalias 'get-charset-property 'get)
 249 (defalias 'put-charset-property 'put)
 250 (defalias 'charset-plist 'object-plist)
 251 (defalias 'set-charset-plist 'setplist)
 252
 253 ;; Setup auto-fill-chars for charsets that should invoke auto-filling.
 254 ;; SPACE and NEWLIE are already set.
 255 ;; (let ((l '(katakana-jisx0201
 256 ;;            japanese-jisx0208 japanese-jisx0212
 257 ;;            chinese-gb2312 chinese-big5-1 chinese-big5-2)))
 258 ;;   (while l
 259 ;;     (put-char-table (car l) t auto-fill-chars)
 260 ;;     (setq l (cdr l))))
 261
 262
 263 ;;; @ Coded character set
 264 ;;;
 265
 266 (when (featurep 'utf-2000)
 267   (setq default-coded-charset-priority-list
 268         '(ascii
 269           control-1
 270           latin-iso8859-1
 271           latin-iso8859-2
 272           latin-iso8859-3
 273           latin-iso8859-4
 274           latin-iso8859-9
 275           latin-jisx0201
 276           cyrillic-iso8859-5
 277           greek-iso8859-7
 278           thai-tis620
 279           =jis-x0208
 280           =gt-pj-2
 281           =gt-pj-3
 282           =gt-pj-4
 283           =gt-pj-5
 284           =gt-pj-6
 285           =gt-pj-7
 286           =gt-pj-8
 287           =gt-pj-9
 288           =gt-pj-10
 289           =gt-pj-11
 290           =gt-pj-k1
 291           =gt-pj-k2
 292           =big5-cdp
 293           japanese-jisx0208
 294           =jis-x0208-1990
 295           japanese-jisx0212
 296           japanese-jisx0208-1978
 297           chinese-gb2312
 298           korean-ksc5601
 299           chinese-cns11643-1
 300           chinese-cns11643-2
 301           chinese-cns11643-3
 302           chinese-cns11643-4
 303           chinese-cns11643-5
 304           chinese-cns11643-6
 305           chinese-cns11643-7
 306           =jis-x0213-1-2000
 307           =jis-x0213-2-2000
 308           ;; chinese-gb12345
 309           chinese-isoir165
 310           katakana-jisx0201
 311           hebrew-iso8859-8
 312           latin-viscii
 313           latin-viscii-lower
 314           latin-viscii-upper
 315           ipa
 316           lao
 317           ethiopic-ucs
 318           ethiopic
 319           arabic-digit
 320           arabic-1-column
 321           arabic-2-column
 322           =gt-pj-1
 323           chinese-big5-eten-a
 324           chinese-big5-eten-b
 325           chinese-big5
 326           =ucs-radicals
 327           =ucs-radicals@unicode
 328           =ucs-bmp-cjk
 329           =ucs-bmp-cjk@unicode
 330           =ucs-sip-ext-b
 331           =ucs-sip-ext-b@iso
 332           =ruimoku-v6
 333           ideograph-daikanwa-2
 334           ideograph-daikanwa
 335           =hanziku-1
 336           =hanziku-2
 337           =hanziku-3
 338           =hanziku-4
 339           =hanziku-5
 340           =hanziku-6
 341           =hanziku-7
 342           =hanziku-8
 343           =hanziku-9
 344           =hanziku-10
 345           =hanziku-11
 346           =hanziku-12
 347           =cbeta
 348           ucs-bmp
 349           =jef-china3
 350           arabic-iso8859-6
 351           chinese-big5-1
 352           chinese-big5-2
 353           ucs-sip)))
 354
 355 ;;; mule-charset.el ends here