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        ((eq name 'list)
  66         (cond
  67          ((or (eq output-format 'plain-text)
  68               (eq output-format 'wiki-text))
  69           (unless separator
  70             (setq separator (plist-get props :separator)))
  71           (setq subtype (plist-get props :subtype))
  72           (setq output-string
  73                 (est-format-list children output-format
  74                                  without-edit as-property separator subtype))
  75           )
  76          ((eq output-format 'html)
  77           (setq props (list* :class name props)
  78                 name 'span)
  79           ))
  80         )
  81        ((eq name 'object)
  82         (cond
  83          ((eq output-format 'html)
  84           (setq name 'span)
  85           (when (setq object (plist-get props :object))
  86             (setq children
  87                   (list
  88                    (list* 'a
  89                           (list :href (www-uri-make-object-url object))
  90                           children))))
  91           )
  92          ((eq output-format 'wiki-text)
  93           (when (setq object (plist-get props :object))
  94             (setq output-string
  95                   (format "[[%s=%s]]"
  96                           (est-object-genre object)
  97                           (est-format-object object))))
  98           ))
  99         )
 100        ((eq name 'prev-char)
 101         (cond
 102          ((eq output-format 'wiki-text)
 103           (setq output-string "{{prev-char}}")
 104           )
 105          ((and (eq output-format 'html)
 106                (setq object (plist-get props :object))
 107                (setq feature (plist-get props :feature))
 108                (setq value (www-get-feature-value object feature))
 109                (setq ret (find-previous-defined-code-point feature value)))
 110           (setq children
 111                 (list
 112                  (list* 'a
 113                         (list :href (www-uri-make-object-url ret))
 114                         children)))
 115           ))
 116         )
 117        ((eq name 'next-char)
 118         (cond
 119          ((eq output-format 'wiki-text)
 120           (setq output-string "{{next-char}}")
 121           )
 122          ((and (eq output-format 'html)
 123                (setq object (plist-get props :object))
 124                (setq feature (plist-get props :feature))
 125                (setq value (www-get-feature-value object feature))
 126                (setq ret (find-next-defined-code-point feature value)))
 127           (setq children
 128                 (list
 129                  (list* 'a
 130                         (list :href (www-uri-make-object-url ret))
 131                         children)))
 132           ))
 133         )
 134        ((eq name 'omitted)
 135         (cond
 136          ((eq output-format 'wiki-text)
 137           (setq output-string "{{...}}")
 138           )
 139          ((and (eq output-format 'html)
 140                (setq object (plist-get props :object))
 141                (setq feature (plist-get props :feature)))
 142           (setq children
 143                 (list
 144                  (list* 'a
 145                         (list :href
 146                               (concat (www-uri-make-object-url object)
 147                                       (if est-hide-cgi-mode
 148                                           "/feature="
 149                                         "&feature=")
 150                                       (www-uri-encode-feature-name feature)))
 151                         children)))
 152           ))
 153         )
 154        ((eq name 'feature-name)
 155         (setq name 'span)
 156         (when (eq output-format 'html)
 157           (when (and (setq object (plist-get props :object))
 158                      (setq feature (plist-get props :feature)))
 159             (setq children
 160                   (list
 161                    (list 'span
 162                          '(:class "feature-name")
 163                          (list* 'a
 164                                 (list :href
 165                                       (www-uri-make-feature-name-url
 166                                        (est-object-genre object)
 167                                        (www-uri-encode-feature-name feature)
 168                                        (www-uri-encode-object object)))
 169                                 children))))))
 170         )
 171        ((eq name 'value)
 172         (cond
 173          ((eq output-format 'wiki-text)
 174           (setq output-string
 175                 (if (and (setq object (plist-get props :object))
 176                          (setq feature (plist-get props :feature)))
 177                     (format "{{value %s %s=%s}}"
 178                             feature
 179                             (est-object-genre object)
 180                             (www-uri-encode-object object))
 181                   "{{value}}"))
 182           )
 183          ((eq output-format 'html)
 184           (setq format
 185                 (if (consp (car children))
 186                     (caar children)))
 187           (unless without-edit
 188             (setq children
 189                   (append children
 190                           (list (list 'edit-value
 191                                       (if format
 192                                           (list* :format format props)
 193                                         props)
 194                                       '(input
 195                                         (:type "submit" :value "edit")))))))
 196           (setq name 'span
 197                 props (list* :class "value" props))
 198           ))
 199         )
 200        ((or (and (eq name 'link)
 201                  (setq ret (plist-get props :ref)))
 202             (and (eq name 'a)
 203                  (setq ret (plist-get props :href))))
 204         (cond
 205          ((eq output-format 'wiki-text)
 206           (setq output-string
 207                 (format "[[%s|%s]]"
 208                         (est-format-list children output-format)
 209                         (est-format-unit ret output-format)
 210                         ))
 211           )
 212          ((eq output-format 'html)
 213           (setq name 'a
 214                 props (list* :href ret
 215                              (plist-remprop (copy-list props) :ref)))
 216           )
 217          ((eq output-format 'xml)
 218           (unless (stringp ret)
 219             (setq props (plist-remprop (copy-list props) :ref))
 220             (setq children
 221                   (cons (list 'ref nil ret)
 222                         children)))
 223           ))
 224         )
 225        ((and (eq name 'edit-value)
 226              (setq object (plist-get props :object))
 227              (setq feature (plist-get props :feature)))
 228         (setq format (or (plist-get props :format) 'default))
 229         (setq name 'a
 230               props (list :href (format "%s?%s=%s&feature=%s&format=%s"
 231                                         chise-wiki-edit-url
 232                                         (est-object-genre object)
 233                                         (www-uri-encode-object object)
 234                                         (www-uri-encode-feature-name feature)
 235                                         format)))
 236         )
 237        ((memq name '(div
 238                      a ul ol p
 239                      span
 240                      input))
 241         )
 242        (t
 243         (when (eq output-format 'html)
 244           (setq props (list* :class name props)
 245                 name 'span))
 246         ))
 247       (cond
 248        (output-string)
 249        (t
 250         (unless separator
 251           (setq separator (plist-get props :separator)))
 252         (setq subtype (plist-get props :subtype))
 253         (if children
 254             (cond
 255              ((eq output-format 'plain-text)
 256               (est-format-list children output-format as-property separator
 257                                subtype)
 258               )
 259              ((eq subtype 'unordered-list)
 260               (format "<ul\n%s><li\n>%s</li></ul\n>"
 261                       (if props
 262                           (est-format-props props)
 263                         "")
 264                       (est-format-list
 265                        children output-format
 266                        without-edit as-property "</li\n><li\n>")
 267                       )
 268
 269               )
 270              (t
 271               (format "<%s%s>%s</%s>"
 272                       name
 273                       (if props
 274                           (est-format-props props)
 275                         "")
 276                       (est-format-list
 277                        children output-format
 278                        without-edit as-property separator)
 279                       name)
 280               ))
 281           (if (eq output-format 'plain-text)
 282               ""
 283             (format "<%s%s/>"
 284                     name (est-format-props props))))
 285         ))
 286       )
 287      (t
 288       (format "%s" format-unit)))))
 289
 290 (defun est-format-list (format-list
 291                         &optional output-format without-edit as-property
 292                         separator subtype)
 293   (cond
 294    ((atom format-list)
 295     (est-format-unit
 296      format-list output-format without-edit as-property separator)
 297     )
 298    ((eq subtype 'unordered-list)
 299     (concat "<ul\n><li>"
 300             (mapconcat (lambda (unit)
 301                          (est-format-unit
 302                           unit output-format without-edit as-property separator))
 303                        format-list "</li\n><li>")
 304             "</li\n></ul\n>")
 305     )
 306    (t
 307     (mapconcat (lambda (unit)
 308                  (est-format-unit
 309                   unit output-format without-edit as-property))
 310                format-list separator)
 311     )))
 312
 313
 314 ;;; @ End.
 315 ;;;
 316
 317 (provide 'est-format)
 318
 319 ;;; est-format.el ends here