Octopodial Chrome

Steve Yegge has prepared a simple emacs lisp primer. It’s by no means complete, but it introduces enough of the language that anyone with a small amount of programming knowledge should be able to start playing around.

Emacs, of course, is the best text editor, mail client, news client, web browser, database interface, Nethack interface and kitchen sink in the world.

A lot of people don’t really understand why Lisp’s macros are so useful. I spent some free time this past week rewriting my beer tasting notes site, and here’s an example of an instance where Common Lisp’s object system and macros really came in handy.

A common need when writing CRUD web apps is to display one of a given class: information about a particular model of car, or an employee—or in my case, a particular brewer, beer, bar, style or whatever. After writing my first function I had something that looked like this:

(defun display-brewer (name)
  (let ((brewer (select 'brewer :where [= [name] name] :flatp t)))
    (if brewer
        (with-template (format nil "~a @ Tasting Notes" (name brewer))
            (modification-date object)
          (:table
           (:tr (:th "Average rating")
                (:td (str (if (rating brewer)
                              (make-sequence 'string 
                                             (rating brewer) 
                                             :initial-element #\*)
                              (htm (:em "No beers"))))))
           (when (plusp (length (notes brewer)))
             (htm (:tr (:th "Notes") (:td (str (notes brewer))))))
           (when (plusp (length (address brewer)))
             (htm (:tr (:th "Address") (:td (str (address brewer))))))
           (when (plusp (length (url brewer)))
             (htm (:tr (:th "Website")
                       (:td (:a :href (url brewer) (str (url brewer))))))))
          (when (beers brewer)
            (htm (:h2 "Beers") (:ul (list-objects (beers brewer))))))
        (progn
          (setf (return-code) +http-not-found+)
          (with-template (format nil "Error: Brewer ~a not found" name)
              nil
            (:p (fmt "Could not find a brewer named ~a." name)))))))

This looks pretty ugly if you don’t understand Lisp, but basically I just defined a function DISPLAY-BREWER which displays some brewer identified by a name. It does this by looking up (selecting) the brewer in a database; if it finds the brewer, then it’s displayed, else an error message is displayed instead.

The thing is, every single display function will look similar, indeed almost identical: to display a bar (also identified by a name), I’ll look it up by name, then if it is found I’ll display it, otherwise I’ll display an error message. DISPLAY-BAR would be:

(defun display-bar (name)
  (let ((bar (select 'bar :where [= [name] name] :flatp t)))
    (if bar
	(with-template (format nil "~a @ Tasting Notes" (name bar))
	    (modification-date object)
	  (:table
	   (when (food-rating bar)
	     (htm (:tr (:th "Food rating")
		       (:td (str (make-sequence 'string 
                                                (round (food-rating bar))
                                                :initial-element #\*))))))
	   (when (owner bar) (htm (:tr (:th "Owner")
				       (:td (:a :href (link (owner bar)) 
                                                (str (name (owner bar))))))))
	   (when
	       (beer-rating bar)
	     (htm (:tr (:th "Drink rating")
		       (:td (str (make-sequence 'string
                                                (round (beer-rating bar))
						:initial-element #\*))))))
	   (when (address bar)
	     (htm (:tr (:th "Address")
		       (:td (str (address bar))))))
	   (when (notes bar)
	     (htm (:tr (:th "Notes")
		       (:td (str (notes bar))))))
	   (when (url bar)
	     (htm (:tr (:th "Website")
		       (:td (:a :href (url bar)))))))
	  (when (beers bar)
	    (htm (:h2 "Beers")
		 (str (list-objects (beers bar)))))
	  (when (foods bar)
	    (htm (:h2 "Foods")
		 (str (list-objects (foods bar))))))
	(progn
	  (setf (return-code) +http-not-found+)
	  (with-template (format nil "Error: Bar ~a not found" name)
	      nil
	    (:p (fmt "Could not find a bar named ~a." bar name)))))))

You notice something? There’s an awful lot of repeated code. For example, over the two functions I call (make-sequence ’string SOMETHING :initial-element #\*) three different times. What this is actually doing is taking a number and turning it into the same number of stars, e.g. turning 4 into ****. The obvious thing to do is to define a function STAR-RATING which does that, so I do (and I change it to use MAKE-STRING instead of MAKE-SEQUENCE, and to always call ROUND, which does nothing to integers but will turning real numbers into integers):

(defun star-rating (number)
  "Return a string consisting of NUMBER stars.  If NUMBER is a float,
  returns that number rounded off."
  (make-string (round number) :initial-element #\*))

This turns (make-sequence ’string (rating brewer) :initial-element #\*) into (star-rating (rating brewer)); (make-sequence ’string (round (food-rating bar)) :initial-element #\*) into (star-rating (food-rating bar)); and (make-sequence ’string (round (beer-rating bar)) :initial-element #\*) into (star-rating (beer-rating bar)). This is a nice savings on typing, and makes the code more readable, although it could be better (STAR-RATING isn’t the best name in the world, but it’ll do for now). Just about every programming language out there can refactor commonly-used code patterns into functions like this; indeed, it’s a major use for functions.

How about the rest of the code? There’s another pattern there: looking up an object, then either displaying it or an error message which refers to the type of the object being displayed. There are a number of ways to handle this, but the cleanest is to write a macro DEFINE-DISPLAY (which uses a function GET-OBJECT I’ve defined elsewhere; its use looks like (get-object ’bar "Falling Rock")):

(defmacro define-display (class function &body body)
  `(defun ,function (name)
     (let ((,class (get-object ',class name)))
       (if ,class
	   (with-template (format nil "~a @ Tasting Notes" (name ,class))
	       (modification-date ,class)
	     ,@body)
	   (progn
	     (setf (return-code) +http-not-found+)
	     (with-template (format nil "Error: ~a ~a not found" ',class name)
		 nil
	       (:p (fmt "Could not find a ~a named ~a."  
                        ',class name))))))))

This takes that pattern and turns it into a macro; I can then re-use the pattern like this:

(define-display brewer display-brewer
  (:table
   (:tr (:th "Average rating")
	(:td (str (if (rating brewer)
		      (make-sequence 'string 
				     (rating brewer) 
				     :initial-element #\*)
		      (htm (:em "No beers"))))))
   (when (plusp (length (notes brewer)))
     (htm (:tr (:th "Notes") (:td (str (notes brewer))))))
   (when (plusp (length (address brewer)))
     (htm (:tr (:th "Address") (:td (str (address brewer))))))
   (when (plusp (length (url brewer)))
     (htm (:tr (:th "Website")
	       (:td (:a :href (url brewer) (str (url brewer))))))))
  (when (beers brewer)
    (htm (:h2 "Beers") (:ul (list-objects (beers brewer))))))

That’s obviously a lot more readable than the first DISPLAY-BREWER I created. What’s more, when I define DISPLAY-BAR, I just have to do this:

(define-display bar display-bar
  (:table
   (when (food-rating bar)
     (htm (:tr (:th "Food rating")
	       (:td (str (make-sequence 'string 
					(round (food-rating bar))
					:initial-element #\*))))))
   (when (owner bar) (htm (:tr (:th "Owner")
			       (:td (:a :href (link (owner bar)) 
					(str (name (owner bar))))))))
   (when
       (beer-rating bar)
     (htm (:tr (:th "Drink rating")
	       (:td (str (make-sequence 'string
					(round (beer-rating bar))
					:initial-element #\*))))))
   (when (address bar)
     (htm (:tr (:th "Address")
	       (:td (str (address bar))))))
   (when (notes bar)
     (htm (:tr (:th "Notes")
	       (:td (str (notes bar))))))
   (when (url bar)
     (htm (:tr (:th "Website")
	       (:td (:a :href (url bar)))))))
	  (when (beers bar)
	    (htm (:h2 "Beers")
		 (str (list-objects (beers bar)))))
	  (when (foods bar)
	    (htm (:h2 "Foods")
		 (str (list-objects (foods bar))))))

The display functions are reduced down to their essential core and I don’t have to keep re-typing (and possibly mis-typing) the fiddly bits which don’t change. There’s still a lot of work which I could still re-do (e.g. one common pattern seems to be (when THING (htm (DO-SOMETHING THING))); another is (:tr (:th HEADING) (:td DATA))), but this is a good first start.

And it’s why Lisp rocks: other languages have functions which let one re-arrange functional abstractions; what they lack are macros, which let one re-arrange syntactical abstractions. In Lisp I can take the actual body which changes and plug it into the unchanging skeleton; I can take the name of the class and plug it in so that I can refer to it in the body. It makes life very easy and simple.

Well, I left my Common Lisp blogging software project lie for long enough; about a fortnight ago I started working on it again. It’s now in a workable condition, and is faster than my current blogging software. I have two more plugins to finish porting and then I’ll be able to convert Octopodial Chrome over to it. How cool will that be—running my blog on my own hand-written blogging tool.

As some of y’all may know, this blog is powered by Blosxom, a neat little file-based blogging engine. Well, it's written in Perl and is not the fastest program in the world; I decided to practise my Lisp skills and port Blosxom to ANSI Common Lisp. Right now Lisp Blosxom isn’t really usable, but every day it improves just a tad.