X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Futf-2000%2Fchar-db-util.el;h=55b26b97391813a681d2942e5ba7cfe205dd691a;hb=61c306a4d83670238541bd1135f5b5f7a7d5d4d8;hp=8a4d35d33b642fb2724494e06585a7b632d3898c;hpb=70023c9968689446daac5c7af73608ea424825b3;p=chise%2Fxemacs-chise.git- diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el index 8a4d35d..55b26b9 100644 --- a/lisp/utf-2000/char-db-util.el +++ b/lisp/utf-2000/char-db-util.el @@ -125,7 +125,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) @@ -211,10 +211,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) @@ -356,6 +360,8 @@ (defvar char-db-convert-obsolete-format t) +(defvar char-db-ignored-attributes nil) + (defun insert-char-attributes (char &optional readable attributes ccs-attributes column) @@ -363,18 +369,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))) @@ -514,6 +534,13 @@ line-breaking)) (setq attributes (delq 'morohashi-daikanwa attributes)) ) + ;; (when (and (memq 'hanyu-dazidian attributes) + ;; (setq value (get-char-attribute char 'hanyu-dazidian))) + ;; (insert (format "(hanyu-dazidian %s)%s" + ;; (mapconcat #'number-to-string value " ") + ;; line-breaking)) + ;; (setq attributes (delq 'hanyu-dazidian attributes)) + ;; ) (setq radical nil strokes nil) (when (and (memq 'ideographic-radical attributes)