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