X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Futf-2000%2Fchar-db-util.el;h=02a9b48d93c89ffdbe4802ecb5aa1b519a17fea2;hb=cc2ab627ec446e4b9f8d1e0d3b7649ac257fbfb3;hp=59bb4fe2a94d1f8c1e4744b1014941e6493ff439;hpb=668352d07462395ce296ae3ee3c9c233435913c2;p=chise%2Fxemacs-chise.git diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el index 59bb4fe..02a9b48 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 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,2019 MORIOKA Tomohiko. ;; Author: MORIOKA Tomohiko ;; Keywords: CHISE, Character Database, ISO/IEC 10646, UCS, Unicode, MULE. @@ -68,18 +68,19 @@ ?屮 ?艸 ?蓐 ?茻 ?小 ?八 ?釆 ?半 ?牛 ?犛 ; 020 ?告 ?口 ?凵 ?吅 ?哭 ?走 ?止 ?癶 ?步 ?此 ; 030 ?正 ?是 ?辵 ?彳 ?廴 ?㢟 ?行 ?齒 ?牙 ?足 ; 040 - ?疋 ?品 ?龠 ?冊 ?㗊 ?舌 ?干 ?谷 ?只 ?㕯 ; 050 + ?疋 ?品 ?龠 ?冊 ?㗊 ?舌 ?干 ?𧮫 ?只 ?㕯 ; 050 ?句 ?丩 ?古 ?十 ?卅 ?言 ?誩 ?音 ?䇂 ?丵 ; 060 - ?菐 ?𠬞 ?廾 ?共 ?異 ?舁 ?𦥑 ?䢅 ?爨 ?革 ; 070 - ?鬲 ?䰜 ?爪 ?𠃨 ?鬥 ?又 ?𠂇 ?㕜 ?支 ?𦘒 ; 080 + ?菐 ?廾 ?𠬜 ?共 ?異 ?舁 ?𦥑 ?䢅 ?爨 ?革 ; 070 + ?鬲 ?䰜 ?爪 ?𠃨 ?鬥 ?又 ?𠂇 ?史 ?支 ?𦘒 ; 080 ?聿 ?畫 ?隶 ?臤 ?臣 ?殳 ?殺 ?𠘧 ?寸 ?皮 ; 090 ?㼱 ?攴 ?敎 ?卜 ?用 ?爻 ?㸚 ?𥄎 ?目 ?䀠 ; 100 ?眉 ?盾 ?自 ?白 ?鼻 ?皕 ?習 ?羽 ?隹 ?奞 ; 110 - ?萑 ?𦫳 ?苜 ?羊 ?羴 ?瞿 ?雔 ?雥 ?鳥 ?烏 ; 120 + ?雈 ?𦫳 ?𥄕 ?羊 ?羴 ?瞿 ?雔 ?雥 ?鳥 ?烏 ; 120 ?𠦒 ?冓 ?幺 ?𢆶 ?叀 ?玄 ?予 ?放 ?𠬪 ?𣦼 ; 130 - ?歺 ?死 ?冎 ?骨 ?肉 ?筋 ?刀 ?刃 ?㓞 ?丰 ; 140 - ?耒 ?𧢲 ?竹 ?箕 ?丌 ?左 ?工 ?㠭 ?巫 ?甘 ; 150 + ?歺 ?死 ?冎 ?骨 ?肉 ?筋 ?刀 ?刃 ?㓞 ?丯 ; 140 + ?耒 ?角 ?竹 ?箕 ?丌 ?左 ?工 ?㠭 ?巫 ?甘 ; 150 ?曰 ?乃 ?丂 ?可 ?兮 ?号 ?亏 ?旨 ?喜 ?壴 ; 160 +; ?旨 ?曰 ?乃 ?丂 ?可 ?兮 ?号 ?亏 ?喜 ?壴 ; 160 ?鼓 ?豈 ?豆 ?豊 ?豐 ?䖒 ?虍 ?虎 ?虤 ?皿 ; 170 ?𠙴 ?去 ?血 ?丶 ?丹 ?青 ?井 ?皀 ?鬯 ?食 ; 180 ?亼 ?會 ?倉 ?入 ?缶 ?矢 ?高 ?冂 ?𩫏 ?京 ; 190 @@ -88,11 +89,22 @@ ?之 ?帀 ?出 ?𣎵 ?生 ?乇 ?𠂹 ?𠌶 ?華 ?𥝌 ; 220 ?稽 ?巢 ?桼 ?束 ?㯻 ?囗 ?員 ?貝 ?邑 ?𨛜 ; 230 ?日 ?旦 ?倝 ?㫃 ?冥 ?晶 ?月 ?有 ?明 ?囧 ; 240 - ?夕 ?多 ?毌 ?𢎘 ?𣐺 ?卣 ?齊 ?朿 ?片 ?鼎 ; 250 + ?夕 ?多 ?毌 ?𢎘 ?𣐺 ?𠧪 ?齊 ?朿 ?片 ?鼎 ; 250 ?克 ?彔 ?禾 ?秝 ?黍 ?香 ?米 ?毇 ?臼 ?凶 ; 260 - ?𣎳 ?林 ?麻 ?尗 ?耑 ?韭 ?瓜 ?瓠 ?宀 ?宮 ; 270 - ?呂 ?穴 ?㝱 ?𤕫 ?冖 ?𠔼 ?冃 ?㒳 ?网 ?襾 ; 280 + ?𣎳 ?𣏟 ?麻 ?尗 ?耑 ?韭 ?瓜 ?瓠 ?宀 ?宮 ; 270 + ?呂 ?穴 ?㝱 ?疒 ?冖 ?𠔼 ?冃 ?㒳 ?网 ?襾 ; 280 ?巾 ?巿 ?帛 ?白 ?㡀 ?黹 ?人 ?𠤎 ?匕 ?从 ; 290 + ?比 ?北 ?丘 ?㐺 ?𡈼 ?重 ?臥 ?身 ?㐆 ?衣 ; 300 + ?裘 ?老 ?毛 ?毳 ?尸 ?尺 ?尾 ?履 ?舟 ?方 ; 310 + ?儿 ?兄 ?兂 ?皃 ?𠑹 ?先 ?秃 ?見 ?覞 ?欠 ; 320 + ?㱃 ?㳄 ?旡 ?頁 ?𦣻 ?面 ?丏 ?首 ?𥄉 ?須 ; 330 + ?彡 ?彣 ?文 ?髟 ?后 ?司 ?卮 ?卩 ?印 ?色 ; 340 + ?𠨍 ?辟 ?勹 ?包 ?茍 ?鬼 ?甶 ?厶 ?嵬 ?山 ; 350 + ?屾 ?屵 ?广 ?厂 ?丸 ?危 ?石 ?長 ?勿 ?冄 ; 360 + ?而 ?豕 ?㣇 ?彑 ?豚 ?豸 ?𤉡 ?易 ?象 ?馬 ; 370 + ?𢊁 ?鹿 ?麤 ?㲋 ?兔 ?萈 ?犬 ?㹜 ?鼠 ?能 ; 380 + ?熊 ?火 ?炎 ?黑 ?囪 ?焱 ?炙 ?赤 ?大 ?亦 ; 390 + ?夨 ?夭 ?交 ?尣 ?壺 ?壹 ?㚔 ?奢 ?亢 ?夲 ; 400 ]) (defun shuowen-radical (number) @@ -114,6 +126,14 @@ cyrillic-iso8859-5 greek-iso8859-7 thai-tis620 + ;; =mj + ;; =adobe-japan1-0 + ;; =adobe-japan1-1 + ;; =adobe-japan1-2 + ;; =adobe-japan1-3 + ;; =adobe-japan1-4 + ;; =adobe-japan1-5 + ;; =adobe-japan1-6 =jis-x0208 =jis-x0208@1978 =jis-x0208@1983 @@ -139,14 +159,6 @@ latin-viscii ethiopic-ucs =big5-cdp - =gt - =adobe-japan1-0 - =adobe-japan1-1 - =adobe-japan1-2 - =adobe-japan1-3 - =adobe-japan1-4 - =adobe-japan1-5 - =adobe-japan1-6 =hanyo-denshi/ja =hanyo-denshi/jb =hanyo-denshi/jc @@ -155,10 +167,41 @@ =hanyo-denshi/ia =hanyo-denshi/ib =hanyo-denshi/hg - ideograph-daikanwa-2 - ideograph-daikanwa - =cbeta + =hanyo-denshi/jt + =hanyo-denshi/ks + =hanyo-denshi/tk + ;; ==mj + ;; ==adobe-japan1-0 + ;; ==adobe-japan1-1 + ;; ==adobe-japan1-2 + ;; ==adobe-japan1-3 + ;; ==adobe-japan1-4 + ;; ==adobe-japan1-5 + ;; ==adobe-japan1-6 + ==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 + =daijiten + =daikanwa@rev2 + =daikanwa@rev1 + =daikanwa/+p + ==daikanwa + ==daijiten + =cbeta ideograph-hanziku-1 ideograph-hanziku-2 ideograph-hanziku-3 @@ -171,6 +214,32 @@ ideograph-hanziku-10 ideograph-hanziku-11 ideograph-hanziku-12 + ;; =>>>adobe-japan1-0 + ;; =>>>adobe-japan1-1 + ;; =>>>adobe-japan1-2 + ;; =>>>adobe-japan1-3 + ;; =>>>adobe-japan1-4 + ;; =>>>adobe-japan1-5 + ;; =>>>adobe-japan1-6 + ;; =>>>jis-x0208 + ;; =>>>jis-x0213-1 + ;; =>>>jis-x0213-2 + ;; =>>>hanyo-denshi/ja + ;; =>>>hanyo-denshi/jb + ;; =>>>hanyo-denshi/jc + ;; =>>>hanyo-denshi/ft + ;; =>>>hanyo-denshi/ib + ;; =>>>hanyo-denshi/hg + ;; =>>>hanyo-denshi/jt + ;; =>>>hanyo-denshi/ks + ;; =>>>gt + =>>adobe-japan1-0 + =>>adobe-japan1-1 + =>>adobe-japan1-2 + =>>adobe-japan1-3 + =>>adobe-japan1-4 + =>>adobe-japan1-5 + =>>adobe-japan1-6 =>>jis-x0208 =>>jis-x0213-1 =>>jis-x0213-1@2000 @@ -178,33 +247,82 @@ =>>jis-x0213-2 =>>jis-x0208@1978 =>>hanyo-denshi/ft + =>>hanyo-denshi/jt =>>hanyo-denshi/ks =>>gt - =>jis-x0208@usual + =>>daikanwa + =>>cbeta + =+>jis-x0208 + =+>jis-x0213-1 + =+>jis-x0213-2 + =+>adobe-japan1-0 + =+>adobe-japan1-1 + =+>adobe-japan1-2 + =+>adobe-japan1-3 + =+>adobe-japan1-4 + =+>adobe-japan1-5 + =+>adobe-japan1-6 + =+>jis-x0208@1978 =>jis-x0208 =>jis-x0208@1997 =>jis-x0213-1 =>jis-x0213-1@2000 =>jis-x0213-1@2004 - =>jis-x0213-2@usual =>jis-x0213-2 ==>ucs@bucs + ==>daijiten + =>iwds-1 + ;; =>ucs@hanyo-denshi =>ucs@iso =>ucs@unicode =>ucs@jis - =>ucs@JP =>ucs@cns =>ucs@ks + =+>ucs@iso + =+>ucs@unicode + =+>ucs@jis + =+>ucs@jis/1990 + =+>ucs@cns + =+>ucs@ks + =>>ucs@iso =>>ucs@unicode =>>ucs@jis =>>ucs@cns + =>>>ucs@iso + =>>>ucs@unicode + ==ucs@iso + ==ucs@unicode + ;; ==ucs@cns + ==gb2312 + ==ks-x1001 + ==cns11643-1 + ==cns11643-2 + ==cns11643-3 + ==cns11643-4 + ==cns11643-5 + ==cns11643-6 + ==cns11643-7 + ==gt + ==jis-x0208@1990 + ;; ==jis-x0208@1983 + ==jis-x0208@1978 + ==gt-k =ucs@iso =ucs@unicode + =ucs@cns + ==big5-cdp + ==cbeta =>>big5-cdp =>>gt-k + =+>gt + =+>big5-cdp =>gt + =>mj =>big5-cdp =>daikanwa + =>daikanwa/ho + =>cns11643-5 + =>cns11643-7 =big5 =big5-eten =>gt-k @@ -212,8 +330,59 @@ =>zinbun-oracle =ruimoku-v6 =>>ruimoku-v6 + ==ruimoku-v6 =jef-china3 - =shinjigen)) + =>cbeta + =shinjigen + =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-012 + =>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@iwds-1 + =>big5-cdp@component + =>big5-cdp@cognate + ==ucs@gb + =ucs@gb + ==ucs-var-002 + =ucs@JP/hanazono)) ;;; @ char-db formatters @@ -232,6 +401,70 @@ (setq char-spec (cons (cons 'name* ret) char-spec)) )) ) + ((encode-char char '=mj 'defined-only) + (setq char-spec nil) + (dolist (ccs (charset-list)) + (if (and (or (eq ccs '=mj) + ;; (eq (charset-property ccs 'iso-ir) 177) + (string-match "=ucs@" (symbol-name ccs)) + ) + (setq ccs (charset-name ccs)) + (null (assq ccs char-spec)) + (setq ret (encode-char char ccs 'defined-only))) + (setq char-spec (cons (cons ccs ret) char-spec)))) + ) + ((encode-char char '==mj 'defined-only) + (setq char-spec nil) + (dolist (ccs (charset-list)) + (if (and (or (eq ccs '==mj) + ;; (eq (charset-property ccs 'iso-ir) 177) + (string-match "=ucs@" (symbol-name ccs)) + ) + (setq ccs (charset-name ccs)) + (null (assq ccs char-spec)) + (setq ret (encode-char char ccs 'defined-only))) + (setq char-spec (cons (cons ccs ret) char-spec)))) + ) + ((encode-char char '=adobe-japan1 'defined-only) + (setq char-spec nil) + (dolist (ccs (charset-list)) + (if (and (or (memq ccs + '(=adobe-japan1-0 + =adobe-japan1-1 + =adobe-japan1-2 + =adobe-japan1-3 + =adobe-japan1-4 + =adobe-japan1-5 + =adobe-japan1-6 + )) + ;; (eq (charset-property ccs 'iso-ir) 177) + (string-match "=ucs@" (symbol-name ccs)) + ) + (setq ccs (charset-name ccs)) + (null (assq ccs char-spec)) + (setq ret (encode-char char ccs 'defined-only))) + (setq char-spec (cons (cons ccs ret) char-spec)))) + ) + ((encode-char char '==adobe-japan1 'defined-only) + (setq char-spec nil) + (dolist (ccs (charset-list)) + (if (and (or (memq ccs + '(==adobe-japan1-0 + ==adobe-japan1-1 + ==adobe-japan1-2 + ==adobe-japan1-3 + ==adobe-japan1-4 + ==adobe-japan1-5 + ==adobe-japan1-6 + )) + ;; (eq (charset-property ccs 'iso-ir) 177) + (string-match "=ucs@" (symbol-name ccs)) + ) + (setq ccs (charset-name ccs)) + (null (assq ccs char-spec)) + (setq ret (encode-char char ccs 'defined-only))) + (setq char-spec (cons (cons ccs ret) char-spec)))) + ) ((setq ret (catch 'tag (let ((rest char-db-coded-charset-priority-list) @@ -253,7 +486,10 @@ ;; =gt-k =jis-x0208@1997 )) - (string-match "=ucs@" (symbol-name ccs))) + (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)) (null (assq ccs char-spec)) (setq ret (encode-char char ccs 'defined-only))) @@ -296,7 +532,8 @@ (insert-char-attributes char readable (union (mapcar #'car char-spec) - required-features)) + required-features) + nil 'for-sub-node) (when temp-char ;; undefine temporary character ;; Current implementation is dirty. @@ -337,7 +574,7 @@ (insert-char-attributes ret readable (or al 'none) ; cal - )) + nil 'for-sub-node)) (insert (prin1-to-string value))) (insert ")") (insert line-breaking)) @@ -369,7 +606,7 @@ (insert-char-attributes ret readable al ; cal - ) + nil 'for-sub-node) (setq separator lbs)) (if separator (insert separator)) @@ -426,6 +663,8 @@ (setq ret (cond ((eq ccs 'arabic-iso8859-6) (decode-char ccs code-point)) + ;; ((eq ccs '=gt) + ;; (decode-builtin-char '==gt code-point)) ((and (memq ccs '(=gt-pj-1 =gt-pj-2 =gt-pj-3 @@ -442,7 +681,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) @@ -452,46 +694,104 @@ (defvar char-db-convert-obsolete-format t) (defun char-db-insert-ccs-feature (name value line-breaking) - (insert - (format - (cond ((memq name '(=shinjigen - =shinjigen@1ed - =shinjigen@rev =shinjigen/+p@rev - =daikanwa/ho)) - "(%-18s . %04d)\t; %c") - ((eq name '=shinjigen@1ed/24pr) - "(%-18s . %04d)\t; %c") - ((or (memq name '(=daikanwa - =daikanwa@rev1 =daikanwa@rev2 - =daikanwa/+p =daikanwa/+2p - =>>daikanwa =>daikanwa - =gt =>>gt =>gt =gt-k =>>gt-k =>gt-k =cbeta - =zinbun-oracle =>zinbun-oracle)) - (string-match "^=adobe-" (symbol-name name))) - "(%-18s . %05d)\t; %c") - ((memq name '(=hanyo-denshi/ks =>>hanyo-denshi/ks mojikyo)) - "(%-18s . %06d)\t; %c") - ((>= (charset-dimension name) 2) - "(%-18s . #x%04X)\t; %c") - (t - "(%-18s . #x%02X)\t; %c")) - name - (if (= (charset-iso-graphic-plane name) 1) - (logior value - (cond ((= (charset-dimension name) 1) - #x80) - ((= (charset-dimension name) 2) - #x8080) - ((= (charset-dimension name) 3) - #x808080) - (t 0))) - value) - (char-db-decode-isolated-char name value))) - (if (and (= (charset-chars name) 94) - (= (charset-dimension name) 2)) - (insert (format " [%02d-%02d]" - (- (lsh value -8) 32) - (- (logand value 255) 32)))) + (cond + ((integerp value) + (insert + (format + (cond + ((memq name '(=>iwds-1 + ==shinjigen + =shinjigen + =shinjigen@1ed ==shinjigen@1ed + =shinjigen@rev ==shinjigen@rev + =shinjigen/+p@rev ==shinjigen/+p@rev + ===daikanwa/ho ==daikanwa/ho + =daikanwa/ho =>>daikanwa/ho =>daikanwa/ho)) + "(%-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 + =daijiten ==daijiten ===daijiten ==>daijiten + ===hng-jou ===hng-keg ===hng-dng ===hng-mam + ===hng-drt ===hng-kgk ===hng-myz ===hng-kda + ===hng-khi ===hng-khm ===hng-fhs ===hng-hok + ===hng-kyd ===hng-sok + ===hng-yhk ===hng-kak ===hng-kar ===hng-kae + ===hng-sys ===hng-tsu ===hng-tzj + ===hng-hos ===hng-kkh ===hng-nak ===hng-jhk + ===hng-hod ===hng-gok ===hng-ink ===hng-nto + ===hng-nkm ===hng-k24 ===hng-ini ===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-sai ===hng-kad ===hng-kss ===hng-kyo ===hng-ykk + ===hng-sab ===hng-wks ===hng-wke ===hng-smk + =shuowen-jiguge ===shuowen-jiguge4 ===shuowen-jiguge5)) + ;; (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 ==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 + "(%-18s . #x%02X)\t; %c")) + name + (if (= (charset-iso-graphic-plane name) 1) + (logior value + (cond ((= (charset-dimension name) 1) + #x80) + ((= (charset-dimension name) 2) + #x8080) + ((= (charset-dimension name) 3) + #x808080) + (t 0))) + value) + (char-db-decode-isolated-char name value))) + (if (and (= (charset-chars name) 94) + (= (charset-dimension name) 2)) + (insert (format " [%02d-%02d]" + (- (lsh value -8) 32) + (- (logand value 255) 32)))) + ) + (t + (insert (format "(%-18s . %s)" name value)) + )) (insert line-breaking)) (defun char-db-insert-relation-feature (char name value line-breaking @@ -517,7 +817,7 @@ (let ((char-db-ignored-attributes (cons '<-subsumptive char-db-ignored-attributes))) - (insert-char-attributes cell readable)) + (insert-char-attributes cell readable nil nil 'for-sub-node)) (setq separator lbs)) ) ((characterp cell) @@ -540,7 +840,10 @@ =jis-x0212 =jis-x0208@1983 =jis-x0208@1978 - =shinjigen)))) + =shinjigen + =shinjigen@1ed + =shinjigen@rev + =shinjigen/+p@rev)))) ((eq source 'CN) (setq required-features (union required-features @@ -593,7 +896,8 @@ (insert ")") (insert line-breaking))) -(defun insert-char-attributes (char &optional readable attributes column) +(defun insert-char-attributes (char &optional readable attributes column + for-sub-node) (unless column (setq column (current-column))) (let (name value ; has-long-ccs-name @@ -625,7 +929,7 @@ #'char-attribute-name<))) (insert "(") (when (memq '<-subsumptive attributes) - (when readable + (when (or readable (not for-sub-node)) (when (setq value (get-char-attribute char '<-subsumptive)) (char-db-insert-relation-feature char '<-subsumptive value line-breaking @@ -637,6 +941,18 @@ 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 '<-denotational@usage attributes) + (setq value (get-char-attribute char '<-denotational@usage))) + (char-db-insert-relation-feature char '<-denotational@usage value + line-breaking + ccss readable) + (setq attributes (delq '<-denotational@usage attributes))) (when (and (memq 'name attributes) (setq value (get-char-attribute char 'name))) (insert (format @@ -886,17 +1202,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) @@ -925,49 +1241,38 @@ (setq strokes value))) (setq attributes (delq 'cns-strokes attributes)) ) - (when (and (memq 'shinjigen-1-radical attributes) - (setq value (get-char-attribute char 'shinjigen-1-radical))) - (unless (eq value radical) - (insert (format "(shinjigen-1-radical . %S)\t; %c%s" - value - (ideographic-radical value) - line-breaking)) - (or radical - (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" @@ -975,21 +1280,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" @@ -1020,181 +1325,166 @@ 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)) - ) (unless readable (dolist (ignored '(composition ->denotational <-subsumptive ->ucs-unified - ->ideographic-component-forms)) + ;; ->ideographic-component-forms + )) (setq attributes (delq ignored attributes)))) (while attributes (setq name (car attributes)) - (if (setq value (get-char-attribute char name)) - (cond ((setq ret (find-charset name)) - (setq name (charset-name ret)) - (if (and (not (memq name dest-ccss)) - (prog1 - (setq value (get-char-attribute char name)) - (setq dest-ccss (cons name dest-ccss)))) - (char-db-insert-ccs-feature name value line-breaking)) - ) - ((string-match "^=>ucs@" (symbol-name name)) - (insert (format "(%-18s . #x%04X)\t; %c%s" - name value (decode-char '=ucs value) - line-breaking)) - ) - ((eq name 'jisx0208-1978/4X) - (insert (format "(%-18s . #x%04X)%s" - name value - line-breaking)) - ) - ((and - (not readable) - (not (eq name '->subsumptive)) - (not (eq name '->uppercase)) - (not (eq name '->lowercase)) - (not (eq name '->titlecase)) - (not (eq name '->canonical)) - (not (eq name '->Bopomofo)) - (not (eq name '->mistakable)) - (not (eq name '->ideographic-variants)) - (null (get-char-attribute - char (intern (format "%s*sources" name)))) - (not (string-match "\\*sources$" (symbol-name name))) - (null (get-char-attribute - char (intern (format "%s*note" name)))) - (not (string-match "\\*note$" (symbol-name name))) - (or (eq name '<-identical) - (eq name '<-uppercase) - (eq name '<-lowercase) - (eq name '<-titlecase) - (eq name '<-canonical) - (eq name '<-ideographic-variants) - ;; (eq name '<-synonyms) - (string-match "^<-synonyms" (symbol-name name)) - (eq name '<-mistakable) - (when (string-match "^->" (symbol-name name)) - (cond - ((string-match "^->fullwidth" (symbol-name name)) - (not (and (consp value) - (characterp (car value)) - (encode-char - (car value) '=ucs 'defined-only))) - ) - (t))) - )) - ) - ((or (eq name 'ideographic-structure) - (eq name 'ideographic-combination) - (eq name 'ideographic-) - (eq name '=decomposition) - (string-match "^=>*decomposition\\(@[^*]+\\)?$" - (symbol-name name)) - (string-match "^\\(->\\|<-\\)[^*]*$" (symbol-name name)) - (string-match "^\\(->\\|<-\\)[^*]*\\*sources$" - (symbol-name name)) - ) - (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)) - ((consp value) - (insert (format "(%-18s " name)) - (setq lbs (concat "\n" (make-string (current-column) ?\ )) - separator nil) - (while (consp value) - (setq cell (car value)) - (if (and (consp cell) - (consp (car cell)) - (setq ret (condition-case nil - (find-char cell) - (error nil)))) - (progn - (setq rest cell - al nil - cal nil) - (while rest - (setq key (car (car rest))) - (if (find-charset key) - (setq cal (cons key cal)) - (setq al (cons key al))) - (setq rest (cdr rest))) - (if separator - (insert lbs)) - (insert-char-attributes ret - readable - al cal) - (setq separator lbs)) - (setq ret (prin1-to-string cell)) - (if separator - (if (< (+ (current-column) - (length ret) - (length separator)) - 76) - (insert separator) - (insert lbs))) - (insert ret) - (setq separator " ")) - (setq value (cdr value))) - (insert ")") + (unless (eq (setq value (get-char-attribute char name 'value-is-empty)) + 'value-is-empty) + (cond ((setq ret (find-charset name)) + (setq name (charset-name ret)) + (when (not (memq name dest-ccss)) + (setq dest-ccss (cons name dest-ccss)) + (char-db-insert-ccs-feature name value line-breaking)) + ) + ((string-match "^=>ucs@" (symbol-name name)) + (insert (format "(%-18s . #x%04X)\t; %c%s" + name value (decode-char '=ucs value) + line-breaking)) + ) + ((eq name 'jisx0208-1978/4X) + (insert (format "(%-18s . #x%04X)%s" + name value + line-breaking)) + ) + ((and + (not readable) + (not (eq name '->subsumptive)) + (not (eq name '->uppercase)) + (not (eq name '->lowercase)) + (not (eq name '->titlecase)) + (not (eq name '->canonical)) + (not (eq name '->Bopomofo)) + (not (eq name '->mistakable)) + (not (eq name '->ideographic-variants)) + (null (get-char-attribute + char (intern (format "%s*sources" name)))) + (not (string-match "\\*sources$" (symbol-name name))) + (null (get-char-attribute + char (intern (format "%s*note" name)))) + (not (string-match "\\*note$" (symbol-name name))) + (or (eq name '<-identical) + (eq name '<-uppercase) + (eq name '<-lowercase) + (eq name '<-titlecase) + (eq name '<-canonical) + (eq name '<-ideographic-variants) + ;; (eq name '<-synonyms) + (string-match "^<-synonyms" (symbol-name name)) + (eq name '<-mistakable) + (when (string-match "^->" (symbol-name name)) + (cond + ((string-match "^->fullwidth" (symbol-name name)) + (not (and (consp value) + (characterp (car value)) + (encode-char + (car value) '=ucs 'defined-only))) + ) + (t))) + )) + ) + ((or (eq name 'ideographic-structure) + (eq name 'ideographic-combination) + ;; (eq name 'ideographic-) + (eq name '=decomposition) + (char-feature-base-name= '=decomposition name) + (char-feature-base-name= '=>decomposition name) + ;; (string-match "^=>*decomposition\\(@[^*]+\\)?$" + ;; (symbol-name name)) + (string-match "^\\(->\\|<-\\)[^*]*$" (symbol-name name)) + (string-match "^\\(->\\|<-\\)[^*]*\\*sources$" + (symbol-name name)) + ) + (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)) + ((consp value) + (insert (format "(%-18s " name)) + (setq lbs (concat "\n" (make-string (current-column) ?\ )) + separator nil) + (while (consp value) + (setq cell (car value)) + (if (and (consp cell) + (consp (car cell)) + (setq ret (condition-case nil + (find-char cell) + (error nil)))) + (progn + (setq rest cell + al nil + cal nil) + (while rest + (setq key (car (car rest))) + (if (find-charset key) + (setq cal (cons key cal)) + (setq al (cons key al))) + (setq rest (cdr rest))) + (if separator + (insert lbs)) + (insert-char-attributes ret + readable + al ; cal + nil 'for-sub-node) + (setq separator lbs)) + (setq ret (prin1-to-string cell)) + (if separator + (if (< (+ (current-column) + (length ret) + (length separator)) + 76) + (insert separator) + (insert lbs))) + (insert ret) + (setq separator " ")) + (setq value (cdr value))) + (insert ")") + (insert line-breaking)) + (t + (insert (format "(%-18s" name)) + (setq ret (prin1-to-string value)) + (unless (< (+ (current-column) + (length ret) + 3) + 76) (insert line-breaking)) - (t - (insert (format "(%-18s" name)) - (setq ret (prin1-to-string value)) - (unless (< (+ (current-column) - (length ret) - 3) - 76) - (insert line-breaking)) - (insert " . " ret ")" line-breaking) - ;; (insert (format "(%-18s . %S)%s" - ;; name value - ;; line-breaking)) - ) - )) + (insert " . " ret ")" line-breaking) + ;; (insert (format "(%-18s . %S)%s" + ;; name value + ;; line-breaking)) + ) + )) (setq attributes (cdr attributes))) (insert ")")))