cgit.sxemacs.org Git - sxemacs/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
   7 ;; Author: Unknown
   8 ;; Keywords: i18n, mule, internal
   9
  10 ;; This file is part of SXEmacs.
  11
  12 ;; SXEmacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; SXEmacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Synched up with: Not synched.  API at source level synched with FSF 20.3.9.
  26
  27 ;;; Commentary:
  28
  29 ;; These functions are not compatible at the bytecode level with Emacs/Mule,
  30 ;; and they never will be.  -sb [1999-05-26]
  31
  32 ;;; Code:
  33 \f
  34 ;;;; Classifying text according to charsets
  35
  36 (defun charsets-in-region (start end &optional buffer)
  37   "Return a list of the charsets in the region between START and END.
  38 BUFFER defaults to the current buffer if omitted."
  39   (let (list)
  40     (save-excursion
  41       (if buffer
  42           (set-buffer buffer))
  43       (save-restriction
  44         (narrow-to-region start end)
  45         (goto-char (point-min))
  46         (while (not (eobp))
  47           (let* (prev-charset
  48                  (ch (char-after (point)))
  49                  (charset (char-charset ch)))
  50             (if (not (eq prev-charset charset))
  51                 (progn
  52                   (setq prev-charset charset)
  53                   (or (memq charset list)
  54                       (setq list (cons charset list))))))
  55           (forward-char))))
  56     list))
  57
  58 (defun charsets-in-string (string)
  59   "Return a list of the charsets in STRING."
  60   (let ((i 0)
  61         (len (length string))
  62         prev-charset charset list)
  63     (while (< i len)
  64       (setq charset (char-charset (aref string i)))
  65       (if (not (eq prev-charset charset))
  66           (progn
  67             (setq prev-charset charset)
  68             (or (memq charset list)
  69                 (setq list (cons charset list)))))
  70       (setq i (1+ i)))
  71     list))
  72
  73 \f
  74 ;;;; Charset accessors
  75
  76 (defun charset-iso-graphic-plane (charset)
  77   "Return the `graphic' property of CHARSET.
  78 See `make-charset'."
  79   (charset-property charset 'graphic))
  80
  81 (defun charset-iso-final-char (charset)
  82   "Return the final byte of the ISO 2022 escape sequence designating CHARSET."
  83   (charset-property charset 'final))
  84
  85 (defun charset-chars (charset)
  86   "Return the number of characters per dimension of CHARSET."
  87   (charset-property charset 'chars))
  88
  89 (defun charset-width (charset)
  90   "Return the number of display columns per character of CHARSET.
  91 This only applies to TTY mode (under X, the actual display width can
  92 be automatically determined)."
  93   (charset-property charset 'columns))
  94
  95 ;; #### FSFmacs returns 0
  96 (defun charset-direction (charset)
  97   "Return the display direction (0 for `l2r' or 1 for `r2l') of CHARSET.
  98 Only left-to-right is currently implemented."
  99   (if (eq (charset-property charset 'direction) 'l2r)
 100       0
 101     1))
 102
 103 ;; Not in Emacs/Mule
 104 (defun charset-registry (charset)
 105   "Return the registry of CHARSET.
 106 This is a regular expression matching the registry field of fonts
 107 that can display the characters in CHARSET."
 108   (charset-property charset 'registry))
 109
 110 (defun charset-ccl-program (charset)
 111   "Return the CCL program of CHARSET.
 112 See `make-charset'."
 113   (charset-property charset 'ccl-program))
 114
 115 (defun charset-bytes (charset)
 116   "Useless in XEmacs, returns 1."
 117    1)
 118
 119 (define-obsolete-function-alias 'charset-columns 'charset-width) ;; 19990409
 120 (define-obsolete-function-alias 'charset-final 'charset-iso-final-char) ;; 19990409
 121 (define-obsolete-function-alias 'charset-graphic 'charset-iso-graphic-plane) ;; 19990409
 122 (define-obsolete-function-alias 'charset-doc-string 'charset-description) ;; 19990409
 123
 124 ;;;; Define setf methods for all settable Charset properties
 125
 126 (defsetf charset-registry    set-charset-registry)
 127 (defsetf charset-ccl-program set-charset-ccl-program)
 128
 129 ;;; FSF compatibility functions
 130 (defun charset-after (&optional pos)
 131   "Return charset of a character in current buffer at position POS.
 132 If POS is nil, it defauls to the current point.
 133 If POS is out of range, the value is nil."
 134   (when (null pos)
 135     (setq pos (point)))
 136   (check-argument-type 'integerp pos)
 137   (unless (or (< pos (point-min))
 138               (> pos (point-max)))
 139     (char-charset (char-after pos))))
 140
 141 ;; Yuck!
 142 ;; We're not going to support this.
 143 ;(defun charset-info (charset)
 144 ;  "Return a vector of information of CHARSET.
 145 ;The elements of the vector are:
 146 ;        CHARSET-ID, BYTES, DIMENSION, CHARS, WIDTH, DIRECTION,
 147 ;        LEADING-CODE-BASE, LEADING-CODE-EXT,
 148 ;        ISO-FINAL-CHAR, ISO-GRAPHIC-PLANE,
 149 ;        REVERSE-CHARSET, SHORT-NAME, LONG-NAME, DESCRIPTION,
 150 ;        PLIST,
 151 ;where
 152 ;CHARSET-ID (integer) is the identification number of the charset.
 153 ;BYTES (integer) is the length of multi-byte form of a character in
 154 ;  the charset: one of 1, 2, 3, and 4.
 155 ;DIMENSION (integer) is the number of bytes to represent a character of
 156 ;the charset: 1 or 2.
 157 ;CHARS (integer) is the number of characters in a dimension: 94 or 96.
 158 ;WIDTH (integer) is the number of columns a character in the charset
 159 ;  occupies on the screen: one of 0, 1, and 2.
 160 ;DIRECTION (integer) is the rendering direction of characters in the
 161 ;  charset when rendering.  If 0, render from left to right, else
 162 ;  render from right to left.
 163 ;LEADING-CODE-BASE (integer) is the base leading-code for the
 164 ;  charset.
 165 ;LEADING-CODE-EXT (integer) is the extended leading-code for the
 166 ;  charset.  All charsets of less than 0xA0 has the value 0.
 167 ;ISO-FINAL-CHAR (character) is the final character of the
 168 ;  corresponding ISO 2022 charset.
 169 ;ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked
 170 ;  while encoding to variants of ISO 2022 coding system, one of the
 171 ;  following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).
 172 ;REVERSE-CHARSET (integer) is the charset which differs only in
 173 ;  LEFT-TO-RIGHT value from the charset.  If there's no such a
 174 ;  charset, the value is -1.
 175 ;SHORT-NAME (string) is the short name to refer to the charset.
 176 ;LONG-NAME (string) is the long name to refer to the charset
 177 ;DESCRIPTION (string) is the description string of the charset.
 178 ;PLIST (property list) may contain any type of information a user
 179 ;  want to put and get by functions `put-charset-property' and
 180 ;  `get-charset-property' respectively."
 181 ;  (vector
 182 ;   (charset-id charset)
 183 ;   1
 184 ;   (charset-dimension charset)
 185 ;   (charset-chars charset)
 186 ;   (charset-width charset)
 187 ;   (charset-direction charset)
 188 ;   nil ;; (charset-leading-code-base (charset))
 189 ;   nil ;; (charset-leading-code-ext (charset))
 190 ;   (charset-iso-final-char charset)
 191 ;   (charset-iso-graphic-plane charset)
 192 ;   -1
 193 ;   (charset-short-name charset)
 194 ;   (charset-long-name charset)
 195 ;   (charset-description charset)
 196 ;   (charset-plist charset)))
 197
 198 ;(make-compatible 'charset-info "Don't use this if you can help it.")
 199
 200 (defun define-charset (charset-id charset property-vector)
 201   "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.
 202 If CHARSET-ID is nil, it is decided automatically, which means CHARSET is
 203  treated as a private charset.
 204 INFO-VECTOR is a vector of the format:
 205    [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE
 206     SHORT-NAME LONG-NAME DESCRIPTION]
 207 The meanings of each elements is as follows:
 208 DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.
 209 CHARS (integer) is the number of characters in a dimension: 94 or 96.
 210 WIDTH (integer) is the number of columns a character in the charset
 211 occupies on the screen: one of 0, 1, and 2.
 212
 213 DIRECTION (integer) is the rendering direction of characters in the
 214 charset when rendering.  If 0, render from left to right, else
 215 render from right to left.
 216
 217 ISO-FINAL-CHAR (character) is the final character of the
 218 corresponding ISO 2022 charset.
 219
 220 ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked
 221 while encoding to variants of ISO 2022 coding system, one of the
 222 following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).
 223
 224
 225 SHORT-NAME (string) is the short name to refer to the charset.
 226
 227 LONG-NAME (string) is the long name to refer to the charset.
 228
 229 DESCRIPTION (string) is the description string of the charset."
 230   (make-charset charset (aref property-vector 8)
 231                 (list
 232                  'short-name (aref property-vector 6)
 233                  'long-name (aref property-vector 7)
 234                  'dimension (aref property-vector 0)
 235                  'columns (aref property-vector 2)
 236                  'chars (aref property-vector 1)
 237                  'final (aref property-vector 4)
 238                  'graphic (aref property-vector 5)
 239                  'direction (aref property-vector 3))))
 240
 241 (make-compatible 'define-charset "")
 242
 243 ;;; Charset property
 244
 245 (defalias 'get-charset-property 'get)
 246 (defalias 'put-charset-property 'put)
 247 (defalias 'charset-plist 'object-plist)
 248 (defalias 'set-charset-plist 'setplist)
 249
 250 ;; Setup auto-fill-chars for charsets that should invoke auto-filling.
 251 ;; SPACE and NEWLIE are already set.
 252 (let ((l '(katakana-jisx0201
 253            japanese-jisx0208 japanese-jisx0212
 254            chinese-gb2312 chinese-big5-1 chinese-big5-2)))
 255   (while l
 256     (put-char-table (car l) t auto-fill-chars)
 257     (setq l (cdr l))))
 258
 259 ;;; mule-charset.el ends here