From: MORIOKA Tomohiko Date: Mon, 6 Dec 2010 10:43:44 +0000 (+0900) Subject: (www-format-value-as-kuten): Moved to cwiki-format.el. X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=ec86874001a5f778639889dca57f5396a02f3329;p=chise%2Fest.git (www-format-value-as-kuten): Moved to cwiki-format.el. (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. --- diff --git a/cwiki-common.el b/cwiki-common.el index aad731d..f2612ae 100644 --- a/cwiki-common.el +++ b/cwiki-common.el @@ -548,193 +548,7 @@ (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 "%s" - chise-wiki-view-url - (www-uri-encode-object unit) - (www-format-encode-string (char-to-string unit))) - (format "%s" - 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 - ", %04d" - start start) - (setq source0 source) - (format - " %s=%04d" - (www-format-encode-string "\u4EAC大人\u6587研甲\u9AA8") - start start))) - (setq start (1+ start)) - (while (<= start end) - (setq ddest - (concat - ddest - (format - ", %04d" - 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 "%s" - 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) @@ -945,256 +759,6 @@ ;; (replace-match "&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 " - 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 "%s" - (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%s" - chise-wiki-view-url - (www-uri-encode-object prev-char) - "" - ;; (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 "%s" - chise-wiki-view-url - (www-uri-encode-object next-char) - "" - ;; (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 "%s" - (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" - (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