X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Futf-2000%2Fideograph-util.el;h=70f41714285558c1d155592b934864f9ef8ee114;hb=341b931fa7ec4177794ad4ee2089fde2c5ec3c36;hp=4f0021bbcbf15ddbacecd658861a261c46aebc09;hpb=d130d690c36e57cd6bf2fa7ef01bcf0e6262cec6;p=chise%2Fxemacs-chise.git.1

diff --git a/lisp/utf-2000/ideograph-util.el b/lisp/utf-2000/ideograph-util.el
index 4f0021b..70f4171 100644
--- a/lisp/utf-2000/ideograph-util.el
+++ b/lisp/utf-2000/ideograph-util.el
@@ -1,7 +1,7 @@
 ;;; ideograph-util.el --- Ideographic Character Database utility
 
 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007, 2008,
-;;   2009, 2010 MORIOKA Tomohiko.
+;;   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.
@@ -170,25 +170,35 @@
           (eq (or (get-char-attribute char 'ideographic-radical)
                   (char-ideographic-radical char radical t))
               radical))
-      (let ((ret (or (encode-char char 'ideograph-daikanwa 'defined-only)
-                     (encode-char char '=daikanwa-rev2 'defined-only))))
+      (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 'ideograph-daikanwa m-m))
-		    (setq pat (list m-m m-s))
-		    (map-char-attribute (lambda (c v)
-					  (if (equal pat v)
-					      c))
-					'morohashi-daikanwa))))
+		      (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 'ideograph-daikanwa ret))
+		     (or (decode-char '=daikanwa@rev2 ret 'defined-only)
+			 (decode-char '=daikanwa ret))
 		   (map-char-attribute (lambda (c v)
 					 (if (equal ret v)
 					     char))
@@ -260,13 +270,20 @@
 	      testers (cdr testers)
 	      defaulters (cdr defaulters))))))
 
+(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)))
 
@@ -276,11 +293,19 @@
     (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)
+      (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)
@@ -289,15 +314,18 @@
 		  ret))
 	    (and (setq ret (get-char-attribute char '=>daikanwa))
 		 (if (numberp ret)
-		     (list ret 0 8)
-		   (append ret '(8))))
+		     (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 lnum)
 		  (setq checked (cons char checked))
@@ -320,8 +348,11 @@
 		    (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))
 		    (when (setq ret (char-daikanwa sc radical checked depth))