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                     (www-format-encode-string
  22                      (format "%s"
  23                              (est-format-unit val 'without-tags
  24                                               'without-edit 'as-property))
  25                      'without-tags))))
  26     dest))
  27
  28 (defun est-format-unit (format-unit
  29                         &optional output-format without-edit as-property
  30                         separator)
  31   (cond
  32    ((or (eq output-format 'without-tags)
  33         (eq output-format t))
  34     (setq output-format 'plain-text)
  35     )
  36    ((eq output-format 'wiki-text)
  37     )
  38    ((eq output-format 'xml)
  39     )
  40    ((null output-format)
  41     (setq output-format 'html)
  42     ))
  43   (let (name props children ret object feature format value
  44              output-string subtype)
  45     (cond
  46      ((stringp format-unit)
  47       (www-format-encode-string format-unit
  48                                 (not (eq output-format 'html))
  49                                 (not as-property))
  50       )
  51      ((characterp format-unit)
  52       (www-format-encode-string (format "%S" format-unit)
  53                                 (not (eq output-format 'html))
  54                                 (not as-property))
  55       )
  56      ((symbolp format-unit)
  57       (www-format-encode-string (format "%s" format-unit)
  58                                 (not (eq output-format 'html))
  59                                 (not as-property))
  60       )
  61      ((consp format-unit)
  62       (setq name (car format-unit)
  63             props (nth 1 format-unit)
  64             children (nthcdr 2 format-unit))
  65       (cond
  66        ((eq name '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* 'a
 163                           (list :href
 164                                 (www-uri-make-feature-name-url
 165                                  (est-object-genre object)
 166                                  (www-uri-encode-feature-name feature)
 167                                  (www-uri-encode-object object)))
 168                           children)))))
 169         )
 170        ((eq name 'value)
 171         (cond
 172          ((eq output-format 'wiki-text)
 173           (setq output-string
 174                 (if (and (setq object (plist-get props :object))
 175                          (setq feature (plist-get props :feature)))
 176                     (format "{{value %s %s=%s}}"
 177                             feature
 178                             (est-object-genre object)
 179                             (www-uri-encode-object object))
 180                   "{{value}}"))
 181           )
 182          ((eq output-format 'html)
 183           (setq format
 184                 (if (consp (car children))
 185                     (caar children)))
 186           (unless without-edit
 187             (setq children
 188                   (append children
 189                           (list (list 'edit-value
 190                                       (if format
 191                                           (list* :format format props)
 192                                         props)
 193                                       '(input
 194                                         (:type "submit" :value "edit")))))))
 195           (setq name 'span
 196                 props (list* :class "value" props))
 197           ))
 198         )
 199        ((or (and (eq name 'link)
 200                  (setq ret (plist-get props :ref)))
 201             (and (eq name 'a)
 202                  (setq ret (plist-get props :href))))
 203         (cond
 204          ((eq output-format 'wiki-text)
 205           (setq output-string
 206                 (format "[[%s|%s]]"
 207                         (est-format-list children output-format)
 208                         (est-format-unit ret output-format)
 209                         ))
 210           )
 211          ((eq output-format 'html)
 212           (setq name 'a
 213                 props (list* :href ret
 214                              (plist-remprop (copy-list props) :ref)))
 215           )
 216          ((eq output-format 'xml)
 217           (unless (stringp ret)
 218             (setq props (plist-remprop (copy-list props) :ref))
 219             (setq children
 220                   (cons (list 'ref nil ret)
 221                         children)))
 222           ))
 223         )
 224        ((and (eq name 'edit-value)
 225              (setq object (plist-get props :object))
 226              (setq feature (plist-get props :feature)))
 227         (setq format (or (plist-get props :format) 'default))
 228         (setq name 'a
 229               props (list :href (format "%s?%s=%s&feature=%s&format=%s"
 230                                         chise-wiki-edit-url
 231                                         (est-object-genre object)
 232                                         (www-uri-encode-object object)
 233                                         (www-uri-encode-feature-name feature)
 234                                         format)))
 235         )
 236        ((memq name '(div
 237                      a ul ol p
 238                      span
 239                      input))
 240         )
 241        (t
 242         (when (eq output-format 'html)
 243           (setq props (list* :class name props)
 244                 name 'span))
 245         ))
 246       (cond
 247        (output-string)
 248        (t
 249         (unless separator
 250           (setq separator (plist-get props :separator)))
 251         (setq subtype (plist-get props :subtype))
 252         (if children
 253             (cond
 254              ((eq output-format 'plain-text)
 255               (est-format-list children output-format as-property separator
 256                                subtype)
 257               )
 258              ((eq subtype 'unordered-list)
 259               (format "<ul\n%s><li\n>%s</li></ul\n>"
 260                       (if props
 261                           (est-format-props props)
 262                         "")
 263                       (est-format-list
 264                        children output-format
 265                        without-edit as-property "</li\n><li\n>")
 266                       )
 267
 268               )
 269              (t
 270               (format "<%s%s>%s</%s>"
 271                       name
 272                       (if props
 273                           (est-format-props props)
 274                         "")
 275                       (est-format-list
 276                        children output-format
 277                        without-edit as-property separator)
 278                       name)
 279               ))
 280           (if (eq output-format 'plain-text)
 281               ""
 282             (format "<%s%s/>"
 283                     name (est-format-props props))))
 284         ))
 285       )
 286      (t
 287       (format "%s" format-unit)))))
 288
 289 (defun est-format-list (format-list
 290                         &optional output-format without-edit as-property
 291                         separator subtype)
 292   (cond
 293    ((atom format-list)
 294     (est-format-unit
 295      format-list output-format without-edit as-property separator)
 296     )
 297    ((eq subtype 'unordered-list)
 298     (concat "<ul\n><li>"
 299             (mapconcat (lambda (unit)
 300                          (est-format-unit
 301                           unit output-format without-edit as-property separator))
 302                        format-list "</li\n><li>")
 303             "</li\n></ul\n>")
 304     )
 305    (t
 306     (mapconcat (lambda (unit)
 307                  (est-format-unit
 308                   unit output-format without-edit as-property))
 309                format-list separator)
 310     )))
 311
 312
 313 ;;; @ End.
 314 ;;;
 315
 316 (provide 'est-format)
 317
 318 ;;; est-format.el ends here