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