;;; ideograph-util.el --- Ideographic Character Database utility
-;; Copyright (C) 1999,2000 MORIOKA Tomohiko.
+;; Copyright (C) 1999,2000,2001 MORIOKA Tomohiko.
;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
;; Keywords: UTF-2000, ISO/IEC 10646, Unicode, UCS-4, MULE.
-;; This file is part of UTF-2000.
+;; This file is part of XEmacs UTF-2000.
-;; UTF-2000 is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; XEmacs UTF-2000 is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
-;; UTF-2000 is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; XEmacs UTF-2000 is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with XEmacs; see the file COPYING. If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
+;; along with XEmacs UTF-2000; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Code:
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))
(aset ideograph-radical-chars-vector radical
(cons char ret))))
(setq i (1+ i)))
+ (setq i 1)
+ (while (<= i 66773)
+ (setq char (decode-char 'ideograph-gt i))
+ (if (and (setq radical (char-ideographic-radical char))
+ (not
+ (memq char
+ (setq ret
+ (aref ideograph-radical-chars-vector radical)))))
+ (aset ideograph-radical-chars-vector radical
+ (cons char ret)))
+ (setq i (1+ i)))
(setq i 0)
(while (< i 50101)
(setq char (decode-char 'ideograph-daikanwa i))
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))
(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)))
(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)))
(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
(if a-u
(if b-u
(< a-u b-u)
- (setq b-u (get-char-attribute b '->ucs))
+ (setq b-u (or (get-char-attribute b '=>ucs)
+ (get-char-attribute b '->ucs)))
(if b-u
(<= a-u b-u)
t))
- (setq a-u (get-char-attribute a '->ucs))
+ (setq a-u (or (get-char-attribute a '=>ucs)
+ (get-char-attribute a '->ucs)))
(if a-u
(if b-u
(< a-u b-u)
- (setq b-u (get-char-attribute b '->ucs))
+ (setq b-u (or (get-char-attribute b '=>ucs)
+ (get-char-attribute b '->ucs)))
(if b-u
(< a-u b-u)
t))
- (if (or b-u (get-char-attribute b '->ucs))
+ (if (or b-u (or (get-char-attribute b '=>ucs)
+ (get-char-attribute b '->ucs)))
nil
(< (char-int a)(char-int b)))))))
(< a-s b-s))
t))))
-;; (defun ideograph-char< (a b)
-;; (let (ra rb mma mmb msa msb)
-;; (cond
-;; ((progn
-;; (if (setq ra (or (get-char-attribute a 'non-morohashi)
-;; (get-char-attribute a 'morohashi-daikanwa)))
-;; (setq msa (cdr ra)
-;; mma (car ra))
-;; (setq mma (get-char-attribute a 'ideograph-daikanwa))))
-;; (cond
-;; ((progn
-;; (if (setq rb (or (get-char-attribute b 'non-morohashi)
-;; (get-char-attribute b 'morohashi-daikanwa)))
-;; (setq msb (cdr rb)
-;; mmb (car rb))
-;; (setq mmb (get-char-attribute b 'ideograph-daikanwa))))
-;; (cond
-;; ((= mma mmb)
-;; (cond ((eq (car msa)(car msb))
-;; (cond ((< (length msa)(length msb)))
-;; ((= (length msa)(length msb))
-;; (cond ((integerp (nth 1 msa))
-;; (cond ((integerp (nth 1 msb))
-;; (< (nth 1 msa)(nth 1 msb)))
-;; (t nil)))
-;; (t
-;; (cond ((setq ra (get-char-attribute a 'ucs))
-;; (cond
-;; ((setq rb (get-char-attribute b 'ucs))
-;; (< ra rb))
-;; (t))))))))
-;; )
-;; ((null (car msa)))
-;; ((null (car msb))
-;; nil)
-;; (t (< (car msa)(car msb)))))
-;; (t (< mma mmb))))
-;; (t)))
-;; ((or (get-char-attribute b 'non-morohashi)
-;; (get-char-attribute b 'morohashi-daikanwa)
-;; (get-char-attribute b 'ideograph-daikanwa))
-;; nil)
-;; ((setq ra (get-char-attribute a 'ucs))
-;; (cond
-;; ((setq rb (get-char-attribute b 'ucs))
-;; (< ra rb))))
-;; (t
-;; (cond
-;; ((setq ra (char-ideographic-strokes a))
-;; (cond ((setq rb (char-ideographic-strokes b))
-;; (cond ((= ra rb)
-;; (not (char-ideographic-strokes b)))
-;; ((< ra rb))))))
-;; )))))
-
(defun insert-ideograph-radical-char-data (radical)
(let ((chars
(sort (copy-list (aref ideograph-radical-chars-vector radical))