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 'feature-name)
 136         (setq name 'span)
 137         (when (eq output-format 'html)
 138           (when (and (setq object (plist-get props :object))
 139                      (setq feature (plist-get props :feature)))
 140             (setq children
 141                   (list
 142                    (list* 'a
 143                           (list :href
 144                                 (www-uri-make-feature-name-url
 145                                  (est-object-genre object)
 146                                  (www-uri-encode-feature-name feature)
 147                                  (www-uri-encode-object object)))
 148                           children)))))
 149         )
 150        ((eq name 'value)
 151         (cond
 152          ((eq output-format 'wiki-text)
 153           (setq output-string
 154                 (if (and (setq object (plist-get props :object))
 155                          (setq feature (plist-get props :feature)))
 156                     (format "{{value %s %s=%s}}"
 157                             feature
 158                             (est-object-genre object)
 159                             (www-uri-encode-object object))
 160                   "{{value}}"))
 161           )
 162          ((eq output-format 'html)
 163           (setq format
 164                 (if (consp (car children))
 165                     (caar children)))
 166           (unless without-edit
 167             (setq children
 168                   (append children
 169                           (list (list 'edit-value
 170                                       (if format
 171                                           (list* :format format props)
 172                                         props)
 173                                       '(input
 174                                         (:type "submit" :value "edit")))))))
 175           (setq name 'span
 176                 props (list* :class "value" props))
 177           ))
 178         )
 179        ((or (and (eq name 'link)
 180                  (setq ret (plist-get props :ref)))
 181             (and (eq name 'a)
 182                  (setq ret (plist-get props :href))))
 183         (cond
 184          ((eq output-format 'wiki-text)
 185           (setq output-string
 186                 (format "[[%s|%s]]"
 187                         (est-format-list children output-format)
 188                         (est-format-unit ret output-format)
 189                         ))
 190           )
 191          ((eq output-format 'html)
 192           (setq name 'a
 193                 props (list* :href ret
 194                              (plist-remprop (copy-list props) :ref)))
 195           )
 196          ((eq output-format 'xml)
 197           (unless (stringp ret)
 198             (setq props (plist-remprop (copy-list props) :ref))
 199             (setq children
 200                   (cons (list 'ref nil ret)
 201                         children)))
 202           ))
 203         )
 204        ((and (eq name 'edit-value)
 205              (setq object (plist-get props :object))
 206              (setq feature (plist-get props :feature)))
 207         (setq format (or (plist-get props :format) 'default))
 208         (setq name 'a
 209               props (list :href (format "%s?%s=%s&feature=%s&format=%s"
 210                                         chise-wiki-edit-url
 211                                         (est-object-genre object)
 212                                         (www-uri-encode-object object)
 213                                         (www-uri-encode-feature-name feature)
 214                                         format)))
 215         )
 216        ((memq name '(div
 217                      a ul ol p
 218                      span
 219                      input))
 220         )
 221        (t
 222         (when (eq output-format 'html)
 223           (setq props (list* :class name props)
 224                 name 'span))
 225         ))
 226       (cond
 227        (output-string)
 228        (t
 229         (unless separator
 230           (setq separator (plist-get props :separator)))
 231         (setq subtype (plist-get props :subtype))
 232         (if children
 233             (cond
 234              ((eq output-format 'plain-text)
 235               (est-format-list children output-format as-property separator
 236                                subtype)
 237               )
 238              ((eq subtype 'unordered-list)
 239               (format "<ul\n%s><li\n>%s</li></ul\n>"
 240                       (if props
 241                           (est-format-props props)
 242                         "")
 243                       (est-format-list
 244                        children output-format
 245                        without-edit as-property "</li\n><li\n>")
 246                       )
 247
 248               )
 249              (t
 250               (format "<%s%s>%s</%s>"
 251                       name
 252                       (if props
 253                           (est-format-props props)
 254                         "")
 255                       (est-format-list
 256                        children output-format
 257                        without-edit as-property separator)
 258                       name)
 259               ))
 260           (if (eq output-format 'plain-text)
 261               ""
 262             (format "<%s%s/>"
 263                     name (est-format-props props))))
 264         ))
 265       )
 266      (t
 267       (format "%s" format-unit)))))
 268
 269 (defun est-format-list (format-list
 270                         &optional output-format without-edit as-property
 271                         separator subtype)
 272   (cond
 273    ((atom format-list)
 274     (est-format-unit
 275      format-list output-format without-edit as-property separator)
 276     )
 277    ((eq subtype 'unordered-list)
 278     (concat "<ul\n><li>"
 279             (mapconcat (lambda (unit)
 280                          (est-format-unit
 281                           unit output-format without-edit as-property separator))
 282                        format-list "</li\n><li>")
 283             "</li\n></ul\n>")
 284     )
 285    (t
 286     (mapconcat (lambda (unit)
 287                  (est-format-unit
 288                   unit output-format without-edit as-property separator))
 289                format-list separator)
 290     )))
 291
 292
 293 ;;; @ End.
 294 ;;;
 295
 296 (provide 'est-format)
 297
 298 ;;; est-format.el ends here