--- /dev/null
+;; -*- coding: utf-8-mcs-er -*-
+(require 'cwiki-common)
+(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-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\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)
+ (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
+;;;
+
+(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)))
+
+
+;;; @ End.
+;;;
+
+(provide 'cwiki-format)
+
+;;; cwiki-format.el ends here
projects / chise / est.git / commitdiff