X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=est-rdf-view.el;h=62e21c7d4ac7eed4db44d05aabd004f279253062;hb=aa419fd536c3c8bee29dfd0ff186d969b4ff8afe;hp=6a7d2252de6b6608c0a2b198a05e4c6577141a42;hpb=ca7ce77367a8e5e76525da5ebe18582c32840ff7;p=chise%2Fest.git diff --git a/est-rdf-view.el b/est-rdf-view.el index 6a7d225..62e21c7 100644 --- a/est-rdf-view.el +++ b/est-rdf-view.el @@ -8,26 +8,39 @@ (defun est-rdf-encode-feature-name (feature-name) (let ((str (symbol-name feature-name)) base domain - ret) + ret is-not-top + xmlns-prefix xmlns-uri) (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 "")) - (if (eq (aref ret 0) ?.) - (setq ret (concat "meta" ret))) - (cons (if domain - (concat "est." - (mapconcat #'identity - (split-string domain "/") - ".")) - "est") + (if domain + (setq xmlns-prefix + (or xmlns-prefix + (concat "est." + (mapconcat #'identity + (split-string domain "/") + ".")))) + (setq xmlns-prefix (or (char-feature-property + feature-name 'rdf-namespace-prefix) + 'est) + xmlns-uri (char-feature-property + feature-name 'rdf-namespace-uri))) + (list xmlns-prefix + (or xmlns-uri + (format "http://www.chise.org/est/rdf.cgi?domain=%s/" + xmlns-prefix)) (www-uri-encode-feature-name (intern ret))))) (defun est-rdf-format-object (obj) @@ -70,10 +83,14 @@ (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-base rdf-feature-name-domain rdf-feature-name-uri 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 @@ -88,25 +105,39 @@ (if (eq genre 'character) (char-attribute-alist object) (concord-object-spec object))) - (princ - (format "\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))) + (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)) - (setq rdf-feature-name (format "%s:%s" (car ret)(cdr ret))) + (setq rdf-feature-name-domain (car ret) + rdf-feature-name-uri (nth 1 ret) + rdf-feature-name-base (nth 2 ret)) + (setq rdf-feature-name (format "%s:%s" + rdf-feature-name-domain + rdf-feature-name-base)) (setq rdf-feature-name-space - (format "xmlns:%s=\"http://www.chise.org/est/rdf.cgi?domain=%s/\"" - (car ret) - (car ret))) + (format "xmlns:%s=\"%s\"" + rdf-feature-name-domain + rdf-feature-name-uri)) (setq feature-type (www-feature-type logical-feature)) (if (and (consp value) (cdr value)) @@ -121,20 +152,74 @@ (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 metadata-feature-type + (intern (substring logical-feature-name + (+ (match-beginning 0) 2)))) + (setq ret (est-rdf-encode-feature-name metadata-feature-target)) + (princ + (format "\n" + (car ret)(nth 2 ret))) + (setq ret (est-rdf-encode-feature-name metadata-feature-type)) + (setq rdf-feature-name-domain (car ret) + rdf-feature-name-uri (nth 1 ret) + rdf-feature-name-base (nth 2 ret)) + (setq rdf-feature-name (format "%s:%s" + rdf-feature-name-domain + rdf-feature-name-base)) + (setq rdf-feature-name-space + (format "xmlns:%s=\"%s\"" + rdf-feature-name-domain + rdf-feature-name-uri)) + ) + (t + (setq metadata-feature-type nil) + (princ + (format "\n" + genre uri-object + )) + )) (princ - (format " <%s\n %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 "\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\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 "\n " rdf-container) + "") + rdf-feature-name) + ) + (t + (format " <%s\n %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 "\n " rdf-container) + "") + rdf-feature-name) + ))) + (princ "\n") )) - (princ "") ))) (defun est-rdf-display-feature-desc (uri-feature-name genre uri-object @@ -323,8 +408,7 @@ lang nil) )) )) - (princ " -") + (princ "") ) (error nil (princ (format "%S" err)))