New file.

diff --git a/est-rdf-view.el b/est-rdf-view.el
new file mode 100644 (file)
index 0000000..6a7d225
--- /dev/null
+++ b/est-rdf-view.el
@@ -0,0 +1,333 @@
+;; -*- coding: utf-8-mcs-er -*-
+(require 'cwiki-format)
+
+(defvar chise-wiki-view-url "view.cgi")
+(defvar chise-wiki-edit-url "edit.cgi")
+(defvar chise-wiki-add-url "add.cgi")
+
+(defun est-rdf-encode-feature-name (feature-name)
+  (let ((str (symbol-name feature-name))
+       base domain
+       ret)
+    (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))))
+                        base ""))
+    (if (eq (aref ret 0) ?.)
+       (setq ret (concat "meta" ret)))
+    (cons (if domain
+             (concat "est."
+                     (mapconcat #'identity
+                                (split-string domain "/")
+                                "."))
+           "est")
+         (www-uri-encode-feature-name (intern ret)))))
+
+(defun est-rdf-format-object (obj)
+  (if (or (characterp obj)
+         (concord-object-p obj))
+      (let ((genre (est-object-genre obj))
+           (url-object (www-uri-encode-object obj)))
+       (format "
+    <rdf:Description
+     rdf:about=\"http://www.chise.org/est/rdf.cgi?%s=%s\">
+    </rdf:Description>"
+               genre url-object))
+    (encode-coding-string (format "
+    %s" obj)
+                         'utf-8-mcs-er)))
+
+(defun est-rdf-format-object-list (obj-list &optional with-li)
+  ;; (concat (mapconcat #'est-rdf-format-object
+  ;;                    obj-list
+  ;;                    "")
+  ;;         "\n")
+  (let ((rest obj-list)
+       dest obj)
+    (while (consp rest)
+      (setq obj (pop rest))
+      (if with-li
+         (setq dest (concat dest
+                            "
+    <rdf:li>"
+                            (est-rdf-format-object obj)
+                            "
+    </rdf:li>"))
+       (setq dest (concat dest (est-rdf-format-object obj)))))
+    (if rest
+       (setq dest (concat dest (est-rdf-format-object rest))))
+    (concat dest "\n  ")))
+
+(defun est-rdf-display-object-desc (genre uri-object &optional lang level)
+  (unless level
+    (setq level 0))
+  (let ((object (www-uri-decode-object genre uri-object))
+       logical-feature chise-wiki-displayed-features
+       object-spec
+       rdf-feature-name rdf-feature-name-space
+       feature-type rdf-container
+       value ret)
+    (if (eq level 0)
+       (setq level 1))
+    (when object
+      (when (and (eq genre 'character)
+                (= (length uri-object) 1))
+       (setq uri-object (www-uri-encode-object object)))
+      (when (eq genre 'character)
+       (dolist (feature (char-feature-property '$object 'additional-features))
+         (mount-char-attribute-table
+          (char-feature-name-at-domain feature '$rev=latest))))
+      (setq object-spec
+           (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)))
+       (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-space
+               (format "xmlns:%s=\"http://www.chise.org/est/rdf.cgi?domain=%s/\""
+                       (car ret)
+                       (car ret)))
+         (setq feature-type (www-feature-type logical-feature))
+         (if (and (consp value)
+                  (cdr value))
+             (cond
+              ((eq feature-type 'structure)
+               (setq rdf-container "rdf:Seq")
+               )
+               ;; ((eq feature-type 'relation)
+               ;;  (setq rdf-container "rdf:Bag")
+               ;;  )
+              (t
+               (setq rdf-container "rdf:Bag")
+               ))
+           (setq rdf-container nil))
+         (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))
+         ))
+      (princ "</rdf:Description>")
+      )))
+
+(defun est-rdf-display-feature-desc (uri-feature-name genre uri-object
+                                                 &optional lang simple)
+  (let ((feature-name (www-uri-decode-feature-name uri-feature-name))
+       (name@lang (intern (format "name@%s" lang))))
+    (princ
+     (encode-coding-string
+      (format "<head>
+<title>EsT feature: %s</title>
+</head>\n"
+             feature-name)
+      'utf-8-mcs-er))
+    (princ "<body>\n")
+    (princ
+     (format
+      (if simple
+         "<div style=\"text-align:right;\">
+<a href=\"edit/view.cgi?feature=%s&%s=%s\">
+<input type=\"submit\" value=\"Edit\" />
+</a>
+<input type=\"submit\" value=\"New Account\" />
+</div>
+<hr />\n"
+         "<div style=\"text-align:right;\">
+<a href=\"../view.cgi?feature=%s&%s=%s\">
+<input type=\"submit\" value=\"Simple\" />
+</a>
+</div>
+<hr />\n")
+      uri-feature-name genre uri-object))
+    (princ
+     (format "<h1>%s</h1>\n"
+            (www-format-encode-string
+             (symbol-name feature-name))))
+    (princ (format "<p>name : %s "
+                  (or (www-format-feature-name feature-name) "")))
+    (unless simple
+      (princ
+       (format
+       " <a href=\"%s?feature=%s&property=name&format=string&%s=%s\">"
+       chise-wiki-edit-url
+       uri-feature-name
+       genre
+       uri-object))
+      (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
+    (princ "</p>\n")
+    (when lang
+      (princ "<p>")
+      (princ
+       (www-format-encode-string
+       (format "%s : %s"
+               name@lang
+               (or (char-feature-property feature-name name@lang) ""))))
+      (unless simple
+       (princ
+        (format
+         " <a href=\"%s?feature=%s&property=%s&format=string&%s=%s\">"
+         chise-wiki-edit-url
+         uri-feature-name
+         name@lang
+         genre
+         uri-object))
+       (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
+      (princ "</p>\n"))
+    (www-html-display-paragraph
+     (format "type : %s"
+             (or (www-feature-type feature-name)
+                ;; (char-feature-property feature-name 'type)
+                'generic)))
+    (princ (format "<p>value-format : %s "
+                  (www-format-value
+                   nil 'value-format 
+                   (or (www-feature-value-format feature-name)
+                       'default)
+                   'default
+                   'without-tags)
+                  ))
+    (unless simple
+      (princ
+       (format
+       " <a href=\"%s?feature=%s&property=value-format&format=wiki-text&%s=%s\"
+>"
+       chise-wiki-edit-url
+       uri-feature-name
+       genre
+       uri-object))
+      (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
+    (princ "</p>\n")
+
+    (princ "<p>format : ")
+    (www-html-display-text
+     (decode-coding-string
+      (www-xml-format-list
+       (www-feature-format feature-name))
+      'utf-8-mcs-er))
+    (unless simple
+      (princ
+       (format
+       " <a href=\"%s?feature=%s&property=format&format=wiki-text&%s=%s\"
+>"
+       chise-wiki-edit-url
+       uri-feature-name
+       genre
+       uri-object))
+      (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
+    (princ "</p>\n")
+    
+    (www-html-display-paragraph
+     (format "description : %s"
+             (or (char-feature-property feature-name 'description)
+                "")))
+    (when lang
+      (www-html-display-paragraph
+       (format "description@%s : %s"
+              lang
+              (or (char-feature-property
+                   feature-name
+                   (intern (format "description@%s" lang)))
+                  ""))))
+    ))
+  
+(defun est-rdf-batch-view ()
+  (setq terminal-coding-system 'binary)
+  (condition-case err
+      (let* ((target (pop command-line-args-left))
+            (user (pop command-line-args-left))
+            (accept-language (pop command-line-args-left))
+            (mode (intern (pop command-line-args-left)))
+            (lang
+             (intern
+              (car (split-string
+                    (car (split-string
+                          (car (split-string accept-language ","))
+                          ";"))
+                    "-"))))
+            ret genre)
+       (princ "Content-Type: application/xml
+
+<?xml version=\"1.0\" encoding=\"UTF-8\" ?>
+<rdf:RDF
+  xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"
+  xmlns:dc=\"http://purl.org/dc/elements/1.1/\">
+")
+       (cond
+        ((stringp target)
+         (when (string-match "^char=\\(&[^&;]+;\\)" target)
+           (setq ret (match-end 0))
+           (setq target
+                 (concat "char="
+                         (www-uri-encode-object
+                          (www-uri-decode-object
+                           'character (match-string 1 target)))
+                         (substring target ret))))
+         (setq target
+               (mapcar (lambda (cell)
+                         (if (string-match "=" cell)
+                             (progn
+                               (setq genre (substring cell 0 (match-beginning 0))
+                                     ret (substring cell (match-end 0)))
+                               (cons
+                                (intern
+                                 (decode-uri-string genre 'utf-8-mcs-er))
+                                ret))
+                           (list (decode-uri-string cell 'utf-8-mcs-er))))
+                       (split-string target "&")))
+         (setq ret (car target))
+         (cond ((eq (car ret) 'char)
+                (est-rdf-display-object-desc
+                 'character
+                  (cdr ret)
+                 lang nil)
+                )
+               ((eq (car ret) 'feature)
+                (est-rdf-display-feature-desc
+                 (decode-uri-string (cdr ret) 'utf-8-mcs-er)
+                 (car (nth 1 target))
+                 (cdr (nth 1 target))
+                 lang
+                 (eq mode 'simple))
+                )
+               (t
+                (est-rdf-display-object-desc
+                 (car ret)
+                  (cdr ret)
+                 lang nil)
+                ))
+         ))
+        (princ "
+</rdf:RDF>")
+       )
+    (error nil
+          (princ (format "%S" err)))
+    ))
+
+(provide 'cwiki-view)