Merge and/or fix missing JIS X 0208 code points.

[chise/xemacs-chise.git-] / lisp / utf-2000 / char-db-util.el

diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el
index 4266da8..0bc9803 100644 (file)
--- a/lisp/utf-2000/char-db-util.el
+++ b/lisp/utf-2000/char-db-util.el
@@ -5,22 +5,22 @@
 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
 ;; Keywords: UTF-2000, ISO/IEC 10646, Unicode, UCS-4, MULE.
 
-;; This file is part of UTF-2000.
+;; This file is part of XEmacs UTF-2000.
 
-;; UTF-2000 is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; XEmacs UTF-2000 is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
 
-;; UTF-2000 is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; XEmacs UTF-2000 is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 ;; General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
+;; along with XEmacs UTF-2000; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 
 ;;; Code:
 
@@ -424,7 +424,8 @@
                                         ((integerp code)
                                          (format "#x%04X" code))
                                         (t
-                                         (format "%s%S" line-breaking code))))
+                                         (format "%s %S"
+                                                 line-breaking code))))
                                 value " ")
                      line-breaking))
       (setq attributes (delq '->ideograph attributes))
@@ -458,7 +459,8 @@
                                         ((integerp code)
                                          (format "#x%04X" code))
                                         (t
-                                         (format "%s%S" line-breaking code))))
+                                         (format "%s %S"
+                                                 line-breaking code))))
                                 value " ")
                      line-breaking))
       (setq attributes (delq '->uppercase attributes))
@@ -472,7 +474,8 @@
                                         ((integerp code)
                                          (format "#x%04X" code))
                                         (t
-                                         (format "%s%S" line-breaking code))))
+                                         (format "%s %S"
+                                                 line-breaking code))))
                                 value " ")
                      line-breaking))
       (setq attributes (delq '->lowercase attributes))
@@ -486,7 +489,8 @@
                                         ((integerp code)
                                          (format "#x%04X" code))
                                         (t
-                                         (format "%s%S" line-breaking code))))
+                                         (format "%s %S"
+                                                 line-breaking code))))
                                 value " ")
                      line-breaking))
       (setq attributes (delq '->titlecase attributes))
@@ -600,7 +604,8 @@
       (setq attributes (cdr attributes)))
     (while ccs-attributes
       (setq name (car ccs-attributes))
-      (if (setq value (get-char-attribute char name))
+      (if (and (eq name (charset-name name))
+              (setq value (get-char-attribute char name)))
          (insert
           (format
            (cond ((memq name '(ideograph-daikanwa ideograph-gt))
@@ -696,8 +701,9 @@
            (insert (format "\t; %c" char)))
          )))))
 
-(defun insert-char-data-with-variant (char &optional script printable
-                                          no-ucs-variant)
+(defun insert-char-data-with-variant (char &optional printable
+                                          no-ucs-variant
+                                          script excluded-script)
   (insert-char-data char printable)
   (let ((variants (or (char-variants char)
                      (let ((ucs (get-char-attribute char '->ucs)))
@@ -706,28 +712,33 @@
        variant vs)
     (while variants
       (setq variant (car variants))
-      (if (or (null script)
-             (null (setq vs (get-char-attribute variant 'script)))
-             (memq script vs))
+      (if (and (or (null script)
+                  (null (setq vs (get-char-attribute variant 'script)))
+                  (memq script vs))
+              (or (null excluded-script)
+                  (null (setq vs (get-char-attribute variant 'script)))
+                  (not (memq excluded-script vs))))
          (or (and no-ucs-variant (get-char-attribute variant 'ucs))
              (insert-char-data variant printable)))
       (setq variants (cdr variants))
       )))
 
-(defun insert-char-range-data (min max &optional script)
+(defun insert-char-range-data (min max &optional script excluded-script)
   (let ((code min)
        char)
     (while (<= code max)
       (setq char (decode-char 'ucs code))
       (if (get-char-attribute char 'ucs)
-         (insert-char-data-with-variant char script nil 'no-ucs-variant))
+         (insert-char-data-with-variant char nil 'no-ucs-variant
+                                        script excluded-script))
       (setq code (1+ code))
       )))
 
-(defun write-char-range-data-to-file (min max file &optional script)
+(defun write-char-range-data-to-file (min max file
+                                         &optional script excluded-script)
   (let ((coding-system-for-write 'utf-8))
     (with-temp-buffer
-      (insert-char-range-data min max script)
+      (insert-char-range-data min max script excluded-script)
       (write-region (point-min)(point-max) file))))
 
 (defvar what-character-original-window-configuration)
@@ -745,7 +756,7 @@
     (erase-buffer)
     (condition-case err
        (progn
-         (insert-char-data-with-variant char nil 'printable)
+         (insert-char-data-with-variant char 'printable)
           ;; (char-db-update-comment)
          (set-buffer-modified-p nil)
          (view-mode the-buf (lambda (buf)