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

   1 ;;; mule-charset.el --- Charset functions for Mule.
   2 ;; Copyright (C) 1992 Free Software Foundation, Inc.
   3 ;; Copyright (C) 1995 Amdahl Corporation.
   4 ;; Copyright (C) 1996 Sun Microsystems.
   5
   6 ;; This file is part of XEmacs.
   7
   8 ;; XEmacs is free software; you can redistribute it and/or modify it
   9 ;; under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 2, or (at your option)
  11 ;; any later version.
  12
  13 ;; XEmacs is distributed in the hope that it will be useful, but
  14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 ;; General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with XEmacs; see the file COPYING.  If not, write to the
  20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21 ;; Boston, MA 02111-1307, USA.
  22
  23 \f
  24 ;;;; Composite character support
  25
  26 (defun compose-region (start end &optional buffer)
  27   "Compose characters in the current region into one composite character.
  28 From a Lisp program, pass two arguments, START to END.
  29 The composite character replaces the composed characters.
  30 BUFFER defaults to the current buffer if omitted."
  31   (interactive "r")
  32   (let ((ch (make-composite-char (buffer-substring start end buffer))))
  33     (delete-region start end buffer)
  34     (insert-char ch nil nil buffer)))
  35
  36 (defun decompose-region (start end &optional buffer)
  37   "Decompose any composite characters in the current region.
  38 From a Lisp program, pass two arguments, START to END.
  39 This converts each composite character into one or more characters,
  40 the individual characters out of which the composite character was formed.
  41 Non-composite characters are left as-is.  BUFFER defaults to the current
  42 buffer if omitted."
  43   (interactive "r")
  44   (save-excursion
  45     (set-buffer buffer)
  46     (save-restriction
  47       (narrow-to-region start end)
  48       (goto-char (point-min))
  49       (let ((compcharset (get-charset 'composite)))
  50         (while (< (point) (point-max))
  51           (let ((ch (char-after (point))))
  52             (if (eq compcharset (char-charset ch))
  53                 (progn
  54                   (delete-char 1)
  55                   (insert (composite-char-string ch))))))))))
  56
  57 \f
  58 ;;;; Classifying text according to charsets
  59
  60 (defun charsets-in-region (start end &optional buffer)
  61   "Return a list of the charsets in the region between START and END.
  62 BUFFER defaults to the current buffer if omitted."
  63   (let (list)
  64     (save-excursion
  65       (if buffer
  66           (set-buffer buffer))
  67       (save-restriction
  68         (narrow-to-region start end)
  69         (goto-char (point-min))
  70         (while (not (eobp))
  71           (let* (prev-charset
  72                  (ch (char-after (point)))
  73                  (charset (char-charset ch)))
  74             (if (not (eq prev-charset charset))
  75                 (progn
  76                   (setq prev-charset charset)
  77                   (or (memq charset list)
  78                       (setq list (cons charset list))))))
  79           (forward-char))))
  80     list))
  81
  82 (defun charsets-in-string (string)
  83   "Return a list of the charsets in STRING."
  84   (let ((i 0)
  85         (len (length string))
  86         prev-charset charset list)
  87     (while (< i len)
  88       (setq charset (char-charset (aref string i)))
  89       (if (not (eq prev-charset charset))
  90           (progn
  91             (setq prev-charset charset)
  92             (or (memq charset list)
  93                 (setq list (cons charset list)))))
  94       (setq i (1+ i)))
  95     list))
  96
  97 \f
  98 ;;;; Charset accessors
  99
 100 (defun charset-graphic (charset)
 101   "Return the `graphic' property of CHARSET.
 102 See `make-charset'."
 103   (charset-property charset 'graphic))
 104
 105 (defun charset-final (charset)
 106   "Return the final byte of the ISO 2022 escape sequence designating CHARSET."
 107   (charset-property charset 'final))
 108
 109 (defun charset-chars (charset)
 110   "Return the number of characters per dimension of CHARSET."
 111   (charset-property charset 'chars))
 112
 113 (defun charset-columns (charset)
 114   "Return the number of display columns per character of CHARSET.
 115 This only applies to TTY mode (under X, the actual display width can
 116 be automatically determined)."
 117   (charset-property charset 'columns))
 118
 119 (defun charset-direction (charset)
 120   "Return the display direction (`l2r' or `r2l') of CHARSET."
 121   (charset-property charset 'direction))
 122
 123 (defun charset-registry (charset)
 124   "Return the registry of CHARSET.
 125 This is a regular expression matching the registry field of fonts
 126 that can display the characters in CHARSET."
 127   (charset-property charset 'registry))
 128
 129 (defun charset-ccl-program (charset)
 130   "Return the CCL program of CHARSET.
 131 See `make-charset'."
 132   (charset-property charset 'ccl-program))
 133
 134 (defun charset-leading-byte (charset)
 135   "Return the leading byte of CHARSET.
 136 See `make-charset'."
 137   (charset-property charset 'leading-byte))
 138
 139 ;;;; Define setf methods for all settable Charset properties
 140
 141 (defsetf charset-registry    set-charset-registry)
 142 (defsetf charset-ccl-program set-charset-ccl-program)