-(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 "%d" (plist-get props :len)))
- (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-char uri-feature
- without-tags)
- (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-char))
- )
- ((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 (eq (plist-get props :mode) 'peek))
- ret
- (format "%s <a href=\"%s?char=%s&feature=%s&format=%s\"
-><input type=\"submit\" value=\"edit\" /></a>"
- ret
- chise-wiki-edit-url
- uri-char uri-feature format))))
-
-(defun www-format-eval-feature-value (char
- feature-name
- &optional format lang uri-char value)
- (unless value
- (setq value (www-char-feature char feature-name)))
- (unless format
- (setq format (www-feature-value-format feature-name)))
- (cond
- ((symbolp format)
- (www-format-apply-value
- char feature-name
- format nil value
- uri-char (www-uri-encode-feature-name feature-name))
- )
- ((consp format)
- (cond ((null (cdr format))
- (setq format (car format))
- (www-format-apply-value
- char feature-name
- (car format) (nth 1 format) value
- uri-char (www-uri-encode-feature-name feature-name))
- )
- (t
- (www-format-eval-list format char feature-name lang uri-char)
- )))))
-
-(defun www-format-eval-unit (exp char feature-name
- &optional lang uri-char value)
- (unless value
- (setq value (www-char-feature char feature-name)))
- (unless uri-char
- (setq uri-char (www-uri-encode-char char)))
- (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 default))
- (if (eq (car exp) 'value)
- (www-format-eval-feature-value char feature-name
- (plist-get (nth 1 exp) :format)
- lang uri-char value)
- (www-format-apply-value
- char feature-name
- (car exp) (nth 1 exp) value
- uri-char (www-uri-encode-feature-name feature-name)))
- )
- ((eq (car exp) 'name)
- (format "<a href=\"%s?feature=%s&char=%s\">%s</a>"
- chise-wiki-view-url
- (www-uri-encode-feature-name feature-name)
- uri-char
- (www-format-feature-name feature-name lang))
- )
- ((eq (car exp) 'link)
- (format "<a
- href=\"%s\"
->%s</a
->"
- (www-format-eval-list (plist-get (nth 1 exp) :ref)
- char feature-name lang uri-char)
- (www-format-eval-list (nthcdr 2 exp)
- char feature-name lang uri-char)))
- (t
- (format "<%s
->%s</%s
->"
- (car exp)
- (www-format-eval-list (nthcdr 2 exp) char feature-name
- lang uri-char)
- (car exp)))))))
-
-(defun www-format-eval-list (format-list char feature-name
- &optional lang uri-char)
- (if (consp format-list)
- (mapconcat
- (lambda (exp)
- (www-format-eval-unit exp char feature-name lang uri-char))
- format-list "")
- (www-format-eval-unit format-list char feature-name lang uri-char)))
-
-
-;;; @ XML generator
-;;;
-
-(defun www-xml-format-props (props)
- (let ((dest "")
- key val)
- (while props
- (setq key (pop props)
- val (pop props))
- (if (symbolp key)
- (setq key (symbol-name key)))
- (if (eq (aref key 0) ?:)
- (setq key (substring key 1)))
- (setq dest
- (format "%s %s=\"%s\""
- dest key
- (www-format-encode-string
- (format "%s" val) 'without-tags))))
- dest))
-
-(defun www-xml-format-unit (format-unit)
- (let (name props children ret)
- (cond
- ((stringp format-unit)
- (mapconcat (lambda (c)
- (cond
- ((eq c ?&) "&")
- ;; ((eq c ?<) "&lt;")
- ;; ((eq c ?>) "&gt;")
- (t
- (char-to-string c))))
- (www-format-encode-string format-unit 'without-tags)
- "")
- )
- ((consp format-unit)
- (setq name (car format-unit)
- props (nth 1 format-unit)
- children (nthcdr 2 format-unit))
- (when (eq name 'link)
- (setq ret (plist-get props :ref))
- (unless (stringp ret)
- (setq props (plist-remprop (copy-list props) :ref))
- (setq children
- (cons (list* 'ref nil ret)
- children))))
- (if children
- (format "<%s%s>%s</%s>"
- name
- (if props
- (www-xml-format-props props)
- "")
- (www-xml-format-list children)
- name)
- (format "<%s%s/>"
- name (www-xml-format-props props)))
- )
- (t
- (format "%s" format-unit)))))
-
-(defun www-xml-format-list (format-list)
- (if (atom format-list)
- (www-xml-format-unit format-list)
- (mapconcat #'www-xml-format-unit
- format-list "")))
-
-
-;;; @ HTML generator
-;;;
-