1 ;; -*- coding: utf-8-mcs-er -*-
2 (require 'cwiki-format)
4 (defvar chise-wiki-view-url "view.cgi")
5 (defvar chise-wiki-edit-url "edit.cgi")
6 (defvar chise-wiki-add-url "add.cgi")
8 (defun est-rdf-encode-feature-name (feature-name)
9 (let ((str (symbol-name feature-name))
12 xmlns-prefix xmlns-uri)
13 (if (string-match "@" str)
14 (setq base (substring str 0 (match-beginning 0))
15 domain (substring str (match-end 0)))
17 (setq ret (mapconcat (lambda (c)
25 (t (char-to-string c)))
33 (split-string domain "/")
35 (setq xmlns-prefix (or (char-feature-property
36 feature-name 'rdf-namespace-prefix)
38 xmlns-uri (char-feature-property
39 feature-name 'rdf-namespace-uri)))
42 (format "http://www.chise.org/est/rdf.cgi?domain=%s/"
44 (www-uri-encode-feature-name (intern ret)))))
46 (defun est-rdf-format-object (obj)
47 (if (or (characterp obj)
48 (concord-object-p obj))
49 (let ((genre (est-object-genre obj))
50 (url-object (www-uri-encode-object obj)))
53 rdf:about=\"http://www.chise.org/est/rdf.cgi?%s=%s\">
56 (encode-coding-string (format "
60 (defun est-rdf-format-object-list (obj-list &optional with-li)
61 ;; (concat (mapconcat #'est-rdf-format-object
70 (setq dest (concat dest
73 (est-rdf-format-object obj)
76 (setq dest (concat dest (est-rdf-format-object obj)))))
78 (setq dest (concat dest (est-rdf-format-object rest))))
81 (defun est-rdf-display-object-desc (genre uri-object &optional lang level)
84 (let ((object (www-uri-decode-object genre uri-object))
85 logical-feature chise-wiki-displayed-features
87 object-spec logical-object-spec
88 rdf-feature-name rdf-feature-name-space
89 rdf-feature-name-base rdf-feature-name-domain rdf-feature-name-uri
90 feature-type rdf-container
92 metadata-feature-target metadata-feature-type
97 (when (and (eq genre 'character)
98 (= (length uri-object) 1))
99 (setq uri-object (www-uri-encode-object object)))
100 (when (eq genre 'character)
101 (dolist (feature (char-feature-property '$object 'additional-features))
102 (mount-char-attribute-table
103 (char-feature-name-at-domain feature '$rev=latest))))
105 (if (eq genre 'character)
106 (char-attribute-alist object)
107 (concord-object-spec object)))
108 (dolist (cell (sort object-spec
110 (char-attribute-name<
111 (char-feature-name-sans-versions (car a))
112 (char-feature-name-sans-versions (car b))))))
113 (setq logical-feature (char-feature-name-sans-versions (car cell)))
114 (setq logical-feature-name (symbol-name logical-feature))
115 (when (string-match "[^*]\\*[^*]+$" logical-feature-name)
116 (setq metadata-feature-target
117 (intern (substring logical-feature-name
118 0 (1+ (match-beginning 0)))))
119 (push metadata-feature-target have-matedata))
120 (push (cons logical-feature (cdr cell))
123 (dolist (cell (nreverse logical-object-spec))
124 ;; (setq logical-feature (char-feature-name-sans-versions (car cell)))
125 (setq logical-feature (car cell))
126 (setq logical-feature-name (symbol-name logical-feature))
127 (unless (memq logical-feature chise-wiki-displayed-features)
128 (push logical-feature chise-wiki-displayed-features)
129 (setq value (www-get-feature-value object logical-feature))
130 (setq ret (est-rdf-encode-feature-name logical-feature))
131 (setq rdf-feature-name-domain (car ret)
132 rdf-feature-name-uri (nth 1 ret)
133 rdf-feature-name-base (nth 2 ret))
134 (setq rdf-feature-name (format "%s:%s"
135 rdf-feature-name-domain
136 rdf-feature-name-base))
137 (setq rdf-feature-name-space
138 (format "xmlns:%s=\"%s\""
139 rdf-feature-name-domain
140 rdf-feature-name-uri))
141 (setq feature-type (www-feature-type logical-feature))
142 (if (and (consp value)
145 ((eq feature-type 'structure)
146 (setq rdf-container "rdf:Seq")
148 ;; ((eq feature-type 'relation)
149 ;; (setq rdf-container "rdf:Bag")
152 (setq rdf-container "rdf:Bag")
154 (setq rdf-container nil))
156 ((string-match "[^*]\\*[^*]+$" logical-feature-name)
157 (setq metadata-feature-target
158 (intern (substring logical-feature-name
159 0 (1+ (match-beginning 0)))))
160 ;; (setq metadata-feature-type
161 ;; (intern (substring logical-feature-name
162 ;; (1+ (match-beginning 0)))))
163 (setq metadata-feature-type
164 (intern (substring logical-feature-name
165 (+ (match-beginning 0) 2))))
166 (setq ret (est-rdf-encode-feature-name metadata-feature-target))
168 (format "<rdf:Description
169 rdf:about=\"#%s...%s\">\n"
170 (car ret)(nth 2 ret)))
171 (setq ret (est-rdf-encode-feature-name metadata-feature-type))
172 (setq rdf-feature-name-domain (car ret)
173 rdf-feature-name-uri (nth 1 ret)
174 rdf-feature-name-base (nth 2 ret))
175 (setq rdf-feature-name (format "%s:%s"
176 rdf-feature-name-domain
177 rdf-feature-name-base))
178 (setq rdf-feature-name-space
179 (format "xmlns:%s=\"%s\""
180 rdf-feature-name-domain
181 rdf-feature-name-uri))
184 (setq metadata-feature-type nil)
186 (format "<rdf:Description
187 rdf:about=\"http://www.chise.org/est/rdf.cgi?%s=%s\">\n"
193 ((memq logical-feature have-matedata)
194 ;; (setq ret (assq logical-feature feature-metadata-alist))
195 (format " <%s\n %s\n rdf:ID=\"%s...%s\">%s%s%s</%s>\n"
197 rdf-feature-name-space
198 rdf-feature-name-domain rdf-feature-name-base
200 (format "\n <%s>" rdf-container)
202 (est-rdf-format-object-list value rdf-container)
204 (format "</%s>\n " rdf-container)
209 (format " <%s\n %s>%s%s%s</%s>\n"
211 rdf-feature-name-space
213 (format "\n <%s>" rdf-container)
215 (est-rdf-format-object-list value rdf-container)
217 (format "</%s>\n " rdf-container)
221 (princ "</rdf:Description>\n")
225 (defun est-rdf-display-feature-desc (uri-feature-name genre uri-object
226 &optional lang simple)
227 (let ((feature-name (www-uri-decode-feature-name uri-feature-name))
228 (name@lang (intern (format "name@%s" lang))))
230 (encode-coding-string
232 <title>EsT feature: %s</title>
240 "<div style=\"text-align:right;\">
241 <a href=\"edit/view.cgi?feature=%s&%s=%s\">
242 <input type=\"submit\" value=\"Edit\" />
244 <input type=\"submit\" value=\"New Account\" />
247 "<div style=\"text-align:right;\">
248 <a href=\"../view.cgi?feature=%s&%s=%s\">
249 <input type=\"submit\" value=\"Simple\" />
253 uri-feature-name genre uri-object))
255 (format "<h1>%s</h1>\n"
256 (www-format-encode-string
257 (symbol-name feature-name))))
258 (princ (format "<p>name : %s "
259 (or (www-format-feature-name feature-name) "")))
263 " <a href=\"%s?feature=%s&property=name&format=string&%s=%s\">"
268 (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
273 (www-format-encode-string
276 (or (char-feature-property feature-name name@lang) ""))))
280 " <a href=\"%s?feature=%s&property=%s&format=string&%s=%s\">"
286 (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
288 (www-html-display-paragraph
290 (or (www-feature-type feature-name)
291 ;; (char-feature-property feature-name 'type)
293 (princ (format "<p>value-format : %s "
296 (or (www-feature-value-format feature-name)
304 " <a href=\"%s?feature=%s&property=value-format&format=wiki-text&%s=%s\"
310 (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
313 (princ "<p>format : ")
314 (www-html-display-text
315 (decode-coding-string
317 (www-feature-format feature-name))
322 " <a href=\"%s?feature=%s&property=format&format=wiki-text&%s=%s\"
328 (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
331 (www-html-display-paragraph
332 (format "description : %s"
333 (or (char-feature-property feature-name 'description)
336 (www-html-display-paragraph
337 (format "description@%s : %s"
339 (or (char-feature-property
341 (intern (format "description@%s" lang)))
345 (defun est-rdf-batch-view ()
346 (setq terminal-coding-system 'binary)
348 (let* ((target (pop command-line-args-left))
349 (user (pop command-line-args-left))
350 (accept-language (pop command-line-args-left))
351 (mode (intern (pop command-line-args-left)))
356 (car (split-string accept-language ","))
360 (princ "Content-Type: application/xml
362 <?xml version=\"1.0\" encoding=\"UTF-8\" ?>
364 xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"
365 xmlns:dc=\"http://purl.org/dc/elements/1.1/\">
369 (when (string-match "^char=\\(&[^&;]+;\\)" target)
370 (setq ret (match-end 0))
373 (www-uri-encode-object
374 (www-uri-decode-object
375 'character (match-string 1 target)))
376 (substring target ret))))
378 (mapcar (lambda (cell)
379 (if (string-match "=" cell)
381 (setq genre (substring cell 0 (match-beginning 0))
382 ret (substring cell (match-end 0)))
385 (decode-uri-string genre 'utf-8-mcs-er))
387 (list (decode-uri-string cell 'utf-8-mcs-er))))
388 (split-string target "&")))
389 (setq ret (car target))
390 (cond ((eq (car ret) 'char)
391 (est-rdf-display-object-desc
396 ((eq (car ret) 'feature)
397 (est-rdf-display-feature-desc
398 (decode-uri-string (cdr ret) 'utf-8-mcs-er)
405 (est-rdf-display-object-desc
414 (princ (format "%S" err)))
417 (provide 'cwiki-view)