X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Futf-2000%2Fideograph-util.el;h=a03cf1217dae24d95610d9f46f633e86e3905a45;hb=a2bc237c12cced56e7b6235c8ffcddbe812dd4bc;hp=7c1a46212d9ac5831d4dc643cdf1134af88463a1;hpb=5a98616f90a5c4f53c1863f0762673ab5ef57b63;p=chise%2Fxemacs-chise.git diff --git a/lisp/utf-2000/ideograph-util.el b/lisp/utf-2000/ideograph-util.el index 7c1a462..a03cf12 100644 --- a/lisp/utf-2000/ideograph-util.el +++ b/lisp/utf-2000/ideograph-util.el @@ -1,6 +1,6 @@ ;;; ideograph-util.el --- Ideographic Character Database utility -;; Copyright (C) 1999,2000 MORIOKA Tomohiko. +;; Copyright (C) 1999,2000,2001 MORIOKA Tomohiko. ;; Author: MORIOKA Tomohiko ;; Keywords: UTF-2000, ISO/IEC 10646, Unicode, UCS-4, MULE. @@ -51,27 +51,27 @@ 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 4 5 5 5 5 5 + 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 - 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 8 8 - 8 8 8 8 8 8 9 9 9 9 - 9 9 9 9 9 9 9 10 10 10 + 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]) (defun char-ideographic-strokes (char) - (or (get-char-attribute char 'ideographic-strokes) + (or (get-char-attribute char 'daikanwa-strokes) + (get-char-attribute char 'ideographic-strokes) (let ((strokes - (or (get-char-attribute char 'daikanwa-strokes) - (get-char-attribute char 'kangxi-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)) @@ -185,12 +185,26 @@ nil) (numberp (car b)))) +(defun morohashi-daikanwa< (a b) + (cond ((eq (car a) 'ho) + (if (eq (car b) 'ho) + (int-list< (cdr a)(cdr b)) + nil)) + ((numberp (car a)) + (if (eq (car b) 'ho) + t + (int-list< a b))) + (t + (if (eq (car b) 'ho) + t + (int-list< a b))))) + (defun ideograph-char< (a b) (let ((a-m-m (get-char-attribute a 'ideograph-daikanwa)) (b-m-m (get-char-attribute b 'ideograph-daikanwa)) a-m-r b-m-r a-s b-s - a-u b-u m) + a-u b-u m ret) (if a-m-m (setq a-s (char-ideographic-strokes a)) (setq a-m-r (get-char-attribute a 'morohashi-daikanwa)) @@ -199,8 +213,12 @@ (setq a-m-m (car a-m-r) a-m-r (cdr a-m-r)) (if (= (car a-m-r) 0) - (setq a-s (char-ideographic-strokes - (decode-char 'ideograph-daikanwa a-m-m))) + (progn + (setq ret (decode-char 'ideograph-daikanwa a-m-m)) + (if (= (get-char-attribute ret 'ideographic-radical) + (get-char-attribute a 'ideographic-radical)) + (setq a-s (char-ideographic-strokes ret)) + (setq a-s (char-ideographic-strokes a)))) (if (setq m (get-char-attribute a '->mojikyo)) (setq a-s (char-ideographic-strokes (decode-char 'mojikyo m))) @@ -214,8 +232,12 @@ (setq b-m-m (car b-m-r) b-m-r (cdr b-m-r)) (if (= (car b-m-r) 0) - (setq b-s (char-ideographic-strokes - (decode-char 'ideograph-daikanwa b-m-m))) + (progn + (setq ret (decode-char 'ideograph-daikanwa b-m-m)) + (if (= (get-char-attribute ret 'ideographic-radical) + (get-char-attribute b 'ideographic-radical)) + (setq b-s (char-ideographic-strokes ret)) + (setq b-s (char-ideographic-strokes b)))) (if (setq m (get-char-attribute b '->mojikyo)) (setq b-s (char-ideographic-strokes (decode-char 'mojikyo m))) @@ -226,8 +248,8 @@ (if (= a-s b-s) (if a-m-m (if b-m-m - (int-list< (cons a-m-m a-m-r) - (cons b-m-m b-m-r)) + (morohashi-daikanwa< (cons a-m-m a-m-r) + (cons b-m-m b-m-r)) t) (if b-m-m nil