msnyder.info

iCloud Reminders in Org-mode: Talking to OS X with Emacs

Mon, 07 May 2012 00:00:00 EDT

In this article I implement a library that allows one to synchronize Org-mode to-do items directly to Apple's iCal. More generally, I describe a synchronization layer between OS X, Clozure Common Lisp, and Emacs, and muse on its potential.

Background

It is a source of joy and pain to customize and extend Emacs. There are many reasons for the attempt, however, and every person has different reasons. I typically describe a few of mine as follows.

When tasks are performed alongside each other in Emacs, it is conceptually simpler to move between them. Most commands have a sort of "Do What I Mean" universality to them.
Passing data between membranes – copying a URL in a web browser to a chat window, e-mailing a snippet of code to a mailing list, or writing an Org-mode outline before publishing it online – is typically effortless.
Every mode and function in Emacs is another tool in your toolbox. You can easily combine tools in the Unix way to slice through work. When you have more tools at your disposal, you can solve more difficult or nuanced problems.

On the other hand, I have an iPhone and an iCloud account, and don't spend all my time in Emacs exclusively. I want to be able to use the fantastic software outside of Emacs, but have the power and flexibility of Emacs.

I've created a dual-language project. One half is in Emacs Lisp; the other in Common Lisp. It uses the foreign function interface provided by Clozure CL. From Emacs, I use SLIME to access Clozure's REPL, which allows me to make calls to the storage APIs for iCal. Once I retrieve the results I want, I can pass them back to Emacs. I can also make changes using this API, allowing Emacs to inform iCal of what changes have been made in my to-do lists.

Environment Setup

There is a one-time cost of a complex environment setup. You will need a copy of OS X and Emacs. I am doing all this work on Lion, and I don't know if earlier versions of OS X will have all the tools we need. I am using Emacs 24:

GNU Emacs 24.0.90.1 (i386-apple-darwin11.2.0, NS apple-appkit-1138.23)

I should mention that Emacs 24 is incredibly stable. There is a lot of activity and approval surrounding its use as a day-to-day text editor.

Make sure you install Clozure Common Lisp. Clozure's Objective-C support is a unique feature of its distribution. This article could not have been written without the indispensable support of their wiki and manual.

You can do this however you'd like, but homebrew makes it easy.

$ brew update
$ brew install clozure-cl

You should have ccl64 in /usr/local/bin, and it should be at least version 1.7. Type (quit) at the REPL to exit it.

You will need SLIME, the essential Lisp IDE for Emacs. What I do is open up my Lisp REPL in my shell, install SLIME through Quicklisp, and then symbolically link the package into my Emacs directory (a tool exists to do this, quicklisp-slime-helper, but out of habit I still do it the more old-fashioned way):

$ ccl64 --load quicklisp.lisp
 
? (quicklisp-quickstart:install :path ".quicklisp-ccl64/")
? (ql:add-to-init-file)
? (ql:quickload 'swank)
? (quit)
  
$ ln -s $HOME/.quicklisp-ccl64/dists/quicklisp/software/slime-*-cvs/ $HOME/.emacs.d/vendor/slime

I've also built up a bit of a preparation function for initializing SLIME, so I will reproduce that below as well.

(defun quicklisp-slime-setup ()
  (add-to-list 'load-path (expand-file-name "~/.emacs.d/vendor/slime"))
  (add-to-list 'load-path (expand-file-name "~/.emacs.d/vendor/slime/contrib"))
  (setq inferior-lisp-program "/usr/local/bin/ccl64")
  (setq slime-autodoc-mode t)
  (setq slime-net-coding-system 'utf-8-unix)
  (require 'slime)
  (slime-setup '(slime-repl slime-fancy)))

Building `ffigen`

ffigen is a utility that slurps up frameworks and provides foreign function interfaces into 'intermediate forms'; in this case, Lisp forms. These instructions exist on the Clozure CL wiki. I'm reproducing them here since they're not easy to find and the wiki may change.

Building a Leopard version with ObjC 2.0 support

# Note that the svn directory is misnamed; this is actually based on Apple GCC 5464 (not 6465).
$ svn co http://svn.clozure.com/publicsvn/ffigen4/branches/ffigen-apple-gcc-6465/ffigen4
 
$ cd ffigen4
$ make
  
$ sudo tar zxvf ffigen-apple-gcc-5465-intel-*.tar.gz -C /usr/local

Generating the Foreign Function Interface

Calendar Store is the name of the framework that Apple provides for accessing calendar data. We need to generate its foreign function interface for Clozure. I did so by copying the FFI generation script from the addressbook framework that Clozure provides access to, and turning it into a script for the calendarstore framework. The script, populate.sh, uses the h-to-ffi.sh terminal command installed by building ffigen above.

I should add that this works with the version of Xcode distributed by the App Store, as well as any version of Xcode you may have in /Developer, but I'm only documenting the former. The changes needed for the latter should be self-evident.

 1:  $ export SDK=/Applications/Xcode.app/Contents/Developer/Platforms/\
 2:  MacOSX.platform/Developer/SDKs/MacOSX10.6.sdk
 3:  
 4:  $ cd $SDK/System/Library/Frameworks/CalendarStore.framework/Headers
 5:  
 6:  $ sed '1i\
 7:  #import <Foundation/Foundation.h>\
 8:  ' CalendarStore.h | sudo tee CalendarStore.ffi.h
 9:  
10:  $ cd /usr/local/Cellar/clozure-cl/1.8/ccl/darwin-x86-headers64
11:  $ mkdir -p calendarstore/C
12:  $ sed 's/AddressBook/CalendarStore/;s/AddressBook/CalendarStore.ffi/' \
13:    addressbook/C/populate.sh > calendarstore/C/populate.sh
14:  $ sed -i '' "s/^SDK.*/SDK=$SDK/" calendarstore/C/populate.sh
15:  $ chmod +x calendarstore/C/populate.sh
16:  $ cd calendarstore/C
17:  $ sh populate.sh

Line 1 above assumes that you are using Xcode off of the App Store. If not, the SDKs/ directory will be located in /Developer.

Lines 6, 7, and 8 comprise a single command, adding a missing import to the CalendarStore header file. Once we populate the framework, we must then tell Clozure about it.

CL-USER> (require 'parse-ffi)
CL-USER> (ccl::parse-standard-ffi-files :calendarstore)

After this is done, we never have to do it again. From now on, whenever we open up a Clozure REPL, we can just load up everything we need.

CL-USER> (require 'objc-support)
CL-USER> (objc:load-framework "CalendarStore" :calendarstore)

Explaining the Bridge

There are a couple aspects of Objective-C and how they translate through the Bridge that we need to be aware of.

Methods in Objective-C

Objective-C uses a message passing syntax. Whereas languages like C++ bind method names to some code during compilation, Objective-C resolves message receivers during runtime. Message names are typically longer than method names because they also contain identifying information about the message's parameters, separated by colons.

Whereas in C++ you may call something like:

obj->method(foo, bar)

In Objective-C you would call:

[obj method:foo andBar:bar]

And we'd consider the message name to be method:andBar:. Yes, even the colons are part of the message name. In our bridge, that method invocation would become:

(#/method:andBar: obj foo bar)

Now that we know this, we can start using Apple's API to pull objects out of the runtime. Open up a REPL with Clozure CL as your inferior Lisp. First we need to load up the bridge.

CL-USER> (require 'objc-support)

Many commonly used Foundation Framework objects are available for us immediately. These objects start with the prefix ns-. An NSDate would become an ns-date. An NSString would become an ns-string. Say we wanted to create an NSDate with the current date and time, and print its string representation. Let's put this functionality in a function called today_as_string.

Take a look at the difference as to how methods are called in Objective-C. today_as_string, implemented in Objective-C, and then Lisp.

NSString* today_as_string() {
  NSDate *today = [NSDate date];
  NSString *date_string = [today description];
  [today release];
  return date_string;
}

(defun today-as-string ()
  (let* ((today (#/date ns:ns-date))
         (date-string (#/description today)))
    (#/release today)
    date-string))

Memory Management

Based on the Clozure documentation (§15.3.3), an autorelease pool is created for us in the toplevel. This means as good citizens, we should manually release the memory when we finish using it. Calling [NSDate date] automatically calls init and alloc on the instance, and the (#/release today) call above dovetails that by decreasing the reference count.

For more detail on reference counting, please see Apple's "Advanced Memory Management Programming Guide".

Miscellaneous

Here are some other things to note. We can get a reference to any class by passing its camel-cased name to @class.

CL-USER> (objc:@class "NSString")
#<OBJC:OBJC-CLASS NS:NS-STRING (#x7FFF75FE69F8)>

We can determine if an object is a null pointer by using %null-ptr-p:

CL-USER> (%null-ptr-p (#/date ns:ns-date))
NIL
CL-USER> (%null-ptr-p (%null-ptr))
T

We are given a reader macro for generating NSStrings (prefix it with a pound sign, #), and we can get a Lisp string out of an NSString with Clozure's lisp-string-from-nsstring function:

CL-USER> (ccl::lisp-string-from-nsstring #@"test")
"test"

The use of the pound sign in the above code ((#/date ns:ns-date)) is a reader macro as well. You can get a hint as to how it works by checking the contents of the package nextstep-functions.

Introducing `nsclasp`

I've written a small utility library for Common Lisp called nsclasp. It provides a set of functions that are very useful when working with Apple's Foundation Framework. You can retrieve it by cloning it into your Quicklisp installation's local-projects directory and refreshing the project list:

$ cd ~/.quicklisp-ccl64/local-projects
$ git clone git://github.com/ardekantur/nsclasp.git

CL-USER> (ql:register-local-projects)
CL-USER> (ql:quickload 'nsclasp)

For more information, see the project documentation.

Implementation

The most important aspect of iCalSync, the thing that makes this so delightfully easy, is that Emacs Lisp can talk directly to the Clozure instance. The key function is this:

(defun icalsync-capture-ccl-result
(command)
  "Convert a result from the SLIME Lisp's REPL into the Emacs\nLisp toplevel."
  (read
   (slime-eval
    `(swank::pprint-eval ,command))))

Using this, we can send code to Clozure's REPL, get the result back, and turn it into a Lisp form.

First Steps: Retrieving Calendar Names

Let's make two useful functions for accessing the CalendarStore, then try to retrieve a list of calendar names from Clozure.

(defun icalsync-cl-calendar-store ()
  "Return the calendar store. Equivalent to
    [CalCalendarStore defaultCalendarStore]."
  (#/defaultCalendarStore ns:cal-calendar-store))

(defun icalsync-cl-all-calendars ()
  "Return a list of all calendars in the default calendar
    store. Equivalent to [[CalCalendarStore defaultCalendarStore]
    calendars]."
  (#/calendars (icalsync-cl-calendar-store)))

(let ((calendars (icalsync-cl-all-calendars)))
  (loop for i upto (1- (#/count calendars))
     for calendar = (#/objectAtIndex: calendars i)
     do (format t "~A, " (ccl::lisp-string-from-nsstring (#/title calendar)))))

Calendar, Matthew Snyder, Do, Buy, Inbox, Example,

Our handling of the NSArray is a little clumsy. We can't just mapcar over it, we need to explicitly iterate over its elements by index. That's why nsclasp is helpful, as it contains a method to make this a little nicer:

(let* ((calendars (nsclasp:ns-array->list (icalsync-cl-all-calendars))))
  (format t "~{~a, ~}" (mapcar (lambda (c) (ccl::lisp-string-from-nsstring (#/title c))) calendars)))

But no matter how you do it, you should have been able to retrieve all your calendar names. As it turns out, this is an important piece of information to have, as the Foundation Framework doesn't yet allow us to create the kind of calendar that would sync with iCloud for us. For the time being, we have to create the calendar we want our TODOs synced to, in iCal.

First Steps: Creating a `CalTask`

Now let's combine this on the tail end of creating an iCal reminder, and sending it to a calendar.

Tasks exist in iCal as instances of the CalTask object of the CalendarStore Framework. Every task has a title, UID, a parent calendar, alarms, due dates, completed dates, notes, and other such attributes. We have to describe a mapping. Our input function takes an Emacs buffer and returns a list of parsed TODOs, and what calendar they should be synced to.

(defun icalsync-el-transform-todos (buffer)
  "Turn an org mode buffer into a list of iCal tasks.

A function that describes one way to retrieve all of the valid
TODOs from a buffer for turning into respective iCal tasks. You
can write a function that best suits your workflow. The function
is expected to take the name of a buffer, or a buffer, and return
a list of plists, each one representing a TODO item / iCal task.

FIXME(msnyder): Use org-map-entries to make this easier."
  (save-excursion
   (let ((calendar-uid (icalsync-el-calendar-name)) todos)
     (switch-to-buffer buffer)
     (beginning-of-buffer)
     (while (re-search-forward org-todo-line-regexp nil t)
      (let* ((todo-text (match-string-no-properties 3))
             (components (org-heading-components))
             (todo-state (nth 2 components))
             (headline (nth 4 components))
             (scheduled-time (org-get-scheduled-time (point)))
             todo-uid)
        (if (and todo-state
                 (funcall icalsync-el-valid-p-function todo-state todo-text))
            (progn (if (string-match org-todo-line-tags-regexp headline)
                       (setq headline (nth 4 (org-heading-components)))
                       (setq todos
                             (cons (list :buffer
                                         (buffer-file-name)
                                         :point
                                         (point)
                                         :calendar-uid
                                         calendar-uid
                                         :incomplete-p
                                         (funcall
                                          icalsync-el-incomplete-p-function
                                          todo-state)
                                         :title
                                         (org-trim headline)
                                         :scheduled
                                         (and
                                          scheduled-time
                                          (decode-time scheduled-time))
                                         :uid
                                         (cdr
                                          (assoc
                                           "ICALSYNC-UID"
                                           (org-entry-properties)))
                                         :dt
                                         (and
                                          (cdr
                                           (assoc
                                            "ICALSYNC-DT"
                                            (org-entry-properties)))
                                          (read
                                           (cdr
                                            (assoc
                                             "ICALSYNC-DT"
                                             (org-entry-properties))))))
                                   todos)))))))
     todos)))

I've created a basic Org file.

#+TITLE: example.org

* TODO Recycling
  SCHEDULED: <2012-04-15 Sun>
* TODO Trash
* TODO Fix toilet

I run the function on it, and after getting asked which calendar I want the items to belong to, I get the following list of lists.

(icalsync-el-transform-todos "example.org")


:buffer	/…/example.org	:point	78	:calendar-uid	C854CB60…	:incomplete-p	t	:title	Fix toilet	:scheduled	nil	:uid	nil	:dt	nil
:buffer	/…/example.org	:point	60	:calendar-uid	C854CB60…	:incomplete-p	t	:title	Trash	:scheduled	nil	:uid	nil	:dt	nil
:buffer	/…/example.org	:point	17	:calendar-uid	C854CB60…	:incomplete-p	t	:title	Recycling	:scheduled	(0 0 0 15 4 2012 0 t -14400)	:uid	nil	:dt	nil

When we upload a task into the Calendar Store, we're going to provide its title, deadline, and whether or not it's complete. There's also priority, which would be nice, but not necessary for the time being. Once the upload is successful, we're going to also retrieve the task's UID, and its dateStamp property, and save them in the property drawer of the TODO, in order to make synchronization easier.

(defun icalsync-el-upload-todo (todo)
  (let (todo-uid)
    (save-excursion
     (setq todo-uid
           (icalsync-capture-ccl-result
            (format "(icalsync-cl-create-task '%S)" todo)))
     (find-file (getf todo :buffer)) (goto-char (getf todo :point))
     (goto-char (car (org-get-property-block nil nil t)))
     (org-set-property "ICALSYNC-UID" todo-uid)
     (org-set-property "ICALSYNC-DT" (current-time)))))

(defun icalsync-el-upload-todos (todos)
  (loop for todo in todos do (icalsync-el-upload-todo todo)))

From here, all we need to do is run the Emacs Lisp functions needed to transform all the TODOs and upload them into the Calendar Store. Keep iCal open when you do this and make sure the Reminder list is visible.

(setq *todos* (icalsync-el-transform-todos "example.org"))
(icalsync-el-upload-todos *todos*)

Et voila!

First Steps: Retrieving Changes

So now you have your Org-mode tasks in a Reminder list on your iPhone. Brilliant! You wander around the town, happily marking off the items you've completed. How can we make Org-mode aware of the items that were checked off?

This is a very rudimentary method, but it works. What we'll do is update TODOs based on buffer, the same way we uploaded them to iCal. For a given buffer, we'll walk through the TODOs, seeing if they have a UID handed out by the calendar store. If so, we ask the calendar store about it. We compare the time-stamp of the TODO to the time-stamp of the reminder, and if the reminder has been changed more recently, we update the TODO.

(defun icalsync-el-download-todo (todo)
  (save-excursion (find-file (getf todo :buffer))
   (goto-char (getf todo :point))
   (let* ((result
           (icalsync-capture-ccl-result
            (format "(icalsync-cl-task->plist (icalsync-cl-get-task %S))"
                    (getf todo :uid))))
          (t1
           (apply 'encode-time
                  (read (cdr (assoc "ICALSYNC-DT" (org-entry-properties))))))
          (t2 (apply 'encode-time (getf result 'datestamp))))
     (if (time-less-p t1 t2)
         (progn (if (getf result 'completeddate) (org-todo 'done))
                (org-set-property "ICALSYNC-DT" (format "%S" t2)))))))

Not the use of the function icalsync-cl-task->plist. Since we can't hand off a CalTask object from Clozure to Emacs Lisp, I've written a function that distills a task down to its most important parts.

(defvar *task-properties* (list "title"
                                "uid"
                                "priority"
                                "dueDate"
                                "dateStamp"
                                "completedDate"))

(defun icalsync-cl-task->plist (task)
  "Convert a CalTask to a plist of properties. The list of properties
    is described by *task-properties*."
  (loop for property in *task-properties*
        for value = (funcall (intern property "NEXTSTEP-FUNCTIONS") task)
        append (list (intern (format nil "~:@(~a~)" property))
                     (icalsync-cl-coerce-value value))))

Next Steps

There are a few things missing from this implementation. We don't check for the existence of a task before creating it from the corresponding TODO. Priority is not synced. Org-mode is not made aware of items added to Reminders.app. We track where our TODOs are based on the buffer name and their position in the buffer, which will quite easily break if we shuffle our TODOs around. Only the reminder's completion status is synced back to Emacs, but if its description or due date changes, we should synchronize those as well. As a proof-of-concept, however, I think this is a solid start.

In addition, the behavior that you use to turn Org-mode files into lists of reminders – or vice versa – is entirely up to you. There are countless ways to do so. A conversion could, for example, take each calendar, and make it a headline in an Org file, with each task becoming a checklist item with a property drawer. Another conversion could check the TODOs for a custom condition, i.e., only tell iCal about TODOs which have a certain property in their drawer, or are scheduled after a certain date.

All the code written for this article is available in my elstar GitHub repository. The elstar name for my repository is a bannerhead of sorts, an invitation for this method to be explored further, and to collect the results in a shared place. I welcome any contributions.

Conclusion

The point of this article was not just to create a synchronization layer for iCal to Org-mode, but to explore the method of synchronization itself. For Emacs users on OS X, the potential exists to fill in the gaps with their usage of operating system (and associated mobile/cloud convenience) and text editor. Some other ideas that may be worth pursuing:

An Emacs mode for interfacing with iTunes
Functionality to convert Address Book entries into BBDB or org-contacts entries
Turning events on calendars into Emacs diary entries

I look forward to seeing what some enterprising Lisp hackers can come up with.

On Web Sanity

Sun, 15 Apr 2012 00:00:00 EDT

When I browse the Internet, I always fight the temptation to waste time by visiting distracting websites. By telling my computer what sites are worth visiting, I've offloaded that drain of willpower to the machine.

The DNS Level

There are a few sites that I 'block' in /etc/hosts because I have no desire for them, whatsoever. I will never want to 'cheat', and visit them, for any reason.

Here is the relevant section of my /etc/hosts:

0.0.0.0 www.facebook.com
0.0.0.0 facebook.com
0.0.0.0 connect.facebook.net
0.0.0.0 facebook.net
0.0.0.0 fbcdn.net
0.0.0.0 www.fbcdn.net
0.0.0.0 badge.facebook.com
0.0.0.0 blog.facebook.com
0.0.0.0 en-gb.facebook.com
0.0.0.0 developers.facebook.com
0.0.0.0 touch.facebook.com
0.0.0.0 de-de.facebook.com
0.0.0.0 stories.facebook.com
0.0.0.0 it-it.facebook.com
0.0.0.0 hu-hu.facebook.com
0.0.0.0 peace.facebook.com
0.0.0.0 et-ee.facebook.com
0.0.0.0 az-az.facebook.com
0.0.0.0 0.facebook.com
0.0.0.0 apps.facebook.com
0.0.0.0 reddit.com
0.0.0.0 www.reddit.com

I would love if there were a central repository of distracting sites, and if my hostsfile could be updated automatically against this repository.

The Browser Level

Earlier on I used the WasteNoTime Safari extension. It helped regulate the time I spent on distracting websites, in a reasonable way. The process went something like this:

I would make a list of websites to blacklist. There's a whitelist functionality, but I never figured out how to use it in a satisfactory way. I would necessarily exclude useful sites I was unaware of.
I would decide how long I would allow myself to visit the distracting websites in total. For example, I would allow myself 45 minutes on each weekday, and then disable the timer on the weekends.
I would browse distracting websites until I ran out of time, and then go do work.

This process isn't horrible. I imagine it would work for a lot of people. For me, however, it was simply too complicated, and invited distraction. Every time I wanted to add a site to the list, I would have to go to the existing list, and see all my personal vices there (Oh yeah! I haven't checked Hacker News today!)

And so I discovered Mindful Browsing. It works in a subtly different way. It's designed to encourage you to consider your decisions, rather than be put off by an admonishment page every time you try to access a distracting site.

It works like this. The extension defaults to always being in effect, though this can be modified. Then, while you're browsing, when you find yourself on a site that's distracting, you press a button. The site is added to a blacklist that you never see. That's it.

What makes it interesting is this: When you try and access a distracting website, you get a warning, and the option to temporarily allow it. This is fantastic in and of itself (sometimes I need to check a distracting forum which also contains useful news and information), but there's another variable: the button to enable the site temporarily is disabled for a configurable amount of time. I set mine to ten minutes.

So if I want to visit one of the distracting websites, I have ten minutes to either go do something useful and come back, or change my mind and close the tab. This is the eponymous 'mindful browsing': the ability to actively decide how you want to approach distracting websites, and the ability to give yourself time to set other goals.

From Spec to Test Suite in Common Lisp: Mustache

Thu, 29 Dec 2011 00:00:00 EST

Just a quick write-up for the holidays.

In this article, I will walk you through writing a test suite in Common Lisp based upon a specification of the software in question. The software we'll be looking at is the excellent mustache.

This is a fairly basic Lisp article, but I will be glossing over a lot of the details of the code I've written – partially because it should be fairly intuitive, partially because I have no idea how idiomatic it is. Take everything with a grain of salt, and enjoy the results.

The Basics

Mustache was written as an example of 'logicless' templating: providing the bare minimum of functionality needed to create template documents that can be interpolated with data. In this scenario, 'bare minimum' is a complement: an explicit design decision to prevent spaghetti code in templates. Mustache templates essentially consist of three primitive constructs:

The data construct: if data exists with the name given in the token, replace the token with the data.
The loop construct: if the name points to data that is 'list-like', render this part of the template for each element in the list.
The inverted construct: if the name points to data that is non-existent, or 'false-like', render something.

Nearly all features that Mustache provides can be narrowed down into one of these categories. It's elegantly simple, but implementations, depending on their language, may vary in difficulty to express.

I think it's interesting that if you ignore that Mustache was designed for 'hash table'-like contexts, Common Lisp already provides a complete implementation of Mustache with its FORMAT directives, specifically the aesthetic, iteration, and conditional expression directives. Right out of the gate you can do most of what you'd want to do in Mustache, as long as you use lists instead of hash tables, and get used to the esoteric syntax. But this isn't good enough for us: we want a rigorous implementation of the Mustache language, and for that, we need to test our implementation against the spec. And here's where it gets interesting.

Mustache's spec was written in YAML, and is also provided as JSON, making it machine-parseable. It is divided up into files. Each file is a discrete section of the spec. Each file contains an overview describing the file, and tests. Each test contains a name, description, context data, template, and expected result.

Using this information we can construct an automated test suite: one that provides our implementation as an input, uses the context and template in each test case, and compares it against the expected result. This is absolutely by design and a wonderful thought on the part of the Mustache 'working group' (for want of a term to describe the various contributors to the language).

Parsing the Spec

First things first. Let's grab a copy of the spec.

$ git clone git://github.com/mustache/spec.git ~/Projects/mustache.spec/

Pop open an REPL. I'm going to load the libraries I know we'll be using, in advance, as well as some helper variables and functions:

(ql:quickload '(fiveam cl-json cl-who))

;; courtesy http://rosettacode.org/wiki/Walk_a_directory/Non-recursively#Common_Lisp
(defun walk-directory (directory pattern)
  (directory (merge-pathnames pattern directory)))

(setq *spec-directory* #P"~/Projects/mustache.spec/")

(defun utf8-json-decode (pathname)
  (with-open-file (stream pathname
                          :direction :input
                          :external-format :utf-8)
    (json:decode-json-from-source stream)))

These forms should be fairly self-explanatory. We provide a helper function to glob over the spec files we want, set the spec directory to a top-level name, and mix our JSON parsing function with a helper that ensures the input stream is UTF-8.

So now:

CL-USER> (walk-directory #P"~/Projects/mustache.spec/" "specs/*.json")

(#P"/Users/msnyder/Projects/mustache.spec/specs/comments.json"
 #P"/Users/msnyder/Projects/mustache.spec/specs/delimiters.json"
 #P"/Users/msnyder/Projects/mustache.spec/specs/interpolation.json"
 #P"/Users/msnyder/Projects/mustache.spec/specs/inverted.json"
 #P"/Users/msnyder/Projects/mustache.spec/specs/partials.json"
 #P"/Users/msnyder/Projects/mustache.spec/specs/sections.json"
 #P"/Users/msnyder/Projects/mustache.spec/specs/~lambdas.json")

(setq *all-specs* 
      (mapcar #'utf8-json-decode (walk-directory *spec-directory* "specs/*.json")))

Let's confirm each loaded file in the spec has the same basic structure.

CL-USER> (mapcar (lambda (x) (mapcar #'car x)) *all-specs*)

((:----+ATTN-- :OVERVIEW :TESTS) (:----+ATTN-- :OVERVIEW :TESTS)
 (:----+ATTN-- :OVERVIEW :TESTS) (:----+ATTN-- :OVERVIEW :TESTS)
 (:----+ATTN-- :OVERVIEW :TESTS) (:----+ATTN-- :OVERVIEW :TESTS)
 (:----+ATTN-- :OVERVIEW :TESTS))

Brilliant.

Our Implementation

… sucks. No really. All it does is return the template, un-interpolated.

(defun mustache-render (template data)
  template)

But this will work for our purposes. All we need is something we can pass the arguments into, and get a result. It doesn't have to be the right result, just yet.

The Test Suite

FiveAM is my go-to unit test library for Common Lisp. It's simple, elegant, and designed to provide test results in a format that can easily be transformed for any purpose.

What we'd like to do is generate this test suite by iterating over each test in the spec, and creating a unit test for it.

To give you an idea of the basic structure of a test, here's one of the imported tests from the spec.

;; courtesy http://aima.cs.berkeley.edu/lisp/utilities/utilities.lisp
(defun random-element (list)
  "Return some element of the list, chosen at random."
  (nth (random (length list)) list))

CL-USER> (random-element (cdr (assoc :tests (random-element *all-specs*))))

((:NAME . "Falsey") (:DATA (:BOOLEAN))
 (:EXPECTED . "\"This should be rendered.\"")
 (:TEMPLATE . "\"{{^boolean}}This should be rendered.{{/boolean}}\"")
 (:DESC . "Falsey sections should have their contents rendered."))

Versus its counterpart in the YAML spec:

- name: Falsey
   desc: Falsey sections should have their contents rendered.
   data: { boolean: false }
   template: '"{{^boolean}}This should be rendered.{{/boolean}}"'
   expected: '"This should be rendered."'

It's hard to see from this example, but our JSON importer turned the data context into an association list, which we should use in the implementation as the type for our context argument. In this case, (cdr (assoc :boolean (cdr (assoc :data test)))) would return nil, a 'falsey' value.

So for each spec, we have a bunch of tests. For each test, we want to make a unit test in our test suite. Simple enough.

(fiveam:def-suite :mustache-specs)
(fiveam:in-suite :mustache-specs)

(loop for spec in *all-specs*
   do (loop for test in (cdr (assoc :tests spec))
         do (let ((name (cdr (assoc :name test)))
                  (desc (cdr (assoc :desc test)))
                  (data (cdr (assoc :data test)))
                  (template (cdr (assoc :template test)))
                  (expected (cdr (assoc :expected test))))
              (fiveam:test name
                desc
                (fiveam:is (string= expected (mustache-render template data)))))))

Try it out.

CL-USER> (fiveam:run :mustache-specs)

; in: LAMBDA ()
;     (MUSTACHE-RENDER TEMPLATE DATA)
; 
; caught WARNING:
;   undefined variable: DATA

;     (LAMBDA ()
;       DESC
;       (IT.BESE.FIVEAM:IS (STRING= EXPECTED (MUSTACHE-RENDER TEMPLATE DATA))))
; 
; caught WARNING:
;   undefined variable: DESC

;     (IT.BESE.FIVEAM:IS (STRING= EXPECTED (MUSTACHE-RENDER TEMPLATE DATA)))
; ==>
;   (LET ((#:E-0 EXPECTED) (#:A-1 (MUSTACHE-RENDER TEMPLATE DATA)))
;     (IF (PROGN (STRING= #:E-0 #:A-1))
;         (IT.BESE.FIVEAM::ADD-RESULT 'IT.BESE.FIVEAM::TEST-PASSED :TEST-EXPR
;                                     '(STRING= EXPECTED
;                                               (MUSTACHE-RENDER TEMPLATE DATA)))
;         (IT.BESE.FIVEAM::PROCESS-FAILURE :REASON
;                                          (FORMAT NIL
;                                                  "~S evaluated to ~S, which is not ~S to ~S."
;                                                  '(MUSTACHE-RENDER TEMPLATE
;                                                                    DATA)
;                                                  #:A-1 'STRING= #:E-0)
;                                          :TEST-EXPR
;                                          '(STRING= EXPECTED
;                                                    (MUSTACHE-RENDER TEMPLATE
;                                                                     DATA)))))
; 
; caught WARNING:
;   undefined variable: EXPECTED

;     (MUSTACHE-RENDER TEMPLATE DATA)
; 
; caught WARNING:
;   undefined variable: TEMPLATE
; 
; compilation unit finished
;   Undefined variables:
;     DATA DESC EXPECTED TEMPLATE
;   caught 4 WARNING conditions
X
(#<IT.BESE.FIVEAM::UNEXPECTED-TEST-FAILURE {10037A5781}>)

What the hell happened? Why is there only one test? Why were all those variables in the loop considered undefined?

Well. FiveAM's test form is a macro. It is evaluated and expanded before the rest of the code, and, in this case, evaluated when none of the variables used in it are actually bound to a value. This means that for every test in the spec, we created a test called 'name', instead of a test called whatever the 'name' variable pointed to. So we are out of luck, in terms of this approach.

But it doesn't mean we're out of luck, period. Knowing that test is a macro, we can reformulate our problem. We don't want to iterate over the specs and tests, and create test cases for each one. We want to write a macro which expands into code which does that. And we can.

(fiveam:def-suite :mustache-specs)      ; redefining a test suite empties it
(fiveam:in-suite :mustache-specs)

(defmacro mustache-spawn-test-suite (specs)
  `(progn
     ,@(loop 
         for spec in (eval specs)
         append (loop
               for test in (cdr (assoc :tests spec))
               for name = (cdr (assoc :name test))
               for template = (cdr (assoc :template test))
               for data = (cdr (assoc :data test))
               for expected = (cdr (assoc :expected test))
               for desc = (cdr (assoc :desc test))
               collect `(fiveam:test ,(intern name) ,desc
                          (fiveam:is (string= ,expected (mustache-render ,template ,data))))))))

Our macro doesn't look too different from our first attempt, but what it does is something quite wonderful.

CL-USER> (macroexpand '(mustache-spawn-test-suite *all-specs*))

(PROGN
 (IT.BESE.FIVEAM:TEST |Inline|
   "Comment blocks should be removed from the template."
   (IT.BESE.FIVEAM:IS
    (STRING= "1234567890"
             (MUSTACHE-RENDER "12345{{! Comment Block! }}67890" NIL))))
 (IT.BESE.FIVEAM:TEST |Multiline|
   "Multiline comments should be permitted."
   (IT.BESE.FIVEAM:IS
    (STRING= "1234567890
"
             (MUSTACHE-RENDER "12345{{!
  This is a
  multi-line comment...
}}67890
"
                              NIL))))
  ;; ...

By writing a macro, we've written a tiny amount of code which generates a lot of code. This code does precisely what we want: iterates over the list of tests in the Mustache spec, and creates a test suite for each and every one of them.

(Lispers frown on the use of eval as above. Can you rewrite the macro to avoid its use?)

Now we can execute the macro, passing in our list of specifications, and generate the test suite that we really want.

(mustache-spawn-test-suite *all-specs*)

Reporting Results

When we use fiveam:run! to run the test suite, we get back results in a very nice printed format. This works well if you're at the REPL, but what if you wanted something to display to the world? Something half-continuous integration, half-implementation progress bar? Using fiveam:run and the excellent CL-WHO, we can do just that.

First, run the tests.

(setq *results* (fiveam:run :mustache-specs))

Then, let's provide a simple transformation of the test results.

(defun pretty-result (test-result)
  (flet ((result-type (result) (format nil "~(~A~)" (symbol-name (type-of result)))))
    (let ((test-case (fiveam::test-case test-result)))
      (list (symbol-name (fiveam::name test-case))
            (fiveam::description test-case)
            (result-type test-result)))))

;; then, try it out:
CL-USER> (pretty-result (nth 0 *results*))
("Inline" "Comment blocks should be removed from the template." "test-failure")

Perfect. Running pretty-result on one of the test results produces a simple list consisting of the name of the test, the description of the test, and a token representing a passed/failed/skipped test.

Now just wrap it in some CL-WHO, fire up Emacs' httpd-server, and navigate over to the generated HTML file.

(with-open-file (stream #P"~/public_html/results.html" :direction :output :if-exists :supersede)
  (cl-who:with-html-output (stream)
    (:style :type "text/css" 
            ".test-passed { background-color: #0f0; }"
            ".test-failure { background-color: #f00; }"
            ".unexpected-test-failure { background-color: #ff0; }")
    (:table
     (loop
        for (name description result) in (mapcar #'pretty-result *results*)
        do (cl-who:htm 
            (:tr 
             (:td (cl-who:fmt name))
             (:td (cl-who:fmt description))
             (:td :class result (cl-who:fmt result))))))))

Pretty impressive, yeah? Fifty source lines of code from start to finish, including our non-existent implementation of mustache-render. At any point that the definition of mustache-render changes, all you need to do to re-generate the test suite results is re-run (setq *results* (fiveam:run :mustache-specs)) and then the above snippet of CL-WHO-infused Lisp.

And there you have it! The next step, of course, is to write a Lisp package that meets the spec, and causes all those red table cells in the generated output to turn green. But, as a wise computer science book once asserted, "this is left as an exercise to the reader."

Introducing gopher.el

Mon, 07 Nov 2011 00:00:00 EST

Gopher is an internet protocol, like the one your web browser uses. It is designed to do a few things well. Gopher makes browsing and sharing information very simple. While it is not in very widespread use anymore, it is still an excellent way to discover and share.

The above screenshot shows a Gopher listing. A listing is a directory, but instead of files, it contains links: links to directories, text documents, images, and other sites.

gopher.el is a Gopher client for Emacs.

Getting it

The package is available on Marmalade.

(add-to-list 'package-archives '("marmalade" . "http://marmalade-repo.org/packages/"))
(package-install 'gopher)

Using it

M-x gopher prompts you for an address. TAB and M-TAB jump between directory links, while [ and ] jump between text links. ENTER opens the link at the cursor's position. There's no history yet, but you can navigate up the directory tree with u.

Contributing

The source code may be forked, and issues may be filed, by visiting gopher.el's GitHub page.

The Future

There are several unimplemented features, the most important of which is HTML viewing. This feature is coming soon.

Clozure CL and Xcode 4

Sat, 10 Sep 2011 00:00:00 EDT

Update: Manually modifying the Homebrew formula for Clozure is unnecessary as of November 2011.

I just learned about Clozure CL, a Common Lisp implementation with a very friendly bridge for Cocoa. The idea of using Lisp to write pseudo-'native' apps for OS X intrigued me, so I modified my Homebrew's formula (changing 1.6 to 1.7 in the URL and changing the MD5 checksum to 4f7d8c48abc9355c69946ef125fa2aa5 and installed it. Getting it into SLIME was no issue, and soon I was working on reproducing some of the example projects. I was using a tutorial from within Clozure's contrib directory entitled Cocoa Interfaces Using the Apple Interface Builder and Clozure Common Lisp, written by Dr. Paul Krueger.

This is where I ran into problems. The general gist of the tutorial (creating a window that takes two inputs, and sums them when a button is pressed) is that the interface can be designed in Apple's Interface Builder, and the backing code written in Lisp. Fair enough. Except Interface Builder really doesn't exist anymore. It has been rolled up into Xcode 4, a component that works seamlessly with the IDE itself. I don't begrudge Apple for improving their software's workflow; in fact, I applaud it. The trouble is that one of the steps the tutorial relies on no longer works the same way.

My understanding of Cocoa is a little spotty so I will explain it the best that I can. Objective-C incorporates message-passing-style object-orientation, and one of the ways it uses this to great effect is by creating delegates of components of the UI to send and receive different messages from. Since the instance that interacts with the UI controls must exist before the UI itself gets loaded, a representation of that instance, called "File's Owner", exists in the Interface Builder. In Xcode 3, the exact object type of the File's Owner did not need to exist in code, because a mechanism existed for generating the object you described when switching between Interface Builder and the Editor.

In Xcode 4, no such mechanism exists. Instead, you can literally drag the connection from your UI into a source code file, and the connections (called 'actions' or 'outlets' depending on their function) will be autowritten for you. A nice touch, if you actually are working in a full-fledged Cocoa project.

You kind of have to do something like that from now on when creating nibs for Clozure-CL projects, as far as I can tell.

In the example of the simplesum project in the above PDF, after creating your UI, create a new 'Cocoa Objective-C class', with implementation and header files, and call it SumWindowOwn. In its header file, you'll be handwriting the connections you'd like.

Where the PDF says:

In the Class Outlets part of the window click the "+" button to add a new outlet. Edit the name to be "input1" and the type to be NSTextField.

We will instead add a line of code in the @interface of SumWindowOwn:

@property (assign) IBOutlet NSTextField *input1;

Where the PDF says:

Click the "+" button and add a new action. Edit the "MyAction1:" name that is generated and change it to "doSum:".

We will instead add a function interface:

- (IBAction)doSum:(id)sender;

Do this for the other outlets in the tutorial, and then you can CTRL-drag the UI controls onto the lines you just wrote. Not between, or after, literally onto.

At this point I was able to load the nib using iu:loadnib without issue.

I recognize some or all of my explanation above may be vague, oversimplified, or flat-out wrong. I will happily consider corrections to my understanding of the situation.

Introducing Narcissus: An Org Mode Blogger

Sun, 31 Jul 2011 00:00:00 EDT

In this article, I attempt to both describe and implement, through literate programming, a set of tools that will allow me to use Org Mode to publish my blog, the way I want and following the rules I want.

NOTE: The source code listings in this file have been hidden with a CSS rule. In order to examine the entirety of the source presented in this article, disable CSS.

Description and Requirements (Progress [33%])

This is an attempt to put together a set of tools that will allow me to create a sort of static blog with Org Mode. There are several pieces of behavior that I am considering necessary for this to be successful:

[ ] Can re-use components from old site
[ ] HTML5 Generation
[X] Preserves existing URL structure
[ ] Rsync-like publishing
[ ] Uploading of resources
[X] Preview exported HTML before publish
[ ] Mark entries as drafts and don't publish
[ ] Mark scraps to publish on separate pages
[X] RSS Generation

Some general thoughts. org-publish seems to be the most reasonable way to attempt this, and indeed an existing org blogging system called blorg is defunct until the author completes a rewrite that is dependent on org-publish.

org-publish-project-alist takes a parameter :publishing-function, which in most stock cases appears to be a tiny function that calls org-publish-org-as with a format. For example:

(defun org-publish-org-to-html (plist filename pub-dir)
  "Publish an org file to HTML.
See `org-publish-org-to' to the list of arguments."
  (org-publish-with-aux-preprocess-maybe
    (org-publish-org-to "html" plist filename pub-dir)))

Within org-publish-org-to, the format is appended to a string that becomes the function name for whatever is actually processing Org mode files. For example, (org-publish-org-to "html" ...) calls the function org-export-as-html.

I'm going to call this project Narcissus. It's fitting that a set of tools that allows me to broadcast my innermost bullshit to the world is named after a dude that couldn't stop staring at his own reflection.

Reusing Components

This is a pseudo-requirement of sorts. Basically, not much work should be done to preserve both the structure of the web pages that make up the old site, and the stylesheets that make up the old site.

Here are some variables set in order to preserve the existing look and feel of the site.

(setq org-export-html-style "<link rel='stylesheet' type='text/css' href='/css/site.css'>
<link rel='alternate' type='application/rss+xml' title='msnyder.info RSS' href='http://msnyder.info/rss.xml'>
<link rel='stylesheet' type='text/css' href='/css/code.css'>
<link rel='stylesheet' href='http://fonts.googleapis.com/css?family=Inconsolata' type='text/css' media='screen, projection' />
<link rel='stylesheet' href='http://fonts.googleapis.com/css?family=Raleway:100' type='text/css' media='screen, projection' />")

(setq org-export-html-preamble "<h1><a href='/'>msnyder<span>&#9879;</span>info</a></h1>")
(setq org-export-html-postamble "Copyright &copy; MMXII <a href='/about/'>Matthew Snyder.</a>")

HTML5 Generation

HTML5 generation should be straightforward. It doesn't explicitly need to be HTML5 generation, it just needs to be standard org-mode exporting into templates with any content in them, as far as I can tell. Writing a function like org-export-as-narcissus-html is basically the ticket.

And here it is. This function is almost entirely cribbed from org-publish's org-export-as-html. Where changes have been made for this project, I've prepended them with a comment starting with NARCISSUS:.

(defun org-export-as-narcissus-html (arg &optional hidden ext-plist
                                     to-buffer body-only pub-dir)
  "Export the outline as a pretty HTML file.
If there is an active region, export only the region.  The prefix
ARG specifies how many levels of the outline should become
headlines.  The default is 3.  Lower levels will become bulleted
lists.  HIDDEN is obsolete and does nothing.
EXT-PLIST is a property list with external parameters overriding
org-mode's default settings, but still inferior to file-local
settings.  When TO-BUFFER is non-nil, create a buffer with that
name and export to that buffer.  If TO-BUFFER is the symbol
`string', don't leave any buffer behind but just return the
resulting HTML as a string.  When BODY-ONLY is set, don't produce
the file header and footer, simply return the content of
<body>...</body>, without even the body tags themselves.  When
PUB-DIR is set, use this as the publishing directory."
  (interactive "P")
  (run-hooks 'org-export-first-hook)

  ;; Make sure we have a file name when we need it.
  (when (and (not (or to-buffer body-only))
             (not buffer-file-name))
    (if (buffer-base-buffer)
        (org-set-local 'buffer-file-name
                       (with-current-buffer (buffer-base-buffer)
                         buffer-file-name))
      (error "Need a file name to be able to export")))

  (message "Exporting...")
  (setq-default org-todo-line-regexp org-todo-line-regexp)
  (setq-default org-deadline-line-regexp org-deadline-line-regexp)
  (setq-default org-done-keywords org-done-keywords)
  (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp)
  (let* ((opt-plist
          (org-export-process-option-filters
           (org-combine-plists (org-default-export-plist)
                               ext-plist
                               (org-infile-export-plist))))
         (body-only (or body-only (plist-get opt-plist :body-only)))
         (style (concat (if (plist-get opt-plist :style-include-default)
                            org-export-html-style-default)
                        (plist-get opt-plist :style)
                        (plist-get opt-plist :style-extra)
                        "\n"
                        (if (plist-get opt-plist :style-include-scripts)
                            org-export-html-scripts)))
         (html-extension (plist-get opt-plist :html-extension))
         valid thetoc have-headings first-heading-pos
         (odd org-odd-levels-only)
         (region-p (org-region-active-p))
         (rbeg (and region-p (region-beginning)))
         (rend (and region-p (region-end)))
         (subtree-p
          (if (plist-get opt-plist :ignore-subtree-p)
              nil
            (when region-p
              (save-excursion
                (goto-char rbeg)
                (and (org-at-heading-p)
                     (>= (org-end-of-subtree t t) rend))))))
         (level-offset (if subtree-p
                           (save-excursion
                             (goto-char rbeg)
                             (+ (funcall outline-level)
                                (if org-odd-levels-only 1 0)))
                         0))
         (opt-plist (setq org-export-opt-plist
                          (if subtree-p
                              (org-export-add-subtree-options opt-plist rbeg)
                            opt-plist)))
         ;; The following two are dynamically scoped into other
         ;; routines below.
         (org-current-export-dir
          (or pub-dir (org-export-directory :html opt-plist)))
         (org-current-export-file buffer-file-name)
         (level 0) (line "") (origline "") txt todo
         (umax nil)
         (umax-toc nil)
         ;; NARCISSUS: Allow EXPORT_FILE_NAME to exist in publish settings
         (concat-thing (cond
                        ((and subtree-p 
                              (org-entry-get (region-beginning) "EXPORT_FILE_NAME" t)
                              (plist-get opt-plist :export-file-name))
                         (concat (org-entry-get (region-beginning) "EXPORT_FILE_NAME" t) "/" (plist-get opt-plist :export-file-name)))
                        (t (or 
                            (concat
                             (narcissus-entry-published-location opt-plist)
                             (plist-get opt-plist :export-file-name))
                            (and subtree-p
                                 (org-entry-get (region-beginning) "EXPORT_FILE_NAME" t))
                            (file-name-nondirectory buffer-file-name)))))
         (filename (if to-buffer nil
                     (expand-file-name
                      (concat
                       (file-name-sans-extension concat-thing) "." html-extension)
                      (file-name-as-directory
                       (or pub-dir (org-export-directory :html opt-plist))))))
         (current-dir (if buffer-file-name
                          (file-name-directory buffer-file-name)
                        default-directory))
         (buffer (if to-buffer
                     (cond
                      ((eq to-buffer 'string) (get-buffer-create "*Org HTML Export*"))
                      (t (get-buffer-create to-buffer)))
                   (find-file-noselect filename)))
         (org-levels-open (make-vector org-level-max nil))
         (date (plist-get opt-plist :date))
         (author      (plist-get opt-plist :author))
         (html-validation-link (or org-export-html-validation-link ""))
         (title       (org-html-expand
                       (or (and subtree-p (org-export-get-title-from-subtree))
                           (plist-get opt-plist :title)
                           (and (not body-only)
                                (not
                                 (plist-get opt-plist :skip-before-1st-heading))
                                (org-export-grab-title-from-buffer))
                           (and buffer-file-name
                                (file-name-sans-extension
                                 (file-name-nondirectory buffer-file-name)))
                           "UNTITLED")))
         (link-up (and (plist-get opt-plist :link-up)
                       (string-match "\\S-" (plist-get opt-plist :link-up))
                       (plist-get opt-plist :link-up)))
         (link-home (and (plist-get opt-plist :link-home)
                         (string-match "\\S-" (plist-get opt-plist :link-home))
                         (plist-get opt-plist :link-home)))
         (dummy (setq opt-plist (plist-put opt-plist :title title)))
         (html-table-tag (plist-get opt-plist :html-table-tag))
         (quote-re0   (concat "^[ \t]*" org-quote-string "\\>"))
         (quote-re    (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)"))
         (inquote     nil)
         (infixed     nil)
         (inverse     nil)
         (email       (plist-get opt-plist :email))
         (language    (plist-get opt-plist :language))
         (keywords    (plist-get opt-plist :keywords))
         (description (plist-get opt-plist :description))
         (num         (plist-get opt-plist :section-numbers))
         (lang-words  nil)
         (head-count  0) cnt
         (start       0)
         (coding-system (and (boundp 'buffer-file-coding-system)
                             buffer-file-coding-system))
         (coding-system-for-write (or org-export-html-coding-system
                                      coding-system))
         (save-buffer-coding-system (or org-export-html-coding-system
                                        coding-system))
         (charset (and coding-system-for-write
                       (fboundp 'coding-system-get)
                       (coding-system-get coding-system-for-write
                                          'mime-charset)))
         (region
          (buffer-substring
           (if region-p (region-beginning) (point-min))
           (if region-p (region-end) (point-max))))
         (org-export-have-math nil)
         (org-export-footnotes-seen nil)
         (org-export-footnotes-data (org-footnote-all-labels 'with-defs))
         (lines
          (org-split-string
           (org-export-preprocess-string
            region
            :emph-multiline t
            :for-backend 'html
            :skip-before-1st-heading
            (plist-get opt-plist :skip-before-1st-heading)
            :drawers (plist-get opt-plist :drawers)
            :todo-keywords (plist-get opt-plist :todo-keywords)
            :tasks (plist-get opt-plist :tasks)
            :tags (plist-get opt-plist :tags)
            :priority (plist-get opt-plist :priority)
            :footnotes (plist-get opt-plist :footnotes)
            :timestamps (plist-get opt-plist :timestamps)
            :archived-trees
            (plist-get opt-plist :archived-trees)
            :select-tags (plist-get opt-plist :select-tags)
            :exclude-tags (plist-get opt-plist :exclude-tags)
            :add-text
            (plist-get opt-plist :text)
            :LaTeX-fragments
            (plist-get opt-plist :LaTeX-fragments))
           "[\r\n]"))
         (mathjax
          (if (or (eq (plist-get opt-plist :LaTeX-fragments) 'mathjax)
                  (and org-export-have-math
                       (eq (plist-get opt-plist :LaTeX-fragments) t)))

              (org-export-html-mathjax-config
               org-export-html-mathjax-template
               org-export-html-mathjax-options
               (or (plist-get opt-plist :mathjax) ""))
            ""))
         table-open
         table-buffer table-orig-buffer
         ind
         rpl path attr desc descp desc1 desc2 link
         snumber fnc
         footnotes footref-seen
         href
         )

    (let ((inhibit-read-only t))
      (org-unmodified
       (remove-text-properties (point-min) (point-max)
                               '(:org-license-to-kill t))))

    (message "--> Exporting %s... to %s" org-current-export-file filename)

    (make-directory 
     (concat (or pub-dir (org-export-directory :html opt-plist))
             (narcissus-entry-published-location opt-plist)) t)

    (setq org-min-level (org-get-min-level lines level-offset))
    (setq org-last-level org-min-level)
    (org-init-section-numbers)

    (cond
     ((and date (string-match "%" date))
      (setq date (format-time-string date)))
     (date)
     (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))

    ;; Get the language-dependent settings
    (setq lang-words (or (assoc language org-export-language-setup)
                         (assoc "en" org-export-language-setup)))

    ;; Switch to the output buffer
    (set-buffer buffer)
    (let ((inhibit-read-only t)) (erase-buffer))
    (fundamental-mode)
    (org-install-letbind)

    (and (fboundp 'set-buffer-file-coding-system)
         (set-buffer-file-coding-system coding-system-for-write))

    (let ((case-fold-search nil)
          (org-odd-levels-only odd))
      ;; create local variables for all options, to make sure all called
      ;; functions get the correct information
      (mapc (lambda (x)
              (set (make-local-variable (nth 2 x))
                   (plist-get opt-plist (car x))))
            org-export-plist-vars)
      (setq umax (if arg (prefix-numeric-value arg)
                   org-export-headline-levels))
      (setq umax-toc (if (integerp org-export-with-toc)
                         (min org-export-with-toc umax)
                       umax))
      (unless body-only
        ;; File header

        ;; NARCISSUS: Provide an HTML5 DOCTYPE and other
        ;; headers for exported files.
        (insert (format
                 "<!DOCTYPE html>
<html lang=\"%s\">
<head>
<title>%s</title>
<meta charset=\"%s\" />
%s
%s
</head>
<body>
%s
"
                 language
                 title
                 (or charset "utf-8")
                 style
                 mathjax
                 (if (or link-up link-home)
                     (concat
                      (format org-export-html-home/up-format
                              (or link-up link-home)
                              (or link-home link-up))
                      "\n")
                   "")))

        ;; insert html preamble
        (when (plist-get opt-plist :html-preamble)
          (let ((html-pre (plist-get opt-plist :html-preamble)))
            (insert (format "<%s id=\"" (plist-get opt-plist :preamble-wrap-tag)) (nth 0 org-export-html-divs) "\">\n")
            (cond ((stringp html-pre)
                   (insert
                    (format-spec html-pre `((?t . ,title) (?a . ,author)
                                            (?d . ,date) (?e . ,email)))))
                  ((functionp html-pre)
                   (funcall html-pre))
                  (t
                   (insert
                    (format-spec
                     (or (cadr (assoc (nth 0 lang-words)
                                      org-export-html-preamble-format))
                         (cadr (assoc "en" org-export-html-preamble-format)))
                     `((?t . ,title) (?a . ,author)
                       (?d . ,date) (?e . ,email))))))
            (insert (format "\n</%s>\n" (plist-get opt-plist :preamble-wrap-tag)))))

        ;; begin wrap around body
        (insert (format "\n<%s id=\"%s\">" 
                        ;; NARCISSUS: use body wrap tag
                        (plist-get opt-plist :body-wrap-tag)
                        ;; FIXME org-export-html-content-div is obsolete since 7.7
                        (or org-export-html-content-div 
                            (nth 1 org-export-html-divs)))))
                ;; FIXME this should go in the preamble but is here so
                ;; that org-infojs can still find it
        (if (plist-get opt-plist :insert-title-into-body)
            (insert "\n<h1 class=\"title\">" title "</h1>\n"))

      ;; insert body
      (if (and org-export-with-toc (not body-only))
          (progn
            (push (format "<h%d>%s</h%d>\n"
                          org-export-html-toplevel-hlevel
                          (nth 3 lang-words)
                          org-export-html-toplevel-hlevel)
                  thetoc)
            (push "<div id=\"text-table-of-contents\">\n" thetoc)
            (push "<ul>\n<li>" thetoc)
            (setq lines
                  (mapcar 
                   #'(lambda (line)
                       (if (and (string-match org-todo-line-regexp line)
                                (not (get-text-property 0 'org-protected line)))
                           ;; This is a headline
                           (progn
                             (setq have-headings t)
                             (setq level (- (match-end 1) (match-beginning 1)
                                            level-offset)
                                   level (org-tr-level level)
                                   txt (save-match-data
                                         (org-html-expand
                                          (org-export-cleanup-toc-line
                                           (match-string 3 line))))
                                   todo
                                   (or (and org-export-mark-todo-in-toc
                                            (match-beginning 2)
                                            (not (member (match-string 2 line)
                                                         org-done-keywords)))
                                        ; TODO, not DONE
                                       (and org-export-mark-todo-in-toc
                                            (= level umax-toc)
                                            (org-search-todo-below
                                             line lines level))))
                             (if (string-match
                                  (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
                                 (setq txt (replace-match  
                                            "&nbsp;&nbsp;&nbsp;<span class=\"tag\"> \\1</span>" t nil txt)))
                             (if (string-match quote-re0 txt)
                                 (setq txt (replace-match "" t t txt)))
                             (setq snumber (org-section-number level))
                             (if (and num (if (integerp num)
                                              (>= num level)
                                            num))
                                 (setq txt (concat snumber " " txt)))
                             (if (<= level (max umax umax-toc))
                                 (setq head-count (+ head-count 1)))
                             (if (<= level umax-toc)
                                 (progn
                                   (if (> level org-last-level)
                                       (progn
                                         (setq cnt (- level org-last-level))
                                         (while (>= (setq cnt (1- cnt)) 0)
                                           (push "\n<ul>\n<li>" thetoc))
                                         (push "\n" thetoc)))
                                   (if (< level org-last-level)
                                       (progn
                                         (setq cnt (- org-last-level level))
                                         (while (>= (setq cnt (1- cnt)) 0)
                                           (push "</li>\n</ul>" thetoc))
                                         (push "\n" thetoc)))
                                   ;; Check for targets
                                   (while (string-match org-any-target-regexp line)
                                     (setq line (replace-match
                                                 (concat "@<span class=\"target\">" 
                                                         (match-string 1 line) "@</span> ")
                                                 t t line)))
                                   (while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
                                     (setq txt (replace-match "" t t txt)))
                                   (setq href
                                         (replace-regexp-in-string
                                          "\\." "-" (format "sec-%s" snumber)))
                                   (setq href (org-solidify-link-text 
                                               (or (cdr (assoc href 
                                                               org-export-preferred-target-alist)) href)))
                                   (push
                                    (format
                                     (if todo
                                         "</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>"
                                       "</li>\n<li><a href=\"#%s\">%s</a>")
                                     href txt) thetoc)

                                   (setq org-last-level level)))))
                       line)
                   lines))
            (while (> org-last-level (1- org-min-level))
              (setq org-last-level (1- org-last-level))
              (push "</li>\n</ul>\n" thetoc))
            (push "</div>\n" thetoc)
            (setq thetoc (if have-headings (nreverse thetoc) nil))))

      (setq head-count 0)
      (org-init-section-numbers)

      (org-open-par)

      (while (setq line (pop lines) origline line)
        (catch 'nextline

          ;; end of quote section?
          (when (and inquote (string-match org-outline-regexp-bol line))
            (insert "</pre>\n")
            (org-open-par)
            (setq inquote nil))
          ;; inside a quote section?
          (when inquote
            (insert (org-html-protect line) "\n")
            (throw 'nextline nil))

          ;; Fixed-width, verbatim lines (examples)
          (when (and org-export-with-fixed-width
                     (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line))
            (when (not infixed)
              (setq infixed t)
              (org-close-par-maybe)

              (insert "<pre class=\"example\">\n"))
            (insert (org-html-protect (match-string 3 line)) "\n")
            (when (or (not lines)
                      (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)"
                                         (car lines))))
              (setq infixed nil)
              (insert "</pre>\n")
              (org-open-par))
            (throw 'nextline nil))

          ;; Protected HTML
          (when (and (get-text-property 0 'org-protected line)
                     ;; Make sure it is the entire line that is protected
                     (not (< (or (next-single-property-change
                                  0 'org-protected line) 10000)
                             (length line))))
            (let (par (ind (get-text-property 0 'original-indentation line)))
              (when (re-search-backward
                     "\\(<p>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t)
                (setq par (match-string 1))
                (replace-match "\\2\n"))
              (insert line "\n")
              (while (and lines
                          (or (= (length (car lines)) 0)
                              (not ind)
                              (equal ind (get-text-property 0 'original-indentation (car lines))))
                          (or (= (length (car lines)) 0)
                              (get-text-property 0 'org-protected (car lines))))
                (insert (pop lines) "\n"))
              (and par (insert "<p>\n")))
            (throw 'nextline nil))

          ;; Blockquotes, verse, and center
          (when (equal "ORG-BLOCKQUOTE-START" line)
            (org-close-par-maybe)
            (insert "<blockquote>\n")
            (org-open-par)
            (throw 'nextline nil))
          (when (equal "ORG-BLOCKQUOTE-END" line)
            (org-close-par-maybe)
            (insert "\n</blockquote>\n")
            (org-open-par)
            (throw 'nextline nil))
          (when (equal "ORG-VERSE-START" line)
            (org-close-par-maybe)
            (insert "\n<p class=\"verse\">\n")
            (setq org-par-open t)
            (setq inverse t)
            (throw 'nextline nil))
          (when (equal "ORG-VERSE-END" line)
            (insert "</p>\n")
            (setq org-par-open nil)
            (org-open-par)
            (setq inverse nil)
            (throw 'nextline nil))
          (when (equal "ORG-CENTER-START" line)
            (org-close-par-maybe)
            (insert "\n<div style=\"text-align: center\">")
            (org-open-par)
            (throw 'nextline nil))
          (when (equal "ORG-CENTER-END" line)
            (org-close-par-maybe)
            (insert "\n</div>")
            (org-open-par)
            (throw 'nextline nil))
          (run-hooks 'org-export-html-after-blockquotes-hook)
          (when inverse
            (let ((i (org-get-string-indentation line)))
              (if (> i 0)
                  (setq line (concat (mapconcat 'identity
                                                (make-list (* 2 i) "\\nbsp") "")
                                     " " (org-trim line))))
              (unless (string-match "\\\\\\\\[ \t]*$" line)
                (setq line (concat line "\\\\")))))

          ;; make targets to anchors
          (setq start 0)
          (while (string-match
                  "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line start)
            (cond
             ((get-text-property (match-beginning 1) 'org-protected line)
              (setq start (match-end 1)))
             ((match-end 2)
              (setq line (replace-match
                          (format
                           "@<a name=\"%s\" id=\"%s\">@</a>"
                           (org-solidify-link-text (match-string 1 line))
                           (org-solidify-link-text (match-string 1 line)))
                          t t line)))
             ((and org-export-with-toc (equal (string-to-char line) ?*))
              ;; FIXME: NOT DEPENDENT on TOC?????????????????????
              (setq line (replace-match
                          (concat "@<span class=\"target\">"
                                  (match-string 1 line) "@</span> ")
                          ;; (concat "@<i>" (match-string 1 line) "@</i> ")
                          t t line)))
             (t
              (setq line (replace-match
                          (concat "@<a name=\""
                                  (org-solidify-link-text (match-string 1 line))
                                  "\" class=\"target\">" (match-string 1 line)
                                  "@</a> ")
                          t t line)))))

          (setq line (org-html-handle-time-stamps line))

          ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;"
          ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
          ;; Also handle sub_superscripts and checkboxes
          (or (string-match org-table-hline-regexp line)
              (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" line)
              (setq line (org-html-expand line)))

          ;; Format the links
          (setq line (narcissus-html-handle-links line opt-plist))

          ;; TODO items
          (if (and (string-match org-todo-line-regexp line)
                   (match-beginning 2))

              (setq line
                    (concat (substring line 0 (match-beginning 2))
                            "<span class=\""
                            (if (member (match-string 2 line)
                                        org-done-keywords)
                                "done" "todo")
                            " " (match-string 2 line)
                            "\"> " (org-export-html-get-todo-kwd-class-name
                                    (match-string 2 line))
                            "</span>" (substring line (match-end 2)))))

          ;; Does this contain a reference to a footnote?
          (when org-export-with-footnotes
            (setq start 0)
            (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start)
              ;; Discard protected matches not clearly identified as
              ;; footnote markers.
              (if (or (get-text-property (match-beginning 2) 'org-protected line)
                      (not (get-text-property (match-beginning 2) 'org-footnote line)))
                  (setq start (match-end 2))
                (let ((n (match-string 2 line)) extra a)
                  (if (setq a (assoc n footref-seen))
                      (progn
                        (setcdr a (1+ (cdr a)))
                        (setq extra (format ".%d" (cdr a))))
                    (setq extra "")
                    (push (cons n 1) footref-seen))
                  (setq line
                        (replace-match
                         (concat
                          (format
                           (concat "%s"
                                   (format org-export-html-footnote-format
                                           (concat "<a class=\"footref\" name=\"fnr.%s%s\" href=\"#fn.%s\">%s</a>")))
                           (or (match-string 1 line) "") n extra n n)
                          ;; If another footnote is following the
                          ;; current one, add a separator.
                          (if (save-match-data
                                (string-match "\\`\\[[0-9]+\\]"
                                              (substring line (match-end 0))))
                              org-export-html-footnote-separator
                            ""))
                         t t line))))))

          (cond
           ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
            ;; This is a headline
            (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
                                         level-offset))
                  txt (match-string 2 line))
            (if (string-match quote-re0 txt)
                (setq txt (replace-match "" t t txt)))
            (if (<= level (max umax umax-toc))
                (setq head-count (+ head-count 1)))
            (setq first-heading-pos (or first-heading-pos (point)))
            (org-html-level-start level txt umax
                                  (and org-export-with-toc (<= level umax))
                                  head-count opt-plist)

            ;; QUOTES
            (when (string-match quote-re line)
              (org-close-par-maybe)
              (insert "<pre>")
              (setq inquote t)))

           ((and org-export-with-tables
                 (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
            (when (not table-open)
              ;; New table starts
              (setq table-open t table-buffer nil table-orig-buffer nil))

            ;; Accumulate lines
            (setq table-buffer (cons line table-buffer)
                  table-orig-buffer (cons origline table-orig-buffer))
            (when (or (not lines)
                      (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
                                         (car lines))))
              (setq table-open nil
                    table-buffer (nreverse table-buffer)
                    table-orig-buffer (nreverse table-orig-buffer))
              (org-close-par-maybe)
              (insert (org-format-table-html table-buffer table-orig-buffer))))

           ;; Normal lines

           (t
            ;; This line either is list item or end a list.
            (when (get-text-property 0 'list-item line)
              (setq line (org-html-export-list-line
                          line
                          (get-text-property 0 'list-item line)
                          (get-text-property 0 'list-struct line)
                          (get-text-property 0 'list-prevs line))))

            ;; Horizontal line
            (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line)
              (if org-par-open
                  (insert "\n</p>\n<hr/>\n<p>\n")
                (insert "\n<hr/>\n"))
              (throw 'nextline nil))

            ;; Empty lines start a new paragraph.  If hand-formatted lists
            ;; are not fully interpreted, lines starting with "-", "+", "*"
            ;; also start a new paragraph.
            (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par))

            ;; Is this the start of a footnote?
            (when org-export-with-footnotes
              (when (and (boundp 'footnote-section-tag-regexp)
                         (string-match (concat "^" footnote-section-tag-regexp)
                                       line))
                ;; ignore this line
                (throw 'nextline nil))
              (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line)
                (org-close-par-maybe)
                (let ((n (match-string 1 line)))
                  (setq org-par-open t
                        line (replace-match
                              (format
                               (concat "<p class=\"footnote\">"
                                       (format org-export-html-footnote-format
                                               "<a class=\"footnum\" name=\"fn.%s\" href=\"#fnr.%s\">%s</a>"))
                               n n n) t t line)))))
            ;; Check if the line break needs to be conserved
            (cond
             ((string-match "\\\\\\\\[ \t]*$" line)
              (setq line (replace-match "<br/>" t t line)))
             (org-export-preserve-breaks
              (setq line (concat line "<br/>"))))

            ;; Check if a paragraph should be started
            (let ((start 0))
              (while (and org-par-open
                          (string-match "\\\\par\\>" line start))
                ;; Leave a space in the </p> so that the footnote matcher
                ;; does not see this.
                (if (not (get-text-property (match-beginning 0)
                                            'org-protected line))
                    (setq line (replace-match "</p ><p >" t t line)))
                (setq start (match-end 0))))

            (insert line "\n")))))

      ;; Properly close all local lists and other lists
      (when inquote
        (insert "</pre>\n")
        (org-open-par))

      (org-html-level-start 1 nil umax
                            (and org-export-with-toc (<= level umax))
                            head-count opt-plist)
      ;; the </div> to close the last text-... div.
      (when (and (> umax 0) first-heading-pos) (insert "</div>\n"))

      (save-excursion
        (goto-char (point-min))
        (while (re-search-forward
                "\\(\\(<p class=\"footnote\">\\)[^\000]*?\\)\\(\\(\\2\\)\\|\\'\\)"
                nil t)
          (push (match-string 1) footnotes)
          (replace-match "\\4" t nil)
          (goto-char (match-beginning 0))))
      (when footnotes
        (insert (format org-export-html-footnotes-section
                        (nth 4 lang-words)
                        (mapconcat 'identity (nreverse footnotes) "\n"))
                "\n"))
      (let ((bib (org-export-html-get-bibliography)))
        (when bib
          (insert "\n" bib "\n")))

      (unless body-only
        ;; end wrap around body
        ;; NARCISSUS: use body-wrap-tag again
        (insert (format "</%s>\n" (plist-get opt-plist :body-wrap-tag)))

        ;; export html postamble
        (let ((html-post (plist-get opt-plist :html-postamble))
              (email
               (mapconcat (lambda(e)
                            (format "<a href=\"mailto:%s\">%s</a>" e e))
                          (split-string email ",+ *")
                          ", "))
              (creator-info
               (concat "Org version " org-version " with Emacs version "
                       (number-to-string emacs-major-version))))

          (when (plist-get opt-plist :html-postamble)
            ;; NARCISSUS: Use postamble-wrap-tag
            (insert (format "\n<%s id=\"" (plist-get opt-plist :postamble-wrap-tag)) (nth 2 org-export-html-divs) "\">\n")
            (cond ((stringp html-post)
                   (insert (format-spec html-post
                                        `((?a . ,author) (?e . ,email)
                                          (?d . ,date)   (?c . ,creator-info)
                                          (?v . ,html-validation-link)))))
                  ((functionp html-post)
                   (funcall html-post))
                  ((eq html-post 'auto)
                   ;; fall back on default postamble
                   (when (plist-get opt-plist :time-stamp-file)
                     (insert "<p class=\"date\">" (nth 2 lang-words) ": " date "</p>\n"))
                   (when (and (plist-get opt-plist :author-info) author)
                       (insert "<p class=\"author\">" (nth 1 lang-words) ": " author "</p>\n"))
                   (when (and (plist-get opt-plist :email-info) email)
                     (insert "<p class=\"email\">" email "</p>\n"))
                   (when (plist-get opt-plist :creator-info)
                     (insert "<p class=\"creator\">"
                             (concat "Org version " org-version " with Emacs version "
                                     (number-to-string emacs-major-version) "</p>\n")))
                   (insert html-validation-link "\n"))
                  (t
                   (insert (format-spec
                            (or (cadr (assoc (nth 0 lang-words)
                                             org-export-html-postamble-format))
                                (cadr (assoc "en" org-export-html-postamble-format)))
                            `((?a . ,author) (?e . ,email)
                              (?d . ,date)   (?c . ,creator-info)
                              (?v . ,html-validation-link))))))

            ;; NARCISSUS: Use postamble-wrap-tag again
            (insert (format "\n</%s>" (plist-get opt-plist :postamble-wrap-tag))))))

      ;; FIXME `org-export-html-with-timestamp' has been declared
      ;; obsolete since Org 7.7 -- don't forget to remove this.
      (if org-export-html-with-timestamp
          (insert org-export-html-html-helper-timestamp))

      (unless body-only (insert "\n</body>\n</html>\n"))

      (unless (plist-get opt-plist :buffer-will-be-killed)
        (normal-mode)
        (if (eq major-mode (default-value 'major-mode))
            (html-mode)))

      ;; insert the table of contents
      (goto-char (point-min))
      (when thetoc
        (if (or (re-search-forward
                 "<p>\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*</p>" nil t)
                (re-search-forward
                 "\\[TABLE-OF-CONTENTS\\]" nil t))
            (progn
              (goto-char (match-beginning 0))
              (replace-match ""))
          (goto-char first-heading-pos)
          (when (looking-at "\\s-*</p>")
            (goto-char (match-end 0))
            (insert "\n")))
        (insert "<div id=\"table-of-contents\">\n")
        (let ((beg (point)))
          (mapc 'insert thetoc)
          (insert "</div>\n")
          (while (re-search-backward "<li>[ \r\n\t]*</li>\n?" beg t)
            (replace-match ""))))
      ;; remove empty paragraphs
      (goto-char (point-min))
      (while (re-search-forward "<p>[ \r\n\t]*</p>" nil t)
        (replace-match ""))
      (goto-char (point-min))
      ;; Convert whitespace place holders
      (goto-char (point-min))
      (let (beg end n)
        (while (setq beg (next-single-property-change (point) 'org-whitespace))
          (setq n (get-text-property beg 'org-whitespace)
                end (next-single-property-change beg 'org-whitespace))
          (goto-char beg)
          (delete-region beg end)
          (insert (format "<span style=\"visibility:hidden;\">%s</span>"
                          (make-string n ?x)))))
      ;; Remove empty lines at the beginning of the file.
      (goto-char (point-min))
      (when (looking-at "\\s-+\n") (replace-match ""))
      ;; Remove display properties
      (remove-text-properties (point-min) (point-max) '(display t))
      ;; Run the hook
      (run-hooks 'org-export-html-final-hook)
      (or to-buffer (save-buffer))
      (goto-char (point-min))
      (or (org-export-push-to-kill-ring "HTML")
          (message "... done exporting."))
      (if (eq to-buffer 'string)
          (prog1 (buffer-substring (point-min) (point-max))
            (kill-buffer (current-buffer)))
        (current-buffer)))))

I use the following functions to publish the index and entries of the blog.

(defun narcissus-publish-entries (plist filename pub-dir)
  (org-publish-org-to "narcissus-html" plist filename pub-dir))

(defun narcissus-publish-index (plist filename pub-dir)
  (org-publish-org-to "narcissus-html" plist filename pub-dir))

RSS Generation

RSS generation is actually fairly simple: I've written the below function, narcissus-publish-rss, which takes the first element of the :include property in its publishing alist, and considers the file a list of links for which to generate RSS metadata for. Scraps are ignored as they don't have a publishing date.

I've also added a bunch of properties to the publishing alist for the channel metadata for the RSS feed. They should be self evident: :rss-title, :rss-language, :rss-description, :rss-link, and :rss-copyright.

(require 'rss)

(defun current-time-format->rfc822 (time)
  (format-time-string "%a, %d %b %Y %H:%M:%S %Z" time))

(defun narcissus-publish-rss (plist filename pub-dir)
  (let* ((index (concat (getf plist :base-directory)
                       (nth 0 (getf plist :include))))
         (index-buffer (find-file index))
         (rss-link (getf plist :rss-link))
         (scraps-directory (getf plist :scraps-directory))
         (rss (make-rss)))
    (rss-channel rss
                 `(title nil ,(getf plist :rss-title))
                 `(link nil ,rss-link)
                 `(language nil ,(getf plist :rss-language))
                 `(description nil ,(getf plist :rss-description))
                 `(copyright nil ,(getf plist :rss-copyright)))
    (save-excursion
      (switch-to-buffer index-buffer)
      (beginning-of-buffer)
      (while (re-search-forward org-bracket-link-regexp nil :return-t-if-found-and-nil-otherwise)
        (let ((link (match-string-no-properties 1))
              (title (match-string-no-properties 3))
              html scrap-p)
          (if (string-match "^file:" link)
              (setq link (replace-match "" t t link)))
          (save-current-buffer
            (setq scrap-p (string-match scraps-directory link))
            (message "File: %s Scrap? %s" (current-buffer) scrap-p)
            (if (not scrap-p)
              (progn
                (set-buffer (find-file link))
                (save-current-buffer
                  (setq html (org-export-as-narcissus-html nil nil nil 'string t)))
                (rss-add-item rss
                              `(attrs
                                (link nil ,(concat rss-link (narcissus-entry-published-location)))
                                (title nil ,(org-publish-find-title (buffer-file-name)))
                                (pubDate nil ,(current-time-format->rfc822 (org-publish-find-date buffer-file-name)))
                                (guid nil ,(concat "msnyder.info:entry:" link))
                                (description nil ,html)))))))))
    (rss-write-file rss (concat (getf plist :publishing-directory)
                                (getf plist :rss-output-filename)))))

Preserves existing URL structure

I'm not keeping tables of redirects, I'm not moving my content. This is 2011. There's no reason I shouldn't be able to graft this system onto the trunk of the old one.

In order to correctly fit into the existing directory structure, we should be able to look at a blog entry and determine, from its filename and its metadata, where it belongs in the directory tree.

First, we make sure we can generate the directory structure from the file we're in.

(defun narcissus-entry-published-location (&optional plist)
  (let* ((plist (or plist (org-infile-export-plist)))
         (date (plist-get plist :date))
         (filename (plist-get plist :macro-input-file)))
    (if date
        (destructuring-bind (_ _ _ _ month year _ _ _)
            (org-parse-time-string date)
          (concat 
           (file-name-as-directory "posts")
           (file-name-as-directory (format "%02d" year))
           (file-name-as-directory (format "%02d" month))
           (file-name-as-directory (file-name-nondirectory (file-name-sans-extension filename)))))
      ;; TODO(msnyder): Simple hack for index file.
      (if (string= filename "index.org")
          ""
        (concat
         (file-name-as-directory (file-name-nondirectory (file-name-sans-extension filename))))))))

narcissus-entry-published-location assumes, for the time being, that all entries are in the root of the content folder, and that there is no subdirectorial relationship between them, which are reasonable assumptions to make. In the Webby form of this site, the posts are organized by the directory structure we're generating after the fact in Narcissus. There's no reason not to just stick all the org files in the same place.

This doesn't stop org-publish from giving the generated file the same name as the org file. org-publish has an EXPORT_FILE_NAME parameter, but it's only used for marking a subtree for export. We will be commandeering it later for use in our HTML generation function as a project-wide publishing option.

This also doesn't fail nicely if the entry in question doesn't have a DATE option.

The second part of this is ensuring that links to other org files are mutated correctly. Right now, the index will simply transform the link foo.org into foo.html, which is no longer correct. What should happen is something like foo.org becomes /posts/2011/07/foo/index.html. org-publish uses the function org-html-handle-links to perform this transformation, so we'll write our own function, and replace its use within the HTML export function.

(defun narcissus-html-handle-links (line opt-plist)
  "Return LINE with markup of Org mode links.
OPT-PLIST is the export options list."
  (let ((start 0)
        (current-dir (if buffer-file-name
                         (file-name-directory buffer-file-name)
                       default-directory))
        (link-validate (plist-get opt-plist :link-validation-function))
        type id-file fnc
        rpl path attr desc descp desc1 desc2 link)
    (while (string-match org-bracket-link-analytic-regexp++ line start)
      (setq start (match-beginning 0))
      (setq path (save-match-data (org-link-unescape
                                   (match-string 3 line))))
      (setq type (cond
                  ((match-end 2) (match-string 2 line))
                  ((save-match-data
                     (or (file-name-absolute-p path)
                         (string-match "^\\.\\.?/" path)))
                   "file")
                  (t "internal")))
      (setq path (org-extract-attributes (org-link-unescape path)))
      (setq attr (get-text-property 0 'org-attributes path))
      (setq desc1 (if (match-end 5) (match-string 5 line))
            desc2 (if (match-end 2) (concat type ":" path) path)
            descp (and desc1 (not (equal desc1 desc2)))
            desc (or desc1 desc2))
      ;; Make an image out of the description if that is so wanted
      (when (and descp (org-file-image-p
                        desc org-export-html-inline-image-extensions))
        (save-match-data
          (if (string-match "^file:" desc)
              (setq desc (substring desc (match-end 0)))))
        (setq desc (org-add-props
                       (concat "<img src=\"" desc "\" alt=\"" 
                               (file-name-nondirectory desc) "\"/>")
                       '(org-protected t))))
      (cond
       ((equal type "internal")
        (let
            ((frag-0
              (if (= (string-to-char path) ?#)
                  (substring path 1)
                path)))
          (setq rpl
                (org-html-make-link
                 opt-plist
                 ""
                 ""
                 (org-solidify-link-text
                  (save-match-data (org-link-unescape frag-0))
                  nil)
                 desc attr nil))))
       ((and (equal type "id")
             (setq id-file (org-id-find-id-file path)))
        ;; This is an id: link to another file (if it was the same file,
        ;; it would have become an internal link...)
        (save-match-data
          (setq id-file (file-relative-name
                         id-file
                         (file-name-directory org-current-export-file)))
          (setq rpl
                (org-html-make-link opt-plist
                                    "file" id-file
                                    (concat (if (org-uuidgen-p path) "ID-") path)
                                    desc
                                    attr
                                    nil))))
       ((member type '("http" "https" "gopher"))
        ;; standard URL, can inline as image
        (setq rpl
              (org-html-make-link opt-plist
                                  type path nil
                                  desc
                                  attr
                                  (org-html-should-inline-p path descp))))
       ((member type '("ftp" "mailto" "news"))
        ;; standard URL, can't inline as image
        (setq rpl
              (org-html-make-link opt-plist
                                  type path nil
                                  desc
                                  attr
                                  nil)))

       ((string= type "coderef")
        (let*
            ((coderef-str (format "coderef-%s" path))
             (attr-1
              (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\""
                      coderef-str coderef-str)))
          (setq rpl
                (org-html-make-link opt-plist
                                    type "" coderef-str
                                    (format
                                     (org-export-get-coderef-format
                                      path
                                      (and descp desc))
                                     (cdr (assoc path org-export-code-refs)))
                                    attr-1
                                    nil))))

       ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
        ;; The link protocol has a function for format the link
        (setq rpl
              (save-match-data
                (funcall fnc (org-link-unescape path) desc1 'html))))

       ((string= type "file")
        ;; FILE link
        (save-match-data
          (let*
              ((components
                (if
                    (string-match "::\\(.*\\)" path)
                    (list
                     (replace-match "" t nil path)
                     (match-string 1 path))
                  (list path nil)))

               ;;The proper path, without a fragment
               (path-1
                (first components))

               ;;The raw fragment
               (fragment-0
                (second components))

               ;;Check the fragment.  If it can't be used as
               ;;target fragment we'll pass nil instead.
               (fragment-1
                (if
                    (and fragment-0
                         (not (string-match "^[0-9]*$" fragment-0))
                         (not (string-match "^\\*" fragment-0))
                         (not (string-match "^/.*/$" fragment-0)))
                    (org-solidify-link-text
                     (org-link-unescape fragment-0))
                  nil))
               (desc-2
                ;;Description minus "file:" and ".org"
                (if (string-match "^file:" desc)
                    (let
                        ((desc-1 (replace-match "" t t desc)))
                      (if (string-match "\\.org$" desc-1)
                          (replace-match "" t t desc-1)
                        desc-1))
                  desc)))

            ;; NARCISSUS: Retrieve the full path of the Org file we're
            ;; linking to
            (setq schema "file")
            (if (string-match "\\.org$" path-1)
                (save-excursion
                  (find-file (concat (plist-get opt-plist :base-directory) path-1))
                  (setq path-1 (concat (narcissus-entry-published-location))))
              (if (string-match "^\\." path-1)
                  (progn
                    (setq path-1 (replace-match "" t t path-1))
                    (setq schema ""))))

            (if fragment-0
                (let* ((f-head (car components))
                       (f-tail (cadr components))
                       (exact-heading (if (string-match "^\*+" f-tail)
                                          (replace-match "" t t f-tail)
                                        nil)))
                  (save-excursion
                    (find-file (expand-file-name f-head))
                    (goto-char (org-find-exact-heading-in-directory exact-heading))
                    (if (org-entry-get (point-marker) "SCRAP")
                        (setq path-1 (concat "scraps/" (org-entry-get (point-marker) "EXPORT_FILE_NAME") "/"))))))

            (setq rpl
                  (if
                      (and
                       (functionp link-validate)
                       (not (funcall link-validate path-1 current-dir)))
                      desc
                    (org-html-make-link opt-plist
                                        schema path-1 fragment-1 desc-2 attr
                                        (org-html-should-inline-p path-1 descp)))))))

       (t
        ;; just publish the path, as default
        (setq rpl (concat "@<i>&lt;" type ":"
                          (save-match-data (org-link-unescape path))
                          "&gt;@</i>"))))
      (setq line (replace-match rpl t t line)
            start (+ start (length rpl))))
    line))

Rsync-like publishing

This is as good a section as any to describe the actual org-publish project listing I'm using.

(setq org-publish-project-alist 
      '(
        ("msnyder.info:entries"
         :preamble-wrap-tag "header"
         :postamble-wrap-tag "footer"
         :base-directory "~/Projects/msnyder.info/"
         :base-extension "org"
         :publishing-directory "~/public_html/"
         :export-file-name "index"
         :insert-title-into-body t
         :publishing-function narcissus-publish-entries
         :exclude "index.org"
         :body-wrap-tag "article")
        ("msnyder.info:css"
         :base-directory "~/Projects/msnyder.info/css/"
         :base-extension "css"
         :publishing-directory "~/public_html/css"
         :publishing-function org-publish-attachment)
        ("msnyder.info:assets"
         :base-directory "~/Projects/msnyder.info/"
         :base-extension "png"
         :publishing-directory "~/public_html/"
         :recursive t
         :publishing-function org-publish-attachment)
        ("msnyder.info:index"
         :base-directory "~/Projects/msnyder.info/"
         :base-extension ""
         :index-title ""
         :export-file-name "index"
         :body-wrap-tag "div"
         :preamble-wrap-tag "header"
         :postamble-wrap-tag "footer"
         :include ("index.org")
         :insert-title-into-body nil
         :publishing-directory "~/public_html/"
         :publishing-function narcissus-publish-index)
        ("msnyder.info:index.rss"
         :base-directory "~/Projects/msnyder.info/"
         :base-extension ""
         :include ("index.org")
         :insert-title-into-body nil
         :publishing-directory "~/public_html/"
         :scraps-directory "~/Documents/Org/Notes/"
         :rss-output-filename "rss.xml"
         :rss-title "msnyder.info"
         :rss-link "http://msnyder.info/"
         :rss-language "en"
         :rss-description "the personal essays of Matthew Snyder"
         :rss-copyright "Copyright 2012 Matthew Snyder"
         :publishing-function narcissus-publish-rss)
        ("msnyder.info:scraps"
         :base-directory "~/Documents/Org/Notes/"
         :base-extension "org"
         :body-wrap-tag "article"
         :export-file-name "index"
         :insert-title-into-body t
         :postamble-wrap-tag "footer"
         :preamble-wrap-tag "header"
         :publishing-directory "~/public_html/scraps/"
         :publishing-function narcissus-publish-scraps
         :recursive nil)
        ("msnyder.info:entries.txt"
         :preamble-wrap-tag "header"
         :postamble-wrap-tag "footer"
         :base-directory "~/Projects/msnyder.info/"
         :base-extension "org"
         :publishing-directory "~/msnyder.org.txt/"
         :insert-title-into-body t
         :publishing-function org-publish-org-to-ascii
         :exclude "index.org"
         :body-wrap-tag "article"
         :export-file-name "index")))

Uploading of resources

Everything that a set of entries uses in terms of stylesheets and images should be uploaded intelligently by the tools.

Preview exported HTML before publish

What it says on the tin. I should be able to use the same set of tools to both publish the blog locally for preview (maybe even self-updating) as well as for public consumption.

I've come up with a fairly sneaky way to do this: uploading emacs-httpd to the Marmalade ELPA repo and installing it. Then, when my site gets published to ~/public_html, it's available in the browser at http://0.0.0.0:8080. This is a completely reasonable approach, since we're using a generic tool instead of writing something specific for this purpose.

Mark entries as drafts and don't publish.

Even if a blog entry is in the right directory, all the right tags, etc., a draft property should be introduced that refuses to publish the entry, no matter what.

Mark scraps to publish on separate pages.

Any node should be markable as a 'scrap', which then gets published on a separate page and included in an accessible table of contents.

(defun narcissus-get-scrap (plist filename pub-dir)
  (if (org-entry-get (point-marker) "SCRAP")
      (let ((export-file-name (org-entry-get (point-marker) "EXPORT_FILE_NAME")))
        (org-mark-subtree)
        (org-export-as-narcissus-html 3 t plist nil nil pub-dir))))

(defun narcissus-publish-scraps (plist filename pub-dir)
  (let ((buffer (find-file filename)))
    (org-map-entries (lambda () (narcissus-get-scrap plist filename pub-dir)) t 'file)
    (kill-buffer buffer)))

(defun narcissus-publish-scraps-attachments (plist filename pub-dir)
  "Publish a file with no transformation of any kind.
See `org-publish-org-to' to the list of arguments."
  ;; make sure eshell/cp code is loaded
  (message "Plist: %s" plist)
  (unless (file-directory-p pub-dir)
    (make-directory pub-dir t))
  (or (equal (expand-file-name (file-name-directory filename))
         (file-name-as-directory (expand-file-name pub-dir)))
      (copy-file filename
         (expand-file-name (file-name-nondirectory filename) pub-dir)
         t)))

Miscellaneous

Syntax Highlighting in Code Blocks

Getting code blocks to be properly syntax highlighted requires the program htmlize to be installed. It can be installed through Emacs's package manager. It also makes sense for the variable org-export-htmlize-output-type to be set to css.

Removing Section Numbers

Section numbers seem legalistic and aren't really necessary. Set org-export-with-section-numbers to nil. This can also be set as the parameter :section-numbers in org-publish-project-alist.

Conclusion

In general, I feel like there is an impedance mismatch of sorts between content that Org mode wants to keep track of, and content as it is typically organized for the web. Time after time I came across situations where Org mode wanted a resource of some kind to be located in a certain place, when web development experience said it belonged somewhere else, and these assumptions were typically deeply ingrained in Org mode. For example, I'd like all the assets (images, javascript) for my website to be in one place, organized by subdirectories. However, Org mode decides that an image is unreachable if it can't find it, during linkification, exactly where it was in the filesystem structure. I fought the battles I thought were worth seeing through, and left other ones alone for the time being.

While I love the idea of using Org mode to not only describe the code I'm writing but actually contain that code, there are a few immediate quirks that make it difficult to endorse:

Describing the code in text is equivalent to commenting, which comes with its own maintenance costs and the risk of getting out of sync with the code its describing.
Attempting to alter an existing piece of code is a little hacky, as you can see above: I've placed comments throughout the existing code indicating where I've made changes. I would prefer a more aware kind of system. Something where the existing code is in some repo, and I can refer to it, make my own changes, and the diff is automatically generated for publication. As it stands, if the functions I based Narcissus on change within Org mode, I won't be able to keep up with development unless I take the code from this file and throw it into a repository.

Lisp for the Web, Part II

Fri, 29 Jul 2011 00:00:00 EDT

In this article, I hope to extend Adam Petersen's article Lisp for the Web, bringing up for discussion some of the aspects of web programming that most of us are familiar with.

[TABLE-OF-CONTENTS]

What to Expect

Adam Petersen wrote an awesome article called Lisp for the Web. In it, he walks readers through creating a simple web application using Common Lisp (hereinafter Lisp). It's a fantastic article, and I recently sat down with it (and some other resources) to finally write some code in Lisp.

So what I'd like to do here is take some of the things that were left out (with good reason) of the original article, and flesh out the experience of developing for the web with Lisp. At the end of the article, Mr. Petersen writes that

Due to the dynamic and interactive nature of Lisp it's a perfect fit for prototyping. And because Lisp programs are so easy to evolve, that prototype may end up as a full-blown product one day.

It's my hope that in continuing his tutorial in this way I can show readers how that process from prototype to production may take place; in an organic way that showcases Lisp's 'evolutionary' abilities.

The Original Program

The original program can be found at the Lisp for the Web article. I made some changes to it in order to fit some specific criteria:

The original article recommends using BerkeleyDB for its backend, accessed through the Lisp library Elephant. I'm still using Elephant, though I believe there may be more "Lispy" serialization libraries available — Elephant requires a lot of dips into foreign functions. BerkeleyDB, however, has been swapped out for SQLite. This makes deployment a lot easier, and avoids the licensing hassles that seem to follow BerkeleyDB around.
We are binding the Elephant store to a variable, namely *store*, in case we want to change databases during top-level interaction.
The syntax for starting a server in Hunchentoot has changed since the original article. We now make an instance of a Hunchentoot acceptor in order to get the server bound and running.
The original article uses URLs which end in .htm. For example, the index page is located at /retro-games.htm. There's no reason for this to not simply be /retro-games, and I've changed all URLs to follow this convention. Remember, kids, cool URIs don't reveal their implementation!
To be a bit more inclusive, we are no longer just voting on retro games. Now you can add votes for any game you wish! (This is not really a necessary change, but I don't know many very old games, so at the very least it makes coming up with examples easier.)

So the first thing we're going to do is make these transformations to the original file, and then we can continue working from there.

If you'd like the diff so you can start off with these changes, I've posted it to Gist: game-voter.patch

Your Lisp Environment

The original article, quite wisely, avoids discussing the actual environment in which its Lisp is set up. It's not useful to anyone to have an obsolete description of a Lisp installation. In this case, however, I'd like to take a snapshot of the state of Lisp in certain ways; I am going to describe, to some extent, my setup.

Running OS X 10.6.7, with Steel Bank Common Lisp installed through the excellent homebrew package management system. My editor, REPL, and general Lisp interaction environment is Emacs 23.3, compiled for the Mac by David Caldwell.

The package manager I'm using is the fantastic Quicklisp. I've tried installing packages for Common Lisp before with ASDF, and Quicklisp is so much more simple, capable, and promising it's scary.

Within a REPL, the following command did everything I expected and nothing I didn't: installed the libraries (often called systems) I needed without complaining or breaking, and providing the packages in the top-level.

CL-USER> (ql:quickload '(cl-who hunchentoot parenscript elephant fiveam css-lite cl-json))

Smarter Routes

There was one thing I noticed almost immediately as I was playing around with the program. If I wanted to make a change to a 'controller', i.e. any of the functions defined by define-url-fn, re-evaluating it would simply push another route onto the hunchentoot:*dispatch-table*. This isn't a huge problem per se, but it is unnecessary computation, and after having pushed a hundred or so different versions of a controller dispatch onto the *dispatch-table*, I desired a more practical way of describing the routes in my site. In addition, using a macro such as define-url-fn to describe the routes means that Emacs doesn't recognize that controller function as a valid symbol. It's a silly convenience, but the more I use defmacro and defun, the easier I can find the code I'm looking for with Emacs' symbol lookup.

So for example, the controller for adding a game goes from this:

(define-url-fn (game-added)
  (let ((name (parameter "name")))
    (unless (or (null name) (zerop (length name))) ; In case JavaScript is turned off.
      (add-game name))
    (redirect "/games"))) ; Display the front page.

To this:

(defun controller-game-added ()
  (let ((name (parameter "name")))
    (unless (or (null name) (zerop (length name)))
      (add-game name))
    (redirect "/retro-games")))

Now with a handful of functions, I manually set the *dispatch-table* to the list of routes I desired, using Hunchentoot's dispatcher creation functions.

hunchentoot:create-regex-dispatcher is a function that takes a regular expression for an endpoint, and runs the function named by the second argument upon execution.

(setq *dispatch-table*
 (list
  (create-regex-dispatcher "^/index" 'controller-index)
  (create-regex-dispatcher "^/vote" 'controller-vote)
  (create-regex-dispatcher "^/game-added" 'controller-game-added)
  (create-regex-dispatcher "^/new-game" 'controller-new-game)))

Writing CSS in Lisp

The original tutorial never supplies the CSS it used to style the website. As you can see, I provided some of my own CSS to pretty things up a bit – but you won't see that if you've made it this far into the article. Why? Because we've overwritten the contents of *dispatch-table* with the four routes we've defined above. What we're going to do is define another route for the CSS, but provide the CSS in a Lisp form that then gets translated into CSS for us. This provides us a little bit of flexibility and can help reduce some of the redundancy that CSS tends to accumulate, without resorting to some CSS extension (like Sass or LESS).

The CSS goes in a controller function, just like the other dynamically created pages on the site.

(defun controller-css ()
  (setf (hunchentoot:content-type* hunchentoot:*reply*) "text/css")
  "...")

We set the content-type header to "text/css", which lets web browsers know that the file we're sending is meant to be interpreted as a stylesheet. I've put together a style, and I'll be using some aspects of it to exemplify some points with Lisp, but you're free to style up the site however you'd like. Either way, replace the ellipsis in the code sample above with your style. You can use your CSS verbatim, explicitly using multiple newlines in one string. Lisp strings understand multiple lines without any special indicator:

(setq *some-string* "This is a string that
spans
multiple
lines.")

My CSS style is reproduced at the following link: game-voter.css

We'll be using the css-lite library to generate our CSS. This library exposes one primary method, css, which takes a list of lists, and from them, generates our CSS. Within this list parameter, every other list describes a set of selectors, and the following list is an associated list of css attributes to values. My first translation into css-lite's format looks something like this:

(defun controller-css ()
  (setf (hunchentoot:content-type* hunchentoot:*reply*) "text/css")
  (css-lite:css
    (("body")
     (:width "70%" :margin "0 auto" :font-family "sans-serif"
      :border-left "1px solid #ccc"
      :border-right "1px solid #ccc"
      :border-bottom "1px solid #ccc"))
    (("h1")
     (:font-size "140%" :text-align "center"))
    (("h2")
     (:color "#000" :background-color "#cef" :margin "0 auto" :padding "4px 0"))
    (("#header")
     (:background-color "#cef" :padding "8px"))
    (("#header .logo")
      (:display "block" :margin "0 auto"))
    (("#header .strapline")
     (:display "block" :text-align "center" :font-size "80%" :font-style "italic"))

    ;; and so on ...

So the first thing that stands out is the repetition in describing the border for the body selector. I'm sure there's some CSS way to describe the border, but as an example, we're going to use a variable to encapsulate the border description.

(let ((border "1px solid #ccc"))
  (css-lite:css (("body")
                 (:border-left border
                  :border-right border
                  :border-bottom border))))

Simple enough, but what if we wanted to reduce some more complicated piece of CSS? For example, some CSS3 attributes that are initialized differently for each browser?

The gradient property currently has several different implementations. Here are the selectors provided by a popular CSS3 gradient generator, Alex Sirota's excellent and comprehensive Ultimate CSS Gradient Generator:

background: #1e5799; /* Old browsers */
background: -moz-linear-gradient(top, #1e5799 0%, #2989d8 50%, #207cca 51%, #7db9e8 100%); /* FF3.6+ */
background: -webkit-gradient(linear, left top, left bottom, color-stop(0%,#1e5799), color-stop(50%,#2989d8), color-stop(51%,#207cca), color-stop(100%,#7db9e8)); /* Chrome,Safari4+ */
background: -webkit-linear-gradient(top, #1e5799 0%,#2989d8 50%,#207cca 51%,#7db9e8 100%); /* Chrome10+,Safari5.1+ */
background: -o-linear-gradient(top, #1e5799 0%,#2989d8 50%,#207cca 51%,#7db9e8 100%); /* Opera11.10+ */
background: -ms-linear-gradient(top, #1e5799 0%,#2989d8 50%,#207cca 51%,#7db9e8 100%); /* IE10+ */
background: linear-gradient(top, #1e5799 0%,#2989d8 50%,#207cca 51%,#7db9e8 100%); /* W3C */

What we'd like to do is describe our CSS as having a gradient, and having Lisp do the work of translating it into all the browsers that we want to support.

The first thing to observe is that a lot of the rules use the same basic format – that of the W3C recommendation. It should be easy to apply those rules while just changing the name of the CSS function. Two other things that should jump out at you are:

We should use a fallthrough background of the first color in the pattern for browsers that don't support the gradient at all.
The -webkit-gradient rule reverses the order of the arguments: instead of taking a color and a percentage, it takes a percentage and a color.

The function should return a flattened list of CSS selectors and values. We then pass it to an internal css-lite function, make-css-function, with an identifier that we can use in the css macro.

(defun css-linear-gradient (colors-and-positions)
  (let ((default-background (caar colors-and-positions)))
    (flet ((w3c-spec (name)
             (format nil "~A(top, ~{~{~A ~A%~}~^, ~})" name colors-and-positions))
           (webkit-gradient ()
             (format nil "-webkit-gradient(linear, left top, left bottom, ~{color-stop(~{~A%, ~A~})~^, ~})"
               (mapcar #'reverse colors-and-positions))))
      (list
       :background default-background
       :background (w3c-spec "-moz-linear-gradient")
       :background (webkit-gradient)
       :background (w3c-spec "-webkit-linear-gradient")
       :background (w3c-spec "-o-linear-gradient")
       :background (w3c-spec "-ms-linear-gradient")
       :background (w3c-spec "linear-gradient")))))

(css-lite::make-css-func
  linear-gradient (colors-and-positions) (css-linear-gradient colors-and-positions))

This works roughly the way we expect, generating the different combinations of gradient methods above.

(css-lite:css
  (("body")
   (linear-gradient '(("#1e5799" 0) ("#2989d8" 50) ("#207cca" 51) ("#7db9e8" 100)))))

Using jQuery

The original article used some Javascript to prevent the user from submitting the Game submission form if they tried entering the empty string for the name of the game. It was written in parenscript, a library that translates Lisp code into the appropriate JavaScript. It was a fairly rudimentary implementation, reproduced below:

GAME-VOTER> (ps-inline
             (when (= name.value "")
               (alert "Please enter a name.")
               (return false)))
"javascript:if (name.value === \"\") {
    alert(\"Please enter a name.\");
    return false;
}"

Modal alert boxes such at this one aren't a horrible idea, but there's a more elegant, expected way to handle this sort of behavior: display an inline message to the user on form submission; and what better way to do that than jQuery?

Parenscript is a fantastic library, but it may require some thought and time to get accustomed to its idioms. Most of them make sense in retrospect, but not before you've used them for a while. The good news is, it works perfectly with jQuery once you've put this work in, and Lisp macros can help bridge the gap and make your life easier.

The primary macro used with Parenscript is ps, especially if you'll be injecting the contents of your code directly into <script> tags. Most of Parenscript consists of 'translators' of a kind, turning lisp forms into the appropriate Javascript verbiage. The Parenscript reference is the canonical bible of these translations, succinctly explaining all of these rules and how they may be applied. For now we will take a look at the ones that are relevant to us.

Simple functions have their obvious counterparts.

GAME-VOTER> (ps (+ 1 2))

"1 + 2;"

Attempting to call a function by name is similarly obvious. It's also here that we're pointing out one of Parenscript's transformative properties: to take hyphenated symbols and turn them into a valid Javascript identifier, capitalizing the letters right after the hyphens. This is a necessary change as symbols in Lisp are interned in all capitals.

GAME-VOTER> (ps (makeFunnyNoise))

"makefunnynoise();"

GAME-VOTER> (ps (make-funny-noise))

"makeFunnyNoise();"

Most jQuery programming is accomplished by the passing of anonymous functions. In Parenscript, these functions are created through – how else? – the use of lambda.

GAME-VOTER> (ps (lambda (foo bar) (+ foo bar)))

"function (foo, bar) {
    return foo + bar;
};"

Variables may be defined in various ways; the way that makes the most sense to us is the use of a let binding, which works in much the way you'd expect. This is the best part of Parenscript: it is predictable. You don't have to alter many habits to start using it.

GAME-VOTER> (ps (let ((a 1) (b 2)) (+ a b)))

"var a = 1;
var b = 2;
a + b;"

Objects can be created with the create operator.

GAME-VOTER> (ps (create :url "http://example.com"))

"{ 'url' : 'http://example.com' };"

If we had a (Javascript) Object named foo, and wanted to call its bar function, we would have to use the 'chain' operator in Parenscript, denoted by the @ symbol. We then surround the chain operator with another set of parentheses to indicate that we are calling the result. This is where we also show you that any not-understood symbol is left unmolested, such as foo and bar.

GAME-VOTER> (ps (@ foo bar))

"foo.bar;"

GAME-VOTER> (ps ((@ foo bar)))

"foo.bar();"

This is one of the ways that we would need to access jQuery core function, i.e. to call functions hanging directly off of it, such as $.ajax(). Parameters can be put into the outer parentheses of the chained call.

GAME-VOTER> (ps ((@ $ ajax)))

"$.ajax();"

GAME-VOTER> (ps ((@ $ ajax) (create :url "http://example.com")))

"$.ajax({ 'url' : 'http://example.com' });"

The other way is to call the jQuery selector, for manipulating elements on the page.

GAME-VOTER> (ps ((@ ($ "div.foo") fade-in)))

"$('div.foo').fadeIn();"

With all these things in mind, let's take a look at the jQuery we want to produce on the page:

$(document).ready(function () {
    $('input.btn').click(function () {
        var text = $('input.txt').val().trim();
        if (text == '') {
            $('#error').fadeIn();
            return false;
        };
    });
});

This is my first go at translating it into Parenscript.

GAME-VOTER> (ps ((@ ($ document) ready)
                 (lambda ()
                   ((@ ($ "input.btn") click)
                    (lambda ()
                      (let ((text (chain ($ "input.txt") (val) (trim))))
                        (cond ((equal text "") 
                               ((@ ($ "#error") fade-in))
                               (return false)))))))))

We have some duplication with the code required to prepare an event handler: two lines for document.ready and two lines for $("input.btn").click. Using Parenscript, we can write a Lisp macro and 'install' it into Parenscript's translator, like so.

(defmacro $$ ((selector event-binding) &body body)
  =((@ ($ ,selector) ,event-binding) (lambda () ,@body)))

(import-macros-from-lisp '$$)

import-macros-from-lisp is described in the macro section of the Parenscript documentation. This allows our second attempt to be a lot cleaner.

GAME-VOTER> (ps ($$ (document ready)
                  ($$ ("input.btn" click)
                    (let ((text (chain ($ "input.txt") (val) (trim))))
                      (cond ((equal text "") 
                             ((@ ($ "#error") fade-in))
                             (return false)))))))

Writing a Test Suite

By this point, your little web application should be looking pretty fantastic. It's simple, but powerful and extensible. The refactoring we've done, while fairly cursory, has gone a long way to making sure that more work on the system is possible and easy. There's one section where we're lacking, however, and that's a test suite. Most programmers today have gotten onboard the unit testing bus in some capacity or another. It is possible to go overboard – my feeling is that test suites should contain absurdly small amounts of logic, and be comprised of one or two assertions per unit test. Even then, it's very easy to start testing the wrong behavior, or writing specious tests.

With these thoughts in mind, we're going to write a small, efffective test suite. We will be doing so using the FiveAM library. FiveAM is attractive for a few reasons:

It encapsulates tests into logical units, called suites, much like functions, macros, and classes are broken up into packages.
The assertion operator is simple. is takes a form and if the form evalutates to non-nil, then the assertion passes. If the form evaluates to nil, the assertion fails.
It allows for the use of a wrapping macro called a fixture. While other testing suites use the term 'fixture' to describe pre-constructed data, such as records in a database, FiveAM extends the notion to include the setup and teardown of tests.

The first thing you should do is create a place to put the tests. Off of my main directory, I've simply touched test/test-game-voter.lisp. test-game-voter will be another package, so declare it:

(defpackage test-game-voter
  (:use :cl :game-voter :elephant :fiveam))

(in-package :test-game-voter)

And we'll write a test to make sure everything works as expected. Make sure to enter the package.

TEST-GAME-VOTER> (test sanity
                   (is (= 4 (+ 2 2))))

TEST-GAME-VOTER> (run!)
.
 Did 1 check.
    Pass: 1 (100%)
    Skip: 0 ( 0%)
    Fail: 0 ( 0%)

Pretty nice, eh? Extremely simple. The single period in the output after the run! command is the single passed test, similar to what you'd see in xUnit derivatives. Now let's see what happens when a test fails.

TEST-GAME-VOTER> (test more-sanity
                   (is (= 4 (+ 2 4))))

TEST-GAME-VOTER> (run!)
.f
 Did 2 checks.
    Pass: 1 (50%)
    Skip: 0 ( 0%)
    Fail: 1 (50%)

 Failure Details:
 --------------------------------
 MORE-SANITY []: 
      (+ 2 4) evaluated to 6, which is not = to 4..
 --------------------------------

Again, a huge amount of detail. Now, remove those tests from the suite with (rem-test 'sanity) and (rem-test 'more-sanity). We have real tests to write.

The first unit tests we're going to tackle are on the model level -- making sure the game class we created in the first tutorial works the way we expect. However, it's a persistent class, and we want to make sure we're saving test instances somewhere else other than our public database. So that's the first step: defining an Elephant configuration and controller to house this new data. The second step is making sure we compartmentalize our model tests into a model suite.

(defparameter *test-database-config*
  '(:clsql (:sqlite3 "test-store"))
  "The connection information and filename of the database used in the
test suite.")

(defparameter *test-database-controller*
  (open-store *test-database-config*)
  "The database controller for the test suite. We open one here so
that every test run doesn't open more.")

(def-suite :suite-game-voter-model)
(in-suite :suite-game-voter-model)

The next part is going to be a little tricky. We don't want every single test adding its own results to the database, and then using that dirtied database in the next test. Elephant exposes database transaction management to us, but that's not quite good enough. We need to be able to specify that the transaction should be aborted. This is going to involve diving into the internals of what makes Elephant go: the clsql-sys and db-clsql packages.

Without getting too much into it, I will say this. *test-database-controller* is our instance of the data store. Stored on it is the information used to track transactions, including the status of the transaction. This field can be set manually, and if Elephant attempts to close a transaction and finds that it has failed, it rolls it back entirely. How does it know if it's failed? It checks to see if the transaction status is :aborted.

With that explanation in mind, here's what we're looking at in terms of code. This may not be the most elegant way of dealing with it, but it works nicely for our purposes.

(def-fixture db-fixtures ()
  (with-transaction (:store-controller *test-database-controller*)
    (&body)
    (setf (clsql-sys::transaction-status
           (clsql-sys::transaction
            (db-clsql::controller-db *test-database-controller*))) :aborted)))

def-fixture is a FiveAM macro. It works almost exactly like defmacro, instead placing the described macro into FiveAM's own repertoire of fixtures. with-transaction is within Elephant's namespace, and takes an associated list of options. In this case we want to make sure the transaction is occuring on our test controller. The &body tag is implicit with def-fixture, so we don't need to provide it in the argument list. Finally, we setf the status of the transaction we're in to :aborted. When with-transaction hits the end of this form, it will see the transaction 'failed', and roll back everything we've done in the body.

Now let's begin writing some tests! Off the top of my head, I can think of a couple things we'd like to test: adding a game, voting for a game, getting a game based on its name, and ensuring we can tell if a game is stored by passing its name. We'll start with adding a game.

(test test-add-game-name
    (with-fixture db-fixtures ()
      (let ((game (game-voter::add-game "test game")))
        (is (equal "test game" (game-voter::name game))))))

(test test-add-game-votes
    (with-fixture db-fixtures ()
      (let ((game (game-voter::add-game "test game")))
        (is (= 0 (game-voter::votes game))))))

Call run! again and check out the results. Did you get two passing checks? Notice that run! reports the total number of checks, or assertions, and not the number of tests. This is because FiveAM will continue through a test even if a check fails, and report the passing status of all the checks in a test.

Note that we have to use the double-colon notation for our game functions, since we haven't made them externally visible from our game-voter package.

This is looking good, but we can remove just a sliver of duplication by writing a macro for tests we know will be using the database. To wit:

(defmacro db-test (test-name &body body)
  `(test ,test-name
     (with-fixture db-fixtures ()
       ,@body)))

(db-test test-add-game-name
  (let ((game (game-voter::add-game "test game")))
    (is (equal "test game" (game-voter::name game)))))

Write some more tests. Make sure that game-from-name returns correct values for games that are or aren't in the system. Make sure adding a game with a duplicate name fails. Then, write something like this:

(db-test test-sanitized-game-name
  (game-voter::add-game "Foo")
  (game-voter::add-game "  Foo  ")
  (is (= 1 (length (game-voter::games)))))

Well, that fails! We aren't sanitizing our input! This isn't even caught on the client side. This is what writing good tests is about -- finding small pieces of behavior that fail in unexpected ways.

We can ensure that the server takes care of extra padding around the game name by trimming it. string-trim takes a string called a char bag, and then the string you wish to trim. Since all strings are array of characters, string-trim walks through the char bag and removes instances of each character from both sides of your argument.

We can modify the add-game function as below:

(defun add-game (name)
  (let ((sanitized-name (string-trim " " name)))
    (with-transaction ()
      (unless (game-stored? sanitized-name)
        (make-instance 'persistent-game :name sanitized-name)))))

Once the new function is evaluated, running the test suite again should pass.

Conclusion

There's a lot of places to go from here. The CSS we wrote gets generated on every load. A caching mechanism would be nice. There's no way to delete entries, or to make sure unscrupulous people aren't voting more than once. It would be cool if we added some information to the games, such as publisher, year, and so on – maybe even box art and screenshots, which would mean dealing with file uploads. We don't have tests for our controller functions.

However, we've brought our little game voter a little closer to a solid, robust modern web application. I hope I've managed to show off how easy it is to extend and refactor a small Lisp project, and have piqued your interest into giving it a try for web development. You'll be amazed how easy it is to start thinking in Lisp.

The Myth of the Heartbeat Friend or: How I Learned to Stop Worrying And Tell Facebook to Fuck Off

Sat, 28 May 2011 00:00:00 EDT

I am done with Facebook. This is for several reasons, most of them uninteresting and pedantic. However, I’d like to take this time to express some thoughts on Facebook and social networks in general.

Facebook is just one random website that we all choose to flock to. There is nothing special about it, nothing specific. Just as everybody once had AIM or Yahoo! chat accounts, just as everybody uses Gmail; everyone uses Facebook now. It has grown to occupy a non-trivial amount of space in our shared culture. It is also demeaning, patronizing, and a dangerous threat to our privacy.

It already has an air of staleness about it, and once our children grow up and start looking for ways to social network, they will find it filled with out-of-touch, older people (that’s us, by the way) and find another avenue to express themselves. Facebook will never die completely, but rather fade off into obscurity while newer, more modern sources of social interaction pop up. People will be urged to join the latest and greatest social network, fragmenting their on-line identities even more. I am perturbed by the idea of having an ‘on-line identity’ in the first place; if I must, I’d rather have as much control over it as possible.

So what is to be done? I shall explain the route I am taking, as an example. I will fill my Facebook with random data. I’ll probably do this two or three times, in case Facebook’s database keeps profile changes past one or two revisions. I will edit my comments when possible, and remove them when necessary. Then I will delete my account completely.

After this, I will direct people to my personal website: http://msnyder.info. On this site is and will be everything that is important to me: cogent entries, a photo gallery, links to compelling websites and essays. Everything I use Facebook for, under my own purview and my own ‘privacy controls’. The work I’m doing on this site is far from complete, but I am optimistic I will be able to create a safe space for myself, the people who care about me, and those who are passionate about the same things as I.

The communication aspect of Facebook is the more difficult one. Social networks encourage a specific kind of social interaction. This kind is public, curt, succinct, and transient. It does not encourage reasoned discussion, articulation, or privacy. This is because Facebook is not interested in friendship as people typically define it. Facebook is interested in friendship because a group of friends forms a graph, and the more nodes they connect with relationships, the more explicit the graph, the more money is made off of these relationships. With Facebook, friendship is a unit of currency; moreso, it devalues the actual value of friendship in favor of a heartbeat system: pulses in a news feed ensuring that the people we care about and cherish are still updating their feeds. This isn’t friendship. This isn’t even social interaction. It’s an addiction to updates, a demand for the dopamine that floods our system when we see a post on our wall, or an update in our feed.

So while I am foregoing this instant-gratification syndrome that Facebook has cultivated, I still wish to hear from people. How? Any way! Text messages, IMs, rambling e-mails, handwritten letters. I desire a return to the form of writing that has worked perfectly well for thousands of years. If you want to write me a letter, send me a message; I’ll happily reply with my snail-mail address. In the past the collected letters of authors, playwrights, artists, and politicians were bound and published as meaningful and visceral insights into their lives. I doubt anyone will ever do the same for their status updates.

Some people may take umbrage with my opinion of Facebook. One argument which has already surfaced is, “But what about Gmail? Google could be reading your e-mail and you’re not doing anything about it, and you’re certainly not writing winding blog entries about that.” Yes, I will continue to use Gmail. Why? Because I trust Gmail. This is not the case with Facebook. If and when Gmail violates that trust, I will enact PGP privacy controls, I will look to another e-mail provider, and eventually host my own e-mail server, if it becomes necessary. That’s one of the main issues in this whole crazy game: trust. Facebook and its partners have already proved time and time again that they care very little for the privacy and well-being of its users, and not at all for the trust that is nurtured between users and service providers.

So, adieu. If you’d like to get in touch with me after this, and don’t know how to at the moment, you can find my e-mail address quite easily by visiting my website. Just remember: m snyder dot info. Simple.

And remember, in Facebook, as on other social networks, and all different paths of life: "If you're not paying for it, you're not the customer; you are the product being sold."

Fallout 2 Journal Part I

Sun, 17 Oct 2010 00:00:00 EDT

Note: It should be more than obvious that I will be discussing Fallout 2 in such a way that involves spoilers. Don't read this article, or any article in this series, if you intend on a spoiler-free Fallout 2 experience.

I finally decided to sit down and put some time into Fallout 2. I anticipated a quirky, post-apocalyptic romp through an America stuck in the bizarro 1950s, punctuated with engaging gunfights. In effect, the only thing I knew about the game was that it was an isometric RPG, and the only thing i knew about the canon and atmosphere was informed by Fallout 3. My expectations were almost immediately shot down, and I couldn't be happier.

Fallout 2 is unforgiving. It is stark, desolate, at once brutal and sensitive, at once expansive and detailed. I haven't put more than ten hours or so into it, and it is easily one of the most difficult games I have ever played. Once again, I couldn't be happier.

I downloaded Fallout 2 off of Steam and applied Killap's Restoration Project, more for the ability to play at higher resolution than for the patched content, which I glanced at in summary but didn't absorb. The patch accommodated my request to play at 1680x1050 but I found it difficult to read the HUD text at that size, and switched to a more reasonable 1024x768.

The impression that you get from Fallout 3 is that the America affected by the nuclear war was flash-frozen in a psuedo-1950s, and that the recovering civilization from then on was simmered in that specific atmosphere. In Fallout 2—at least in my playthrough so far—this couldn't be further from the truth. Your character hails from what can only be described as savage. The places you visit don't have enough set pieces to simulate any kind of ambiance. The basic descriptive language is: "dry, rotting, dirty, low". Even cities that have been touched by industry follow this pattern; hollowed out husks of buildings, drug-addled vagrants wandering the streets mumbling to themselves in chemical hazes. In Fallout 3 the happy-go-lucky Galaxy News Radio and the lost-in-the-Golden-era residents were an ironic counterpoint to the world they inhabited. In Fallout 2, there is no room for irony. These are people for which every day in a struggle, and any day could be their last. The stage is appropriately set.

I spent about an hour in the introductory temple, and got my ass handed to me so consistently I swore it was an incongruity in how I rolled my character. I rolled again, taking care to pay attention to the attributes I enhanced, and the abilities I tagged. The next time through was a little easier, but I still saved before and after every single fight, and used most of my action points per turn running away from my enemies so they wouldn't have points left, after catching up to me, to get in an attack.

The artificial economy is incredibly well done. I wandered into my first city loaded up with Radscorpion tails, wondering what kind of firearms I'd be able to barter for. The answer? None. There were none of any kind available. At best I was able to steal a basic rifle: a pop gun in comparison to my foes. Even after I had trudged through the quests of the first city, and made my way to the second one, there was at most one pistol and one machine gun available for purchase. The pistol was 30 times more expensive than the cash I had on hand; the machine gun, even more expensive than that. It gave the impression of a deserted, empty world. This wasn't Fallout 3, with spare rifles and grenades around every corner.

As unprepared as I was for the combat and difficulty, I was even more so for how the game reacted to me. I traipsed into a bar looking for information and trade. The bartender had nothing to trade but women and whiskey, the latter being 20 dollars a glass. On a whim, I chose a dialog option insulting him for the steep price of his booze. He got into a fight with me about it. I said something else stupid, and we left the dialog screen and entered combat when he punched me in the gut. By about this time, I had had enough of people trying to beat me up for whatever arbitrary reason, so I kicked him in the groin and shot the fucker. If you've had any experience with Fallout 3, this would be the time when you reloaded, since killing a member of a community typically sets that whole community against you. In Fallout 2, in this case: no one moved. The entire bar was docile, staring into their glasses. Steeped in roleplay, I imagined this was just another day of reckless violence for them. There were no loyalties; there was another bar where they could drink. When I returned to the town some time later, a sign had been placed over the entrance to the bar: Out of Business. That was incredible to me.

My playthrough ended, for the time being, based on my own stupidity. I fell through a trap rug in a deserted farm, to find a group of people who had eked an existence out underground. They asked me to return a letter to the surface, and I dropped it somewhere in a cornfield. After spending about twenty or so minutes clicking around trying to find it, I gave up, and discovered I hadn't saved in the past half hour.

I'm probably going to roll again, and pay much more attention to the things I'm trying to accomplish in the game. I'll chronicle that in another entry. For now, some final thoughts and advice:

Combat is a bitch, and you need to pare it down at the beginning just to survive. You will be running away, a lot, from things you believe you are equipped to handle. Combat is also monumentally frustrating at the default speed. Change it before you go insane.
It helps to actually equip your party.
Use of healing powder includes a dent to your Perception skill. Only use it when you know you can sacrifice the hit. Maybe there's another drug to counteract that effect, but then you introduce addiction, etc.

msnyder.info

iCloud Reminders in Org-mode: Talking to OS X with Emacs

Background

Environment Setup

Building ffigen

Generating the Foreign Function Interface

Explaining the Bridge

Methods in Objective-C

Memory Management

Miscellaneous

Introducing nsclasp

Implementation

First Steps: Retrieving Calendar Names

First Steps: Creating a CalTask

First Steps: Retrieving Changes

Next Steps

Conclusion

On Web Sanity

The DNS Level

The Browser Level

From Spec to Test Suite in Common Lisp: Mustache

The Basics

Parsing the Spec

Our Implementation

The Test Suite

Reporting Results

Introducing gopher.el

Getting it

Using it

Contributing

The Future

Clozure CL and Xcode 4

Introducing Narcissus: An Org Mode Blogger

Description and Requirements (Progress [33%])

Reusing Components

HTML5 Generation

RSS Generation

Preserves existing URL structure

Rsync-like publishing

Uploading of resources

Preview exported HTML before publish

Mark entries as drafts and don't publish.

Mark scraps to publish on separate pages.

Miscellaneous

Syntax Highlighting in Code Blocks

Removing Section Numbers

Conclusion

Lisp for the Web, Part II

What to Expect

The Original Program

Your Lisp Environment

Smarter Routes

Writing CSS in Lisp

Using jQuery

Writing a Test Suite

Conclusion

The Myth of the Heartbeat Friend or: How I Learned to Stop Worrying And Tell Facebook to Fuck Off

Fallout 2 Journal Part I

Building `ffigen`

Introducing `nsclasp`

First Steps: Creating a `CalTask`