Mercurial > hg > xemacs-beta
diff lisp/mule/mule-charset.el @ 412:697ef44129c6 r21-2-14
Import from CVS: tag r21-2-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:20:41 +0200 |
parents | 2f8bb876ab1d |
children | da8ed4261e83 |
line wrap: on
line diff
--- a/lisp/mule/mule-charset.el Mon Aug 13 11:19:22 2007 +0200 +++ b/lisp/mule/mule-charset.el Mon Aug 13 11:20:41 2007 +0200 @@ -1,12 +1,8 @@ ;;; mule-charset.el --- Charset functions for Mule. - ;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Copyright (C) 1995 Amdahl Corporation. ;; Copyright (C) 1996 Sun Microsystems. -;; Author: Unknown -;; Keywords: i18n, mule, internal - ;; This file is part of XEmacs. ;; XEmacs is free software; you can redistribute it and/or modify it @@ -24,14 +20,40 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;;; Synched up with: Not synched. API at source level synched with FSF 20.3.9. + +;;;; Composite character support -;;; Commentary: +(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))) -;; These functions are not compatible at the bytecode level with Emacs/Mule, -;; and they never will be. -sb [1999-05-26] +(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)))))))))) -;;; Code: ;;;; Classifying text according to charsets @@ -94,15 +116,10 @@ be automatically determined)." (charset-property charset 'columns)) -;; #### FSFmacs returns 0 (defun charset-direction (charset) - "Return the display direction (0 for `l2r' or 1 for `r2l') of CHARSET. -Only left-to-right is currently implemented." - (if (eq (charset-property charset 'direction) 'l2r) - 0 - 1)) + "Return the display direction (`l2r' or `r2l') of CHARSET." + (charset-property charset 'direction)) -;; Not in Emacs/Mule (defun charset-registry (charset) "Return the registry of CHARSET. This is a regular expression matching the registry field of fonts @@ -127,135 +144,3 @@ (defsetf charset-registry set-charset-registry) (defsetf charset-ccl-program set-charset-ccl-program) - -;;; FSF compatibility functions -(defun charset-after (&optional pos) - "Return charset of a character in current buffer at position POS. -If POS is nil, it defauls to the current point. -If POS is out of range, the value is nil." - (when (null pos) - (setq pos (point))) - (check-argument-type 'integerp pos) - (unless (or (< pos (point-min)) - (> pos (point-max))) - (char-charset (char-after pos)))) - -;; Yuck! -;; We're not going to support this. -;(defun charset-info (charset) -; "Return a vector of information of CHARSET. -;The elements of the vector are: -; CHARSET-ID, BYTES, DIMENSION, CHARS, WIDTH, DIRECTION, -; LEADING-CODE-BASE, LEADING-CODE-EXT, -; ISO-FINAL-CHAR, ISO-GRAPHIC-PLANE, -; REVERSE-CHARSET, SHORT-NAME, LONG-NAME, DESCRIPTION, -; PLIST, -;where -;CHARSET-ID (integer) is the identification number of the charset. -;BYTES (integer) is the length of multi-byte form of a character in -; the charset: one of 1, 2, 3, and 4. -;DIMENSION (integer) is the number of bytes to represent a character of -;the charset: 1 or 2. -;CHARS (integer) is the number of characters in a dimension: 94 or 96. -;WIDTH (integer) is the number of columns a character in the charset -; occupies on the screen: one of 0, 1, and 2. -;DIRECTION (integer) is the rendering direction of characters in the -; charset when rendering. If 0, render from left to right, else -; render from right to left. -;LEADING-CODE-BASE (integer) is the base leading-code for the -; charset. -;LEADING-CODE-EXT (integer) is the extended leading-code for the -; charset. All charsets of less than 0xA0 has the value 0. -;ISO-FINAL-CHAR (character) is the final character of the -; corresponding ISO 2022 charset. -;ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked -; while encoding to variants of ISO 2022 coding system, one of the -; following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR). -;REVERSE-CHARSET (integer) is the charset which differs only in -; LEFT-TO-RIGHT value from the charset. If there's no such a -; charset, the value is -1. -;SHORT-NAME (string) is the short name to refer to the charset. -;LONG-NAME (string) is the long name to refer to the charset -;DESCRIPTION (string) is the description string of the charset. -;PLIST (property list) may contain any type of information a user -; want to put and get by functions `put-charset-property' and -; `get-charset-property' respectively." -; (vector -; (charset-id charset) -; 1 -; (charset-dimension charset) -; (charset-chars charset) -; (charset-width charset) -; (charset-direction charset) -; nil ;; (charset-leading-code-base (charset)) -; nil ;; (charset-leading-code-ext (charset)) -; (charset-iso-final-char charset) -; (charset-iso-graphic-plane charset) -; -1 -; (charset-short-name charset) -; (charset-long-name charset) -; (charset-description charset) -; (charset-plist charset))) - -;(make-compatible 'charset-info "Don't use this if you can help it.") - -(defun define-charset (charset-id charset property-vector) - "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR. -If CHARSET-ID is nil, it is decided automatically, which means CHARSET is - treated as a private charset. -INFO-VECTOR is a vector of the format: - [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE - SHORT-NAME LONG-NAME DESCRIPTION] -The meanings of each elements is as follows: -DIMENSION (integer) is the number of bytes to represent a character: 1 or 2. -CHARS (integer) is the number of characters in a dimension: 94 or 96. -WIDTH (integer) is the number of columns a character in the charset -occupies on the screen: one of 0, 1, and 2. - -DIRECTION (integer) is the rendering direction of characters in the -charset when rendering. If 0, render from left to right, else -render from right to left. - -ISO-FINAL-CHAR (character) is the final character of the -corresponding ISO 2022 charset. - -ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked -while encoding to variants of ISO 2022 coding system, one of the -following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR). - - -SHORT-NAME (string) is the short name to refer to the charset. - -LONG-NAME (string) is the long name to refer to the charset. - -DESCRIPTION (string) is the description string of the charset." - (make-charset charset (aref property-vector 8) - (list - 'short-name (aref property-vector 6) - 'long-name (aref property-vector 7) - 'dimension (aref property-vector 0) - 'columns (aref property-vector 2) - 'chars (aref property-vector 1) - 'final (aref property-vector 4) - 'graphic (aref property-vector 5) - 'direction (aref property-vector 3)))) - -(make-compatible 'define-charset "") - -;;; Charset property - -(defalias 'get-charset-property 'get) -(defalias 'put-charset-property 'put) -(defalias 'charset-plist 'object-plist) -(defalias 'set-charset-plist 'setplist) - -;; Setup auto-fill-chars for charsets that should invoke auto-filling. -;; SPACE and NEWLIE are already set. -(let ((l '(katakana-jisx0201 - japanese-jisx0208 japanese-jisx0212 - chinese-gb2312 chinese-big5-1 chinese-big5-2))) - (while l - (put-char-table (car l) t auto-fill-chars) - (setq l (cdr l)))) - -;;; mule-charset.el ends here