-(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
-;;;
-