From 31491d9cfa31c819bac164603ae4c58c6d0dc914 Mon Sep 17 00:00:00 2001 From: MORIOKA Tomohiko Date: Thu, 9 Dec 2010 09:57:59 +0900 Subject: [PATCH] New implementation based on `est-eval' and `est-format'. (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 | 435 ++----------------------------------------------------- 1 file changed, 13 insertions(+), 422 deletions(-) diff --git a/cwiki-format.el b/cwiki-format.el index 649cb45..c11eff4 100644 --- a/cwiki-format.el +++ b/cwiki-format.el @@ -1,192 +1,14 @@ ;; -*- 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 "%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-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 - ", %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) + (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 @@ -194,255 +16,24 @@ 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 " - 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))))))) + (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. -- 1.7.10.4