(www-format-encode-string): Add setting of

[chise/est.git] / char-db-json.el

diff --git a/char-db-json.el b/char-db-json.el
index d8044d1..2da62e5 100644 (file)
--- a/char-db-json.el
+++ b/char-db-json.el
@@ -30,6 +30,7 @@
 
 (setq char-db-ignored-attributes
       '(ideographic-products
 
 (setq char-db-ignored-attributes
       '(ideographic-products

+       composition

         ;; ->HNG
        *instance@ruimoku/bibliography/title
        *instance@morpheme-entry/zh-classical))
         ;; ->HNG
        *instance@ruimoku/bibliography/title
        *instance@morpheme-entry/zh-classical))

@@ -290,6 +291,8 @@
   (let ((lbs (concat "\n" (make-string (current-column) ?\ )))
        separator cell sources required-features
        ret)
   (let ((lbs (concat "\n" (make-string (current-column) ?\ )))
        separator cell sources required-features
        ret)

+    (if (characterp value)
+       (setq value (list value)))

     (while (consp value)
       (setq cell (car value))
       (if (integerp cell)
     (while (consp value)
       (setq cell (car value))
       (if (integerp cell)

@@ -367,11 +370,14 @@
        (if separator
            (insert separator)
          (setq separator (format ",%s" lbs)))
        (if separator
            (insert separator)
          (setq separator (format ",%s" lbs)))

-       (if readable
-           (insert (format "%S" cell))
-         (char-db-json-insert-char-spec cell readable
-                                        nil
-                                        required-features))
+        ;; (if readable
+        ;;     (insert (format "%S" cell))
+        ;;   (char-db-json-insert-char-spec cell readable
+        ;;                                  nil
+        ;;                                  required-features))
+       (char-db-json-insert-char-spec cell readable
+                                      nil
+                                      required-features)

        )
        ((consp cell)
        (if separator
        )
        ((consp cell)
        (if separator

@@ -512,9 +518,8 @@
       (when (and (memq name attributes)
                 (setq value (get-char-attribute char name)))
        (insert line-separator)
       (when (and (memq name attributes)
                 (setq value (get-char-attribute char name)))
        (insert line-separator)

-       (insert (format " \"%-20s\":  #x%04X,\t\"_comment\": \"%c\"%s"
-                       name value (decode-char '=ucs value)
-                       line-breaking))
+       (insert (format " \"%-20s\":  #x%04X,\t\"_comment\": \"%c\""
+                       name value (decode-char '=ucs value)))

        (setq attributes (delq name attributes))))
     (dolist (name '(=>ucs@gb =>ucs@big5))
       (when (and (memq name attributes)
        (setq attributes (delq name attributes))))
     (dolist (name '(=>ucs@gb =>ucs@big5))
       (when (and (memq name attributes)

@@ -726,18 +731,6 @@
            (setq strokes value)))
       (setq attributes (delq 'kangxi-strokes attributes))
       )
            (setq strokes value)))
       (setq attributes (delq 'kangxi-strokes attributes))
       )

-    (when (and (memq 'japanese-radical attributes)
-              (setq value (get-char-attribute char 'japanese-radical)))
-      (unless (eq value radical)
-       (insert line-separator)
-       (insert (format "{\"japanese-radical\":\t%S},\t\"_comment\": \"%c\"%s"
-                       value
-                       (ideographic-radical value)
-                       line-breaking))
-       (or radical
-           (setq radical value)))
-      (setq attributes (delq 'japanese-radical attributes))
-      )

     (when (and (memq 'japanese-strokes attributes)
               (setq value (get-char-attribute char 'japanese-strokes)))
       (unless (eq value strokes)
     (when (and (memq 'japanese-strokes attributes)
               (setq value (get-char-attribute char 'japanese-strokes)))
       (unless (eq value strokes)

@@ -769,39 +762,6 @@
            (setq strokes value)))
       (setq attributes (delq 'cns-strokes attributes))
       )
            (setq strokes value)))
       (setq attributes (delq 'cns-strokes attributes))
       )

-    (when (and (memq 'ideographic- attributes)
-              (setq value (get-char-attribute char 'ideographic-)))
-      (insert line-separator)
-      (insert "{\"ideographic-\":       ")
-      (setq lbs (concat "\n" (make-string (current-column) ?\ ))
-           separator nil)
-      (while (consp value)
-       (setq cell (car value))
-       (if (integerp cell)
-           (setq cell (decode-char '=ucs cell)))
-       (cond ((characterp cell)
-              (if separator
-                  (insert lbs))
-              (if readable
-                  (insert (format "%S" cell))
-                (char-db-json-insert-char-spec cell readable))
-              (setq separator lbs))
-             ((consp cell)
-              (if separator
-                  (insert lbs))
-              (if (consp (car cell))
-                  (char-db-json-insert-char-spec cell readable)
-                (char-db-json-insert-char-reference cell readable))
-              (setq separator lbs))
-             (t
-              (if separator
-                  (insert separator))
-              (insert (prin1-to-string cell))
-              (setq separator " ")))
-       (setq value (cdr value)))
-      (insert " }")
-      (insert line-breaking)
-      (setq attributes (delq 'ideographic- attributes)))

     (when (and (memq 'total-strokes attributes)
               (setq value (get-char-attribute char 'total-strokes)))
       (insert line-separator)
     (when (and (memq 'total-strokes attributes)
               (setq value (get-char-attribute char 'total-strokes)))
       (insert line-separator)

@@ -810,22 +770,6 @@
                      ))
       (setq attributes (delq 'total-strokes attributes))
       )
                      ))
       (setq attributes (delq 'total-strokes attributes))
       )

-    (when (and (memq '->ideograph attributes)
-              (setq value (get-char-attribute char '->ideograph)))
-      (insert line-separator)
-      (insert (format "{\"->ideograph\":\t%s}%s"
-                     (mapconcat (lambda (code)
-                                  (cond ((symbolp code)
-                                         (symbol-name code))
-                                        ((integerp code)
-                                         (format "#x%04X" code))
-                                        (t
-                                         (format "%s %S"
-                                                 line-breaking code))))
-                                value " ")
-                     line-breaking))
-      (setq attributes (delq '->ideograph attributes))
-      )

     (if (equal (get-char-attribute char '->titlecase)
               (get-char-attribute char '->uppercase))
        (setq attributes (delq '->titlecase attributes)))
     (if (equal (get-char-attribute char '->titlecase)
               (get-char-attribute char '->uppercase))
        (setq attributes (delq '->titlecase attributes)))

@@ -895,7 +839,7 @@
               )
              ((or (eq name 'ideographic-structure)
                   (eq name 'ideographic-combination)
               )
              ((or (eq name 'ideographic-structure)
                   (eq name 'ideographic-combination)

-                  (eq name 'ideographic-)
+                   ;; (eq name 'ideographic-)

                   (eq name '=decomposition)
                   (char-feature-base-name= '=decomposition name)
                   (char-feature-base-name= '=>decomposition name)
                   (eq name '=decomposition)
                   (char-feature-base-name= '=decomposition name)
                   (char-feature-base-name= '=>decomposition name)

@@ -909,35 +853,6 @@
               (char-db-json-insert-relation-feature char name value
                                                     line-breaking
                                                     ccss readable))
               (char-db-json-insert-relation-feature char name value
                                                     line-breaking
                                                     ccss readable))

-             ((memq name '(ideograph=
-                           original-ideograph-of
-                           ancient-ideograph-of
-                           vulgar-ideograph-of
-                           wrong-ideograph-of
-                           ;; simplified-ideograph-of
-                           ideographic-variants
-                           ;; ideographic-different-form-of
-                           ))
-              (insert line-separator)
-              (insert (format "{\"%-20s\":%s " name line-breaking))
-              (setq lbs (concat "\n" (make-string (current-column) ?\ ))
-                    separator nil)
-              (while (consp value)
-                (setq cell (car value))
-                (if (and (consp cell)
-                         (consp (car cell)))
-                    (progn
-                      (if separator
-                          (insert lbs))
-                      (char-db-json-insert-alist cell readable)
-                      (setq separator lbs))
-                  (if separator
-                      (insert separator))
-                  (insert (prin1-to-string cell))
-                  (setq separator " "))
-                (setq value (cdr value)))
-              (insert " }")
-              (insert line-breaking))

              ((consp value)
               (insert line-separator)
               (insert (format " %-20s [ "
              ((consp value)
               (insert line-separator)
               (insert (format " %-20s [ "

@@ -1076,7 +991,8 @@
 ;;;###autoload
 (defun what-char-definition-json (char)
   (interactive (list (char-after)))
 ;;;###autoload
 (defun what-char-definition-json (char)
   (interactive (list (char-after)))

-  (let ((buf (get-buffer-create "*Character Description*"))
+  (let ((est-hide-cgi-mode t)
+       (buf (get-buffer-create "*Character Description*"))

        (the-buf (current-buffer))
        (win-conf (current-window-configuration)))
     (pop-to-buffer buf)
        (the-buf (current-buffer))
        (win-conf (current-window-configuration)))
     (pop-to-buffer buf)

@@ -1086,7 +1002,7 @@
     (erase-buffer)
     (condition-case err
        (progn
     (erase-buffer)
     (condition-case err
        (progn

-         (char-db-json-char-data-with-variant char nil)
+         (char-db-json-char-data-with-variant char 'printable)

          (unless (char-attribute-alist char)
            (insert (format "// = %c\n"
                            (let* ((rest (split-char char))
          (unless (char-attribute-alist char)
            (insert (format "// = %c\n"
                            (let* ((rest (split-char char))