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