X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Futf-2000%2Fchar-db-util.el;h=b3b5e081d159dcd0a81dc63de05a082a6103217d;hb=ceb91d852860c4869d088e81931a554031afb3c5;hp=75a9326a8091d8a302bdcf09f0c7c0a1a479eeda;hpb=667a2b3a2dbea07c3c228e17d986110cc6a33084;p=chise%2Fxemacs-chise.git- diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el index 75a9326..b3b5e08 100644 --- a/lisp/utf-2000/char-db-util.el +++ b/lisp/utf-2000/char-db-util.el @@ -61,9 +61,62 @@ ("So" symbol other) )) +(defconst ideographic-radicals + (let ((v (make-vector 215 nil)) + (i 1)) + (while (< i 215) + (aset v i (int-char (+ #x2EFF i))) + (setq i (1+ i))) + (if (< (charset-iso-final-char (car (split-char (aref v 34)))) ?0) + (aset v 34 (make-char 'chinese-gb2312 #x62 #x3A))) + v)) + +(defun char-attribute-name< (ka kb) + (cond + ((find-charset ka) + (cond + ((find-charset kb) + (cond + ((= (charset-dimension ka) + (charset-dimension kb)) + (cond ((= (charset-chars ka)(charset-chars kb)) + (cond + ((>= (charset-iso-final-char ka) ?@) + (if (>= (charset-iso-final-char kb) ?@) + (< (charset-iso-final-char ka) + (charset-iso-final-char kb)) + t)) + ((>= (charset-iso-final-char ka) ?0) + (cond + ((>= (charset-iso-final-char kb) ?@) + nil) + ((>= (charset-iso-final-char kb) ?0) + (< (charset-iso-final-char ka) + (charset-iso-final-char kb))) + (t))))) + ((<= (charset-chars ka)(charset-chars kb))))) + (t + (< (charset-dimension ka) + (charset-dimension kb)) + ))) + ((symbolp kb) + nil) + (t + t))) + ((find-charset kb) + t) + ((symbolp ka) + (cond ((symbolp kb) + (string< (symbol-name ka) + (symbol-name kb))) + (t))) + ((symbolp kb) + nil))) + (defun insert-char-data (char) (let ((data (char-attribute-alist char)) - cell ret name has-long-ccs-name rest) + cell ret has-long-ccs-name rest + radical strokes) (when data (save-restriction (narrow-to-region (point)(point)) @@ -137,7 +190,8 @@ cell)) (setq data (del-alist 'mirrored data)) ) - (when (setq cell (assq 'decimal-digit-value data)) + (cond + ((setq cell (assq 'decimal-digit-value data)) (setq cell (cdr cell)) (insert (format "(decimal-digit-value . %S) " @@ -158,6 +212,104 @@ (setq data (del-alist 'numeric-value data)) ) ) + (t + (when (setq cell (assq 'digit-value data)) + (setq cell (cdr cell)) + (insert (format "(digit-value\t. %S) + " + cell)) + (setq data (del-alist 'digit-value data)) + ) + (when (setq cell (assq 'numeric-value data)) + (setq cell (cdr cell)) + (insert (format "(numeric-value\t. %S) + " + cell)) + (setq data (del-alist 'numeric-value data)) + ))) + (when (setq cell (assq 'iso-10646-comment data)) + (setq cell (cdr cell)) + (insert (format "(iso-10646-comment\t. %S) + " + cell)) + (setq data (del-alist 'iso-10646-comment data)) + ) + (when (setq cell (assq 'morohashi-daikanwa data)) + (setq cell (cdr cell)) + (insert (format "(morohashi-daikanwa\t%s) + " + (mapconcat (function prin1-to-string) cell " "))) + (setq data (del-alist 'morohashi-daikanwa data)) + ) + (setq radical nil) + (when (setq cell (assq 'ideographic-radical data)) + (setq radical (cdr cell)) + (insert (format "(ideographic-radical . %S)\t; %c + " + 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 . %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 + " + cell + (aref ideographic-radicals cell))) + (setq data (del-alist 'cns-radical data)) + ) + (setq strokes nil) + (cond + ((setq cell (assq 'ideographic-strokes data)) + (setq strokes (cdr cell)) + (insert (format "(ideographic-strokes . %S) + " + strokes)) + (setq data (del-alist 'ideographic-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) + " + cell)) + (setq data (del-alist 'total-strokes data)) + )) (when (setq cell (assq '->decomposition data)) (setq cell (cdr cell)) (insert (format "(->decomposition\t%s) @@ -186,9 +338,9 @@ cell " "))) (setq data (del-alist '->uppercase data)) ) - (when (setq cell (assq '->titlecase data)) + (when (setq cell (assq '->lowercase data)) (setq cell (cdr cell)) - (insert (format "(->titlecase\t%s) + (insert (format "(->lowercase\t%s) " (mapconcat (lambda (code) (cond ((symbolp code) @@ -198,11 +350,11 @@ (t (format "\n %S" code)))) cell " "))) - (setq data (del-alist '->titlecase data)) + (setq data (del-alist '->lowercase data)) ) - (when (setq cell (assq '->lowercase data)) + (when (setq cell (assq '->titlecase data)) (setq cell (cdr cell)) - (insert (format "(->lowercase\t%s) + (insert (format "(->titlecase\t%s) " (mapconcat (lambda (code) (cond ((symbolp code) @@ -212,45 +364,12 @@ (t (format "\n %S" code)))) cell " "))) - (setq data (del-alist '->lowercase data)) + (setq data (del-alist '->titlecase data)) ) (setq data (sort data (lambda (a b) - (let ((ka (car a)) - (kb (car b))) - (cond ((find-charset ka) - (cond ((find-charset kb) - (cond ((= (charset-dimension ka) - (charset-dimension kb)) - (cond - ((>= (charset-final ka) ?@) - (if (>= (charset-final kb) ?@) - (< (charset-final ka) - (charset-final kb)) - t)) - ((>= (charset-final ka) ?0) - (cond - ((>= (charset-final kb) ?@) - nil) - ((>= (charset-final kb) ?0) - (< (charset-final ka) - (charset-final kb))) - (t))))) - (t - (< (charset-dimension ka) - (charset-dimension kb)) - ))) - (t))) - ((find-charset kb) - t) - ((symbolp ka) - (cond ((symbolp kb) - (string< (symbol-name ka) - (symbol-name kb))) - (t))) - ((symbolp kb) - nil)))))) + (char-attribute-name< (car a)(car b))))) (setq rest data) (while (and rest (progn @@ -266,17 +385,22 @@ (while data (setq cell (car data)) (cond ((setq ret (find-charset (car cell))) - (insert (format (if has-long-ccs-name - "(%-26s %s) + (insert + (format + (if has-long-ccs-name + "(%-26s %s) " - "(%-18s %s) + "(%-18s %s) " - ) - (charset-name ret) - (mapconcat (lambda (b) - (format "#x%02X" b) - ) - (cdr cell) " ")))) + ) + (charset-name ret) + (mapconcat + (lambda (b) + (format "#x%02X" + (if (= (charset-iso-graphic-plane ret) 1) + (logior b 128) + b))) + (cdr cell) " ")))) ((string-match "^->" (symbol-name (car cell))) (insert (format "(%-18s %s) @@ -291,9 +415,11 @@ (format "\n %S" code)))) (cdr cell) " ")))) ((consp (cdr cell)) - (insert (format "%S + (insert (format "(%-18s %s) " - cell))) + (car cell) + (mapconcat (function prin1-to-string) + (cdr cell) " ")))) (t (insert (format "(%-18s . %S) " @@ -308,25 +434,6 @@ (tabify (point-min)(point-max)) )))) -(defun insert-char-range-data (min max) - (let ((code min) - char - variants) - (while (<= code max) - (setq char (int-char code)) - (insert-char-data char) - (setq variants (char-variants char)) - (while variants - (insert-char-data (car variants)) - (setq variants (cdr variants))) - (setq code (1+ code)) - ))) - -(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))) - ;;;###autoload (defun char-db-update-comment () (interactive) @@ -339,8 +446,15 @@ (when (find-charset (car cdef)) (goto-char (match-end 0)) (setq char - (if (or (eq (car cdef) 'ascii) - (= (char-int (charset-final (car cdef))) 0)) + (if (and + (not (eq (car cdef) 'ideograph-daikanwa)) + (or (memq (car cdef) '(ascii latin-viscii-upper + latin-viscii-lower + arabic-iso8859-6 + japanese-jisx0213-1 + japanese-jisx0213-2)) + (= (char-int (charset-iso-final-char (car cdef))) + 0))) (apply (function make-char) cdef) (if (setq table (charset-mapping-table (car cdef))) (set-charset-mapping-table (car cdef) nil)) @@ -349,12 +463,36 @@ (if table (set-charset-mapping-table (car cdef) table))))) (when (not (or (< (char-int char) 32) - (and (<= (char-int char) 128) + (and (<= 128 (char-int char)) (< (char-int char) 160)))) (delete-region (point) (point-at-eol)) (insert (format "\t; %c" char))) ))))) +(defun insert-char-data-with-variant (char) + (insert-char-data char) + (let ((variants (char-variants char))) + (while variants + (insert-char-data (car variants)) + (setq variants (cdr variants)) + ))) + +(defun insert-char-range-data (min max) + (let ((code min) + char) + (while (<= code max) + (setq char (int-char code)) + (insert-char-data-with-variant char) + (setq code (1+ code)) + ))) + +(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))) + +(defvar what-character-original-window-configuration) + ;;;###autoload (defun what-char-definition (char) (interactive (list (char-after))) @@ -368,7 +506,8 @@ (erase-buffer) (condition-case err (progn - (insert-char-data char) + (insert-char-data-with-variant char) + (char-db-update-comment) (set-buffer-modified-p nil) (view-mode the-buf (lambda (buf) (set-window-configuration