X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Futf-2000%2Fchar-db-util.el;h=60c70c67603538684a08038b23b12458d9f28f0c;hb=1c0dcd37222b5cd57e184af3593bfdb82bd942a8;hp=b5539d33d52afc0c9c9519422d8f93d646cf9ed7;hpb=083cc5a545249d075e69421102c94299f2053675;p=chise%2Fxemacs-chise.git- diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el index b5539d3..60c70c6 100644 --- a/lisp/utf-2000/char-db-util.el +++ b/lisp/utf-2000/char-db-util.el @@ -115,7 +115,8 @@ (defun insert-char-data (char) (let ((data (char-attribute-alist char)) - cell ret has-long-ccs-name rest) + cell ret has-long-ccs-name rest + radical strokes) (when data (save-restriction (narrow-to-region (point)(point)) @@ -152,9 +153,9 @@ ) (when (setq cell (assq '->ucs data)) (setq cell (cdr cell)) - (insert (format "(->ucs\t\t. #x%04X) + (insert (format "(->ucs\t\t. #x%04X)\t; %c " - cell)) + cell (decode-char 'ucs cell))) (setq data (del-alist '->ucs data)) ) (when (setq cell (assq 'general-category data)) @@ -240,14 +241,35 @@ (mapconcat (function prin1-to-string) cell " "))) (setq data (del-alist 'morohashi-daikanwa data)) ) + (setq radical nil) (when (setq cell (assq 'ideographic-radical data)) - (setq cell (cdr cell)) + (setq radical (cdr cell)) (insert (format "(ideographic-radical . %S)\t; %c " - cell - (aref ideographic-radicals cell))) + radical + (aref ideographic-radicals radical))) (setq data (del-alist 'ideographic-radical data)) ) + (when (setq cell (assq 'kangxi-radical data)) + (setq cell (cdr cell)) + (unless (eq cell radical) + (insert (format "(kangxi-radical\t . %S)\t; %c + " + cell + (aref ideographic-radicals cell))) + (setq radical cell)) + (setq data (del-alist 'kangxi-radical data)) + ) + (when (setq cell (assq 'japanese-radical data)) + (setq cell (cdr cell)) + (unless (eq cell radical) + (insert (format "(japanese-radical . %S)\t; %c + " + cell + (aref ideographic-radicals cell))) + (setq radical cell)) + (setq data (del-alist 'japanese-radical data)) + ) (when (setq cell (assq 'cns-radical data)) (setq cell (cdr cell)) (insert (format "(cns-radical\t . %S)\t; %c @@ -256,20 +278,40 @@ (aref ideographic-radicals cell))) (setq data (del-alist 'cns-radical data)) ) + (setq strokes nil) (cond ((setq cell (assq 'ideographic-strokes data)) - (setq cell (cdr cell)) + (setq strokes (cdr cell)) (insert (format "(ideographic-strokes . %S) " - cell)) + strokes)) (setq data (del-alist 'ideographic-strokes data)) + (when (setq cell (assq 'kangxi-strokes data)) + (setq cell (cdr cell)) + (unless (eq cell strokes) + (insert (format "(kangxi-strokes\t . %S) + " + cell)) + (setq strokes cell)) + (setq data (del-alist 'kangxi-strokes data)) + ) + (when (setq cell (assq 'japanese-strokes data)) + (setq cell (cdr cell)) + (unless (eq cell strokes) + (insert (format "(japanese-strokes\t . %S) + " + cell)) + (setq strokes cell)) + (setq data (del-alist 'japanese-strokes data)) + ) (when (setq cell (assq 'total-strokes data)) (setq cell (cdr cell)) (insert (format "(total-strokes\t . %S) " cell)) (setq data (del-alist 'total-strokes data)) - )) + ) + ) ((setq cell (assq 'total-strokes data)) (setq cell (cdr cell)) (insert (format "(total-strokes\t. %S) @@ -352,22 +394,39 @@ (while data (setq cell (car data)) (cond ((setq ret (find-charset (car cell))) - (insert - (format - (if has-long-ccs-name - "(%-26s %s) - " - "(%-18s %s) - " - ) - (charset-name ret) - (mapconcat - (lambda (b) - (format "#x%02X" - (if (= (charset-iso-graphic-plane ret) 1) - (logior b 128) - b))) - (cdr cell) " ")))) + (or (string-match "^mojikyo-pj-" + (symbol-name (charset-name ret))) + (insert + (format + (if has-long-ccs-name + (if (memq ret + (list (find-charset 'ideograph-daikanwa) + (find-charset 'mojikyo))) + "(%-26s . %05d)\t; %c + " + "(%-26s . #x%X)\t; %c + " + ) + (if (memq ret + (list (find-charset 'ideograph-daikanwa) + (find-charset 'mojikyo))) + "(%-18s . %05d)\t; %c + " + "(%-18s . #x%X)\t; %c + " + )) + (charset-name ret) + (if (= (charset-iso-graphic-plane ret) 1) + (logior (cdr cell) + (cond ((= (charset-dimension ret) 1) + #x80) + ((= (charset-dimension ret) 2) + #x8080) + ((= (charset-dimension ret) 3) + #x808080) + (t 0))) + (cdr cell)) + (decode-builtin-char ret (cdr cell)))))) ((string-match "^->" (symbol-name (car cell))) (insert (format "(%-18s %s) @@ -387,6 +446,10 @@ (car cell) (mapconcat (function prin1-to-string) (cdr cell) " ")))) + ((eq (car cell) 'jisx0208-1978/4X) + (insert (format "(%-18s . #x%04X) + " + (car cell)(cdr cell)))) (t (insert (format "(%-18s . %S) " @@ -401,6 +464,26 @@ (tabify (point-min)(point-max)) )))) +(defun decode-builtin-char (charset code-point) + (setq charset (get-charset charset)) + (if (and (not (memq (charset-name charset) + '(ideograph-daikanwa mojikyo))) + (or (memq (charset-name charset) + '(ascii latin-viscii-upper + latin-viscii-lower + arabic-iso8859-6 + japanese-jisx0213-1 + japanese-jisx0213-2)) + (= (char-int (charset-iso-final-char charset)) 0))) + (decode-char charset code-point) + (let ((table (charset-mapping-table charset))) + (if table + (prog2 + (set-charset-mapping-table charset nil) + (decode-char charset code-point) + (set-charset-mapping-table charset table)) + (decode-char charset code-point))))) + ;;;###autoload (defun char-db-update-comment () (interactive) @@ -417,7 +500,9 @@ (not (eq (car cdef) 'ideograph-daikanwa)) (or (memq (car cdef) '(ascii latin-viscii-upper latin-viscii-lower - arabic-iso8859-6)) + arabic-iso8859-6 + japanese-jisx0213-1 + japanese-jisx0213-2)) (= (char-int (charset-iso-final-char (car cdef))) 0))) (apply (function make-char) cdef) @@ -436,7 +521,10 @@ (defun insert-char-data-with-variant (char) (insert-char-data char) - (let ((variants (char-variants char))) + (let ((variants (or (char-variants char) + (let ((ucs (get-char-attribute char '->ucs))) + (if ucs + (delete char (char-variants (int-char ucs)))))))) (while variants (insert-char-data (car variants)) (setq variants (cdr variants)) @@ -452,9 +540,10 @@ ))) (defun write-char-range-data-to-file (min max file) - (with-temp-buffer - (insert-char-range-data min max) - (write-region (point-min)(point-max) file))) + (let ((coding-system-for-write 'utf-8)) + (with-temp-buffer + (insert-char-range-data min max) + (write-region (point-min)(point-max) file)))) (defvar what-character-original-window-configuration) @@ -472,7 +561,7 @@ (condition-case err (progn (insert-char-data-with-variant char) - (char-db-update-comment) + ;; (char-db-update-comment) (set-buffer-modified-p nil) (view-mode the-buf (lambda (buf) (set-window-configuration