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