[Move examples into their own file
clinton@unknownlamer.org**20090429185818
 Ignore-this: 5af34f87b1e131707174a91f26f491f6
 Just to make working with the main xmlisp code easier
] addfile ./src/examples.lisp
hunk ./src/examples.lisp 1
+#|
+
+;; 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"/>)
+
+|#
hunk ./src/xmlisp.lisp 2065
-
-
-#|
-
-;; 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"/>)
-
-|#
-
-
-