X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Futf-2000%2Fideograph-util.el;h=70f41714285558c1d155592b934864f9ef8ee114;hp=042c87b805e8759ac30d74f415a38003b61b3319;hb=8ba3626da629f1b4ecafae24c85f3d0cb3bf8b8e;hpb=a4ca99907d304b09f58457a476e7e9b47e1cbef0

diff --git a/lisp/utf-2000/ideograph-util.el b/lisp/utf-2000/ideograph-util.el
index 042c87b..70f4171 100644
--- a/lisp/utf-2000/ideograph-util.el
+++ b/lisp/utf-2000/ideograph-util.el
@@ -1,6 +1,7 @@
 ;;; ideograph-util.el --- Ideographic Character Database utility
 
-;; Copyright (C) 1999,2000,2001,2002,2003,2004 MORIOKA Tomohiko.
+;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007, 2008,
+;;   2009, 2010, 2012, 2014, 2015 MORIOKA Tomohiko.
 
 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
 ;; Keywords: CHISE, Chaon model, ISO/IEC 10646, Unicode, UCS-4, MULE.
@@ -24,241 +25,27 @@
 
 ;;; Code:
 
+(require 'chise-subr)
+(require 'ideograph-subr)
 (require 'char-db-util)
 
-;;;###autoload
-(defun expand-char-feature-name (feature domain)
-  (if domain
-      (intern (format "%s@%s" feature domain))
-    feature))
-
-(defun map-char-family (function char &optional ignore-sisters)
-  (let ((rest (list char))
-	ret checked)
-    (catch 'tag
-      (while rest
-	(unless (memq (car rest) checked)
-	  (if (setq ret (funcall function (car rest)))
-	      (throw 'tag ret))
-	  (setq checked (cons (car rest) checked)
-		rest (append rest
-			     (get-char-attribute (car rest) '->subsumptive)
-			     (get-char-attribute (car rest) '->denotational)
-			     (get-char-attribute (car rest) '->identical)))
-	  (unless ignore-sisters
-	    (setq rest (append rest
-			       (get-char-attribute (car rest) '<-subsumptive)
-			       (get-char-attribute (car rest) '<-denotational)))))
-	(setq rest (cdr rest))))))
-
-(defun get-char-feature-from-domains (char feature domains
-					   &optional tester arg
-					   ignore-sisters)
-  (map-char-family
-   (lambda (ch)
-     (let (ret)
-       (catch 'tag
-	 (dolist (domain domains)
-	   (if (and (or (null tester)
-			(equal (or (char-feature
-				    ch (expand-char-feature-name
-					tester domain))
-				   (char-feature ch tester))
-			       arg))
-		    (setq ret (or (char-feature
-				   ch (expand-char-feature-name
-				       feature domain))
-				  (char-feature ch feature))))
-	       (throw 'tag ret))))))
-   char ignore-sisters)
-  ;; (let ((rest (list char))
-  ;;       ret checked)
-  ;;   (catch 'tag
-  ;;     (while rest
-  ;;       (setq char (car rest))
-  ;;       (unless (memq char checked)
-  ;;         (dolist (domain domains)
-  ;;           (if (and (setq ret (char-feature
-  ;;                               char
-  ;;                               (expand-char-feature-name
-  ;;                                feature domain)))
-  ;;                    (or (null tester)
-  ;;                        (equal (or (char-feature
-  ;;                                    char
-  ;;                                    (expand-char-feature-name
-  ;;                                     tester domain))
-  ;;                                   (char-feature char tester))
-  ;;                               arg)))
-  ;;               (throw 'tag ret)))
-  ;;         (setq rest (append rest
-  ;;                            (get-char-attribute char '->subsumptive)
-  ;;                            (get-char-attribute char '->denotational)
-  ;;                            (get-char-attribute char '<-subsumptive)
-  ;;                            (get-char-attribute char '<-denotational))
-  ;;               checked (cons char checked)))
-  ;;       (setq rest (cdr rest)))))
-  )
-
 
 (defvar ideograph-radical-chars-vector
   (make-vector 215 nil))
 
-(defun char-ideographic-radical (char &optional radical ignore-sisters)
-  (let (ret)
-    (or (if radical
-	    (get-char-feature-from-domains
-	     char 'ideographic-radical (cons nil char-db-feature-domains)
-	     'ideographic-radical radical ignore-sisters)
-	  (get-char-feature-from-domains
-	   char 'ideographic-radical (cons nil char-db-feature-domains)
-	   ignore-sisters))
-        ;; (catch 'tag
-        ;;   (dolist (domain char-db-feature-domains)
-        ;;     (if (and (setq ret (char-feature
-        ;;                         char
-        ;;                         (intern
-        ;;                          (format "%s@%s"
-        ;;                                  'ideographic-radical domain))))
-        ;;              (or (eq ret radical)
-        ;;                  (null radical)))
-        ;;         (throw 'tag ret))))
-	(catch 'tag
-	  (dolist (cell (get-char-attribute char 'ideographic-))
-	    (if (and (setq ret (plist-get cell :radical))
-		     (or (eq ret radical)
-			 (null radical)))
-		(throw 'tag ret))))
-	(get-char-feature-from-domains
-	 char 'ideographic-radical (cons nil char-db-feature-domains))
-        ;; (char-feature char 'ideographic-radical)
-	(progn
-	  (setq ret
-		(or (get-char-attribute char 'daikanwa-radical)
-		    (get-char-attribute char 'kangxi-radical)
-		    (get-char-attribute char 'japanese-radical)
-		    (get-char-attribute char 'korean-radical)))
-	  (when ret
-	    (put-char-attribute char 'ideographic-radical ret)
-	    ret)))))
-
-(defvar ideograph-radical-strokes-vector
-  ;;0  1  2  3  4  5  6  7  8  9
-  [nil 1  1  1  1  1  1  2  2  2
-    2  2  2  2  2  2  2  2  2  2
-    2  2  2  2  2  2  2  2  2  2
-    3  3  3  3  3  3  3  3  3  3
-    3  3  3  3  3  3  3  3  3  3
-    3  3  3  3  3  3  3  3  3  3
-    3  4  4  4  3  4  4  4  4  4
-    4  4  4  4  4  4  4  4  4  4
-    4  4  4  4  4  3  4  4  4  4
-    4  4  4  4  3  5  4  5  5  5
-    ;; 100
-    5  5  5  5  5  5  5  5  5  5
-    5  5  5  5  5  5  5  5  6  6
-    6  6  6  6  6  6  6  6  6  6
-    4  6  6  6  6  6  6  6  6  6
-    4  6  6  6  6  6  6  7  7  7
-    7  7  7  7  7  7  7  7  7  7
-    7  7  4  3  7  7  7  8  7  8
-    3  8  8  8  8  8  9  9  9  9
-    9  9  9  9  8  9  9 10 10 10
-   10 10 10 10 10 11 11 11 11 11
-   ;; 200
-   11 12 12 12 12 13 13 13 13 14
-   14 15 16 16 17])
-
-;;;###autoload
-(defun char-ideographic-strokes-from-domains (char domains &optional radical)
-  (if radical
-      (get-char-feature-from-domains char 'ideographic-strokes domains
-				     'ideographic-radical radical)
-    (get-char-feature-from-domains char 'ideographic-strokes domains))
-  ;; (let ((rest (list char))
-  ;;       ret checked)
-  ;;   (catch 'tag
-  ;;     (while rest
-  ;;       (setq char (car rest))
-  ;;       (unless (memq char checked)
-  ;;         (dolist (domain domains)
-  ;;           (if (and (setq ret (or (char-feature
-  ;;                                   char
-  ;;                                   (expand-char-feature-name
-  ;;                                    'ideographic-radical domain))
-  ;;                                  (char-feature
-  ;;                                   char 'ideographic-radical)))
-  ;;                    (or (eq ret radical)
-  ;;                        (null radical))
-  ;;                    (setq ret (or (char-feature
-  ;;                                   char
-  ;;                                   (expand-char-feature-name
-  ;;                                    'ideographic-strokes domain))
-  ;;                                  (char-feature
-  ;;                                   char 'ideographic-strokes))))
-  ;;               (throw 'tag ret)))
-  ;;         (setq rest (append rest
-  ;;                            (get-char-attribute char '->subsumptive)
-  ;;                            (get-char-attribute char '->denotational))
-  ;;               checked (cons char checked)))
-  ;;       (setq rest (cdr rest)))))
-  )
-
-;;;###autoload
-(defun char-ideographic-strokes (char &optional radical preferred-domains)
-  (let (ret)
-    (or (catch 'tag
-	  (dolist (cell (get-char-attribute char 'ideographic-))
-	    (if (and (setq ret (plist-get cell :radical))
-		     (or (eq ret radical)
-			 (null radical)))
-		(throw 'tag (plist-get cell :strokes)))))
-	(char-ideographic-strokes-from-domains
-	 char (append preferred-domains
-		      (cons nil
-			    char-db-feature-domains))
-	 radical)
-	(get-char-attribute char 'daikanwa-strokes)
-	(let ((strokes
-	       (or (get-char-attribute char 'kangxi-strokes)
-		   (get-char-attribute char 'japanese-strokes)
-		   (get-char-attribute char 'korean-strokes)
-		   (let ((r (char-ideographic-radical char))
-			 (ts (get-char-attribute char 'total-strokes)))
-		     (if (and r ts)
-			 (- ts (aref ideograph-radical-strokes-vector r))))
-		   )))
-	  (when strokes
-	    (put-char-attribute char 'ideographic-strokes strokes)
-	    strokes)))))
-
-;;;###autoload
-(defun char-total-strokes-from-domains (char domains)
-  (let (ret)
-    (catch 'tag
-      (dolist (domain domains)
-	(if (setq ret (get-char-attribute
-		       char
-		       (intern
-			(format "%s@%s"
-				'total-strokes domain))))
-	    (throw 'tag ret))))))
-
-;;;###autoload
-(defun char-total-strokes (char &optional preferred-domains)
-  (or (char-total-strokes-from-domains char preferred-domains)
-      (get-char-attribute char 'total-strokes)
-      (char-total-strokes-from-domains char char-db-feature-domains)))
 
 ;;;###autoload
 (defun update-ideograph-radical-table ()
   (interactive)
-  (let (ret radical script dest)
+  (let (ret rret radical script dest)
     (dolist (feature
 	     (cons 'ideographic-radical
-		   (mapcar
-		    (lambda (domain)
-		      (intern (format "%s@%s" 'ideographic-radical domain)))
-		    char-db-feature-domains)))
+		   (progn
+		     (dolist (feature (char-attribute-list))
+		       (if (string-match "^ideographic-radical@[^@*]+$"
+					 (symbol-name feature))
+			   (setq dest (cons feature dest))))
+		     dest)))
       (map-char-attribute
        (lambda (chr radical)
 	 (dolist (char (append
@@ -270,7 +57,11 @@
 				(unless (eq (get-char-attribute
 					     pc 'ideographic-radical)
 					    radical)
-				  (setq dest (cons pc dest))))
+				  (if (setq rret
+					    (get-char-attribute
+					     pc '<-subsumptive))
+				      (setq ret (append ret rret))
+				    (setq dest (cons pc dest)))))
 			      dest)
 			  (list chr))
 			(let ((rest (append
@@ -323,30 +114,38 @@
 		   (cons char ret))))))
      'ideographic-)))
 
+
 (defun int-list< (a b)
   (if (numberp (car a))
       (if (numberp (car b))
 	  (if (= (car a) (car b))
 	      (int-list< (cdr a)(cdr b))
 	    (< (car a) (car b)))
-	nil)
-    (numberp (car b))))
+	(if (= (car a) 0)
+	    nil
+	  (< (car a) 0)))
+    (if (numberp (car b))
+	(if (= (car b) 0)
+	    t
+	  (< 0 (car b)))
+      )))
 
 (defun morohashi-daikanwa< (a b)
   (if (integerp a)
       (setq a (list a)))
   (if (integerp b)
       (setq b (list b)))
-  (cond ((eq (car a) 'ho)
-	 (if (eq (car b) 'ho)
-	     (int-list< (cdr a)(cdr b))
+  (cond ((eq (car-safe a) 'ho)
+	 (if (eq (car-safe b) 'ho)
+	     (int-list< (cdr-safe a)(cdr-safe b))
 	   nil))
-	((numberp (car a))
+	((or (integerp a)
+	     (integerp (car a)))
 	 (if (eq (car b) 'ho)
 	     t
 	   (int-list< a b)))
 	(t
-	 (if (eq (car b) 'ho)
+	 (if (eq (car-safe b) 'ho)
 	     t
 	   (int-list< a b)))))
 
@@ -360,61 +159,86 @@
 ;;         ((null b) t)
 ;;         (t (< a b))))
 
+(defvar ideographic-radical nil)
+
 ;;;###autoload
 (defun char-representative-of-daikanwa (char &optional radical
-					     ignore-default dont-inherit)
+					     ignore-default checked)
   (unless radical
     (setq radical ideographic-radical))
-  (if (or (encode-char char 'ideograph-daikanwa 'defined-only)
-	  (encode-char char '=daikanwa-rev2 'defined-only))
-      char
-    (let ((m (char-feature char '=>daikanwa))
-	  m-m m-s pat
-	  ;;scs sc ret
-	  )
-      (or (and (integerp m)
-	       (or (decode-char '=daikanwa-rev2 m 'defined-only)
-		   (decode-char 'ideograph-daikanwa m)))
-	  (when (or m
-		    (setq m (get-char-attribute char 'morohashi-daikanwa)))
-	    (setq m-m (car m))
-	    (setq m-s (nth 1 m))
-	    (if (= m-s 0)
-		(or (decode-char '=daikanwa-rev2 m-m 'defined-only)
-		    (decode-char 'ideograph-daikanwa m-m))
-	      (when m
-		(setq pat (list m-m m-s))
-		(map-char-attribute (lambda (c v)
-				      (if (equal pat v)
-					  c))
-				    'morohashi-daikanwa))))
-	  (unless dont-inherit
-	    (map-char-family
-	     (lambda (sc)
-	       (let ((ret (char-representative-of-daikanwa sc nil t t)))
-		 (if (and ret
-			  (or (null radical)
-			      (eq (char-ideographic-radical ret radical)
-				  radical)))
-		     ret)))
-	     char))
-	  ;; (when (setq scs (append
-          ;;                  (get-char-attribute char '->subsumptive)
-          ;;                  (get-char-attribute char '->denotational)))
-          ;;   (while (and scs
-          ;;               (setq sc (car scs))
-          ;;               (not
-          ;;                (and
-          ;;                 (setq ret
-          ;;                       (char-representative-of-daikanwa sc nil t))
-          ;;                 (or (null radical)
-          ;;                     (eq (char-ideographic-radical ret radical)
-          ;;                         radical)
-          ;;                     (setq ret nil)))))
-          ;;     (setq scs (cdr scs)))
-          ;;   ret)
-	  (unless ignore-default
-	    char)))))
+  (if (or (null radical)
+          (eq (or (get-char-attribute char 'ideographic-radical)
+                  (char-ideographic-radical char radical t))
+              radical))
+      (let ((ret (or (encode-char char '=daikanwa@rev2 'defined-only)
+		     (encode-char char '=daikanwa/+p 'defined-only)
+                     (encode-char char '=daikanwa/+2p 'defined-only)
+                     (encode-char char '=daikanwa/ho 'defined-only)
+                     )))
+	(or (and ret char)
+	    (if (setq ret (get-char-attribute char 'morohashi-daikanwa))
+		(let ((m-m (car ret))
+		      (m-s (nth 1 ret))
+		      pat)
+		  (if (= m-s 0)
+		      (or (decode-char '=daikanwa@rev2 m-m 'defined-only)
+			  (decode-char '=daikanwa m-m))
+		    (or (cond ((eq m-m 'ho)
+			       (decode-char '=daikanwa/ho m-s))
+			      ((eq m-s 1)
+			       (decode-char '=daikanwa/+p m-m))
+			      ((eq m-s 2)
+			       (decode-char '=daikanwa/+2p m-m)))
+			(progn
+			  (setq pat (list m-m m-s))
+			  (map-char-attribute (lambda (c v)
+						(if (equal pat v)
+						    c))
+					      'morohashi-daikanwa))))))
+            (and (setq ret (get-char-attribute char '=>daikanwa))
+		 (if (numberp ret)
+		     (or (decode-char '=daikanwa@rev2 ret 'defined-only)
+			 (decode-char '=daikanwa ret))
+		   (map-char-attribute (lambda (c v)
+					 (if (equal ret v)
+					     char))
+				       'morohashi-daikanwa)))
+	    (unless (memq char checked)
+	      (catch 'tag
+		(let ((rest
+		       (append (get-char-attribute char '->subsumptive)
+			       (get-char-attribute char '->denotational)))
+		      (i 0)
+		      sc)
+		  (setq checked (cons char checked))
+		  (while rest
+		    (setq sc (car rest))
+		    (if (setq ret (char-representative-of-daikanwa
+				   sc radical t checked))
+			(throw 'tag ret))
+		    (setq checked (cons sc checked)
+			  rest (cdr rest)
+			  i (1+ i)))
+		  (setq rest (get-char-attribute char '->identical))
+		  (while rest
+		    (setq sc (car rest))
+		    (when (setq ret (char-representative-of-daikanwa
+				     sc radical t checked))
+		      (throw 'tag ret))
+		    (setq checked (cons sc checked)
+			  rest (cdr rest)))
+		  (setq rest
+			(append (get-char-attribute char '<-subsumptive)
+				(get-char-attribute char '<-denotational)))
+		  (while rest
+		    (setq sc (car rest))
+		    (when (setq ret (char-representative-of-daikanwa
+				     sc radical t checked))
+		      (throw 'tag ret))
+		    (setq checked (cons sc checked)
+			  rest (cdr rest))))))
+	    (unless ignore-default
+	      char)))))
 
 (defun char-attributes-poly< (c1 c2 accessors testers defaulters)
   (catch 'tag
@@ -446,53 +270,77 @@
 	      testers (cdr testers)
 	      defaulters (cdr defaulters))))))
 
-(defvar ideographic-radical nil)
+(defun char-daikanwa-radical (char &optional radical ignore-sisters)
+  (or (and (encode-char char '=daikanwa@rev2 'defined-only)
+	   (or (get-char-attribute char 'ideographic-radical@daikanwa)
+	       (get-char-attribute char 'ideographic-radical)))
+      (char-ideographic-radical char radical ignore-sisters)))
 
 (defun char-daikanwa-strokes (char &optional radical)
   (unless radical
     (setq radical ideographic-radical))
   (let ((drc (char-representative-of-daikanwa char radical))
 	(r (char-ideographic-radical char radical)))
-    (if (or (null r)
-	    (= (char-ideographic-radical drc radical) r))
+    (if (and drc
+	     (or (null r)
+		 (= (char-ideographic-radical drc radical) r)))
 	(setq char drc)))
   (char-ideographic-strokes char radical '(daikanwa)))
 
 ;;;###autoload
-(defun char-daikanwa (char &optional radical checked)
+(defun char-daikanwa (char &optional radical checked depth)
   (unless radical
     (setq radical ideographic-radical))
   (if (or (null radical)
           (eq (or (get-char-attribute char 'ideographic-radical)
-                  (char-ideographic-radical char radical t))
+                  (char-daikanwa-radical char radical t))
               radical))
-      (let ((ret (or (encode-char char 'ideograph-daikanwa 'defined-only)
-                     (encode-char char '=daikanwa-rev2 'defined-only)
-                     (get-char-attribute char 'morohashi-daikanwa)
-                     (get-char-attribute char '=>daikanwa))))
-        (or ret
+      (let ((ret (or (encode-char char '=daikanwa@rev2 'defined-only)
+                     ;; (encode-char char '=daikanwa 'defined-only)
+                     (get-char-attribute char 'morohashi-daikanwa))))
+	(unless ret
+	  (cond
+	   ((setq ret (encode-char char '=daikanwa/+p 'defined-only))
+	    (setq ret (list ret 1)))
+	   ((setq ret (encode-char char '=daikanwa/+2p 'defined-only))
+	    (setq ret (list ret 2)))
+	   ((setq ret (encode-char char '=daikanwa/ho 'defined-only))
+	    (setq ret (list 'ho ret)))))
+        (or (if ret
+		(if depth
+		    (if (integerp ret)
+			(list ret depth)
+		      (append ret (list depth)))
+		  ret))
+	    (and (setq ret (get-char-attribute char '=>daikanwa))
+		 (if (numberp ret)
+		     (list ret -10)
+		   (append ret '(-10))))
 	    (unless (memq char checked)
+	      (unless depth
+		(setq depth 0))
 	      (catch 'tag
 		(let ((rest
-		       (append (get-char-attribute char '<-subsumptive)
-			       (get-char-attribute char '<-denotational)))
+		       (append
+			(get-char-attribute char '->subsumptive)
+			(get-char-attribute char '->denotational)
+			(get-char-attribute char '->denotational@component)
+			))
 		      (i 0)
-		      sc)
+		      sc lnum)
 		  (setq checked (cons char checked))
 		  (while rest
 		    (setq sc (car rest))
-		    (when (setq ret (char-daikanwa sc radical checked))
-		      (throw 'tag
-			     (if (numberp ret)
-				 (list ret 0 i)
-			       (append ret (list i)))))
+		    (if (setq ret (char-daikanwa sc radical checked
+						 (1- depth)))
+			(throw 'tag ret))
 		    (setq checked (cons sc checked)
 			  rest (cdr rest)
 			  i (1+ i)))
 		  (setq rest (get-char-attribute char '->identical))
 		  (while rest
 		    (setq sc (car rest))
-		    (when (setq ret (char-daikanwa sc radical checked))
+		    (when (setq ret (char-daikanwa sc radical checked depth))
 		      (throw 'tag
 			     (if (numberp ret)
 				 (list ret 0)
@@ -500,31 +348,43 @@
 		    (setq checked (cons sc checked)
 			  rest (cdr rest)))
 		  (setq rest
-			(append (get-char-attribute char '->subsumptive)
-				(get-char-attribute char '->denotational)))
+			(append
+			 (get-char-attribute char '<-subsumptive)
+			 (get-char-attribute char '<-denotational)
+			 (get-char-attribute char '<-denotational@component)
+			 ))
 		  (while rest
 		    (setq sc (car rest))
-		    (if (setq ret (char-daikanwa sc radical checked))
-			(throw 'tag ret))
+		    (when (setq ret (char-daikanwa sc radical checked depth))
+		      (throw 'tag
+			     (if (numberp ret)
+				 (list ret 0 i)
+			       (if (>= (setq lnum (car (last ret))) 0)
+				   (append ret (list i))
+				 (nconc (butlast ret)
+					(list 0 (- lnum) i))))))
 		    (setq checked (cons sc checked)
 			  rest (cdr rest))))))))))
 
-;;;###autoload
-(defun char-ucs (char)
-  (or (encode-char char '=ucs 'defined-only)
-      (char-feature char '=>ucs)))
-
-(defun char-id (char)
-  (logand (char-int char) #x3FFFFFFF))
+(defun char-ideographic-strokes-diff (char &optional radical)
+  (if (or (get-char-attribute char '<-subsumptive)
+	  (get-char-attribute char '<-denotational))
+      (let (s ds)
+	(when (and (setq s (char-ideographic-strokes char radical))
+		   (setq ds (char-daikanwa-strokes char radical)))
+	  (abs (- s ds))))
+    0))
 
+;;;###autoload
 (defun ideograph-char< (a b &optional radical)
   (let ((ideographic-radical (or radical
 				 ideographic-radical)))
     (char-attributes-poly<
      a b
-     '(char-daikanwa-strokes char-daikanwa char-ucs char-id)
-     '(< morohashi-daikanwa< < <)
-     '(> > > >))))
+     '(char-daikanwa-strokes char-daikanwa char-ucs
+			     char-ideographic-strokes-diff char-id)
+     '(< morohashi-daikanwa< < < <)
+     '(> > > > >))))
 
 (defun insert-ideograph-radical-char-data (radical)
   (let ((chars
@@ -558,7 +418,8 @@
 
 (defun write-ideograph-radical-char-data (radical file)
   (if (file-directory-p file)
-      (let ((name (get-char-attribute (int-char (+ #x2EFF radical)) 'name)))
+      (let ((name (char-feature (decode-char 'ucs (+ #x2EFF radical))
+				'name)))
 	(if (string-match "KANGXI RADICAL " name)
 	    (setq name (capitalize (substring name (match-end 0)))))
 	(setq name (mapconcat (lambda (char)
@@ -570,11 +431,11 @@
 	       (format "Ideograph-R%03d-%s.el" radical name)
 	       file))))
   (with-temp-buffer
-    (insert ";; -*- coding: utf-8-mcs -*-\n")
+    (insert (format ";; -*- coding: %s -*-\n"
+		    char-db-file-coding-system))
     (insert-ideograph-radical-char-data radical)
-    (let ((coding-system-for-write 'utf-8-mcs))
-      (write-region (point-min)(point-max) file)
-      )))
+    (let ((coding-system-for-write char-db-file-coding-system))
+      (write-region (point-min)(point-max) file))))
 
 (defun ideographic-structure= (char1 char2)
   (if (char-ref-p char1)
@@ -616,39 +477,6 @@
 			      char)))
 			'ideographic-structure)))
 
-;;;###autoload
-(defun chise-string< (string1 string2 accessors)
-  (let ((len1 (length string1))
-	(len2 (length string2))
-	len
-	(i 0)
-	c1 c2
-	rest func
-	v1 v2)
-    (setq len (min len1 len2))
-    (catch 'tag
-      (while (< i len)
-	(setq c1 (aref string1 i)
-	      c2 (aref string2 i))
-	(setq rest accessors)
-	(while (and rest
-		    (setq func (car rest))
-		    (setq v1 (funcall func c1)
-			  v2 (funcall func c2))
-		    (eq v1 v2))
-	  (setq rest (cdr rest)))
-	(if v1
-	    (if v2
-		(cond ((< v1 v2)
-		       (throw 'tag t))
-		      ((> v1 v2)
-		       (throw 'tag nil)))
-	      (throw 'tag nil))
-	  (if v2
-	      (throw 'tag t)))
-	(setq i (1+ i)))
-      (< len1 len2))))
-
 
 (provide 'ideograph-util)