From: MORIOKA Tomohiko Date: Sun, 5 Jun 2011 14:01:46 +0000 (+0900) Subject: (est-format-unit): Change optional argument `without-tags' to X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=578906c647cfa2a94b1c95806deca27d2b218c7e;p=chise%2Fest.git (est-format-unit): Change optional argument `without-tags' to `output-format'; now `output-format' accepts various formats such as 'html, 'plain-text and 'wiki-text instead of nil and non-nil. (est-format-list): Likewise. --- diff --git a/est-format.el b/est-format.el index 7288d8f..116d412 100644 --- a/est-format.el +++ b/est-format.el @@ -26,55 +26,114 @@ dest)) (defun est-format-unit (format-unit - &optional without-tags without-edit as-property + &optional output-format without-edit as-property separator) - (let (name props children ret object feature format value) + (cond + ((or (eq output-format 'without-tags) + (eq output-format t)) + (setq output-format 'plain-text) + ) + ((eq output-format 'wiki-text) + ) + ((eq output-format 'xml) + ) + ((null output-format) + (setq output-format 'html) + )) + (let (name props children ret object feature format value + output-string) (cond ((stringp format-unit) - (www-format-encode-string format-unit without-tags (not as-property)) + (www-format-encode-string format-unit + (not (eq output-format 'html)) + (not as-property)) + ) + ((characterp format-unit) + (www-format-encode-string (format "%S" format-unit) + (not (eq output-format 'html)) + (not as-property)) + ) + ((symbolp format-unit) + (www-format-encode-string (format "%s" format-unit) + (not (eq output-format 'html)) + (not as-property)) ) ((consp format-unit) (setq name (car format-unit) props (nth 1 format-unit) children (nthcdr 2 format-unit)) (cond + ((eq name 'list) + (cond + ((or (eq output-format 'plain-text) + (eq output-format 'wiki-text)) + (unless separator + (setq separator (plist-get props :separator))) + (setq output-string + (est-format-list children output-format + without-edit as-property separator)) + ) + ((eq output-format 'html) + (setq props (list* :class name props) + name 'span) + )) + ) ((eq name 'object) - (setq name 'span) - (unless without-tags + (cond + ((eq output-format 'html) + (setq name 'span) (when (setq object (plist-get props :object)) (setq children (list (list* 'a (list :href (www-uri-make-object-url object)) - children))))) + children)))) + ) + ((eq output-format 'wiki-text) + (when (setq object (plist-get props :object)) + (setq output-string + (format "[[%s=%s]]" + (est-object-genre object) + (est-format-object object)))) + )) ) ((eq name 'prev-char) - (when (and (not without-tags) - (setq object (plist-get props :object)) - (setq feature (plist-get props :feature)) - (setq value (www-get-feature-value object feature)) - (setq ret (find-previous-defined-code-point feature value))) + (cond + ((eq output-format 'wiki-text) + (setq output-string "{{prev-char}}") + ) + ((and (eq output-format 'html) + (setq object (plist-get props :object)) + (setq feature (plist-get props :feature)) + (setq value (www-get-feature-value object feature)) + (setq ret (find-previous-defined-code-point feature value))) (setq children (list (list* 'a (list :href (www-uri-make-object-url ret)) - children)))) + children))) + )) ) ((eq name 'next-char) - (when (and (not without-tags) - (setq object (plist-get props :object)) - (setq feature (plist-get props :feature)) - (setq value (www-get-feature-value object feature)) - (setq ret (find-next-defined-code-point feature value))) + (cond + ((eq output-format 'wiki-text) + (setq output-string "{{next-char}}") + ) + ((and (eq output-format 'html) + (setq object (plist-get props :object)) + (setq feature (plist-get props :feature)) + (setq value (www-get-feature-value object feature)) + (setq ret (find-next-defined-code-point feature value))) (setq children (list (list* 'a (list :href (www-uri-make-object-url ret)) - children)))) + children))) + )) ) ((eq name 'feature-name) (setq name 'span) - (unless without-tags + (when (eq output-format 'html) (when (and (setq object (plist-get props :object)) (setq feature (plist-get props :feature))) (setq children @@ -88,33 +147,58 @@ children))))) ) ((eq name 'value) - (setq format - (if (consp (car children)) - (caar children))) - (unless without-edit - (setq children - (append children - (list (list 'edit-value - (if format - (list* :format format props) - props) - '(input - (:type "submit" :value "edit"))))))) - (unless without-tags + (cond + ((eq output-format 'wiki-text) + (setq output-string + (if (and (setq object (plist-get props :object)) + (setq feature (plist-get props :feature))) + (format "{{value %s %s=%s}}" + feature + (est-object-genre object) + (www-uri-encode-object object)) + "{{value}}")) + ) + ((eq output-format 'html) + (setq format + (if (consp (car children)) + (caar children))) + (unless without-edit + (setq children + (append children + (list (list 'edit-value + (if format + (list* :format format props) + props) + '(input + (:type "submit" :value "edit"))))))) (setq name 'span - props (list* :class "value" props))) + props (list* :class "value" props)) + )) ) - ((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))) - (unless without-tags + ((or (and (eq name 'link) + (setq ret (plist-get props :ref))) + (and (eq name 'a) + (setq ret (plist-get props :href)))) + (cond + ((eq output-format 'wiki-text) + (setq output-string + (format "[[%s|%s]]" + (est-format-list children output-format) + (est-format-unit ret output-format) + )) + ) + ((eq output-format 'html) (setq name 'a props (list* :href ret - (plist-remprop (copy-list props) :ref)))) + (plist-remprop (copy-list props) :ref))) + ) + ((eq output-format 'xml) + (unless (stringp ret) + (setq props (plist-remprop (copy-list props) :ref)) + (setq children + (cons (list 'ref nil ret) + children))) + )) ) ((and (eq name 'edit-value) (setq object (plist-get props :object)) @@ -131,44 +215,48 @@ ((memq name '(div a ul ol p span - img input)) ) (t - (unless without-tags + (when (eq output-format 'html) (setq props (list* :class name props) name 'span)) )) - (unless separator - (setq separator (plist-get props :separator))) - (if children - (if without-tags - (est-format-list children without-tags as-property separator) - (format "<%s%s>%s" - name - (if props - (est-format-props props) - "") - (est-format-list - children nil without-edit as-property separator) - name)) - (if without-tags - "" - (format "<%s%s/>" - name (est-format-props props)))) + (cond + (output-string) + (t + (unless separator + (setq separator (plist-get props :separator))) + (if children + (if (eq output-format 'plain-text) + (est-format-list children output-format as-property separator) + (format "<%s%s>%s" + name + (if props + (est-format-props props) + "") + (est-format-list + children output-format + without-edit as-property separator) + name)) + (if (eq output-format 'plain-text) + "" + (format "<%s%s/>" + name (est-format-props props)))) + )) ) (t (format "%s" format-unit))))) (defun est-format-list (format-list - &optional without-tags without-edit as-property + &optional output-format without-edit as-property separator) (if (atom format-list) (est-format-unit - format-list without-tags without-edit as-property separator) + format-list output-format without-edit as-property separator) (mapconcat (lambda (unit) (est-format-unit - unit without-tags without-edit as-property separator)) + unit output-format without-edit as-property separator)) format-list separator)))