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