From: tomo <tomo>
Date: Fri, 4 Jun 2010 10:10:02 +0000 (+0000)
Subject: Require `chise-subr'.
X-Git-Tag: chise-base-0_25^20~6
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=4039e7d16e1751656ab1b8ee8fe029594439f2db;p=chise%2Fxemacs-chise.git-

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.
---

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