From: tomo <tomo>
Date: Thu, 3 Sep 2009 11:01:56 +0000 (+0000)
Subject: (int-list<): Support minus values.
X-Git-Tag: r21-4-22-chise-0_24-jis-x0213-rep-diffs^20~275
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=91df9567daac043925ff6ca177ab53a58cd80ab8;p=chise%2Fxemacs-chise.git

(int-list<): Support minus values.
(morohashi-daikanwa<): Support notation for abstract characters and
their children.
(char-daikanwa): New optional argument `depth'; return (nnnnn -depth),
(nnnnn d -depth) or (ho nnnnn -depth) for abstract object.
---

diff --git a/lisp/utf-2000/ideograph-util.el b/lisp/utf-2000/ideograph-util.el
index 18f6f4d..3f1aae5 100644
--- a/lisp/utf-2000/ideograph-util.el
+++ b/lisp/utf-2000/ideograph-util.el
@@ -281,24 +281,31 @@
 	  (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)))))
 
@@ -424,7 +431,7 @@
   (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)
@@ -434,22 +441,30 @@
       (let ((ret (or (encode-char char 'ideograph-daikanwa 'defined-only)
                      (encode-char char '=daikanwa-rev2 'defined-only)
                      (get-char-attribute char 'morohashi-daikanwa))))
-        (or 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 0 8)
 		   (append ret '(8))))
 	    (unless (memq char checked)
+	      (unless depth
+		(setq depth 0))
 	      (catch 'tag
 		(let ((rest
 		       (append (get-char-attribute char '->subsumptive)
 			       (get-char-attribute char '->denotational)))
 		      (i 0)
-		      sc)
+		      sc lnum)
 		  (setq checked (cons char checked))
 		  (while rest
 		    (setq sc (car rest))
-		    (if (setq ret (char-daikanwa sc radical checked))
+		    (if (setq ret (char-daikanwa sc radical checked
+						 (1- depth)))
 			(throw 'tag ret))
 		    (setq checked (cons sc checked)
 			  rest (cdr rest)
@@ -457,7 +472,7 @@
 		  (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)
@@ -469,11 +484,14 @@
 				(get-char-attribute char '<-denotational)))
 		  (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 i)
-			       (append ret (list 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))))))))))