X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Futf-2000%2Fchar-db-util.el;h=4aa1368ba4e834aff8ccbe01ee6833ac4620030f;hb=d134e0bfe7bef5fcc0153ba64d81a5e5cd88f327;hp=7cd5bf65fb5c44900820b310cb374c7e261b5553;hpb=6498a95be33eaca429ad5309cd37a42a698bb5e1;p=chise%2Fxemacs-chise.git diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el index 7cd5bf6..4aa1368 100644 --- a/lisp/utf-2000/char-db-util.el +++ b/lisp/utf-2000/char-db-util.el @@ -1,6 +1,6 @@ ;;; char-db-util.el --- Character Database utility -;; Copyright (C) 1998,1999,2000,2001 MORIOKA Tomohiko. +;; Copyright (C) 1998,1999,2000,2001,2002 MORIOKA Tomohiko. ;; Author: MORIOKA Tomohiko ;; Keywords: UTF-2000, ISO/IEC 10646, Unicode, UCS-4, MULE. @@ -71,6 +71,8 @@ (aset v 34 (make-char 'chinese-gb2312 #x62 #x3A))) v)) +(defvar char-db-ignored-attributes nil) + ;;;###autoload (defun char-ref-p (obj) (and (consp obj) @@ -125,7 +127,7 @@ t))) (if (charset-iso-final-char kb) nil - (> (charset-id ka)(charset-id kb))))) + (< (charset-id ka)(charset-id kb))))) ((<= (charset-chars ka)(charset-chars kb))))) (t (< (charset-dimension ka) @@ -159,13 +161,15 @@ arabic-digit arabic-1-column arabic-2-column))) + ((string-match "^chinese-big5" (symbol-name (car rest)))) ((string-match "^ideograph-gt-pj-" (symbol-name (car rest))) (unless (memq 'ideograph-gt dest) (setq dest (cons 'ideograph-gt dest)))) (t (setq dest (cons (car rest) dest))))) (setq rest (cdr rest))) - (sort dest #'char-attribute-name<))) + (append (sort dest #'char-attribute-name<) + '(chinese-big5-cdp chinese-big5-eten chinese-big5)))) (defun char-db-insert-char-spec (char &optional readable column) (unless column @@ -210,10 +214,14 @@ cal nil) (while char-spec (setq key (car (car char-spec))) - (if (find-charset key) - (setq cal (cons key cal)) - (setq al (cons key al))) + (unless (memq key char-db-ignored-attributes) + (if (find-charset key) + (setq cal (cons key cal)) + (setq al (cons key al)))) (setq char-spec (cdr char-spec))) + (unless (or cal + (memq 'ideographic-structure al)) + (push 'ideographic-structure al)) (insert-char-attributes char readable (or al 'none) cal) @@ -362,18 +370,32 @@ (setq attributes (sort (if attributes (if (consp attributes) - (copy-sequence attributes)) + (progn + (dolist (name attributes) + (unless (memq name char-db-ignored-attributes) + (push name atr-d))) + atr-d)) (dolist (name (char-attribute-list)) - (if (find-charset name) - (push name ccs-d) - (push name atr-d))) + (unless (memq name char-db-ignored-attributes) + (if (find-charset name) + (push name ccs-d) + (push name atr-d)))) atr-d) #'char-attribute-name<)) (setq ccs-attributes (sort (if ccs-attributes - (copy-sequence ccs-attributes) + (progn + (setq ccs-d nil) + (dolist (name ccs-attributes) + (unless (memq name char-db-ignored-attributes) + (push name ccs-d))) + ccs-d) (or ccs-d - (charset-list))) + (progn + (dolist (name (charset-list)) + (unless (memq name char-db-ignored-attributes) + (push name ccs-d))) + ccs-d))) #'char-attribute-name<))) (unless column (setq column (current-column))) @@ -415,6 +437,13 @@ line-breaking)) (setq attributes (delq '=>ucs* attributes)) ) + (when (and (memq '=>ucs-jis attributes) + (setq value (get-char-attribute char '=>ucs-jis))) + (insert (format "(=>ucs-jis\t\t. #x%04X)\t; %c%s" + value (decode-char 'ucs value) + line-breaking)) + (setq attributes (delq '=>ucs-jis attributes)) + ) (when (and (memq '->ucs attributes) (setq value (get-char-attribute char '->ucs))) (insert (format (if char-db-convert-obsolete-format @@ -666,6 +695,10 @@ value line-breaking)) (setq attributes (delq 'hanyu-dazidian-char attributes)) ) + (when (and (not readable) + (memq '->ucs-variants attributes)) + (setq attributes (delq '->ucs-variants attributes)) + ) (setq rest ccs-attributes) (while (and rest (progn @@ -685,22 +718,24 @@ (insert (format "(%-18s . #x%04X)%s" name value line-breaking))) - ((memq name '(->lowercase - ->uppercase ->titlecase - ->fullwidth <-fullwidth - ->identical - ->vulgar-ideograph <-vulgar-ideograph - ->ancient-ideograph <-ancient-ideograph - ->original-ideograph <-original-ideograph - ->simplified-ideograph <-simplified-ideograph - ->wrong-ideograph <-wrong-ideograph - ->same-ideograph - ->ideographic-variants - ->synonyms - ->radical <-radical - ->bopomofo <-bopomofo - ->ideographic <-ideographic - ideographic-structure)) + ((or (eq name 'ideographic-structure) + (string-match "^\\(->\\|<-\\)" (symbol-name name))) + ;; (memq name '(->lowercase + ;; ->uppercase ->titlecase + ;; ->fullwidth <-fullwidth + ;; ->identical + ;; ->vulgar-ideograph <-vulgar-ideograph + ;; ->ancient-ideograph <-ancient-ideograph + ;; ->original-ideograph <-original-ideograph + ;; ->simplified-ideograph <-simplified-ideograph + ;; ->wrong-ideograph <-wrong-ideograph + ;; ->same-ideograph + ;; ->ideographic-variants + ;; ->synonyms + ;; ->radical <-radical + ;; ->bopomofo <-bopomofo + ;; ->ideographic <-ideographic + ;; ideographic-structure)) (insert (format "(%-18s%s " name line-breaking)) (setq lbs (concat "\n" (make-string (current-column) ?\ )) separator nil) @@ -711,7 +746,9 @@ (cond ((characterp cell) (if separator (insert lbs)) - (char-db-insert-char-spec cell readable) + (if readable + (insert (format "%S" cell)) + (char-db-insert-char-spec cell readable)) (setq separator lbs)) ((consp cell) (if separator @@ -755,20 +792,20 @@ (setq value (cdr value))) (insert ")") (insert line-breaking)) - ((string-match "^->" (symbol-name name)) - (insert - (format "(%-18s %s)%s" - name - (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))) + ;; ((string-match "^->" (symbol-name name)) + ;; (insert + ;; (format "(%-18s %s)%s" + ;; name + ;; (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))) ((consp value) (insert (format "(%-18s " name)) (setq lbs (concat "\n" (make-string (current-column) ?\ )) @@ -815,8 +852,10 @@ (setq value (get-char-attribute char name))) (insert (format - (cond ((memq name '(ideograph-daikanwa ideograph-gt - ideograph-cbeta)) + (cond ((memq name '(ideograph-daikanwa-2 + ideograph-daikanwa + ideograph-gt + ideograph-cbeta)) (if has-long-ccs-name "(%-26s . %05d)\t; %c%s" "(%-18s . %05d)\t; %c%s"))