X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=ids-util.el;h=b1b96f11a9fc60a544131e053c58a2b6c6c848b4;hb=4c90cd0886e569ddcceea110e9416f0b60c96072;hp=5892ac33e170f94999917d79404f39ee95f6eba4;hpb=65ca132204013c66f804b948ba26c11a234b34a8;p=chise%2Fids.git

diff --git a/ids-util.el b/ids-util.el
index 5892ac3..b1b96f1 100644
--- a/ids-util.el
+++ b/ids-util.el
@@ -1,9 +1,9 @@
 ;;; ids-util.el --- Utilities about ideographic-structure -*- coding: utf-8 -*-
 
-;; Copyright (C) 2001,2002 MORIOKA Tomohiko
+;; Copyright (C) 2001,2002,2003,2004 MORIOKA Tomohiko
 
 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
-;; Keywords: ideographic-structure, UTF-2000, database
+;; Keywords: ideographic-structure, CHISE, IDS, IDC, UCS, database
 
 ;; This file is a part of Tomoyo Utilities.
 
@@ -27,6 +27,30 @@
 ;;; Code:
 
 ;;;###autoload
+(defun ideographic-structure-convert-to-domain (structure domain)
+  (let (dest cell ret)
+    (while structure
+      (setq cell (car structure))
+      (setq dest
+	    (cons
+	     (cond ((characterp cell)
+		    (char-representative-of-domain cell domain))
+		   ((and (consp cell)
+			 (symbolp (car cell)))
+		    cell)
+		   ((setq ret (find-char cell))
+		    (char-representative-of-domain cell domain))
+		   ((setq ret (assq 'ideographic-structure cell))
+		    (put-alist 'ideographic-structure
+			       (ideographic-structure-convert-to-domain
+				(cdr ret) domain)
+			       (copy-alist cell)))
+		   (t cell))
+	     dest))
+      (setq structure (cdr structure)))
+    (nreverse dest)))
+
+;;;###autoload
 (defun ideographic-structure-convert-to-ucs (structure)
   (let (dest cell ucs ret)
     (while structure
@@ -62,6 +86,50 @@
       (setq structure (cdr structure)))
     (nreverse dest)))
 
+(defun char-cns11643-p (char &optional defined-only)
+  (some (lambda (n)
+	  (encode-char char
+		       (intern (format "=cns11643-%d" n))
+		       defined-only))
+	'(1 2 3 4 5 6 7)))
+
+(defun char-representative-of-cns11643 (char)
+  (if (char-cns11643-p char)
+      char
+    (let ((ucs (char-ucs char))
+	  variants)
+      (if (and ucs
+	       (setq variants
+		     (char-variants (decode-char 'ucs ucs))))
+	  (while (and variants
+		      (setq char (car variants))
+		      (not (char-cns11643-p char)))
+	    (setq variants (cdr variants))))
+      char)))
+
+(defun ideographic-structure-convert-to-cns11643 (structure)
+  (let (dest cell ucs ret)
+    (while structure
+      (setq cell (car structure))
+      (setq dest
+	    (cons
+	     (cond ((characterp cell)
+		    (char-representative-of-cns11643 cell))
+		   ((and (consp cell)
+			 (symbolp (car cell)))
+		    cell)
+		   ((setq ret (find-char cell))
+		    (char-representative-of-cns11643 ret))
+		   ((setq ret (assq 'ideographic-structure cell))
+		    (put-alist 'ideographic-structure
+			       (ideographic-structure-convert-to-cns11643
+				(cdr ret))
+			       (copy-alist cell)))
+		   (t cell))
+	     dest))
+      (setq structure (cdr structure)))
+    (nreverse dest)))
+
 (defvar morohashi-char-replace-alist
   (list
    (cons (decode-char 'chinese-big5-cdp #x8B42)