#|

;; Example 1: HTML Link
;;   simple mapping between class/element and slot/attribute name


(defclass A (xml-serializer)
   ((href :accessor href :initform "" :initarg :href))
   (:documentation "HTML link"))


(inspect <a href="http://www.agentsheets.com"/>)
(read-from-string "<a href=\"http://www.agentsheets.com\">AgentSheets</a>")

(href <a href="http://agentsheets.com/lisp/XMLisp/">XMLisp examples</a>)


;; Example 2: RSS

(defclass RSS (xml-serializer)
   ((version :accessor version :initform "")
    (channel :accessor channel :initform nil))
   (:documentation "RSS main element"))

(defclass CHANNEL (xml-serializer)
   ((title :accessor title :initform "")
    (link :accessor link :initform "")
    (description :accessor description :initform "")
    (image :accessor image :initform nil)
    (managingeditor :accessor managingeditor :initform "")
    (ttl :accessor ttl :initform nil :documentation "don't know what this is")
    (language :accessor language :initform "")
    (copyright :accessor copyright :initform "")
    (webmaster :accessor webMaster :initform "")
    (pubdate :accessor pubDate :initform "")
    (lastbuilddate :accessor lastBuildDate :initform "")
    (category :accessor category :initform "")
    (generator :accessor generator :initform "")
    (docs :accessor docs :initform "")
    (items :accessor items :initform nil :documentation "list of RSS item"))
   (:documentation "RSS channel"))


(defclass IMAGE (xml-serializer)
   ((title :accessor title :initform "")
    (url :accessor url :initform "")
    (link :accessor link :initform "")
    (width :accessor width :initform 0))
   (:documentation "RSS Image"))


(defclass ITEM (xml-serializer)
   ((title :accessor title :initform "")
    (link :accessor link :initform "")
    (description :accessor description :initform "")
    (pubdate :accessor pubdate :initform ""))
   (:documentation "RSS news Item"))

;; pick an XML RSS file from the examples/xml folder
;; if you pick other RSS files keep in mind that the above spec is incomplete


(defparameter *RSS-News* (load-object (ccl:choose-file-dialog)))

(save-object *RSS-News* "ccl:delete_me.xml" :if-exists :overwrite)


;; and walk throught the RSS structure

(inspect *RSS-News*)



;; Example 3: Typed Slots
;;   Typed slots use the print-typed-attribute-value, read-typed-attribute-value, print-typed-subelement-value
;;   CODECs

(defclass COIN (xml-serializer)
  ((head-is-up :accessor head-is-up :type boolean)))


(inspect <coin head-is-up="true"/>)



;; Example 4: simple Aggregation: rule based Visual AgenTalk-like language
;;  use MOP name matching to implement aggregation
;;  e.g. slot "RULES" will contain a list of "RULE" elements

(defclass COMMAND (xml-serializer)
  ((name :accessor name :initform "" :initarg :name)
   (comments :accessor comments :initform nil)))


(defclass BEHAVIOR (command)
  ((method-commands :accessor method-commands :initform nil)))


(defclass METHOD-COMMAND (command)
  ((trigger :accessor trigger :initform nil)
   (rules :accessor rules :initform nil)))

(defclass TRIGGER (command)
  ())

(defclass RULE (command)
  ((condition-commands :accessor condition-commands :initform nil :initarg :condition-commands)
   (action-commands :accessor action-commands :initform nil :initarg :action-commands)
   (is-enabled :accessor is-enabled :initform t :initarg :is-enabled :type boolean)
   (probablility :accessor probability :initform 0.9s0 :initarg :probability :type short-float)))


(defclass CONDITION-COMMAND (command)
  ())


(defclass ACTION-COMMAND (command)
  ())



(inspect
 <behavior name="random Move">
   <method-command name="mouse" trigger="on mouse down">
     <rule>
       <condition-command name="see_a"/>
       <condition-command name="key"/>
       <action-command name="play_sound"/>
     </rule>
   </method-command>
 </behavior> )


;; Example 5: User defined Aggregation
;;   This is by no means a complete definition


(defclass HTML-BASE-CLASS (xml-serializer)
  ()
  (:documentation "mother of all HTML element classes"))


(defclass HTML (html-base-class)
  ((items :accessor items :initform nil))
  (:documentation "Contains all the html items of an HTML document"))


(defmethod ADD-SUBOBJECT ((Self html) (Item html-base-class))
  ;; extend this method to add all html-base-class instances to the "items" slot
  (add-object-to-slot Self Item 'items))



(defclass A (html-base-class)
   ((href :accessor href :initform "" :initarg :href))
   (:documentation "HTML link"))


(defclass FONT (html-base-class)
  ((face :accessor face)
   (size :accessor size :type number))
  (:documentation "Font info"))




(inspect

<HTML>

<font face="arial, sans-serif" size="-2">Small Text here</font>
<font face="arial, sans-serif" size="+2">Large Text here</font>
<a href="http://www.cs.colorado.edu">Go CU</a>

</HTML>   )



;;; Example 6: specialized attribute/slot name mapping


(defclass ARGUMENT (xml-serializer)
  ((pros :accessor pros :initform nil)
   (against :accessor against :initform nil)))  ;; cons would be slot name that would conflict with Common Lisp symbol


(defmethod ATTRIBUTE-NAME->SLOT-NAME ((Self argument) Attribute-Name)
  (case Attribute-Name
    (cons 'against)
    (t (call-next-method))))


(defmethod SLOT-NAME->ATTRIBUTE-NAME ((Self argument) Slot-Name)
  (case Slot-Name
    (against 'cons)
    (t (call-next-method))))


<argument pros="macs are cool" cons="everybody has windows boxes"/>

<argument pros="macs are cool" against="everybody has windows boxes"/>    ;; still works: could overwrite that if needed

(against <argument pros="macs are cool" cons="everybody has windows boxes"/>)



;;; Example 7: Name spaces
;;; XML Name spaces map to Lisp Packages
;;; if you need to be able to read, say, <simulation pikim:content_type="agentcubes" xmlns:pikim="http://ctl.sri.com/piki/mime"/>

;; define packages if they do not already exist:

(defpackage PIKIM)

(defpackage XMLNS)

;; then define your element class including slot names and accessors with package prefixes:

(defclass SIMULATION (xml-serializer)
  ((pikim::content_type :accessor pikim::content_type :initform nil)
   (xmlns::pikim :accessor xmlns::pikim :initform nil)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Example 8: comments, http://www.w3.org/TR/REC-xml/#sec-comments

;; well formed: (content <!-- declarations for <head> & <body> -->)

;; not well formed: <!-- B+, B, or B--->

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Example 9: printing attributes based on accessor instead of slots

(defclass class-with-missing-slot (xml-serializer)
  ())

(defmethod print-slots ((Self class-with-missing-slot))
  '(accessor-with-no-matching-slot))  ; note: class does not have this slot

(defmethod accessor-with-no-matching-slot ((Self class-with-missing-slot))
  55)

(setq c (make-instance 'class-with-missing-slot))

(defclass list-of-class-with-missing-slot (xml-serializer)
  ((stuff :accessor stuff :initform 0 :type number :initarg :stuff)))

(defmethod elements ((Self list-of-class-with-missing-slot))
  (let ((List nil))
    (dotimes (i 20 List)
      (push (make-instance 'class-with-missing-slot) List))))

(defmethod print-slots ((Self list-of-class-with-missing-slot))
  '(stuff elements))

(defparameter *lc* (make-instance 'list-of-class-with-missing-slot :stuff 111))

(stuff *lc*)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Example 10: Read return values

(defclass SUM (xml-serializer)
  ((a :accessor a :type number)
   (b :accessor b :type number)))


(defmethod READ-RETURN-VALUE ((Self sum))
  ;; overwrite: instead of returning self return the actual sum of a and b
  (+ (a Self) (b Self)))

<sum a="2" b="3"/>

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Example 11: Keyword type

(defclass REFERENCE (xml-serializer)
  ((name :accessor name :type keyword)))


(name <reference name="left"/>)

|#