New implementation based on `est-eval' and `est-format'.
authorMORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Thu, 9 Dec 2010 00:57:59 +0000 (09:57 +0900)
committerMORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Thu, 9 Dec 2010 00:57:59 +0000 (09:57 +0900)
(www-format-value-as-kuten): Abolished.
(www-format-value-default): Abolished.
(www-format-value-as-char-list): Abolished.
(www-format-value-as-domain-list): Abolished.
(www-format-value-as-ids): Abolished.
(www-format-value-as-S-exp): Abolished.
(www-format-value-as-HEX): Abolished.
(www-format-value-as-kangxi-radical): Abolished.
(www-format-value): If `object' is a symbol, it is decoded as
`feature' object.
(www-format-props-to-string): Abolished.
(www-format-apply-value): New implementation; use
`est-eval-apply-value' and `est-format-unit'.
(www-format-eval-feature-value): Abolished.
(www-format-eval-list): New implementation; use `est-eval-list' and
`est-format-unit'.

cwiki-format.el

index 649cb45..c11eff4 100644 (file)
 ;; -*- coding: utf-8-mcs-er -*-
 (require 'cwiki-common)
+(require 'est-eval)
+(require 'est-format)
 (require 'est-xml)
 
-;;; @ 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-representative-feature)
-                                       'name))))
-                        (www-format-eval-feature-value
-                         unit name-f nil nil nil ret
-                         'without-tags 'without-edit)
-                        )
-                       ((and genre-o
-                             (setq ret (concord-object-get
-                                        genre-o
-                                        'object-representative-format)))
-                        (www-format-eval-list
-                         ret unit nil nil nil '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\e$BBg?M\e(B\u6587\e$B8&9C\e(B\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)
+  (if (symbolp object)
+      (setq object (concord-decode-object '=id object 'feature)))
   (unless value
     (setq value (www-get-feature-value object feature-name)))
   (www-format-apply-value object feature-name
                          without-tags without-edit)
   )
 
-
-;;; @ format evaluator
-;;;
-
-(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-value-as-char-list (value &optional without-tags)
+  (est-format-unit
+   (est-eval-value-as-object-list value " ") without-tags))
 
 (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)))))))
+  (est-format-unit
+   (est-eval-apply-value object feature-name format props value uri-object)
+   without-tags without-edit))
 
 (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)))
+  (est-format-unit
+   (est-eval-list format-list object feature-name lang uri-object)
+   without-tags without-edit))
 
 
 ;;; @ End.