(www-format-value-as-kuten): Moved to cwiki-format.el.
authorMORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Mon, 6 Dec 2010 10:43:44 +0000 (19:43 +0900)
committerMORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Mon, 6 Dec 2010 10:43:44 +0000 (19:43 +0900)
(www-format-value-default): Ditto.
(www-format-value-as-char-list): Ditto.
(www-format-value-as-domain-list): Ditto.
(www-format-value-as-ids): Ditto.
(www-format-value-as-S-exp): Ditto.
(www-format-value-as-HEX): Ditto.
(www-format-value-as-CCS-default): Ditto.
(www-format-value-as-CCS-94x94): Ditto.
(www-format-value-as-kangxi-radical): Ditto.
(www-format-value): Ditto.
(www-format-props-to-string): Ditto.
(www-format-apply-value): Ditto.
(www-format-eval-feature-value): Ditto.
(www-format-eval-unit): Ditto.
(www-format-eval-list): Ditto.

cwiki-common.el

index aad731d..f2612ae 100644 (file)
    (www-format-feature-name* feature-name lang)))
 
 
-;;; @ Feature value presentation
-;;;
-
-(defun www-format-value-as-kuten (value)
-  (format "%02d-%02d"
-         (- (lsh value -8) 32)
-         (- (logand value 255) 32)))
-
-(defun www-format-value-default (value &optional without-tags)
-  (if (listp value)
-      (mapconcat
-       (lambda (unit)
-        (www-format-encode-string
-         (format "%S" unit)
-         without-tags))
-       value " ")
-    (www-format-encode-string (format "%S" value) without-tags)))
-  
-(defun www-format-value-as-char-list (value &optional without-tags)
-  (if (listp value)
-      (mapconcat
-       (if without-tags
-          (lambda (unit)
-            (www-format-encode-string
-             (format (if (characterp unit)
-                         "%c"
-                       "%s")
-                     unit)
-             'without-tags))
-        (let (genre-o name-f ret)
-          (lambda (unit)
-            (if (characterp unit)
-                (format "<a href=\"%s?char=%s\">%s</a>"
-                        chise-wiki-view-url
-                        (www-uri-encode-object unit)
-                        (www-format-encode-string (char-to-string unit)))
-              (format "<a href=\"%s?%s=%s\">%s</a>"
-                      chise-wiki-view-url
-                      (concord-object-genre unit)
-                      (concord-object-id unit)
-                      (cond
-                       ((setq ret
-                              (www-get-feature-value
-                               unit
-                               (setq name-f
-                                     (if (setq genre-o
-                                               (concord-decode-object
-                                                '=id
-                                                (concord-object-genre unit)
-                                                'genre))
-                                         (www-get-feature-value
-                                          genre-o
-                                          'object-representation-format)
-                                       'name))))
-                        (www-format-eval-feature-value
-                         unit name-f nil nil nil ret
-                         'without-tags 'without-edit)
-                        )
-                        (t
-                        (www-format-encode-string
-                         (format "%S" unit))
-                        ))
-                      unit)))))
-       value " ")
-    (www-format-encode-string (format "%s" value) without-tags)))
-
-(defun www-format-value-as-domain-list (value &optional without-tags)
-  (let (name source0 source num dest rest unit start end ddest)
-    (if (listp value)
-       (if without-tags
-           (mapconcat
-            (lambda (unit)
-              (format "%s" unit))
-            value " ")
-         (setq rest value)
-         (while rest
-           (setq unit (pop rest))
-           (if (symbolp unit)
-               (setq name (symbol-name unit)))
-           (setq dest
-                 (concat
-                  dest
-                  (cond
-                   ((string-match "^zob1968=" name)
-                    (setq source (intern (substring name 0 (match-end 0)))
-                          num (substring name (match-end 0)))
-                    (if (string-match "^\\([0-9]+\\)-\\([0-9]+\\)$" num)
-                        (setq start (string-to-number
-                                     (match-string 1 num))
-                              end (string-to-number
-                                   (match-string 2 num)))
-                      (setq start (string-to-number num)
-                            end start))
-                    (setq ddest
-                          (if (eq source source0)
-                              (format
-                               ", <a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d\">%04d</a>"
-                               start start)
-                            (setq source0 source)
-                            (format
-                             " <a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/\">%s</a>=<a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d\">%04d</a>"
-                             (www-format-encode-string "\u4EAC大人\u6587研甲\u9AA8")
-                             start start)))
-                    (setq start (1+ start))
-                    (while (<= start end)
-                      (setq ddest
-                            (concat
-                             ddest
-                             (format
-                              ", <a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d\">%04d</a>"
-                              start start)))
-                      (setq start (1+ start)))
-                    ddest)
-                   (t
-                    (setq source unit)
-                    (if (eq source source0)
-                        ""
-                      (setq source0 source)
-                      (concat " " name))
-                    )))))
-         dest)
-      (www-format-encode-string (format "%s" value) without-tags))))
-
-(defun www-format-value-as-ids (value &optional without-tags)
-  (if (listp value)
-      (mapconcat
-       (if without-tags
-          (lambda (unit)
-            (www-format-encode-string
-             (format (if (characterp unit)
-                         "%c"
-                       "%s")
-                     unit)
-             'without-tags))
-        (lambda (unit)
-          (if (characterp unit)
-              (format "<a href=\"%s?char=%s\">%s</a>"
-                      chise-wiki-view-url
-                      (www-uri-encode-object unit)
-                      (www-format-encode-string (char-to-string unit)))
-            (www-format-encode-string (format "%s" unit)))))
-       (ideographic-structure-to-ids value) " ")
-    (www-format-encode-string (format "%s" value) without-tags)))
-
-(defun www-format-value-as-S-exp (value &optional without-tags)
-  (www-format-encode-string (format "%S" value) without-tags))
-
-(defun www-format-value-as-HEX (value)
-  (if (integerp value)
-      (format "%X" value)
-    (www-format-value-as-S-exp value)))
-
-(defun www-format-value-as-CCS-default (value)
-  (if (integerp value)
-      (format "0x%s (%d)"
-             (www-format-value-as-HEX value)
-             value)
-    (www-format-value-as-S-exp value)))
-
-(defun www-format-value-as-CCS-94x94 (value)
-  (if (integerp value)
-      (format "0x%s [%s] (%d)"
-             (www-format-value-as-HEX value)
-             (www-format-value-as-kuten value)
-             value)
-    (www-format-value-as-S-exp value)))
-
-(defun www-format-value-as-kangxi-radical (value)
-  (if (and (integerp value)
-          (<= 0 value)
-          (<= value 214))
-      (www-format-encode-string
-       (format "%c" (ideographic-radical value)))
-    (www-format-value-as-S-exp value)))
-
-(defun www-format-value (object feature-name
-                               &optional value format
-                               without-tags without-edit)
-  (unless value
-    (setq value (www-get-feature-value object feature-name)))
-  (www-format-apply-value object feature-name
-                         format nil value nil nil
-                         without-tags without-edit)
-  )
-
-
-;;; @ format evaluator
+;;; @ HTML generator
 ;;;
 
 (defun www-format-encode-string (string &optional without-tags)
       ;;   (replace-match "&amp;GT-" t 'literal))
       (buffer-string))))
 
-(defun www-format-props-to-string (props &optional format)
-  (unless format
-    (setq format (plist-get props :format)))
-  (concat "%"
-         (plist-get props :flag)
-          ;; (if (plist-get props :zero-padding)
-          ;;     "0")
-         (if (plist-get props :len)
-             (format "0%d"
-                     (let ((ret (plist-get props :len)))
-                       (if (stringp ret)
-                           (string-to-int ret)
-                         ret))))
-         (cond
-          ((eq format 'decimal) "d")
-          ((eq format 'hex) "x")
-          ((eq format 'HEX) "X")
-          ((eq format 'S-exp) "S")
-          (t "s"))))      
-
-(defun www-format-apply-value (object feature-name
-                                     format props value
-                                     &optional uri-object uri-feature
-                                     without-tags without-edit)
-  (let (ret)
-    (setq ret
-         (cond
-          ((memq format '(decimal hex HEX))
-           (if (integerp value)
-               (format (www-format-props-to-string props format)
-                       value)
-             (www-format-encode-string
-              (format "%s" value)
-              without-tags))
-           )
-          ((eq format 'wiki-text)
-           (if without-tags
-               (www-xml-format-list value)
-             (www-format-eval-list value object feature-name nil uri-object
-                                   without-tags without-edit))
-           )
-          ((eq format 'S-exp)
-           (www-format-encode-string
-            (format (www-format-props-to-string props format)
-                    value)
-            without-tags))
-          ((eq format 'ku-ten)
-           (www-format-value-as-kuten value))
-          ((eq format 'kangxi-radical)
-           (www-format-value-as-kangxi-radical value))
-          ((eq format 'space-separated-char-list)
-           (www-format-value-as-char-list value without-tags))
-          ((eq format 'space-separated-ids)
-           (www-format-value-as-ids value without-tags))
-          ((eq format 'space-separated-domain-list)
-           (www-format-value-as-domain-list value without-tags))
-          ((eq format 'string)
-           (www-format-encode-string (format "%s" value) without-tags)
-           )
-          (t
-           (www-format-value-default value without-tags)
-            ))
-         )
-    (if (or without-tags
-           without-edit
-           (eq (plist-get props :mode) 'peek))
-       ret
-      (format "%s <a href=\"%s?%s=%s&feature=%s&format=%s\"
-><input type=\"submit\" value=\"edit\" /></a>"
-             ret
-             chise-wiki-edit-url
-             (est-object-genre object)
-             uri-object uri-feature format))))
-
-(defun www-format-eval-feature-value (object
-                                     feature-name
-                                     &optional format lang uri-object value
-                                     without-tags without-edit)
-  (unless value
-    (setq value (www-get-feature-value object feature-name)))
-  (unless format
-    (setq format (www-feature-value-format feature-name)))
-  (cond
-   ((symbolp format)
-    (www-format-apply-value
-     object feature-name
-     format nil value
-     uri-object (www-uri-encode-feature-name feature-name)
-     without-tags without-edit)
-    )
-   ((consp format)
-    (cond ((null (cdr format))
-          (setq format (car format))
-          (www-format-apply-value
-           object feature-name
-           (car format) (nth 1 format) value
-           uri-object (www-uri-encode-feature-name feature-name)
-           without-tags without-edit)
-          )
-         (t
-          (www-format-eval-list format object feature-name lang uri-object
-                                without-tags without-edit)
-          )))))
-
-(defun www-format-eval-unit (exp object feature-name
-                                &optional lang uri-object value
-                                without-tags without-edit)
-  (unless value
-    (setq value (www-get-feature-value object feature-name)))
-  (unless uri-object
-    (setq uri-object (www-uri-encode-object object)))
-  (cond
-   ((stringp exp) (www-format-encode-string exp))
-   ((null exp) "")
-   ((consp exp)
-    (cond
-     ((memq (car exp) '(value decimal hex HEX ku-ten kangxi-radical
-                             S-exp string default))
-      (let ((fn (plist-get (nth 1 exp) :feature))
-           domain domain-fn ret)
-       (when fn
-         (when (stringp fn)
-           (setq fn (intern fn)))
-         (setq domain (char-feature-name-domain feature-name))
-         (setq domain-fn (char-feature-name-at-domain fn domain))
-         (if (setq ret (www-get-feature-value object domain-fn))
-             (setq feature-name domain-fn
-                   value ret)
-           (setq feature-name fn
-                 value (www-get-feature-value object fn)))
-         (push feature-name chise-wiki-displayed-features)
-          ))
-      (if (eq (car exp) 'value)
-         (www-format-eval-feature-value object feature-name
-                                        (plist-get (nth 1 exp) :format)
-                                        lang uri-object value
-                                        without-tags without-edit)
-       (www-format-apply-value
-        object feature-name
-        (car exp) (nth 1 exp) value
-        uri-object (www-uri-encode-feature-name feature-name)
-        without-tags without-edit))
-      )
-     ((eq (car exp) 'name)
-      (let ((fn (plist-get (nth 1 exp) :feature))
-           domain domain-fn)
-       (when fn
-         (setq domain (char-feature-name-domain feature-name))
-         (when (stringp fn)
-           (setq fn (intern fn)))
-         (setq domain-fn (char-feature-name-at-domain fn domain))
-         (setq feature-name domain-fn)))
-      (if without-tags
-         (www-format-feature-name feature-name lang)
-       (format "<a href=\"%s\">%s</a>"
-               (www-uri-make-feature-name-url
-                (www-uri-encode-feature-name feature-name)
-                uri-object)
-               (www-format-feature-name feature-name lang))
-        )
-      )
-     ((eq (car exp) 'name-url)
-      (let ((fn (plist-get (nth 1 exp) :feature))
-           domain domain-fn)
-       (when fn
-         (setq domain (char-feature-name-domain feature-name))
-         (when (stringp fn)
-           (setq fn (intern fn)))
-         (setq domain-fn (char-feature-name-at-domain fn domain))
-         (setq feature-name domain-fn)))
-      (www-uri-make-feature-name-url
-       (www-uri-encode-feature-name feature-name)
-       uri-object)
-      )
-     ((eq (car exp) 'domain-name)
-      (let ((domain (char-feature-name-domain feature-name)))
-       (if domain
-           (format "@%s" domain))))
-     ((eq (car exp) 'prev-char)
-      (if without-tags
-         ""
-       (let ((prev-char (find-previous-defined-code-point
-                         feature-name value)))
-         (if prev-char
-             (format "\n<a href=\"%s?char=%s\">%s</a>"
-                     chise-wiki-view-url
-                     (www-uri-encode-object prev-char)
-                      "<input type=\"submit\" value=\"-\" />"
-                     ;; (www-format-encode-string
-                      ;;  (char-to-string prev-char))
-                     )
-           "")))
-      )
-     ((eq (car exp) 'next-char)
-      (if without-tags
-         ""
-       (let ((next-char (find-next-defined-code-point
-                         feature-name value)))
-         (if next-char
-             (format "<a href=\"%s?char=%s\">%s</a>"
-                     chise-wiki-view-url
-                     (www-uri-encode-object next-char)
-                      "<input type=\"submit\" value=\"+\" />"
-                     ;; (www-format-encode-string
-                      ;;  (char-to-string next-char))
-                     )
-           "")))
-      )
-     ((eq (car exp) 'link)
-      (if without-tags
-         (www-format-eval-list (nthcdr 2 exp)
-                               object feature-name lang uri-object
-                               without-tags without-edit)
-       (format "<a
- href=\"%s\"
->%s</a
->"
-               (www-format-eval-list (plist-get (nth 1 exp) :ref)
-                                     object feature-name lang uri-object
-                                     'without-tags 'without-edit)
-               (www-format-eval-list (nthcdr 2 exp)
-                                     object feature-name lang uri-object
-                                     without-tags without-edit)))
-      )
-     (t
-      (format "<%s
->%s</%s
->"
-             (car exp)
-             (www-format-eval-list (nthcdr 2 exp) object feature-name
-                                   lang uri-object
-                                   without-tags without-edit)
-             (car exp)))))))
-
-(defun www-format-eval-list (format-list object feature-name
-                                        &optional lang uri-object
-                                        without-tags without-edit)
-  (if (consp format-list)
-      (mapconcat
-       (lambda (exp)
-        (www-format-eval-unit exp object feature-name lang uri-object
-                              nil without-tags without-edit))
-       format-list "")
-    (www-format-eval-unit format-list object feature-name lang uri-object
-                         nil without-tags without-edit)))
-
-
-;;; @ HTML generator
-;;;
-
 (defun www-html-display-text (text)
   (princ
    (with-temp-buffer