(est-coded-charset-entity-reference-alist): New variable.
[chise/est.git] / est-format.el
1 ;; -*- coding: utf-8-mcs-er -*-
2 (require 'cwiki-common)
3
4
5 ;;; @ XML generator
6 ;;;
7
8 (defun est-format-props (props)
9   (let ((dest "")
10         key val)
11     (while props
12       (setq key (pop props)
13             val (pop props))
14       (if (symbolp key)
15           (setq key (symbol-name key)))
16       (if (eq (aref key 0) ?:)
17           (setq key (substring key 1)))
18       (setq dest
19             (format "%s %s=\"%s\""
20                     dest key
21                     (format "%s"
22                             (est-format-unit val 'without-tags
23                                              'without-edit 'as-property))
24                     )))
25     dest))
26
27 (defun est-format-unit (format-unit
28                         &optional output-format without-edit as-property
29                         separator)
30   (cond
31    ((or (eq output-format 'without-tags)
32         (eq output-format t))
33     (setq output-format 'plain-text)
34     )
35    ((eq output-format 'wiki-text)
36     )
37    ((eq output-format 'xml)
38     )
39    ((null output-format)
40     (setq output-format 'html)
41     ))
42   (let (name props children ret object feature format value
43              output-string subtype)
44     (cond
45      ((stringp format-unit)
46       (www-format-encode-string format-unit
47                                 (not (eq output-format 'html))
48                                 (not as-property))
49       )
50      ((characterp format-unit)
51       (www-format-encode-string (format "%S" format-unit)
52                                 (not (eq output-format 'html))
53                                 (not as-property))
54       )
55      ((symbolp format-unit)
56       (www-format-encode-string (format "%s" format-unit)
57                                 (not (eq output-format 'html))
58                                 (not as-property))
59       )
60      ((consp format-unit)
61       (setq name (car format-unit)
62             props (nth 1 format-unit)
63             children (nthcdr 2 format-unit))
64       (cond
65        ((or (eq name 'list)
66             (eq name 'image-list))
67         (cond
68          ((or (eq output-format 'plain-text)
69               (eq output-format 'wiki-text))
70           (unless separator
71             (setq separator (plist-get props :separator)))
72           (setq subtype (plist-get props :subtype))
73           (setq output-string
74                 (est-format-list children output-format
75                                  without-edit as-property separator subtype))
76           )
77          ((eq output-format 'html)
78           (setq props (list* :class name props)
79                 name 'span)
80           ))
81         )
82        ((eq name 'object)
83         (cond
84          ((eq output-format 'html)
85           (setq name 'span)
86           (when (setq object (plist-get props :object))
87             (setq children
88                   (list
89                    (list* 'a
90                           (list :href (www-uri-make-object-url object))
91                           children))))
92           )
93          ((eq output-format 'wiki-text)
94           (when (setq object (plist-get props :object))
95             (setq output-string
96                   (format "[[%s=%s]]"
97                           (est-object-genre object)
98                           (est-format-object object))))
99           ))
100         )
101        ((eq name 'prev-char)
102         (cond
103          ((eq output-format 'wiki-text)
104           (setq output-string "{{prev-char}}")
105           )
106          ((and (eq output-format 'html)
107                (setq object (plist-get props :object))
108                (setq feature (plist-get props :feature))
109                (setq value (www-get-feature-value object feature))
110                (setq ret (find-previous-defined-code-point feature value)))
111           (setq children
112                 (list
113                  (list* 'a
114                         (list :href (www-uri-make-object-url ret))
115                         children)))
116           ))
117         )
118        ((eq name 'next-char)
119         (cond
120          ((eq output-format 'wiki-text)
121           (setq output-string "{{next-char}}")
122           )
123          ((and (eq output-format 'html)
124                (setq object (plist-get props :object))
125                (setq feature (plist-get props :feature))
126                (setq value (www-get-feature-value object feature))
127                (setq ret (find-next-defined-code-point feature value)))
128           (setq children
129                 (list
130                  (list* 'a
131                         (list :href (www-uri-make-object-url ret))
132                         children)))
133           ))
134         )
135        ((eq name 'omitted)
136         (cond
137          ((eq output-format 'wiki-text)
138           (setq output-string "{{...}}")
139           )
140          ((and (eq output-format 'html)
141                (setq object (plist-get props :object))
142                (setq feature (plist-get props :feature)))
143           (setq children
144                 (list
145                  (list* 'a
146                         (list :href
147                               (concat (www-uri-make-object-url object)
148                                       (if est-hide-cgi-mode
149                                           "/feature="
150                                         "&feature=")
151                                       (www-uri-encode-feature-name feature)))
152                         children)))
153           ))
154         )
155        ((eq name 'feature-name)
156         (setq name 'span)
157         (when (eq output-format 'html)
158           (when (and (setq object (plist-get props :object))
159                      (setq feature (plist-get props :feature)))
160             (setq children
161                   (list
162                    (list 'span
163                          '(:class "feature-name")
164                          (list* 'a
165                                 (list :href
166                                       (www-uri-make-feature-name-url
167                                        (est-object-genre object)
168                                        (www-uri-encode-feature-name feature)
169                                        (www-uri-encode-object object)))
170                                 children))))))
171         )
172        ((eq name 'value)
173         (cond
174          ((eq output-format 'wiki-text)
175           (setq output-string
176                 (if (and (setq object (plist-get props :object))
177                          (setq feature (plist-get props :feature)))
178                     (format "{{value %s %s=%s}}"
179                             feature
180                             (est-object-genre object)
181                             (www-uri-encode-object object))
182                   "{{value}}"))
183           )
184          ((eq output-format 'html)
185           (setq format
186                 (if (consp (car children))
187                     (caar children)))
188           (unless without-edit
189             (setq children
190                   (append children
191                           (list (list 'edit-value
192                                       (if format
193                                           (list* :format format props)
194                                         props)
195                                       '(input
196                                         (:type "submit" :value "edit")))))))
197           (setq name 'span
198                 props (list* :class "value" props))
199           ))
200         )
201        ((or (and (eq name 'link)
202                  (setq ret (plist-get props :ref)))
203             (and (eq name 'a)
204                  (setq ret (plist-get props :href))))
205         (cond
206          ((eq output-format 'wiki-text)
207           (setq output-string
208                 (format "[[%s|%s]]"
209                         (est-format-list children output-format)
210                         (est-format-unit ret output-format)
211                         ))
212           )
213          ((eq output-format 'html)
214           (setq name 'a
215                 props (list* :href ret
216                              (plist-remprop (copy-list props) :ref)))
217           )
218          ((eq output-format 'xml)
219           (unless (stringp ret)
220             (setq props (plist-remprop (copy-list props) :ref))
221             (setq children
222                   (cons (list 'ref nil ret)
223                         children)))
224           ))
225         )
226        ((and (eq name 'edit-value)
227              (setq object (plist-get props :object))
228              (setq feature (plist-get props :feature)))
229         (setq format (or (plist-get props :format) 'default))
230         (setq name 'a
231               props (list :href (format "%s?%s=%s&feature=%s&format=%s"
232                                         chise-wiki-edit-url
233                                         (est-object-genre object)
234                                         (www-uri-encode-object object)
235                                         (www-uri-encode-feature-name feature)
236                                         format)))
237         )
238        ((memq name '(div
239                      a ul ol p
240                      span
241                      input img))
242         )
243        (t
244         (when (eq output-format 'html)
245           (setq props (list* :class name props)
246                 name 'span))
247         ))
248       (cond
249        (output-string)
250        (t
251         (unless separator
252           (setq separator (plist-get props :separator)))
253         (setq subtype (plist-get props :subtype))
254         (if children
255             (cond
256              ((eq output-format 'plain-text)
257               (est-format-list children output-format as-property separator
258                                subtype)
259               )
260              ((eq subtype 'unordered-list)
261               (format "<ul\n%s><li\n>%s</li></ul\n>"
262                       (if props
263                           (est-format-props props)
264                         "")
265                       (est-format-list
266                        children output-format
267                        without-edit as-property "</li\n><li\n>")
268                       )
269               
270               )
271              (t
272               (format "<%s%s>%s</%s>"
273                       name
274                       (if props
275                           (est-format-props props)
276                         "")
277                       (est-format-list
278                        children output-format
279                        without-edit as-property separator)
280                       name)
281               ))
282           (if (eq output-format 'plain-text)
283               ""
284             (format "<%s%s/>"
285                     name (est-format-props props))))
286         ))
287       )
288      (t
289       (format "%s" format-unit)))))
290
291 (defun est-format-list (format-list
292                         &optional output-format without-edit as-property
293                         separator subtype)
294   (cond
295    ((atom format-list)
296     (est-format-unit
297      format-list output-format without-edit as-property separator)
298     )
299    ((eq subtype 'unordered-list)
300     (concat "<ul\n><li>"
301             (mapconcat (lambda (unit)
302                          (est-format-unit
303                           unit output-format without-edit as-property separator))
304                        format-list "</li\n><li>")
305             "</li\n></ul\n>")
306     )
307    (t
308     (mapconcat (lambda (unit)
309                  (est-format-unit
310                   unit output-format without-edit as-property))
311                format-list separator)
312     )))
313
314
315 ;;; @ End.
316 ;;;
317
318 (provide 'est-format)
319
320 ;;; est-format.el ends here