From: tomo Date: Mon, 16 Feb 2004 17:21:49 +0000 (+0000) Subject: (insert-char-attributes): Check each character specified in X-Git-Tag: r21-4-14-chise-0_21-25^2~37 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=eac9f8a3dc4114ba0cacf27dfad0efe6887c2f6c;p=chise%2Fxemacs-chise.git- (insert-char-attributes): Check each character specified in `->subsumptive' with `char-db-ignored-attributes'. --- diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el index 01f6894..5c3aac5 100644 --- a/lisp/utf-2000/char-db-util.el +++ b/lisp/utf-2000/char-db-util.el @@ -419,20 +419,6 @@ (defvar char-db-convert-obsolete-format t) (defun insert-char-attributes (char &optional readable attributes column) - (let (atr-d) - (setq attributes - (sort (if attributes - (if (consp attributes) - (progn - (dolist (name attributes) - (unless (memq name char-db-ignored-attributes) - (push name atr-d))) - atr-d)) - (dolist (name (char-attribute-list)) - (unless (memq name char-db-ignored-attributes) - (push name atr-d))) - atr-d) - #'char-attribute-name<))) (unless column (setq column (current-column))) (let (name value has-long-ccs-name rest @@ -442,7 +428,26 @@ lbs cell separator ret key al cal dest-ccss - sources required-features) + sources required-features + ccss) + (let (atr-d) + (setq attributes + (sort (if attributes + (if (consp attributes) + (progn + (dolist (name attributes) + (unless (memq name char-db-ignored-attributes) + (if (find-charset name) + (push name ccss)) + (push name atr-d))) + atr-d)) + (dolist (name (char-attribute-list)) + (unless (memq name char-db-ignored-attributes) + (if (find-charset name) + (push name ccss)) + (push name atr-d))) + atr-d) + #'char-attribute-name<))) (insert "(") (when (and (memq 'name attributes) (setq value (get-char-attribute char 'name))) @@ -932,13 +937,22 @@ (if (integerp cell) (setq cell (decode-char '=ucs cell))) (cond ((eq name '->subsumptive) - (if separator - (insert lbs)) - (let ((char-db-ignored-attributes - (cons '<-subsumptive - char-db-ignored-attributes))) - (insert-char-attributes cell readable)) - (setq separator lbs)) + (when (or (not + (some (lambda (atr) + (get-char-attribute cell atr)) + char-db-ignored-attributes)) + (some (lambda (ccs) + (encode-char cell ccs + 'defined-only)) + ccss)) + (if separator + (insert lbs)) + (let ((char-db-ignored-attributes + (cons '<-subsumptive + char-db-ignored-attributes))) + (insert-char-attributes cell readable)) + (setq separator lbs)) + ) ((characterp cell) (setq sources (get-char-attribute