(est-rdf-encode-feature-name):
authorMORIOKA Tomohiko <tomo.git@chise.org>
Mon, 10 Dec 2012 08:31:55 +0000 (17:31 +0900)
committerMORIOKA Tomohiko <tomo.git@chise.org>
Mon, 10 Dec 2012 08:31:55 +0000 (17:31 +0900)
- Use ".-." instead of "." for non-top `*'.
- Use "..." instead of "-" for `/'.
(est-rdf-display-object-desc): Support metadata feature.
(est-rdf-batch-view): Modify for `est-rdf-display-object-desc'.

est-rdf-view.el

index 6a7d225..eaafab7 100644 (file)
@@ -8,20 +8,24 @@
 (defun est-rdf-encode-feature-name (feature-name)
   (let ((str (symbol-name feature-name))
        base domain
 (defun est-rdf-encode-feature-name (feature-name)
   (let ((str (symbol-name feature-name))
        base domain
-       ret)
+       ret is-not-top)
     (if (string-match "@" str)
        (setq base (substring str 0 (match-beginning 0))
              domain (substring str (match-end 0)))
       (setq base str))
     (setq ret (mapconcat (lambda (c)
     (if (string-match "@" str)
        (setq base (substring str 0 (match-beginning 0))
              domain (substring str (match-end 0)))
       (setq base str))
     (setq ret (mapconcat (lambda (c)
-                          (cond ((eq c ?*)
-                                 ".")
-                                ((eq c ?/)
-                                 "-")
-                                (t (char-to-string c))))
+                          (prog1
+                              (cond ((eq c ?*)
+                                     (if is-not-top
+                                         ".-."
+                                       "meta."))
+                                    ((eq c ?/)
+                                     "...")
+                                    (t (char-to-string c)))
+                            (setq is-not-top t)))
                         base ""))
                         base ""))
-    (if (eq (aref ret 0) ?.)
-       (setq ret (concat "meta" ret)))
+    ;; (if (eq (aref ret 0) ?.)
+    ;;     (setq ret (concat "meta" ret)))
     (cons (if domain
              (concat "est."
                      (mapconcat #'identity
     (cons (if domain
              (concat "est."
                      (mapconcat #'identity
     (setq level 0))
   (let ((object (www-uri-decode-object genre uri-object))
        logical-feature chise-wiki-displayed-features
     (setq level 0))
   (let ((object (www-uri-decode-object genre uri-object))
        logical-feature chise-wiki-displayed-features
-       object-spec
+       logical-feature-name
+       object-spec logical-object-spec
        rdf-feature-name rdf-feature-name-space
        rdf-feature-name rdf-feature-name-space
+       rdf-feature-name-base rdf-feature-name-domain
        feature-type rdf-container
        feature-type rdf-container
-       value ret)
+       value ret
+       metadata-feature-target metadata-feature-type
+       have-matedata)
     (if (eq level 0)
        (setq level 1))
     (when object
     (if (eq level 0)
        (setq level 1))
     (when object
            (if (eq genre 'character)
                (char-attribute-alist object)
              (concord-object-spec object)))
            (if (eq genre 'character)
                (char-attribute-alist object)
              (concord-object-spec object)))
-      (princ
-       (format "<rdf:Description
- rdf:about=\"http://www.chise.org/est/rdf.cgi/%s=%s\">\n"
-              genre uri-object))
       (dolist (cell (sort object-spec
                          (lambda (a b)
                            (char-attribute-name<
                             (char-feature-name-sans-versions (car a))
                             (char-feature-name-sans-versions (car b))))))
        (setq logical-feature (char-feature-name-sans-versions (car cell)))
       (dolist (cell (sort object-spec
                          (lambda (a b)
                            (char-attribute-name<
                             (char-feature-name-sans-versions (car a))
                             (char-feature-name-sans-versions (car b))))))
        (setq logical-feature (char-feature-name-sans-versions (car cell)))
+       (setq logical-feature-name (symbol-name logical-feature))
+       (when (string-match "[^*]\\*[^*]+$" logical-feature-name)
+         (setq metadata-feature-target
+               (intern (substring logical-feature-name
+                                  0 (1+ (match-beginning 0)))))
+          (push metadata-feature-target have-matedata))
+       (push (cons logical-feature (cdr cell))
+             logical-object-spec)
+       )
+      (dolist (cell (nreverse logical-object-spec))
+        ;; (setq logical-feature (char-feature-name-sans-versions (car cell)))
+       (setq logical-feature (car cell))
+       (setq logical-feature-name (symbol-name logical-feature))
        (unless (memq logical-feature chise-wiki-displayed-features)
          (push logical-feature chise-wiki-displayed-features)
          (setq value (www-get-feature-value object logical-feature))
          (setq ret (est-rdf-encode-feature-name logical-feature))
        (unless (memq logical-feature chise-wiki-displayed-features)
          (push logical-feature chise-wiki-displayed-features)
          (setq value (www-get-feature-value object logical-feature))
          (setq ret (est-rdf-encode-feature-name logical-feature))
+         (setq rdf-feature-name-domain (car ret)
+               rdf-feature-name-base (cdr ret))
          (setq rdf-feature-name (format "%s:%s" (car ret)(cdr ret)))
          (setq rdf-feature-name-space
                (format "xmlns:%s=\"http://www.chise.org/est/rdf.cgi?domain=%s/\""
          (setq rdf-feature-name (format "%s:%s" (car ret)(cdr ret)))
          (setq rdf-feature-name-space
                (format "xmlns:%s=\"http://www.chise.org/est/rdf.cgi?domain=%s/\""
                (setq rdf-container "rdf:Bag")
                ))
            (setq rdf-container nil))
                (setq rdf-container "rdf:Bag")
                ))
            (setq rdf-container nil))
+         (cond
+          ((string-match "[^*]\\*[^*]+$" logical-feature-name)
+           (setq metadata-feature-target
+                 (intern (substring logical-feature-name
+                                    0 (1+ (match-beginning 0)))))
+           (setq metadata-feature-type
+                 (intern (substring logical-feature-name
+                                    (1+ (match-beginning 0)))))
+           (setq ret (est-rdf-encode-feature-name metadata-feature-target))
+           (princ
+            (format "<rdf:Description
+ rdf:about=\"#%s...%s\">\n"
+                    (car ret)(cdr ret)))
+           (setq ret (est-rdf-encode-feature-name metadata-feature-type))
+           (setq rdf-feature-name-domain (car ret)
+                 rdf-feature-name-base (cdr ret))
+           (setq rdf-feature-name (format "%s:%s" (car ret)(cdr ret)))
+           (setq rdf-feature-name-space
+                 (format
+                  "xmlns:%s=\"http://www.chise.org/est/rdf.cgi?domain=%s/\""
+                  (car ret)
+                  (car ret)))
+           )
+          (t
+           (setq metadata-feature-type nil)
+           (princ
+            (format "<rdf:Description
+ rdf:about=\"http://www.chise.org/est/rdf.cgi?%s=%s\">\n"
+                    genre uri-object
+                    ))
+           ))
          (princ
          (princ
-          (format "  <%s\n   %s>%s%s%s</%s>\n"
-                  rdf-feature-name
-                  rdf-feature-name-space
-                  (if rdf-container
-                      (format "\n  <%s>" rdf-container)
-                    "")
-                   (est-rdf-format-object-list value rdf-container)
-                  (if rdf-container
-                      (format "</%s>\n  " rdf-container)
-                    "")
-                   rdf-feature-name))
+          (cond
+           ((memq logical-feature have-matedata)
+            ;; (setq ret (assq logical-feature feature-metadata-alist))
+            (format "  <%s\n   %s\n   rdf:ID=\"%s...%s\">%s%s%s</%s>\n"
+                    rdf-feature-name
+                    rdf-feature-name-space
+                    rdf-feature-name-domain rdf-feature-name-base
+                    (if rdf-container
+                        (format "\n  <%s>" rdf-container)
+                      "")
+                    (est-rdf-format-object-list value rdf-container)
+                    (if rdf-container
+                        (format "</%s>\n  " rdf-container)
+                      "")
+                    rdf-feature-name)
+            )
+           (t
+            (format "  <%s\n   %s>%s%s%s</%s>\n"
+                    rdf-feature-name
+                    rdf-feature-name-space
+                    (if rdf-container
+                        (format "\n  <%s>" rdf-container)
+                      "")
+                    (est-rdf-format-object-list value rdf-container)
+                    (if rdf-container
+                        (format "</%s>\n  " rdf-container)
+                      "")
+                    rdf-feature-name)
+            )))
+         (princ "</rdf:Description>\n")
          ))
          ))
-      (princ "</rdf:Description>")
       )))
 
 (defun est-rdf-display-feature-desc (uri-feature-name genre uri-object
       )))
 
 (defun est-rdf-display-feature-desc (uri-feature-name genre uri-object
                  lang nil)
                 ))
          ))
                  lang nil)
                 ))
          ))
-        (princ "
-</rdf:RDF>")
+        (princ "</rdf:RDF>")
        )
     (error nil
           (princ (format "%S" err)))
        )
     (error nil
           (princ (format "%S" err)))