From 4039e7d16e1751656ab1b8ee8fe029594439f2db Mon Sep 17 00:00:00 2001 From: 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 ;; 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