From 4039e7d16e1751656ab1b8ee8fe029594439f2db Mon Sep 17 00:00:00 2001
From: tomo <tomo>
Date: Fri, 4 Jun 2010 10:10:02 +0000
Subject: [PATCH] Require `chise-subr'. (ideograph-radical-strokes-vector):
 New variable [moved from ideograph-util.el].
 (char-ideographic-strokes): New function [moved from
 ideograph-util.el]. (char-total-strokes-from-domains):
 Ditto. (char-total-strokes): Ditto.

---
 lisp/utf-2000/ideograph-subr.el |   89 ++++++++++++++++++++++++++++++++++++++-
 1 file changed, 87 insertions(+), 2 deletions(-)

diff --git a/lisp/utf-2000/ideograph-subr.el b/lisp/utf-2000/ideograph-subr.el
index c8344ac..3addab5 100644
--- a/lisp/utf-2000/ideograph-subr.el
+++ b/lisp/utf-2000/ideograph-subr.el
@@ -1,7 +1,7 @@
 ;;; ideograph-subr.el --- basic lisp subroutines about Ideographs -*- coding: utf-8-er; -*-
 
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-;;   2007, 2008, 2009, 2010 MORIOKA Tomohiko.
+;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2010
+;;   MORIOKA Tomohiko.
 
 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
 ;; Keywords: CHISE, Character Database, ISO/IEC 10646, UCS, Unicode, MULE.
@@ -25,6 +25,9 @@
 
 ;;; Code:
 
+(require 'chise-subr)
+
+
 ;;; @ radical code
 ;;;
 
@@ -67,6 +70,9 @@
    char ignore-sisters))
 
 
+;;; @@ radical
+;;;
+
 (defun char-ideographic-radical (char &optional radical ignore-sisters)
   (let (ret)
     (or (if radical
@@ -106,6 +112,9 @@
 	    ret)))))
 
 
+;;; @@ strokes of non-radical parts
+;;;
+
 ;;;###autoload
 (defun char-ideographic-strokes-from-domains (char domains &optional radical)
   (if radical
@@ -113,6 +122,82 @@
 				     'ideographic-radical radical)
     (get-char-feature-from-domains char 'ideographic-strokes domains)))
 
+(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 (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)))))
+
+
+;;; @@ total-strokes
+;;;
+
+;;;###autoload
+(defun char-total-strokes-from-domains (char domains)
+  (let (ret)
+    (catch 'tag
+      (dolist (domain domains)
+	(if (setq ret (char-feature
+		       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)
+      (char-feature char 'total-strokes)
+      (char-total-strokes-from-domains char char-db-feature-domains)))
 
 
 ;;; @ end
-- 
1.7.10.4