(www-display-object-desc): Add a link-button for RDF.
[chise/est.git] / cwiki-view.el
index e2ca292..42fe042 100644 (file)
@@ -5,14 +5,71 @@
 (defvar chise-wiki-edit-url "edit.cgi")
 (defvar chise-wiki-add-url "add.cgi")
 
-(defun www-display-object-desc (genre uri-object &optional lang level simple)
+(defun www-edit-display-feature-input-box (char feature-name
+                                               &optional format value)
+  (if (symbolp char)
+      (setq char (or (concord-decode-object '=id char 'feature)
+                    (concord-make-object 'feature char))))
+  (unless format
+    (setq format 'default))
+  (unless value
+    (setq value (www-get-feature-value char feature-name)))
+  (if (and (symbolp value)
+          (eq format 'wiki-text))
+      (setq value (list (list value))))
+  (princ
+   (format "<p><input type=\"text\" name=\"feature-name\"
+size=\"32\" maxlength=\"256\" value=\"%s\">"
+          feature-name))
+  (princ (encode-coding-string " \u2190 " 'utf-8-mcs-er))
+  (princ
+   (format "%s<input type=\"text\" name=\"%s\"
+size=\"64\" maxlength=\"256\" value=\"%s\">
+<input type=\"submit\" value=\"set\" /></p>
+"
+          (if (or (eq format 'HEX)(eq format 'hex))
+              "0x"
+            "")
+          format
+          (mapconcat (lambda (c)
+                       (cond
+                         ;; ((eq c ?<) "&amp;lt;")
+                         ;; ((eq c ?>) "&amp;gt;")
+                        ((eq c ?\u0022) "&quot;")
+                        (t
+                         (char-to-string c))))
+                     (est-format-list value format nil nil " ")
+                     "")))
+  )
+
+(defun www-display-object-desc (genre uri-object &optional lang level simple
+                                     uri-feature-name-to-edit editing-format)
   (unless level
-    (setq level 1))
+    (setq level 0))
   (let ((object (www-uri-decode-object genre uri-object))
+       feature-name-to-edit
+       base-name-to-edit metadata-name-to-edit
+       without-header
        logical-feature chise-wiki-displayed-features
        parents
-       GlyphWiki-id)
+       GlyphWiki-id ret object-spec)
+    (if (eq level 0)
+       (setq level 1
+             without-header nil)
+      (setq without-header t))
     (when object
+      (when uri-feature-name-to-edit
+       (setq feature-name-to-edit
+             (www-uri-decode-feature-name uri-feature-name-to-edit))
+       (setq ret (symbol-name feature-name-to-edit))
+       (if (string-match "\\*" ret)
+           (setq base-name-to-edit (intern
+                                    (substring ret 0 (match-beginning 0)))
+                 metadata-name-to-edit (intern
+                                        (substring ret (match-end 0))))
+         (setq base-name-to-edit feature-name-to-edit))
+       (when (stringp editing-format)
+         (setq editing-format (intern editing-format))))
       (when (and (eq genre 'character)
                 (= (length uri-object) 1))
        (setq uri-object (www-uri-encode-object object)))
 <input type=\"submit\" value=\"Edit\" />
 </a>
 <input type=\"submit\" value=\"New Account\" />
+<a href=\"http://www.chise.org/est/rdf.cgi?%s=%s\">
+<input type=\"submit\" value=\"RDF\" />
+</a>
 </div>
 <hr />\n"
          "<div style=\"text-align:right;\">
 <a href=\"../view.cgi?%s=%s\">
 <input type=\"submit\" value=\"Simple\" />
 </a>
+<input type=\"submit\" value=\"New Account\" />
+<a href=\"http://www.chise.org/est/rdf.cgi?%s=%s\">
+<input type=\"submit\" value=\"RDF\" />
+</a>
 </div>
 <hr />\n")
-       genre
-       uri-object))
+       genre uri-object
+       genre uri-object))
       (when (setq parents (www-get-feature-value object '<-denotational))
        (princ (format "<p>%s %s</p>\n<hr>\n"
                       (www-format-value-as-char-list parents)
       (princ (format "<h%d>%s%s</h%d>\n"
                     level
                     (www-format-encode-string
-                     (est-format-object object)
-                      ;; (if (eq genre 'character)
-                      ;;     (char-to-string object)
-                      ;;   (format "%s" (concord-object-id object)))
-                     )
+                     (est-format-object object 'readable))
                     (if GlyphWiki-id
                         (format
                          " <a href=\"http://glyphwiki.org/wiki/%s\"><img alt=\"%s\" src=\"http://glyphwiki.org/glyph/%s.50px.png\" /></a>"
                     level))
       (if (> level 1)
          (princ "<ul>"))
-      (dolist (cell (sort (if (eq genre 'character)
-                             (char-attribute-alist object)
-                           (concord-object-spec object))
+      (when feature-name-to-edit
+       (princ "<form action=\"set.cgi\" method=\"GET\">\n")
+       (princ
+        (encode-coding-string
+         (format "<p>(%s : <input type=\"text\" name=\"%s\"
+size=\"30\" maxlength=\"30\" value=\"%s\">)</p>
+"
+                 genre genre
+                 (decode-uri-string uri-object 'utf-8-mcs-er))
+         'utf-8-mcs-er)))
+      (setq object-spec
+           (if (eq genre 'character)
+               (char-attribute-alist object)
+             (concord-object-spec object)))
+      (when feature-name-to-edit
+       (unless (assq base-name-to-edit object-spec)
+         (setq object-spec (cons (cons base-name-to-edit nil)
+                                 object-spec))))
+      (dolist (cell (sort object-spec
                          (lambda (a b)
                            (char-attribute-name<
                             (char-feature-name-sans-versions (car a))
        (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)
-         (princ
-          (if (= level 1)
-              "<div class=\"feature\" style=\"line-height:150%\">\n"
-            "<li>\n"))
-         (princ
-          (www-format-eval-list
-           (www-feature-format logical-feature)
-           object
-           logical-feature ; (car cell)
-           lang uri-object
-           nil simple))
-         (unless simple
+         (cond
+          ((and feature-name-to-edit
+                (eq (car cell) feature-name-to-edit))
+           (www-edit-display-feature-input-box
+            object feature-name-to-edit editing-format)
+           )
+          (t
+           (princ
+            (if (= level 1)
+                "<div class=\"feature\" style=\"line-height:150%\">\n"
+              "<li>\n"))
            (princ
-            (format " <a href=\"%s?%s=%s&feature=%s&format=wiki-text\"
+            (www-format-eval-list
+             (www-feature-format logical-feature)
+             object
+             logical-feature ; (car cell)
+             lang uri-object
+             nil simple))
+           (unless simple
+             (princ
+              (format " <a href=\"%s?%s=%s&feature=%s&format=wiki-text\"
 ><input type=\"submit\" value=\"note\" /></a>"
-                    chise-wiki-edit-url
-                    genre
-                    (www-format-encode-string uri-object)
-                    (www-format-encode-string
-                     (www-uri-encode-feature-name
-                      (intern (format "%s*note"
-                                      logical-feature ; (car cell)
-                                      )))))))
-         (princ
-          (if (= level 1)
-              "</div>\n"
-            "<li>\n"))
+                      chise-wiki-edit-url
+                      genre
+                      (www-format-encode-string uri-object)
+                      (www-format-encode-string
+                       (www-uri-encode-feature-name
+                        (intern (format "%s*note"
+                                        logical-feature ; (car cell)
+                                        )))))))
+           (when (and feature-name-to-edit
+                      (eq base-name-to-edit (car cell)) metadata-name-to-edit)
+             (princ "<ul>\n")
+             (princ "<li>")
+             (www-edit-display-feature-input-box
+              object feature-name-to-edit editing-format)
+             (princ "</li>")
+             (princ "</ul>"))
+           (princ
+            (if (= level 1)
+                "</div>\n"
+              "<li>\n"))
+           ))
          ))
       (princ
        (if (= level 1)
           "<p>\n"
         "<li>\n"))
+      (when feature-name-to-edit
+       (princ "</form>\n"))
       (unless simple
        (princ
         (format "<a href=\"%s?%s=%s\"
@@ -234,7 +328,8 @@ size=\"30\" maxlength=\"30\" value=\"%s\" />"
                    (or (www-feature-value-format feature-name)
                        'default)
                    'default
-                   'without-tags)))
+                   'without-tags)
+                  ))
     (unless simple
       (princ
        (format
@@ -293,7 +388,7 @@ size=\"30\" maxlength=\"30\" value=\"%s\" />"
                           (car (split-string accept-language ","))
                           ";"))
                     "-"))))
-            ret)
+            ret genre)
        (princ "Content-Type: text/html; charset=UTF-8
 
 <!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
@@ -313,12 +408,13 @@ size=\"30\" maxlength=\"30\" value=\"%s\" />"
          (setq target
                (mapcar (lambda (cell)
                          (if (string-match "=" cell)
-                             (cons
-                              (intern
-                               (decode-uri-string
-                                (substring cell 0 (match-beginning 0))
-                                'utf-8-mcs-er))
-                              (substring cell (match-end 0)))
+                             (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))