X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Futf-2000%2Fchar-db-util.el;h=def4915b36aea41527af0cdd945b2e4ad0ea5ca4;hb=c298618ed8a867da51c8aaac5f3e2ecbf9b14131;hp=563d6a4d1a88c433342b73e3c5a2a899682695d6;hpb=533d79866ec47e68491aaf5a9a48b5f86167e539;p=chise%2Fxemacs-chise.git diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el index 563d6a4..def4915 100644 --- a/lisp/utf-2000/char-db-util.el +++ b/lisp/utf-2000/char-db-util.el @@ -116,45 +116,49 @@ ((symbolp kb) nil))) -(defun char-db-insert-char-ref (char &optional readable column) +(defun char-db-insert-char-spec (char &optional readable column) (unless column (setq column (current-column))) - (let (char-ref ret al cal key) + (let (char-spec ret al cal key) (cond ((characterp char) (cond ((setq ret (get-char-attribute char 'ucs)) - (setq char-ref (list (cons 'ucs ret))) + (unless (and (<= #xE000 ret)(<= ret #xF8FF)) + (setq char-spec (list (cons 'ucs ret)))) + (if (setq ret (get-char-attribute char 'chinese-big5-cdp)) + (setq char-spec (cons (cons 'chinese-big5-cdp ret) + char-spec))) (if (setq ret (get-char-attribute char 'name)) - (setq char-ref (cons (cons 'name ret) char-ref))) + (setq char-spec (cons (cons 'name ret) char-spec))) ) ((setq ret (split-char char)) - (setq char-ref (list ret)) + (setq char-spec (list ret)) (dolist (ccs (delq (car ret) (charset-list))) (if (and (>= (charset-iso-final-char ccs) ?0) (setq ret (get-char-attribute char ccs))) - (setq char-ref (cons (cons ccs ret) char-ref)))) + (setq char-spec (cons (cons ccs ret) char-spec)))) (if (setq ret (get-char-attribute char 'name)) - (setq char-ref (cons (cons 'name ret) char-ref))) + (setq char-spec (cons (cons 'name ret) char-spec))) ))) ((consp char) - (setq char-ref char) + (setq char-spec char) (setq char nil))) (if (or char (setq char (condition-case nil - (define-char char-ref) + (find-char char-spec) (error nil)))) (progn (setq al nil cal nil) - (while char-ref - (setq key (car (car char-ref))) + (while char-spec + (setq key (car (car char-spec))) (if (find-charset key) (setq cal (cons key cal)) (setq al (cons key al))) - (setq char-ref (cdr char-ref))) + (setq char-spec (cdr char-spec))) (insert-char-attributes char readable (or al 'none) cal)) - (insert (prin1-to-string char-ref))))) + (insert (prin1-to-string char-spec))))) (defun char-db-insert-alist (alist &optional readable column) (unless column @@ -171,7 +175,7 @@ (cond ((eq name 'char) (insert "(char . ") (if (setq ret (condition-case nil - (define-char value) + (find-char value) (error nil))) (progn (setq al nil @@ -196,7 +200,7 @@ (if (and (consp cell) (consp (car cell)) (setq ret (condition-case nil - (define-char cell) + (find-char cell) (error nil))) ) (progn @@ -229,7 +233,7 @@ (setq alist (cdr alist)))) (insert ")")) -(defun char-db-insert-char-map (plist &optional readable column) +(defun char-db-insert-char-reference (plist &optional readable column) (unless column (setq column (current-column))) (let ((line-breaking @@ -241,7 +245,9 @@ (setq value (pop plist)) (cond ((eq name :char) (insert ":char\t") - (char-db-insert-char-ref value readable) + (if (numberp value) + (setq value (decode-char 'ucs value))) + (char-db-insert-char-spec value readable) (insert line-breaking)) (t (insert (format "%s\t%S%s" @@ -253,21 +259,24 @@ (defun char-db-decode-isolated-char (ccs code-point) (let (ret) (setq ret - (if (and (memq ccs '(ideograph-gt-pj-1 - ideograph-gt-pj-2 - ideograph-gt-pj-3 - ideograph-gt-pj-4 - ideograph-gt-pj-5 - ideograph-gt-pj-6 - ideograph-gt-pj-7 - ideograph-gt-pj-8 - ideograph-gt-pj-9 - ideograph-gt-pj-10 - ideograph-gt-pj-11)) - (setq ret (decode-char ccs code-point)) - (setq ret (get-char-attribute ret 'ideograph-gt))) - (decode-builtin-char 'ideograph-gt ret) - (decode-builtin-char ccs code-point))) + (cond ((eq ccs 'arabic-iso8859-6) + (decode-char ccs code-point)) + ((and (memq ccs '(ideograph-gt-pj-1 + ideograph-gt-pj-2 + ideograph-gt-pj-3 + ideograph-gt-pj-4 + ideograph-gt-pj-5 + ideograph-gt-pj-6 + ideograph-gt-pj-7 + ideograph-gt-pj-8 + ideograph-gt-pj-9 + ideograph-gt-pj-10 + ideograph-gt-pj-11)) + (setq ret (decode-char ccs code-point)) + (setq ret (get-char-attribute ret 'ideograph-gt))) + (decode-builtin-char 'ideograph-gt ret)) + (t + (decode-builtin-char ccs code-point)))) (cond ((and (<= 0 (char-int ret)) (<= (char-int ret) #x1F)) (decode-char 'ucs (+ #x2400 (char-int ret)))) @@ -303,7 +312,7 @@ (when (and (memq 'name attributes) (setq value (get-char-attribute char 'name))) (insert (format - (if (> (length value) 47) + (if (> (+ (current-column) (length value)) 48) "(name . %S)%s" "(name . %S)%s") value line-breaking)) @@ -581,9 +590,16 @@ ->fullwidth <-fullwidth ->vulgar-ideograph <-vulgar-ideograph ->ancient-ideograph <-ancient-ideograph + ->original-ideograph <-original-ideograph ->simplified-ideograph <-simplified-ideograph + ->wrong-ideograph <-wrong-ideograph ->same-ideograph - ->bopomofo)) + ->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) @@ -594,14 +610,14 @@ (cond ((characterp cell) (if separator (insert lbs)) - (char-db-insert-char-ref cell readable) + (char-db-insert-char-spec cell readable) (setq separator lbs)) ((consp cell) (if separator (insert lbs)) (if (consp (car cell)) - (char-db-insert-char-ref cell readable) - (char-db-insert-char-map cell readable)) + (char-db-insert-char-spec cell readable) + (char-db-insert-char-reference cell readable)) (setq separator lbs)) (t (if separator @@ -661,7 +677,7 @@ (if (and (consp cell) (consp (car cell)) (setq ret (condition-case nil - (define-char cell) + (find-char cell) (error nil)))) (progn (setq rest cell @@ -790,6 +806,7 @@ (if ucs (delete char (char-variants (int-char ucs))))))) variant vs) + (setq variants (sort variants #'<)) (while variants (setq variant (car variants)) (if (and (or (null script)