Mercurial > hg > xemacs-beta
diff lisp/mule/mule-charset.el @ 70:131b0175ea99 r20-0b30
Import from CVS: tag r20-0b30
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:02:59 +0200 |
parents | |
children | 8e84bee8ddd0 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/mule/mule-charset.el Mon Aug 13 09:02:59 2007 +0200 @@ -0,0 +1,137 @@ +;;; mule-charset.el --- Charset functions for Mule. +;; Copyright (C) 1992 Free Software Foundation, Inc. +;; Copyright (C) 1995 Amdahl Corporation. +;; Copyright (C) 1996 Sun Microsystems. + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;;;; Composite character support + +(defun compose-region (start end &optional buffer) + "Compose characters in the current region into one composite character. +From a Lisp program, pass two arguments, START to END. +The composite character replaces the composed characters. +BUFFER defaults to the current buffer if omitted." + (interactive "r") + (let ((ch (make-composite-char (buffer-substring start end buffer)))) + (delete-region start end buffer) + (insert-char ch nil nil buffer))) + +(defun decompose-region (start end &optional buffer) + "Decompose any composite characters in the current region. +From a Lisp program, pass two arguments, START to END. +This converts each composite character into one or more characters, +the individual characters out of which the composite character was formed. +Non-composite characters are left as-is. BUFFER defaults to the current +buffer if omitted." + (interactive "r") + (save-excursion + (set-buffer buffer) + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (let ((compcharset (get-charset 'composite))) + (while (< (point) (point-max)) + (let ((ch (char-after (point)))) + (if (eq compcharset (char-charset ch)) + (progn + (delete-char 1) + (insert (composite-char-string ch)))))))))) + + +;;;; Classifying text according to charsets + +(defun charsets-in-region (start end &optional buffer) + "Return a list of the charsets in the region between START and END. +BUFFER defaults to the current buffer if omitted." + (let (list) + (save-excursion + (if buffer + (set-buffer buffer)) + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (not (eobp)) + (let* (prev-charset + (ch (char-after (point))) + (charset (char-charset ch))) + (if (not (eq prev-charset charset)) + (progn + (setq prev-charset charset) + (or (memq charset list) + (setq list (cons charset list)))))) + (forward-char)))) + list)) + +(defun charsets-in-string (string) + "Return a list of the charsets in STRING." + (let ((i 0) + (len (length string)) + prev-charset charset list) + (while (< i len) + (setq charset (char-charset (aref string i))) + (if (not (eq prev-charset charset)) + (progn + (setq prev-charset charset) + (or (memq charset list) + (setq list (cons charset list))))) + (setq i (1+ i))) + list)) + + +;;;; Charset accessors + +(defun charset-graphic (charset) + "Return the `graphic' property of CHARSET. +See `make-charset'." + (charset-property charset 'graphic)) + +(defun charset-final (charset) + "Return the final byte of the ISO 2022 escape sequence designating CHARSET." + (charset-property charset 'final)) + +(defun charset-chars (charset) + "Return the number of characters per dimension of CHARSET." + (charset-property charset 'chars)) + +(defun charset-columns (charset) + "Return the number of display columns per character of CHARSET. +This only applies to TTY mode (under X, the actual display width can +be automatically determined)." + (charset-property charset 'columns)) + +(defun charset-direction (charset) + "Return the display direction (`l2r' or `r2l') of CHARSET." + (charset-property charset 'direction)) + +(defun charset-registry (charset) + "Return the registry of CHARSET. +This is a regular expression matching the registry field of fonts +that can display the characters in CHARSET." + (charset-property charset 'registry)) + +(defun charset-ccl-program (charset) + "Return the CCL program of CHARSET. +See `make-charset'." + (charset-property charset 'ccl-program)) + +;;;; Define setf methods for all settable Charset properties + +(defsetf charset-registry set-charset-registry) +(defsetf charset-ccl-program set-charset-ccl-program)