From 9b710aef5540ef8db1dec890dc94da125b2f576f Mon Sep 17 00:00:00 2001
From: tomo <tomo>
Date: Thu, 7 Jul 2005 13:41:12 +0000
Subject: [PATCH] (ideographic-radical): New function. (shuowen-radicals): New
 constant. (shuowen-radical): New function.
 (char-db-insert-char-reference): Use function
 `ideographic-radical' to avoid to refer
 `ideographic-radicals'. (insert-char-attributes): Likewise;
 add code to format char-feature `shuowen-radical'.
 (insert-char-attributes): Don't display `->formed' when
 running with non-readable mode.

---
 lisp/utf-2000/char-db-util.el |   36 +++++++++++++++++++++++++++---------
 1 file changed, 27 insertions(+), 9 deletions(-)

diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el
index eaab82e..7e9a87d 100644
--- a/lisp/utf-2000/char-db-util.el
+++ b/lisp/utf-2000/char-db-util.el
@@ -1,9 +1,9 @@
-;;; char-db-util.el --- Character Database utility
+;;; char-db-util.el --- Character Database utility -*- coding: utf-8-er; -*-
 
 ;; Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2005 MORIOKA Tomohiko.
 
 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
-;; Keywords: CHISE, Character Database, ISO/IEC 10646, Unicode, UCS-4, MULE.
+;; Keywords: CHISE, Character Database, ISO/IEC 10646, UCS, Unicode, MULE.
 
 ;; This file is part of XEmacs CHISE.
 
@@ -69,6 +69,15 @@
       (setq i (1+ i)))
     v))
 
+(defun ideographic-radical (number)
+  (aref ideographic-radicals number))
+
+(defconst shuowen-radicals
+  [?一 ?上 ?示 ?三 ?王 ?玉 ?玨 ?气 ?士 ?丨 ?屮 ?艸 ?茻])
+
+(defun shuowen-radical (number)
+  (aref shuowen-radicals (1- number)))
+
 (defvar char-db-file-coding-system 'utf-8-mcs-er)
 
 (defvar char-db-feature-domains
@@ -359,7 +368,7 @@
 	     (insert (format "%s%s\t%d ; %c%s"
 			     separator
 			     name value
-			     (aref ideographic-radicals value)
+			     (ideographic-radical value)
 			     line-breaking))
 	     (setq separator ""))
             (t
@@ -620,10 +629,18 @@
       (setq radical value)
       (insert (format "(ideographic-radical . %S)\t; %c%s"
 		      radical
-		      (aref ideographic-radicals radical)
+		      (ideographic-radical radical)
 		      line-breaking))
       (setq attributes (delq 'ideographic-radical attributes))
       )
+    (when (and (memq 'shuowen-radical attributes)
+	       (setq value (get-char-attribute char 'shuowen-radical)))
+      (insert (format "(shuowen-radical\t. %S)\t; %c%s"
+		      value
+		      (shuowen-radical value)
+		      line-breaking))
+      (setq attributes (delq 'shuowen-radical attributes))
+      )
     (let (key)
       (dolist (domain
 	       (append
@@ -645,7 +662,7 @@
 	  (insert (format "(%s . %S)\t; %c%s"
 			  key
 			  radical
-			  (aref ideographic-radicals radical)
+			  (ideographic-radical radical)
 			  line-breaking))
 	  (setq attributes (delq key attributes))
 	  )
@@ -695,7 +712,7 @@
       (unless (eq value radical)
 	(insert (format "(kangxi-radical\t . %S)\t; %c%s"
 			value
-			(aref ideographic-radicals value)
+			(ideographic-radical value)
 			line-breaking))
 	(or radical
 	    (setq radical value)))
@@ -716,7 +733,7 @@
       (unless (eq value radical)
 	(insert (format "(japanese-radical\t . %S)\t; %c%s"
 			value
-			(aref ideographic-radicals value)
+			(ideographic-radical value)
 			line-breaking))
 	(or radical
 	    (setq radical value)))
@@ -736,7 +753,7 @@
 	       (setq value (get-char-attribute char 'cns-radical)))
       (insert (format "(cns-radical\t . %S)\t; %c%s"
 		      value
-		      (aref ideographic-radicals value)
+		      (ideographic-radical value)
 		      line-breaking))
       (setq attributes (delq 'cns-radical attributes))
       )
@@ -755,7 +772,7 @@
       (unless (eq value radical)
 	(insert (format "(shinjigen-1-radical . %S)\t; %c%s"
 			value
-			(aref ideographic-radicals value)
+			(ideographic-radical value)
 			line-breaking))
 	(or radical
 	    (setq radical value)))
@@ -907,6 +924,7 @@
 			  (string-match "^->vulgar" (symbol-name name))
 			  (string-match "^->wrong" (symbol-name name))
 			  (string-match "^->same" (symbol-name name))
+			  (string-match "^->formed" (symbol-name name))
 			  (string-match "^->original" (symbol-name name))
 			  (string-match "^->ancient" (symbol-name name))
 			  (string-match "^->Oracle-Bones" (symbol-name name))
-- 
1.7.10.4