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 without-tags without-edit as-property
  30                         separator)
  31   (let (name props children ret object feature format value)
  32     (cond
  33      ((stringp format-unit)
  34       (www-format-encode-string format-unit without-tags (not as-property))
  35       )
  36      ((consp format-unit)
  37       (setq name (car format-unit)
  38             props (nth 1 format-unit)
  39             children (nthcdr 2 format-unit))
  40       (cond
  41        ((eq name 'object)
  42         (setq name 'span)
  43         (unless without-tags
  44           (when (setq object (plist-get props :object))
  45             (setq children
  46                   (list
  47                    (list* 'a
  48                           (list :href (www-uri-make-object-url object))
  49                           children)))))
  50         )
  51        ((eq name 'prev-char)
  52         (when (and (not without-tags)
  53                    (setq object (plist-get props :object))
  54                    (setq feature (plist-get props :feature))
  55                    (setq value (www-get-feature-value object feature))
  56                    (setq ret (find-previous-defined-code-point feature value)))
  57           (setq children
  58                 (list
  59                  (list* 'a
  60                         (list :href (www-uri-make-object-url ret))
  61                         children))))
  62         )
  63        ((eq name 'next-char)
  64         (when (and (not without-tags)
  65                    (setq object (plist-get props :object))
  66                    (setq feature (plist-get props :feature))
  67                    (setq value (www-get-feature-value object feature))
  68                    (setq ret (find-next-defined-code-point feature value)))
  69           (setq children
  70                 (list
  71                  (list* 'a
  72                         (list :href (www-uri-make-object-url ret))
  73                         children))))
  74         )
  75        ((eq name 'feature-name)
  76         (setq name 'span)
  77         (unless without-tags
  78           (when (and (setq object (plist-get props :object))
  79                      (setq feature (plist-get props :feature)))
  80             (setq children
  81                   (list
  82                    (list* 'a
  83                           (list :href
  84                                 (www-uri-make-feature-name-url
  85                                  (est-object-genre object)
  86                                  (www-uri-encode-feature-name feature)
  87                                  (www-uri-encode-object object)))
  88                           children)))))
  89         )
  90        ((eq name 'value)
  91         (setq format
  92               (if (consp (car children))
  93                   (caar children)))
  94         (unless without-edit
  95           (setq children
  96                 (append children
  97                         (list (list 'edit-value
  98                                     (if format
  99                                         (list* :format format props)
 100                                       props)
 101                                     '(input
 102                                       (:type "submit" :value "edit")))))))
 103         (unless without-tags
 104           (setq name 'span
 105                 props (list* :class "value" props)))
 106         )
 107        ((eq name 'link)
 108         (setq ret (plist-get props :ref))
 109         ;; (unless (stringp ret)
 110         ;;   (setq props (plist-remprop (copy-list props) :ref))
 111         ;;   (setq children
 112         ;;         (cons (list 'ref nil ret)
 113         ;;               children)))
 114         (unless without-tags
 115           (setq name 'a
 116                 props (list* :href ret
 117                              (plist-remprop (copy-list props) :ref))))
 118         )
 119        ((and (eq name 'edit-value)
 120              (setq object (plist-get props :object))
 121              (setq feature (plist-get props :feature)))
 122         (setq format (or (plist-get props :format) 'default))
 123         (setq name 'a
 124               props (list :href (format "%s?%s=%s&feature=%s&format=%s"
 125                                         chise-wiki-edit-url
 126                                         (est-object-genre object)
 127                                         (www-uri-encode-object object)
 128                                         (www-uri-encode-feature-name feature)
 129                                         format)))
 130         )
 131        ((memq name '(div
 132                      a ul ol p
 133                      span
 134                      img
 135                      input))
 136         )
 137        (t
 138         (unless without-tags
 139           (setq props (list* :class name props)
 140                 name 'span))
 141         ))
 142       (unless separator
 143         (setq separator (plist-get props :separator)))
 144       (if children
 145           (if without-tags
 146               (est-format-list children without-tags as-property separator)
 147             (format "<%s%s>%s</%s>"
 148                     name
 149                     (if props
 150                         (est-format-props props)
 151                       "")
 152                     (est-format-list
 153                      children nil without-edit as-property separator)
 154                     name))
 155         (if without-tags
 156             ""
 157           (format "<%s%s/>"
 158                   name (est-format-props props))))
 159       )
 160      (t
 161       (format "%s" format-unit)))))
 162
 163 (defun est-format-list (format-list
 164                         &optional without-tags without-edit as-property
 165                         separator)
 166   (if (atom format-list)
 167       (est-format-unit
 168        format-list without-tags without-edit as-property separator)
 169     (mapconcat (lambda (unit)
 170                  (est-format-unit
 171                   unit without-tags without-edit as-property separator))
 172                format-list separator)))
 173
 174
 175 ;;; @ End.
 176 ;;;
 177
 178 (provide 'est-format)
 179
 180 ;;; est-format.el ends here