X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Futf-2000%2Fchar-db-util.el;h=3113bde359648b83ef7a66873ab9e1fe9eae8201;hp=6066a2972eb1643076744df128d6d7719432ab1c;hb=3bcced00929f35213211bb328e20d71cd862e44a;hpb=c160ed701e7f9e16bd130927252b62493b5fe0a4 diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el index 6066a29..3113bde 100644 --- a/lisp/utf-2000/char-db-util.el +++ b/lisp/utf-2000/char-db-util.el @@ -1,7 +1,7 @@ ;;; char-db-util.el --- Character Database utility -*- coding: utf-8-er; -*- -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, -;; 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 MORIOKA Tomohiko. +;; Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2005,2006,2007, +;; 2008,2009,2010,2011,2012,2013,2014,2015,2016,2017,2018 MORIOKA Tomohiko. ;; Author: MORIOKA Tomohiko ;; Keywords: CHISE, Character Database, ISO/IEC 10646, UCS, Unicode, MULE. @@ -103,6 +103,7 @@ ?屾 ?屵 ?广 ?厂 ?丸 ?危 ?石 ?長 ?勿 ?冄 ; 360 ?而 ?豕 ?㣇 ?彑 ?豚 ?豸 ?𤉡 ?易 ?象 ?馬 ; 370 ?𢊁 ?鹿 ?麤 ?㲋 ?兔 ?萈 ?犬 ?㹜 ?鼠 ?能 ; 380 + ?熊 ?火 ?炎 ?黑 ?囪 ?焱 ?炙 ?赤 ?大 ?亦 ; 390 ]) (defun shuowen-radical (number) @@ -167,6 +168,7 @@ =hanyo-denshi/hg =hanyo-denshi/jt =hanyo-denshi/ks + =hanyo-denshi/tk ;; ==mj ;; ==adobe-japan1-0 ;; ==adobe-japan1-1 @@ -178,19 +180,23 @@ ==jis-x0208 ==jis-x0213-1 ==jis-x0213-2 + ==jis-x0212 ==hanyo-denshi/ja ==hanyo-denshi/jb ==hanyo-denshi/jc ==hanyo-denshi/ft + ==hanyo-denshi/ia ==hanyo-denshi/ib ==hanyo-denshi/hg ==hanyo-denshi/jt ==hanyo-denshi/ks + ==hanyo-denshi/tk =gt =gt-k =daikanwa =daikanwa@rev2 =daikanwa@rev1 + =daikanwa/+p ==daikanwa =cbeta ideograph-hanziku-1 @@ -261,7 +267,8 @@ =>jis-x0213-1@2004 =>jis-x0213-2 ==>ucs@bucs - =>ucs@hanyo-denshi + =>iwds-1 + ;; =>ucs@hanyo-denshi =>ucs@iso =>ucs@unicode =>ucs@jis @@ -294,7 +301,7 @@ ==gt ==jis-x0208@1990 ;; ==jis-x0208@1983 - ;; ==jis-x0208@1978 + ==jis-x0208@1978 ==gt-k =ucs@iso =ucs@unicode @@ -304,10 +311,13 @@ =>>big5-cdp =>>gt-k =+>gt + =+>big5-cdp =>gt + =>mj =>big5-cdp =>daikanwa =>daikanwa/ho + =>cns11643-5 =>cns11643-7 =big5 =big5-eten @@ -320,8 +330,53 @@ =jef-china3 =>cbeta =shinjigen - =big5-cdp-var-3 - =big5-cdp-var-5)) + =ucs-var-001 + =ucs-var-002 + =ucs-var-003 + =ucs-var-004 + =ucs-var-005 + =ucs-var-006 + =ucs-var-008 + =ucs-var-010 + =ucs-itaiji-001 + =ucs-itaiji-002 + =ucs-itaiji-003 + =ucs-itaiji-004 + =ucs-itaiji-005 + =ucs-itaiji-006 + =ucs-itaiji-007 + =ucs-itaiji-008 + =ucs-itaiji-009 + =ucs-itaiji-010 + =ucs-itaiji-011 + =>ucs-itaiji-001 + =>ucs-itaiji-002 + =>ucs-itaiji-003 + =>ucs-itaiji-004 + =>ucs-itaiji-005 + =>ucs-itaiji-006 + =>ucs-itaiji-007 + =>ucs-itaiji-009 + =big5-cdp-var-001 + =big5-cdp-var-002 + =big5-cdp-var-003 + =big5-cdp-var-004 + =big5-cdp-var-005 + =big5-cdp-var-010 + =big5-cdp-itaiji-001 + =big5-cdp-itaiji-002 + =big5-cdp-itaiji-003 + =>big5-cdp-itaiji-001 + =>ucs@iwds-1 + =>ucs@cognate + =>ucs@component + =>ucs-itaiji-001@iwds-1 + =>big5-cdp@component + =>big5-cdp@cognate + ==ucs@gb + =ucs@gb + ==ucs-var-002 + =ucs@JP/hanazono)) ;;; @ char-db formatters @@ -425,7 +480,8 @@ ;; =gt-k =jis-x0208@1997 )) - (eq (charset-property ccs 'iso-ir) 177) + (and (eq (charset-property ccs 'iso-ir) 177) + (not (eq (charset-name ccs) '=ucs@big5))) ;; (string-match "=ucs@" (symbol-name ccs)) ) (setq ccs (charset-name ccs)) @@ -619,7 +675,10 @@ (decode-builtin-char '=gt ret)) (t (decode-builtin-char ccs code-point)))) - (cond ((and (<= 0 (char-int ret)) + (cond ((null ret) + (or (decode-char ccs code-point) + (define-char (list (cons ccs code-point))))) + ((and (<= 0 (char-int ret)) (<= (char-int ret) #x1F)) (decode-char '=ucs (+ #x2400 (char-int ret)))) ((= (char-int ret) #x7F) @@ -634,7 +693,8 @@ (insert (format (cond - ((memq name '(==shinjigen + ((memq name '(=>iwds-1 + ==shinjigen =shinjigen =shinjigen@1ed ==shinjigen@1ed =shinjigen@rev ==shinjigen@rev @@ -644,42 +704,60 @@ "(%-18s . %04d)\t; %c") ((eq name '=shinjigen@1ed/24pr) "(%-18s . %04d)\t; %c") - ((or (memq name '(===daikanwa - ==daikanwa =daikanwa =>>daikanwa =>daikanwa - =daikanwa@rev1 =daikanwa@rev2 - =daikanwa/+p ==daikanwa/+p ===daikanwa/+p - =>>daikanwa/+p - =daikanwa/+2p =>>daikanwa/+2p - =gt ==gt ===gt - =>>gt =+>gt =>gt - =gt-k ==gt-k ===gt-k - =>>gt-k =>gt-k - =adobe-japan1-0 ==adobe-japan1-0 ===adobe-japan1-0 - =adobe-japan1-1 ==adobe-japan1-1 ===adobe-japan1-1 - =adobe-japan1-2 ==adobe-japan1-2 ===adobe-japan1-2 - =adobe-japan1-3 ==adobe-japan1-3 ===adobe-japan1-3 - =adobe-japan1-4 ==adobe-japan1-4 ===adobe-japan1-4 - =adobe-japan1-5 ==adobe-japan1-5 ===adobe-japan1-5 - =adobe-japan1-6 ==adobe-japan1-6 ===adobe-japan1-6 - =>>adobe-japan1-0 =+>adobe-japan1-0 - =>>adobe-japan1-1 =+>adobe-japan1-1 - =>>adobe-japan1-2 =+>adobe-japan1-2 - =>>adobe-japan1-3 =+>adobe-japan1-3 - =>>adobe-japan1-4 =+>adobe-japan1-4 - =>>adobe-japan1-5 =+>adobe-japan1-5 - =>>adobe-japan1-6 =+>adobe-japan1-6 - =>cbeta =cbeta =>>cbeta ==cbeta ===cbeta - =zinbun-oracle =>zinbun-oracle)) - ;; (string-match "^=adobe-" (symbol-name name)) - ) + ((or + (memq name + '(===daikanwa + ==daikanwa =daikanwa =>>daikanwa =>daikanwa + =daikanwa@rev1 =daikanwa@rev2 + =daikanwa/+p ==daikanwa/+p ===daikanwa/+p + =>>daikanwa/+p + =daikanwa/+2p =>>daikanwa/+2p + =gt ==gt ===gt + =>>gt =+>gt =>gt + =gt-k ==gt-k ===gt-k + =>>gt-k =>gt-k + =adobe-japan1-0 ==adobe-japan1-0 ===adobe-japan1-0 + =adobe-japan1-1 ==adobe-japan1-1 ===adobe-japan1-1 + =adobe-japan1-2 ==adobe-japan1-2 ===adobe-japan1-2 + =adobe-japan1-3 ==adobe-japan1-3 ===adobe-japan1-3 + =adobe-japan1-4 ==adobe-japan1-4 ===adobe-japan1-4 + =adobe-japan1-5 ==adobe-japan1-5 ===adobe-japan1-5 + =adobe-japan1-6 ==adobe-japan1-6 ===adobe-japan1-6 + =>>adobe-japan1-0 =+>adobe-japan1-0 + =>>adobe-japan1-1 =+>adobe-japan1-1 + =>>adobe-japan1-2 =+>adobe-japan1-2 + =>>adobe-japan1-3 =+>adobe-japan1-3 + =>>adobe-japan1-4 =+>adobe-japan1-4 + =>>adobe-japan1-5 =+>adobe-japan1-5 + =>>adobe-japan1-6 =+>adobe-japan1-6 + =>cbeta =cbeta =>>cbeta ==cbeta ===cbeta + =zinbun-oracle =>zinbun-oracle + ===hng-jou ===hng-keg ===hng-dng ===hng-mam + ===hng-drt ===hng-kgk ===hng-myz ===hng-kda + ===hng-khi ===hng-khm ===hng-hok ===hng-kyd ===hng-sok + ===hng-yhk ===hng-kak ===hng-kar ===hng-kae + ===hng-sys ===hng-tsu ===hng-tzj + ===hng-hos ===hng-nak ===hng-jhk + ===hng-hod ===hng-gok ===hng-ink ===hng-nto + ===hng-nkm ===hng-k24 ===hng-nkk + ===hng-kcc ===hng-kcj ===hng-kbk ===hng-sik + ===hng-skk ===hng-kyu ===hng-ksk ===hng-wan + ===hng-okd ===hng-wad ===hng-kmi + ===hng-zkd ===hng-doh ===hng-jyu + ===hng-tzs ===hng-kss ===hng-kyo + ===hng-smk)) + ;; (string-match "^=adobe-" (symbol-name name)) + ) "(%-18s . %05d)\t; %c") ((memq name '(=hanyo-denshi/ks ==hanyo-denshi/ks ===hanyo-denshi/ks =>>hanyo-denshi/ks - =koseki - =mj ==mj ===mj =>>mj + =koseki ==koseki + =mj ==mj ===mj =>>mj =>mj =zihai mojikyo)) "(%-18s . %06d)\t; %c") + ((memq name '(=hanyo-denshi/tk ==hanyo-denshi/tk)) + "(%-18s . %08d)\t; %c") ((>= (charset-dimension name) 2) "(%-18s . #x%04X)\t; %c") (t @@ -854,6 +932,12 @@ line-breaking ccss readable) (setq attributes (delq '<-denotational attributes))) + (when (and (memq '<-denotational@component attributes) + (setq value (get-char-attribute char '<-denotational@component))) + (char-db-insert-relation-feature char '<-denotational@component value + line-breaking + ccss readable) + (setq attributes (delq '<-denotational@component attributes))) (when (and (memq 'name attributes) (setq value (get-char-attribute char 'name))) (insert (format @@ -1103,17 +1187,17 @@ (setq strokes value))) (setq attributes (delq 'kangxi-strokes attributes)) ) - (when (and (memq 'japanese-radical attributes) - (setq value (get-char-attribute char 'japanese-radical))) - (unless (eq value radical) - (insert (format "(japanese-radical\t . %S)\t; %c%s" - value - (ideographic-radical value) - line-breaking)) - (or radical - (setq radical value))) - (setq attributes (delq 'japanese-radical attributes)) - ) + ;; (when (and (memq 'japanese-radical attributes) + ;; (setq value (get-char-attribute char 'japanese-radical))) + ;; (unless (eq value radical) + ;; (insert (format "(japanese-radical\t . %S)\t; %c%s" + ;; value + ;; (ideographic-radical value) + ;; line-breaking)) + ;; (or radical + ;; (setq radical value))) + ;; (setq attributes (delq 'japanese-radical attributes)) + ;; ) (when (and (memq 'japanese-strokes attributes) (setq value (get-char-attribute char 'japanese-strokes))) (unless (eq value strokes) @@ -1153,38 +1237,38 @@ ;; (setq radical value))) ;; (setq attributes (delq 'shinjigen-1-radical attributes)) ;; ) - (when (and (memq 'ideographic- attributes) - (setq value (get-char-attribute char 'ideographic-))) - (insert "(ideographic- ") - (setq lbs (concat "\n" (make-string (current-column) ?\ )) - separator nil) - (while (consp value) - (setq cell (car value)) - (if (integerp cell) - (setq cell (decode-char '=ucs cell))) - (cond ((characterp cell) - (if separator - (insert lbs)) - (if readable - (insert (format "%S" cell)) - (char-db-insert-char-spec cell readable)) - (setq separator lbs)) - ((consp cell) - (if separator - (insert lbs)) - (if (consp (car cell)) - (char-db-insert-char-spec cell readable) - (char-db-insert-char-reference cell readable)) - (setq separator lbs)) - (t - (if separator - (insert separator)) - (insert (prin1-to-string cell)) - (setq separator " "))) - (setq value (cdr value))) - (insert ")") - (insert line-breaking) - (setq attributes (delq 'ideographic- attributes))) + ;; (when (and (memq 'ideographic- attributes) + ;; (setq value (get-char-attribute char 'ideographic-))) + ;; (insert "(ideographic- ") + ;; (setq lbs (concat "\n" (make-string (current-column) ?\ )) + ;; separator nil) + ;; (while (consp value) + ;; (setq cell (car value)) + ;; (if (integerp cell) + ;; (setq cell (decode-char '=ucs cell))) + ;; (cond ((characterp cell) + ;; (if separator + ;; (insert lbs)) + ;; (if readable + ;; (insert (format "%S" cell)) + ;; (char-db-insert-char-spec cell readable)) + ;; (setq separator lbs)) + ;; ((consp cell) + ;; (if separator + ;; (insert lbs)) + ;; (if (consp (car cell)) + ;; (char-db-insert-char-spec cell readable) + ;; (char-db-insert-char-reference cell readable)) + ;; (setq separator lbs)) + ;; (t + ;; (if separator + ;; (insert separator)) + ;; (insert (prin1-to-string cell)) + ;; (setq separator " "))) + ;; (setq value (cdr value))) + ;; (insert ")") + ;; (insert line-breaking) + ;; (setq attributes (delq 'ideographic- attributes))) (when (and (memq 'total-strokes attributes) (setq value (get-char-attribute char 'total-strokes))) (insert (format "(total-strokes . %S)%s" @@ -1192,21 +1276,21 @@ line-breaking)) (setq attributes (delq 'total-strokes attributes)) ) - (when (and (memq '->ideograph attributes) - (setq value (get-char-attribute char '->ideograph))) - (insert (format "(->ideograph\t%s)%s" - (mapconcat (lambda (code) - (cond ((symbolp code) - (symbol-name code)) - ((integerp code) - (format "#x%04X" code)) - (t - (format "%s %S" - line-breaking code)))) - value " ") - line-breaking)) - (setq attributes (delq '->ideograph attributes)) - ) + ;; (when (and (memq '->ideograph attributes) + ;; (setq value (get-char-attribute char '->ideograph))) + ;; (insert (format "(->ideograph\t%s)%s" + ;; (mapconcat (lambda (code) + ;; (cond ((symbolp code) + ;; (symbol-name code)) + ;; ((integerp code) + ;; (format "#x%04X" code)) + ;; (t + ;; (format "%s %S" + ;; line-breaking code)))) + ;; value " ") + ;; line-breaking)) + ;; (setq attributes (delq '->ideograph attributes)) + ;; ) ;; (when (and (memq '->decomposition attributes) ;; (setq value (get-char-attribute char '->decomposition))) ;; (insert (format "(->decomposition\t%s)%s" @@ -1237,24 +1321,24 @@ line-breaking)) (setq attributes (delq '->mojikyo attributes)) ) - (when (and (memq 'hanyu-dazidian-vol attributes) - (setq value (get-char-attribute char 'hanyu-dazidian-vol))) - (insert (format "(hanyu-dazidian-vol . %d)%s" - value line-breaking)) - (setq attributes (delq 'hanyu-dazidian-vol attributes)) - ) - (when (and (memq 'hanyu-dazidian-page attributes) - (setq value (get-char-attribute char 'hanyu-dazidian-page))) - (insert (format "(hanyu-dazidian-page . %d)%s" - value line-breaking)) - (setq attributes (delq 'hanyu-dazidian-page attributes)) - ) - (when (and (memq 'hanyu-dazidian-char attributes) - (setq value (get-char-attribute char 'hanyu-dazidian-char))) - (insert (format "(hanyu-dazidian-char . %d)%s" - value line-breaking)) - (setq attributes (delq 'hanyu-dazidian-char attributes)) - ) + ;; (when (and (memq 'hanyu-dazidian-vol attributes) + ;; (setq value (get-char-attribute char 'hanyu-dazidian-vol))) + ;; (insert (format "(hanyu-dazidian-vol . %d)%s" + ;; value line-breaking)) + ;; (setq attributes (delq 'hanyu-dazidian-vol attributes)) + ;; ) + ;; (when (and (memq 'hanyu-dazidian-page attributes) + ;; (setq value (get-char-attribute char 'hanyu-dazidian-page))) + ;; (insert (format "(hanyu-dazidian-page . %d)%s" + ;; value line-breaking)) + ;; (setq attributes (delq 'hanyu-dazidian-page attributes)) + ;; ) + ;; (when (and (memq 'hanyu-dazidian-char attributes) + ;; (setq value (get-char-attribute char 'hanyu-dazidian-char))) + ;; (insert (format "(hanyu-dazidian-char . %d)%s" + ;; value line-breaking)) + ;; (setq attributes (delq 'hanyu-dazidian-char attributes)) + ;; ) (unless readable (dolist (ignored '(composition ->denotational <-subsumptive ->ucs-unified @@ -1318,7 +1402,7 @@ ) ((or (eq name 'ideographic-structure) (eq name 'ideographic-combination) - (eq name 'ideographic-) + ;; (eq name 'ideographic-) (eq name '=decomposition) (char-feature-base-name= '=decomposition name) (char-feature-base-name= '=>decomposition name) @@ -1331,34 +1415,34 @@ (char-db-insert-relation-feature char name value line-breaking ccss readable)) - ((memq name '(ideograph= - original-ideograph-of - ancient-ideograph-of - vulgar-ideograph-of - wrong-ideograph-of - ;; simplified-ideograph-of - ideographic-variants - ;; ideographic-different-form-of - )) - (insert (format "(%-18s%s " name line-breaking)) - (setq lbs (concat "\n" (make-string (current-column) ?\ )) - separator nil) - (while (consp value) - (setq cell (car value)) - (if (and (consp cell) - (consp (car cell))) - (progn - (if separator - (insert lbs)) - (char-db-insert-alist cell readable) - (setq separator lbs)) - (if separator - (insert separator)) - (insert (prin1-to-string cell)) - (setq separator " ")) - (setq value (cdr value))) - (insert ")") - (insert line-breaking)) + ;; ((memq name '(ideograph= + ;; original-ideograph-of + ;; ancient-ideograph-of + ;; vulgar-ideograph-of + ;; wrong-ideograph-of + ;; ;; simplified-ideograph-of + ;; ideographic-variants + ;; ;; ideographic-different-form-of + ;; )) + ;; (insert (format "(%-18s%s " name line-breaking)) + ;; (setq lbs (concat "\n" (make-string (current-column) ?\ )) + ;; separator nil) + ;; (while (consp value) + ;; (setq cell (car value)) + ;; (if (and (consp cell) + ;; (consp (car cell))) + ;; (progn + ;; (if separator + ;; (insert lbs)) + ;; (char-db-insert-alist cell readable) + ;; (setq separator lbs)) + ;; (if separator + ;; (insert separator)) + ;; (insert (prin1-to-string cell)) + ;; (setq separator " ")) + ;; (setq value (cdr value))) + ;; (insert ")") + ;; (insert line-breaking)) ((consp value) (insert (format "(%-18s " name)) (setq lbs (concat "\n" (make-string (current-column) ?\ ))