addfile ./README hunk ./README 1 - +xml-emitter: An XML emitter +=========================== + +Often, programs have to generate XML output. This is fairly easy, but +not quite trivial. You need to do escaping, and indentation can be a +little tricky to keep track of. One approach you could use is to get +an XML parser/unparser like XMLS, build your XML data structure in +memory, then dump the whole thing. This is fairly easy, but not as +easy as it could be, and it requires holding the whole structure in +memory. Oh, and XMLS doesn't handle indentation for you. + +So, I wrote xml-emitter. xml-emitter simply emits XML, with some +complexity for handling indentation. It can be used to produce all +sorts of useful XML output; it has an RSS 2.0 emitter built in. + +There is no real home page, but you can download it from the +asdf-packaging project: + +http://common-lisp.net/project/asdf-packaging/ + +If you have comments, questions, or bug reports, email them to Peter +Scott . + +Installation +------------ + +There are two ways to install xml-emitter. Via asdf-install: + +(asdf-install:install :xml-emitter) + +Or you can download the latest version at: + +http://common-lisp.net/project/asdf-packaging/xml-emitter-latest.tar.gz + +Usage +----- + +The WITH-XML-OUTPUT macro wraps all XML output to a stream. + +The WITH-TAG macro places the XML produced by its body inside a +tag. Its output cannot be on just one line, since it puts starting and +closing tags on their own lines. + +The WITH-SIMPLE-TAG macro is like WITH-TAG, but starting and closing +tags don't get their own lines. + +XML-OUT prints its argument to the XML output stream, escaped. + +XML-AS-IS prints its argument to the XML output stream, unescaped. + +SIMPLE-TAG prints a simple value tag. It's a shortened +version of a typical use of WITH-SIMPLE-TAG and XML-OUT. + +EMIT-SIMPLE-TAGS takes a plist of tag names and tag values. For every +tag with a non-NIL value, it prints the tag with SIMPLE-TAG. Tag names +given as keyword symbols (like :this) are downcased. + +Example: + +(with-xml-output (*standard-output*) + (with-tag ("person" '(("age" "19"))) + (with-simple-tag ("firstName") + (xml-out "Peter")) + (simple-tag "lastName" "Scott") + (emit-simple-tags :age 17 + :school "Iowa State Univeristy" + "mixedCaseTag" "Check out the mixed case!" + "notShown" nil))) + +The RSS 2.0 emitter +------------------- + +The WITH-RSS2 macro wraps up all output of RSS. + +RSS-CHANNEL-HEADER outputs the RSS channel information. + +RSS-ITEM outputs information about one RSS item. + +Example: + +(with-rss2 (*standard-output*) + (rss-channel-header "Peter's Blog" "http://peter.blogspot.com/" + :description "A place where I sometimes post stuff" + :image "myhead.jpg" + :image-title "My glorious visage") + (rss-item "Breaking news!" + :link "http://google.com/" + :description "The biggest problem with the DO-ODD macro above is that it puts BODY +into LOOP. Code from the user of the macro should never be run in the +environment established by the LOOP macro. LOOP does a number of +things behind your back, and it's hard to disable them. For example, +what happens here?" + :author "Peter Scott" + :category "Lisp" + :pubDate "Sun, 29 Sep 2002 19:59:01 GMT") + (rss-item "RSS emitter created" + :description "An RSS emitter has been released! Hahahahaha!" + :author "Peter Scott" + :link "http://gmail.google.com/")) + +There is also a complete example of how you might use the RSS emitter +in mailbox.lisp + +License +------- + +I, Peter Scott, place this code in the public domain. You can do +whatever you like with it. + +-Peter Scott, addfile ./mailbox.lisp hunk ./mailbox.lisp 1 - +;; This is an example of something you might use the RSS emitter for +;; if you were writing a web-based email program. Google's Gmail does +;; something like this, so I was inspired. + +(in-package :xml-emitter) + +;; The email structure is deliberately simplistic. +(defstruct email + from subject body date id) + +;; In a real email app, we would get this from an SMTP server or a +;; database or something. +(defparameter *inbox* (list (make-email + :from "Peter Scott " + :subject "Queue" + :date "Sat, 07 Sep 2002 00:00:01 GMT" + :id 34834) + (make-email + :from "Dave Pearson " + :subject "THIS REALLY WORKS SKETERPOT!!!" + :date "Tue, 25 Sep 1987 13:42:41 GMT" + :id 34833) + (make-email + :from "Bubs " + :subject "Bubs' Weekly Spamvertisement" + :date "Wed, 14 Aug 2003 09:23:07 GMT" + :id 34832))) + +(defun emit-inbox-feed (username stream) + "Emit an RSS 2.0 feed for *INBOX* to STREAM, marking it as belonging +to USERNAME." + (with-rss2 (stream) + ;; Emit the header, with information about the feed + (rss-channel-header (format nil "Inbox for ~A" username) + (format nil "http://rss.mywebmail.com/~A.rss" + username) + :description "Your email inbox") + (dolist (email *inbox*) + ;; Emit an entry for a single email + (rss-item (email-subject email) + :link (format nil "http://www.mywebmail.com/viewemail?id=~A" + (email-id email)) + :author (email-from email) + :pubDate (email-date email) + :description (email-body email))))) + +;; Evaluate this, and you should get the output below. +(emit-inbox-feed "sketerpot" *standard-output*) + +#| + + + + Inbox for sketerpot + http://rss.mywebmail.com/sketerpot.rss + Your email inbox + en-us + + Queue + http://www.mywebmail.com/viewemail?id=34834 + Peter Scott <sketerpot@gmail.com> + Sat, 07 Sep 2002 00:00:01 GMT + + + THIS REALLY WORKS SKETERPOT!!! + http://www.mywebmail.com/viewemail?id=34833 + Dave Pearson <i54jsw2@hotmail.com> + Tue, 25 Sep 1987 13:42:41 GMT + + + Bubs' Weekly Spamvertisement + http://www.mywebmail.com/viewemail?id=34832 + Bubs <bubs@homestarrunner.com> + Wed, 14 Aug 2003 09:23:07 GMT + + + +|# addfile ./package.lisp hunk ./package.lisp 1 - +(in-package :common-lisp) + +(defpackage :xml-emitter + (:use :cl :cl-utilities) + (:export #:xml-out + #:xml-as-is + #:with-tag + #:with-simple-tag + #:with-xml-output + #:simple-tag + #:emit-simple-tags + ;; RSS 2.0 + #:rss-channel-header + #:rss-item + #:with-rss2)) addfile ./package.sh hunk ./package.sh 1 +#!/bin/sh + +mkdir xml-emitter-1.0.2 +cp xml-emitter.asd package.sh package.lisp README xml.lisp rss2.lisp mailbox.lisp xml-emitter-1.0.2/ + +rm -f xml-emitter-latest.tar.gz xml-emitter-latest.tar.gz.asc + +tar -czvf xml-emitter-1.0.2.tar.gz xml-emitter-1.0.2/ +ln -s ~/.sbcl/site/xml-emitter-1.0.1/xml-emitter-1.0.2.tar.gz ~/.sbcl/site/xml-emitter-1.0.1/xml-emitter-latest.tar.gz +gpg -b -a ~/.sbcl/site/xml-emitter-1.0.1/xml-emitter-1.0.2.tar.gz +ln -s ~/.sbcl/site/xml-emitter-1.0.1/xml-emitter-1.0.2.tar.gz.asc ~/.sbcl/site/xml-emitter-1.0.1/xml-emitter-latest.tar.gz.asc +rm -Rf xml-emitter-1.0.2/ + +scp xml-emitter-1.0.2.tar.gz pscott@common-lisp.net:/project/asdf-packaging/public_html/xml-emitter-1.0.2.tar.gz +scp xml-emitter-1.0.2.tar.gz.asc pscott@common-lisp.net:/project/asdf-packaging/public_html/xml-emitter-1.0.2.tar.gz.asc +scp xml-emitter-latest.tar.gz pscott@common-lisp.net:/project/asdf-packaging/public_html/xml-emitter-latest.tar.gz +scp xml-emitter-latest.tar.gz.asc pscott@common-lisp.net:/project/asdf-packaging/public_html/xml-emitter-latest.tar.gz.asc addfile ./rss2.lisp hunk ./rss2.lisp 1 - +;; This is some code for a simple RSS emitter. It lets you easily +;; construct RSS feeds using a common subset of RSS. It has some +;; advantages and disadvantages; it's fast and efficient, but it +;; doesn't support any advanced features of RSS. If you need them, +;; though, it shouldn't be hard to hack this to do what you want. + +(in-package :xml-emitter) + +(defun rss-channel-header (title link &key description (language "en-us") + image image-title image-link) + (emit-simple-tags :title title + :link link + :description description + :language language) + (when image + (with-tag ("image") + (emit-simple-tags :title (or image-title title) + :url image + :link (or image-link link))))) + +(defun rss-item (title &key link description author category + comments guid pubDate source) + (with-tag ("item") + (emit-simple-tags :title title + :link link + :description description + :author author + :category category + :comments comments + :guid guid + "pubDate" pubDate + :source source))) + +(defmacro with-rss2 ((stream &key (encoding "ISO-8859-1")) &body body) + `(with-xml-output (,stream :encoding ,encoding) + (with-tag ("rss" '(("version" "2.0"))) + (with-tag ("channel") + ,@body)))) + +;; This sample RSS feed demonstrates how to use the RSS emitter. As +;; you can see, you can use a fairly decent subset of RSS with +;; relative ease. + +#+nil +(with-rss2 (*standard-output*) + (rss-channel-header "Peter's Blog" "http://peter.blogspot.com/" + :description "A place where I sometimes post stuff" + :image "myhead.jpg" + :image-title "My glorious visage") + (rss-item "Breaking news!" + :link "http://google.com/" + :description "The biggest problem with the DO-ODD macro above is that it puts BODY +into LOOP. Code from the user of the macro should never be run in the +environment established by the LOOP macro. LOOP does a number of +things behind your back, and it's hard to disable them. For example, +what happens here?" + :author "Peter Scott" + :category "Lisp" + :pubDate "Sun, 29 Sep 2002 19:59:01 GMT") + (rss-item "RSS emitter created" + :description "An RSS emitter has been released! Hahahahaha!" + :author "Peter Scott" + :link "http://gmail.google.com/")) addfile ./xml-emitter.asd hunk ./xml-emitter.asd 1 - +;; -*- Lisp -*- + +(defpackage #:xml-emitter-system + (:use #:common-lisp #:asdf)) + +(in-package #:xml-emitter-system) + +(defsystem xml-emitter + :author "Peter Scott" + :serial t + :components ((:file "package") + (:file "xml") + (:file "rss2")) + :depends-on (cl-utilities)) addfile ./xml.lisp hunk ./xml.lisp 1 - +(in-package :xml-emitter) + +;; Character escaping +;;;;;;;;;;;;;;;;;;;;; + +;; This code was adapted from XMLS, by Miles Egan. Thanks, Miles. + +(defvar *entities* + #(("lt;" #\<) + ("gt;" #\>) + ("amp;" #\&) + ("apos;" #\') + ("quot;" #\"))) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defvar *whitespace* (remove-duplicates + '(#\Newline #\Space #\Tab #\Return #\Linefeed)))) + +(defvar *char-escapes* + (let ((table (make-array 256 :element-type 'string :initial-element ""))) + (declare (type vector *entities*)) + (loop for code from 0 to 255 + for char = (code-char code) + for entity = (first (find char *entities* + :test #'char= :key #'second)) + do (setf (svref table code) + (cond + (entity + (concatenate 'string "&" entity)) + ((and (or (< code 32) (> code 126)) + (not (= code 10)) + (not (= code 9))) + (format nil "&#x~x;" code)) + (t + (format nil "~x" char)))) + finally (return table)) + table)) + +(defun write-escaped (string stream) + "Writes string to stream with all character entities escaped." + (coerce string 'simple-base-string) + (loop for char across string + for esc = (svref *char-escapes* (char-code char)) + do (write-sequence esc stream))) + +;; Low-level XML output +;;;;;;;;;;;;;;;;;;;;;;; + +(defvar *xml-output-stream* *standard-output* + "The stream to write XML to") + +(defvar *indent* 0 + "Number of spaces to indent each line of XML output") + +(defun indent (&optional (spaces *indent*)) + "Indent a given number of spaces" + (loop repeat spaces do (write-char #\Space *xml-output-stream*))) + +(defmacro with-indent ((&optional (spaces 4)) &body body) + "Increase the indentation level in BODY by SPACES" + `(let ((*indent* (+ *indent* ,spaces))) + ,@body)) + +(defun xml-out (x &key (indent t)) + "Write X to XML output, escaped and optionally indented" + (when indent (indent)) + (write-escaped (format nil "~A" x) *xml-output-stream*)) + +(defun xml-as-is (x &key (indent t)) + "Write X to XML output, unescaped and optionally indented" + (when indent (indent)) + (format *xml-output-stream* "~A" x)) + +(defun start-tag (name &optional attrs namespace) + "Write a start tag to XML output" + (indent) + (format *xml-output-stream* "<~A~@[ xmlns=\"~A\"~]" + name namespace) + (dolist (attr attrs) + (write-char #\Space *xml-output-stream*) + (write-string (first attr) *xml-output-stream*) + (write-string "=\"" *xml-output-stream*) + (xml-out (second attr) :indent nil) + (write-char #\" *xml-output-stream*)) + (write-char #\> *xml-output-stream*)) + +(defun end-tag (name) + "Write en ending tag to XML output" + (indent) + (format *xml-output-stream* "" name)) + +;; High-level XML output +;;;;;;;;;;;;;;;;;;;;;;;; + +(defmacro with-tag ((name &optional attrs namespace) &body body) + "Wrap BODY in a tag. BODY is indented, and linebreaks are added." + (once-only (name) + `(progn + (fresh-line *xml-output-stream*) + (start-tag ,name ,attrs ,namespace) + (terpri *xml-output-stream*) + (with-indent () + ,@body) + (terpri *xml-output-stream*) + (end-tag ,name)))) + +(defmacro with-simple-tag ((name &optional attrs namespace) &body body) + "Like WITH-TAG, but without the linebreaks." + (once-only (name) + `(progn + (fresh-line *xml-output-stream*) + (start-tag ,name ,attrs ,namespace) + (let ((*indent* 0)) + ,@body + (end-tag ,name))))) + +(defmacro with-xml-output ((stream &key (encoding "ISO-8859-1")) &body body) + "Wrap XML output on STREAM with the necessary XML heading information" + `(let ((*xml-output-stream* ,stream)) + (format *xml-output-stream* "~%" + ,encoding) + ,@body)) + +(defun simple-tag (name content &optional attrs namespace) + "Emit a simple tag with given content" + (with-simple-tag (name attrs namespace) + (xml-out content))) + +(defun emit-simple-tags (&rest tags-plist) + "Given a plist mapping tag names to values (or nil), emit tags in +the order given, skipping ones with nil values. Tag names are +downcased unless they're passed as strings." + (loop for (name tag) on tags-plist by #'cddr + do (when tag + (simple-tag (format nil (if (symbolp name) + "~(~A~)" + "~A") + name) tag)))) + +;; Here is some example code. It writes a simple person description to +;; standard output, using most of the ways of doing output. + +#+nil +(with-xml-output (*standard-output*) + (with-tag ("person" '(("age" "19"))) + (with-simple-tag ("firstName") + (xml-out "Peter")) + (simple-tag "lastName" "Scott") + (emit-simple-tags :age 17 + :school "Iowa State Univeristy" + "mixedCaseTag" "Check out the mixed case!" + "notShown" nil)))