X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fest.git;a=blobdiff_plain;f=cwiki-edit.el;h=0c9a07bd7d62d34403032ccea1e092a214128d90;hp=dc633c954c7511043a3a6a904b1a50895b13edd0;hb=HEAD;hpb=9a3766c07578e4798ba19b92f79518bdb902d1b2

diff --git a/cwiki-edit.el b/cwiki-edit.el
index dc633c9..0c9a07b 100644
--- a/cwiki-edit.el
+++ b/cwiki-edit.el
@@ -1,140 +1,164 @@
 ;; -*- coding: utf-8-mcs-er -*-
-(defvar chise-wiki-view-url "../view.cgi")
+(defvar chise-wiki-view-url "view.cgi")
 (defvar chise-wiki-edit-url "edit.cgi")
 
-(require 'cwiki-common)
+;; (require 'cwiki-format)
+(require 'cwiki-view)
 
-(defun www-edit-display-char-feature-default (char feature-name &optional value
-					      lang)
-  (unless value
-    (setq value (char-feature char feature-name)))
-  (www-html-display-paragraph
-   (format "[[%s|%s?feature=%s]] : %s [[[edit|edit.cgi?char=%s&feature=%s]]]"
-	   (www-format-feature-name feature-name lang)
-	   chise-wiki-view-url
-	   (www-uri-encode-feature-name feature-name)
-	   (www-format-value value feature-name nil 'without-tags)
-	   (char-to-string char)
-	   (www-uri-encode-feature-name feature-name)
-	   )))
+;; (defun www-edit-display-input-box (object name value &optional format)
+;;   (when (stringp format)
+;;     (setq format (intern format)))
+;;   (let (prefix)
+;;     (if (or (eq format 'HEX)
+;;             (eq format 'hex))
+;;         (if (integerp value)
+;;             (setq prefix "0x")))
+;;     (princ (www-format-encode-string
+;;             (format "%s \u2190 %s"
+;;                     name
+;;                     (or prefix ""))))
+;;     (princ
+;;      (format "<input type=\"text\" name=\"%s\"
+;; size=\"30\" maxlength=\"30\" value=\"%s\">
+;; <input type=\"submit\" value=\"set\" />
+;; 
+;; "
+;;              (www-format-encode-string
+;;               (format "%s" name) 'without-tags)
+;;              (www-format-apply-value object name
+;;                                      format nil value
+;;                                      nil nil
+;;                                      'without-tags)
+;;              ))))
 
-(defun www-edit-display-char-feature-as-ucs (char feature-name &optional value)
-  (unless value
-    (setq value (char-feature char feature-name)))
-  (www-html-display-paragraph
-   (format "= [[U+%s|http://www.unicode.org/cgi-bin/GetUnihanData.pl?codepoint=%s]] (%d)"
-	   (www-format-value-as-HEX value)
-	   (www-format-value-as-HEX value)
-	   value)))
+;; (defun www-edit-display-feature-input-box (char feature-name
+;;                                                 &optional format value)
+;;   (unless format
+;;     (setq format 'default))
+;;   (unless value
+;;     (setq value (www-get-feature-value char feature-name)))
+;;   (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-unit
+;;                        (est-eval-unit
+;;                         (if (symbolp format)
+;;                             (list format)
+;;                           format)
+;;                         char feature-name)
+;;                        'without-tags)
+;;                       ;; (www-format-value char feature-name
+;;                       ;;                   value format 'without-tags)
+;;                       "")))
+;;   )
 
-(defun www-edit-display-input-box (name value &optional format)
-  (when (stringp format)
-    (setq format (intern format)))
-  (let (prefix)
-    (if (or (eq format 'HEX)
-	    (eq format 'hex))
-	(if (integerp value)
-	    (setq prefix "0x")))
-    (princ (www-format-encode-string
-	    (format "%s \u2190 %s"
-		    name
-		    (or prefix ""))))
-    (princ
-     (format "<input type=\"text\" name=\"%s\"
-size=\"30\" maxlength=\"30\" value=\"%s\">
-<input type=\"submit\" value=\"set\" />
+(defun www-edit-display-object-desc (genre uri-object uri-feature-name
+					   &optional lang format)
+  (www-display-object-desc genre uri-object nil lang 1 nil
+			   uri-feature-name format))
 
-"
-	     (www-format-encode-string
-	      (format "%s" name) 'without-tags)
-             (www-format-apply-value format nil value
-				     nil nil
-				     'without-tags)
-	     ))))
-
-(defun www-edit-display-char-desc (uri-char uri-feature-name
-					    &optional lang format)
-  (when (stringp format)
-    (setq format (intern format)))
-  (let ((char (www-uri-decode-char uri-char))
-	(feature-name (www-uri-decode-feature-name uri-feature-name))
-	base-name metadata-name
-	char-spec str)
-    (when (characterp char)
-      (princ
-       (format "<head>
-<title>CHISE-wiki character: %s</title>
-</head>\n"
-	       (encode-coding-string
-		(decode-uri-string uri-char 'utf-8-mcs-er)
-		'utf-8-mcs-er)))
-      (princ "<body>\n")
-      (princ
-       (format "<h1>%s</h1>\n"
-	       (www-format-encode-string (char-to-string char))))
-      (princ "<form action=\"set.cgi\" method=\"GET\">\n")
-      (princ
-       (encode-coding-string
-	(format "<p>(char : <input type=\"text\" name=\"char\"
-size=\"30\" maxlength=\"30\" value=\"%s\">)</p>
-"
-		(decode-uri-string uri-char 'utf-8-mcs-er))
-	'utf-8-mcs-er))
-      (setq char-spec (char-attribute-alist char))
-      (if (string-match "\\*" (setq str (symbol-name feature-name)))
-	  (setq base-name (intern (substring str 0 (match-beginning 0)))
-		metadata-name (intern (substring str (match-end 0))))
-	(setq base-name feature-name))
-      (unless (assq base-name char-spec)
-	(setq char-spec (cons (cons base-name nil)
-			      char-spec)))
-      (dolist (cell (sort char-spec
-			  (lambda (a b)
-			    (char-attribute-name< (car a)(car b)))))
-	(cond
-	 ((eq (car cell) feature-name)
-          ;; (www-edit-display-input-box feature-name (cdr cell) format)
-	  (princ
-	   (format "<p><input type=\"text\" name=\"feature-name\"
-size=\"30\" maxlength=\"30\" value=\"%s\">"
-		   feature-name))
-	  (princ (encode-coding-string " \u2190 " 'utf-8-mcs-er))
-	  (princ
-	   (format "%s<input type=\"text\" name=\"%s\"
-size=\"30\" maxlength=\"30\" value=\"%s\">
-<input type=\"submit\" value=\"set\" /></p>
-"
-		   (if (or (eq format 'HEX)(eq format 'hex))
-		       "0x"
-		     "")
-		   format
-		   (www-format-value (cdr cell) feature-name
-				     format 'without-tags)))
-	  )
-	 (t
-	  (princ "<p>")
-	  (princ
-	   (www-format-eval-list
-	    (or (char-feature-property (car cell) 'format)
-		'((name) " : " (value)))
-	    char (car cell) lang uri-char))
-	  (princ "</p>\n")
-	  (when (and (eq base-name (car cell)) metadata-name)
-	    (princ "<ul>\n")
-	    (princ "<li>")
-	    (www-edit-display-input-box feature-name
-					(char-feature char feature-name)
-					format)
-	    (princ "</li>")
-	    (princ "</ul>"))
-	  ))
-	)
-      (princ "</form>\n")
-      )))
+;; (defun www-edit-display-object-desc (genre uri-object uri-feature-name
+;;                                            &optional lang format)
+;;   (when (stringp format)
+;;     (setq format (intern format)))
+;;   (let ((object (www-uri-decode-object genre uri-object))
+;;         (feature-name (www-uri-decode-feature-name uri-feature-name))
+;;         base-name metadata-name
+;;         parents
+;;         object-spec str)
+;;     (when object
+;;       (princ
+;;        (encode-coding-string
+;;         (format "<head>
+;; <title>EsT %s = %s</title>
+;; </head>\n"
+;;                 genre
+;;                 (decode-uri-string uri-object 'utf-8-mcs-er))
+;;         'utf-8-mcs-er))
+;;       (princ "<body>\n")
+;;       (when (eq genre 'character)
+;;         (dolist (feature (char-feature-property '$object 'additional-features))
+;;           (mount-char-attribute-table
+;;            (char-feature-name-at-domain feature '$rev=latest))))
+;;       (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)
+;;                        (www-format-feature-name '->denotational lang))))
+;;       (when (setq parents (www-get-feature-value object '<-subsumptive))
+;;         (princ (format "<p>%s %s</p>\n<hr>\n"
+;;                        (www-format-value-as-char-list parents)
+;;                        (www-format-feature-name '->subsumptive lang))))
+;;       (princ
+;;        (format "<h1>%s</h1>\n"
+;;                (www-format-encode-string (est-format-object object))))
+;;       (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)))
+;;       (if (string-match "\\*" (setq str (symbol-name feature-name)))
+;;           (setq base-name (intern (substring str 0 (match-beginning 0)))
+;;                 metadata-name (intern (substring str (match-end 0))))
+;;         (setq base-name feature-name))
+;;       (unless (assq base-name object-spec)
+;;         (setq object-spec (cons (cons base-name nil)
+;;                               object-spec)))
+;;       (dolist (cell (sort object-spec
+;;                           (lambda (a b)
+;;                             (char-attribute-name< (car a)(car b)))))
+;;         (cond
+;;          ((eq (car cell) feature-name)
+;;           (www-edit-display-feature-input-box object feature-name format)
+;;           )
+;;          (t
+;;           (princ "<p>")
+;;           (princ
+;;            (www-format-eval-list
+;;             (or (char-feature-property (car cell) 'format)
+;;                 '((name) " : " (value)))
+;;             object (car cell) lang uri-object))
+;;           (princ "</p>\n")
+;;           (when (and (eq base-name (car cell)) metadata-name)
+;;             (princ "<ul>\n")
+;;             (princ "<li>")
+;;             (www-edit-display-feature-input-box object feature-name format)
+;;             (princ "</li>")
+;;             (princ "</ul>"))
+;;           ))
+;;         )
+;;       (princ "</form>\n")
+;;       )))
 
 (defun www-edit-display-feature-desc (uri-feature-name
 				      uri-property-name
-				      &optional lang uri-char)
+				      &optional lang
+				      object-genre uri-object)
   (let ((feature-name (www-uri-decode-feature-name uri-feature-name))
 	(property-name (www-uri-decode-feature-name uri-property-name))
 	name@lang)
@@ -158,13 +182,17 @@ size=\"30\" maxlength=\"30\" value=\"%s\"></h1>\n"
       (format "<p>(<input type=\"text\" name=\"char\"
 size=\"30\" maxlength=\"30\" value=\"%s\">に限\u5B9Aしない)
 "
-	      (decode-uri-string uri-char 'utf-8-mcs-er))
+	      (decode-uri-string uri-object 'utf-8-mcs-er))
       'utf-8-mcs-er))
     (princ "<p>")
     (if (eq property-name 'name)
-	(www-edit-display-input-box
-	 property-name
-	 (or (www-format-feature-name* feature-name) ""))
+	;; (www-edit-display-input-box
+        ;;  feature-name
+        ;;  property-name
+        ;;  (or (www-format-feature-name* feature-name) ""))
+	(www-edit-display-feature-input-box
+	 feature-name property-name
+	 'string (or (www-format-feature-name* feature-name) ""))
       (www-html-display-paragraph
        (format "name : %s [[[edit|edit.cgi?feature=%s&property=name]]]"
 	       (or (www-format-feature-name* feature-name) "")
@@ -174,9 +202,13 @@ size=\"30\" maxlength=\"30\" value=\"%s\">に限\u5B9Aしない)
     (when lang
       (setq name@lang (intern (format "name@%s" lang)))
       (if (eq property-name name@lang)
-	  (www-edit-display-input-box
-	   name@lang
-	   (or (char-feature-property feature-name name@lang) ""))
+          ;; (www-edit-display-input-box
+          ;;  feature-name
+          ;;  name@lang
+          ;;  (or (char-feature-property feature-name name@lang) ""))
+	  (www-edit-display-feature-input-box
+	   feature-name name@lang
+	   'string (or (char-feature-property feature-name name@lang) ""))
 	(www-html-display-paragraph
 	 (format "%s : %s [[[edit|edit.cgi?feature=%s&property=%s]]]"
 		 name@lang
@@ -188,6 +220,41 @@ size=\"30\" maxlength=\"30\" value=\"%s\">に限\u5B9Aしない)
              (or (www-feature-type feature-name)
 		 ;; (char-feature-property feature-name 'type)
 		 'generic)))
+    (if (eq property-name 'value-format)
+	(www-edit-display-feature-input-box
+	 feature-name property-name
+	 'default ; 'wiki-text
+	 (or (www-feature-value-format feature-name)
+	     'default))
+      (www-html-display-paragraph
+       (format "value-format : %s [[[edit|edit.cgi?feature=%s&property=value-format]]]"
+	       (www-xml-format-list
+		(or (www-feature-value-format feature-name)
+		    'default))
+	       uri-feature-name)))
+    (if (eq property-name 'value-presentation-format)
+	(www-edit-display-feature-input-box
+	 feature-name property-name
+	 'default ; 'wiki-text
+	 (or (www-feature-value-format feature-name)
+	     'default))
+      (www-html-display-paragraph
+       (format "value-presentation-format : %s [[[edit|edit.cgi?feature=%s&property=value-presentation-format]]]"
+	       (www-xml-format-list
+		(or (www-feature-value-format feature-name)
+		    'default))
+	       uri-feature-name)))
+    (if (eq property-name 'format)
+	(www-edit-display-feature-input-box
+	 feature-name property-name
+	 'wiki-text
+	 (or (char-feature-property feature-name 'format)
+	     '((name) " : " (value))))
+      (www-html-display-paragraph
+       (format "format : %s [[[edit|edit.cgi?feature=%s&property=format]]]"
+	       (www-xml-format-list
+		(char-feature-property feature-name 'format))
+	       uri-feature-name)))
     (www-html-display-paragraph
      (format "description : %s"
              (or (char-feature-property feature-name 'description)
@@ -235,7 +302,8 @@ size=\"30\" maxlength=\"30\" value=\"%s\">に限\u5B9Aしない)
 		      (split-string target "&")))
 	(setq ret (car target))
 	(cond ((eq (car ret) 'char)
-	       (www-edit-display-char-desc
+	       (www-edit-display-object-desc
+		'character
                 (cdr ret) ; (decode-uri-string (cdr ret) 'utf-8-mcs-er)
 		(decode-uri-string (cdr (assq 'feature target))
 				   'utf-8-mcs-er)
@@ -249,10 +317,20 @@ size=\"30\" maxlength=\"30\" value=\"%s\">に限\u5B9Aしない)
 		(decode-uri-string (cdr (assq 'property target))
 				   'utf-8-mcs-er)
 		lang
-		(cdr (assq 'char target))
-                ;; (decode-uri-string (cdr (assq 'char target))
-                ;;                    'utf-8-mcs-er)
-		)
+		(car (nth 3 target))
+                (cdr (nth 3 target))
+                ;; (cdr (assq 'char target))
+                )
+	       )
+	      (t
+	       (www-edit-display-object-desc
+                (car ret)
+		(cdr ret)
+		(decode-uri-string (cdr (assq 'feature target))
+				   'utf-8-mcs-er)
+		lang
+		(decode-uri-string (cdr (assq 'format target))
+				   'utf-8-mcs-er))
 	       ))
 	(www-html-display-paragraph
 	 (format "%S" target))
@@ -262,7 +340,7 @@ size=\"30\" maxlength=\"30\" value=\"%s\">に限\u5B9Aしない)
 	(princ (format "lang=%S\n" lang))
 	(princ emacs-version)
 	(princ " CHISE ")
-	(princ xemacs-chise-version)
+	(princ (encode-coding-string xemacs-chise-version 'utf-8-jp-er))
 	(princ "
 </body>
 </html>")
@@ -270,3 +348,5 @@ size=\"30\" maxlength=\"30\" value=\"%s\">に限\u5B9Aしない)
     (error nil
 	   (princ (format "%S" err)))
     ))
+
+(provide 'cwiki-edit)