From: MORIOKA Tomohiko Date: Mon, 10 Dec 2012 08:31:55 +0000 (+0900) Subject: (est-rdf-encode-feature-name): X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fest.git;a=commitdiff_plain;h=8ce688a1c36155c8aeecc469a5d4a93bb2da45cc (est-rdf-encode-feature-name): - 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'. --- diff --git a/est-rdf-view.el b/est-rdf-view.el index 6a7d225..eaafab7 100644 --- a/est-rdf-view.el +++ b/est-rdf-view.el @@ -8,20 +8,24 @@ (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) - (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))) + ;; (if (eq (aref ret 0) ?.) + ;; (setq ret (concat "meta" ret))) (cons (if domain (concat "est." (mapconcat #'identity @@ -70,10 +74,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 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,20 +96,31 @@ (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-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/\"" @@ -121,20 +140,69 @@ (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 "\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 "\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 +391,7 @@ lang nil) )) )) - (princ " -") + (princ "") ) (error nil (princ (format "%S" err)))