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                                  (www-uri-encode-feature-name feature)
  86                                  (www-uri-encode-object object)))
  87                           children)))))
  88         )
  89        ((eq name 'value)
  90         (setq format
  91               (if (consp (car children))
  92                   (caar children)))
  93         (unless without-edit
  94           (setq children
  95                 (append children
  96                         (list (list 'edit-value
  97                                     (if format
  98                                         (list* :format format props)
  99                                       props)
 100                                     '(input
 101                                       (:type "submit" :value "edit")))))))
 102         (unless without-tags
 103           (setq name 'span
 104                 props (list* :class "value" props)))
 105         )
 106        ((eq name 'link)
 107         (setq ret (plist-get props :ref))
 108         ;; (unless (stringp ret)
 109         ;;   (setq props (plist-remprop (copy-list props) :ref))
 110         ;;   (setq children
 111         ;;         (cons (list 'ref nil ret)
 112         ;;               children)))
 113         (unless without-tags
 114           (setq name 'a
 115                 props (list* :href ret
 116                              (plist-remprop (copy-list props) :ref))))
 117         )
 118        ((and (eq name 'edit-value)
 119              (setq object (plist-get props :object))
 120              (setq feature (plist-get props :feature)))
 121         (setq format (or (plist-get props :format) 'default))
 122         (setq name 'a
 123               props (list :href (format "%s?%s=%s&feature=%s&format=%s"
 124                                         chise-wiki-edit-url
 125                                         (est-object-genre object)
 126                                         (www-uri-encode-object object)
 127                                         (www-uri-encode-feature-name feature)
 128                                         format)))
 129         )
 130        ((memq name '(div
 131                      a ul ol p
 132                      span
 133                      input))
 134         )
 135        (t
 136         (unless without-tags
 137           (setq props (list* :class name props)
 138                 name 'span))
 139         ))
 140       (unless separator
 141         (setq separator (plist-get props :separator)))
 142       (if children
 143           (if without-tags
 144               (est-format-list children without-tags as-property separator)
 145             (format "<%s%s>%s</%s>"
 146                     name
 147                     (if props
 148                         (est-format-props props)
 149                       "")
 150                     (est-format-list
 151                      children nil without-edit as-property separator)
 152                     name))
 153         (if without-tags
 154             ""
 155           (format "<%s%s/>"
 156                   name (est-format-props props))))
 157       )
 158      (t
 159       (format "%s" format-unit)))))
 160
 161 (defun est-format-list (format-list
 162                         &optional without-tags without-edit as-property
 163                         separator)
 164   (if (atom format-list)
 165       (est-format-unit
 166        format-list without-tags without-edit as-property separator)
 167     (mapconcat (lambda (unit)
 168                  (est-format-unit
 169                   unit without-tags without-edit as-property separator))
 170                format-list separator)))
 171
 172
 173 ;;; @ End.
 174 ;;;
 175
 176 (provide 'est-format)
 177
 178 ;;; est-format.el ends here