Written on 2024-01-30 by Daniel 'jackdaniel' Kochmański

Preliminary steps
Embracing the chaos
Presentations
Managing a blog collection
Managing a blog instance
Big ball of mud
Closing thoughts

Coleslaw is a "Flexible Lisp Blogware". It is a program that I'm using to manage my blogs and allows for an offline blog compilation. The functionality of the website may be extended with plugins and the visual appearance is defined by configurable themes.

Its design is straightforward (if not a bit messy), so it is a good candidate to show how to slap a CLIM interface on top of existing software. The integration will be very shallow to not encroach into Coleslaw responsibilities, yet deep enough to provide a convenience utility over the library.

Preliminary steps

In this post we will use a few dependencies. Of course one of them is mcclim. Please make sure that you are using an up-to-date version; i.e clone it from the repository to ~/quicklisp/local-projects. There are other dependencies too. Load them all in the REPL with:

(ql:quickload '(coleslaw-cli cl-fad alexandria local-time
                mcclim clouseau hunchentoot)
              :verbose t)

The whole program described in this tutorial is defined in a single package:

(defpackage "COLESLAW-GUI"
  (:use "CLIM-LISP"))
(in-package "COLESLAW-GUI")

We are good to go now.

Embracing the chaos

The README.md in the project's repository mentions a few commands that may be invoked from the command line and from the lisp REPL. What they have in common is that they assume, that the blog resides in the current working directory. Here we are going to introduce a macro that estabilishes a necessary context:

(defmacro with-current-directory ((path value) &body body)
  `(let* ((,path (cl-fad:pathname-as-directory ,value))
          (*default-pathname-defaults* ,path))
     (ensure-directories-exist ,path)
     (uiop:chdir ,path)
     ,@body))

Moreover Coleslaw assumes that only one blog will be loaded during its lifetime and many objects are treated as singletons. We will embrace this chaos and provide a macro that estabilishes an appropriate environment for a blog. The key to each environment is its directory pathname:

;;; Allow for passing "env" here.
(defun blog-key (blog)
  (etypecase blog
    (null nil)
    (cons (coleslaw:repo-dir (first blog)))
    (coleslaw::blog (coleslaw:repo-dir blog))))

(defun blog () coleslaw:*config*)
(defun site () coleslaw::*site*)

(defun make-null-env ()
  (list nil (make-hash-table :test #'equal)))

(defun copy-blog-env ()
  (list coleslaw:*config*
        coleslaw::*site*))

(defun load-blog-env (env)
  (destructuring-bind (blog site)
      (or env (make-null-env))
    (setf coleslaw:*config* blog
          coleslaw::*site* site)
    ;; Populates *ALL-TAGS* and *ALL-MONTHS* using *SITE*.
    (coleslaw::update-content-metadata)))

(defun save-blog-env (table)
  (when table
    (setf (gethash (blog-key coleslaw:*config*) table)
          (copy-blog-env))))

(defmacro with-blog-env ((env table) &body body)
  `(let (coleslaw:*config*
         coleslaw::*site*)
     (load-blog-env ,env)
     (multiple-value-prog1 (progn ,@body)
       (save-blog-env ,table))))

Presentations

First we will define presentation types, so we can associate them with objects on the screen. The blog environment is composed of a pair:

a blog: an instance of the class coleslaw::blog
a site: a hash table that contains posts

(clim:define-presentation-type coleslaw::blog () :description "(Configuration)")

(clim:define-presentation-type blog-env () :description "(Blog)")

Presentation types are like types denoted by classes, but with a twist - they may be additionally parametrized; i.e (INTEGER 3) is a presentation type. There are also an abstract presentation types that are not tied to a single class. For example we may have presentation types "red team" and "blue team", where some arbitrary objects are presented as one or the another.

The presentation method present is used to associate the object with the presentation type and put it on the screen as the presentation. In other words the presentation is a pair (object type). The method specializes arguments:

object: most notably the object class, sometimes left unspecialized
type: obligatory specialization to the presentation type (may be abstract)
stream: typically left unspecialized, but may be utilized for serialization
view: customizes how the object is presented depending on the local context

The most primitive view is the textual view. Methods specializing to it should treat the stream as if it handles only text, so the representation should be a string. Note that presentations may be nested, like in our case:

(clim:define-presentation-method clim:present
    (self (type coleslaw::blog) stream (view clim:textual-view) &key acceptably for-context-type)
  (declare (ignore view acceptably for-context-type))
  (format stream "~a" (blog-key self)))

(clim:define-presentation-method clim:present
    (env (type blog-env) stream (view clim:textual-view) &key acceptably for-context-type)
  (declare (ignore acceptably for-context-type))
  (with-blog-env (env nil)
    (princ "[" stream)
    (clim:present (blog) 'coleslaw::blog :stream stream :view view)
    (princ "]" stream)))

Managing a blog collection

The system coleslaw-cli that is bundled with coleslaw defines commands that allow for creating a blog, adding (stub) post files to it, compiling the blog to the staging area and deploying the blog using plugins.

We are going to extend this set of operations to allow working with a collection of blogs. Since we are not barbarians, we are going to encapsulate the state in the application frame, and not in a global variable.

(clim:define-application-frame coleslaw-cli ()
  ((envs :initform (make-hash-table :test #'equal) :reader envs)))

Adding new blogs to the collection is a result of opening them or creating new ones. Both operations require for the program to operate in a target directory:

(clim:define-command (com-open-blog :name t :command-table coleslaw-cli)
    ((directory 'pathname))
  (clim:with-application-frame (frame)
    (with-current-directory (path directory)
      (with-blog-env (nil (envs frame))
        (format *query-io* "Opening a blog in ~s.~%" path)
        (coleslaw::load-config path)))))

(clim:define-command (com-make-blog :name t :command-table coleslaw-cli)
    ((directory 'pathname))
  (clim:with-application-frame (frame)
    (with-current-directory (path directory)
      (with-blog-env (nil (envs frame))
        (format *query-io* "Creating a new blog in ~s. " path)
        (coleslaw-cli:setup)
        (coleslaw::load-config path)))))

We need a command to list loaded blogs. All remaining operations will specialize to presentation types blog-env and coleslaw::blog, so we will present them with the function present:

(clim:define-command (com-list-blogs :name t :command-table coleslaw-cli)
    ()
  (clim:with-application-frame (frame)
    (dolist (env (alexandria:hash-table-values (envs frame)))
      (clim:present env 'blog-env :stream (clim:frame-query-io frame)
                                  :single-box t)
      (terpri (clim:frame-query-io frame)))))

For completness we need a command that will remove a blog from the collection.

(clim:define-command (com-close-blog :name t :command-table coleslaw-cli)
    ((self 'blog-env))
  (clim:with-application-frame (frame)
    (remhash (blog-key self) (envs frame))))

Finally there are two very important commands that compile the blog. Note that both commands will fail if there are no posts in the blog (coleslaw behavior).

(clim:define-command (com-stage-blog :name t :command-table coleslaw-cli)
    ((self 'blog-env))
  (clim:with-application-frame (frame)
    (with-current-directory (path (blog-key self))
      (with-blog-env (self (envs frame))
        (format *query-io* "Staging the blog from ~s. " path)
        (coleslaw-cli:stage)))))

(clim:define-command (com-deploy-blog :name t :command-table coleslaw-cli)
    ((self 'blog-env))
  (clim:with-application-frame (frame)
    (with-current-directory (path (blog-key self))
      (with-blog-env (self (envs frame))
        (format *query-io* "Deploying the blog from ~s. " path)
        (coleslaw-cli:deploy)))))

Additionally we define a few convenience commands:

creating test data
clearing the screen

(clim:define-command (com-spam-blogs :name t :command-table coleslaw-cli)
    ()
  (dotimes (i 8)
    (let ((d (format nil "/tmp/blogs/specimen-~2,'0d/" i)))
      (if (probe-file d)
          (com-open-blog d)
          (with-current-directory (path d)
            (com-make-blog d)
            ;; Without any content "Stage" and "Deploy" will fail.
            (coleslaw-cli:new))))))

(clim:define-command (com-clear :name t :command-table coleslaw-cli)
    ()
  (clim:with-application-frame (frame)
    (clim:window-clear (clim:frame-query-io frame))))

Now to execute a command on the blog we may type the command name and select an element from the list (with a pointer). We want also to allow the user to click on the blog with the right pointer button and select the operation without explicitly typing the command, so we define presentation to command translators:

(macrolet ((def (name command short-description long-description)
             `(clim:define-presentation-to-command-translator ,name
                  (blog-env ,command coleslaw-cli
                   :gesture nil
                   :documentation ,short-description
                   :pointer-documentation ,long-description)
                  (self)
                `(,self))))
  (def trn-close-blog  com-close-blog  "Close"  "Remove blog from collection")
  (def trn-stage-blog  com-stage-blog  "Stage"  "Compile blog to staging area")
  (def trn-deploy-blog com-deploy-blog "Deploy" "Compile blog to production"))

Moreover we'd like to be able to type the blog from the keyboard, so we define a presentation method accept that matches the blog against loaded ones.

(clim:define-presentation-method clim:accept
    ((type blog-env) stream (view clim:textual-view) &rest args)
  (declare (ignore args))
  (clim:with-application-frame (frame)
    (clim:completing-from-suggestions (stream)
      (maphash (lambda (key val)
                 (clim:suggest (namestring key) val))
               (envs frame)))))

This concludes our command line blog manager. We've mentioned the following topics:

application frame: defines the dynamic context of the application
command table: defines available commands and translators
presentation types: specify ontologies that may be shared among programs
presentation methods: specify interactions like present and accept

Managing a blog instance

Until now we've been working with the interactor and the textual view. Focusing first on presentation types and commands is good, because it captures an essence of the application interface and delays distracting stuff like visuals. Now, to make this post more appealing (less appalling?), we will extend the application with additional functionality.

The display function is responsible for presenting content on the application stream. It may be anything really, but we will defer it to a method PRESENT specialized to the frame itself. That's the purest approach. We also define a few utilities for later.

(defun display (object stream)
  (clim:present object (clim:presentation-type-of object) :stream stream))

(defun present* (object stream)
  (clim:present object (clim:presentation-type-of object) :stream stream))

(defmacro dohash (((key val) hash &optional result) &body body)
  (let ((cont (gensym)))
    `(flet ((,cont (,key ,val) ,@body))
       (declare (dynamic-extent (function ,cont)))
       (maphash (function ,cont) ,hash)
       ,result)))

(defun format-today ()
  (local-time:format-timestring nil (local-time:now)
                                :format '((:year 4) "-" (:month 2) "-" (:day 2) "-"
                                          (:hour 2) "-" (:min 2) "-" (:sec 2))))

Our application frame will feature graphics and other fluff to cater to people who are into this kind of thing. To do that we define a separate view class that extends the textual-view. While we are technically subclassing it, this is not a semantically correct description. In reality we are extending the class with non-textual capabilities. If you were looking for CLOS conceptual limits, then here you have one.

;;; KLUDGE: FANCY-VIEW extends (not specializes) the TEXTUAL-VIEW.
(defclass fancy-view (clim:textual-view) ())
(defvar +fancy-view+ (make-instance 'fancy-view))

Finally the application frame definition. It inherits from coleslaw-cli and adds a new application pane to show the frame state.

(clim:define-application-frame coleslaw-gui (coleslaw-cli)
  ((current-blog :initform nil :accessor current-blog))
  (:command-table (coleslaw-gui :inherit-from (coleslaw-cli)))
  (:reinitialize-frames t)
  (:panes (app :application :display-function 'display :default-view +fancy-view+
               :text-margins '(:left 20 :top 10))
          (int :interactor)))

Now we define new commands to load content, select a loaded blog and create a new blog. Loading the content is the operation that walks directories and adds found resources to the model.

(clim:define-command (com-update :command-table coleslaw-gui)
    ((self 'blog-env))
  (clim:with-application-frame (frame)
    (with-current-directory (path (blog-key self))
      (with-blog-env (self (envs frame))
        ;; This function removes content from *site* before adding it back.
        (coleslaw::load-content)))))

(clim:define-command (com-select :command-table coleslaw-gui)
    ((self 'blog-env))
  (clim:with-application-frame (frame)
    (setf (current-blog frame) self)
    (com-update self)))

(clim:define-command (com-create :name t :command-table coleslaw-cli)
    ((self 'blog-env)
     (type 'string :default "post")
     (name 'string :default (format-today)))
  (clim:with-application-frame (frame)
    (with-current-directory (path (blog-key self))
      (with-blog-env (self (envs frame))
        ;; This function removes content from *site* before adding it back.
        (coleslaw-cli:new type name)
        (com-update self)))))

(macrolet ((def (name command gesture short-description long-description)
             `(clim:define-presentation-to-command-translator ,name
                  (blog-env ,command coleslaw-gui
                   :gesture ,gesture
                   :documentation ,short-description
                   :pointer-documentation ,long-description)
                  (self)
                `(,self))))
  (def trn-update com-update nil     "Update"  "Update blog from disk")
  (def trn-select com-select :select "Select"  "Show blog details")
  (def trn-create com-create nil     "Create"  "Create new content"))

The implementation of the present method specializes to fancy-view. First we show the list of opened blogs (using the textual view), and then we show the selected blog. Rendering of the current blog is defered to another present method.

The current blog will show the same content as it is presented on the list above, until we define a specialized method. Note that we present it so it is not sensitive to pointer clicks. This is to avoid unnecessary noise.

(clim:define-presentation-method clim:present
    ((frame coleslaw-gui) (type coleslaw-gui) stream (view fancy-view) &rest args)
  (declare (ignore args))
  (clim:formatting-item-list (stream)
   (dohash ((dir env) (envs frame))
     (declare (ignore dir))
     (clim:formatting-cell (stream)
       (clim:with-drawing-options (stream :ink (if (eql env (current-blog frame))
                                                   clim:+dark-red+
                                                   clim:+foreground-ink+))
         (clim:present env 'blog-env :stream stream :view clim:+textual-view+ :single-box t)))))
  (terpri stream)
  (clim:present (current-blog frame) 'blog-env :stream stream :view view
                                               :sensitive nil
                                               :allow-sensitive-inferiors t))

Presenting the current blog will be implemented as follows:

Show the blog title – header text style
Show available commands – deliberely goofy icons
Show the blog content – defered to the next method

(clim:define-presentation-type coleslaw::index ()
  :description "(Index)")

(clim:define-presentation-type site ()
  :description "(Site)")

(clim:define-presentation-type post ()
  :description "(Post)")

(clim:define-presentation-type post ()
  :description "(Page)")

(defun gap-the-gap (stream command label color)
  (clim:with-output-as-presentation (stream command '(clim:command :command-table coleslaw-gui))
    (clim:with-room-for-graphics (stream :first-quadrant nil)
      (clim:draw-circle* stream 0 0 40 :ink clim:+dark-red+ :filled nil :line-thickness 20)
      (clim:surrounding-output-with-border (stream :filled t :ink color)
        (clim:draw-text* stream label 0 0 :align-x :center :align-y :center
                                          :text-size :small
                                          :text-family :fix
                                          :ink clim:+white+)))))

(clim:define-presentation-method clim:present
    ((self cons) (type blog-env) stream (view fancy-view) &rest args)
  (declare (ignore args))
  (clim:with-application-frame (frame)
    (with-blog-env (self (envs frame))
      ;; Blog title
      (clim:with-text-style (stream (clim:make-text-style :serif :bold :large))
        (format stream "~a" (coleslaw:title (blog))))
      (terpri stream)
      ;; Update the blog bleeper
      (gap-the-gap stream `(com-update ,self) "Mind the gap!" clim:+dark-blue+)
      (princ " " stream)
      (gap-the-gap stream `(com-create ,self "post" ,(format-today)) "Fill the gap!" clim:+dark-green+)
      (princ " " stream)
      (gap-the-gap stream `(com-create ,self "page" ,(format-today)) "Keep the gap!" clim:+dark-red+)
      (terpri stream)
      ;; The content
      (clim:present (site) 'site :stream stream :view view))))

(clim:define-presentation-method clim:present
    (self (type site) stream (view fancy-view) &rest args)
  (declare (ignore args))
  (clim:formatting-table (stream)
   (dohash ((key val) self)
     (clim:formatting-row (stream)
       (clim:formatting-cell (stream) (present* key stream))
       (clim:formatting-cell (stream) (present* val stream))))))

The discovered content is stored in a hash table. Keys are URL addresses and values are content objects: posts, rss feeds, tag feeds and indexes. Values are presented, so these presentations may be selected with a pointer when the input context matches. For example we may invoke the inspector or a file editor:

(clim:define-presentation-action act-open-content
    (coleslaw::content nil coleslaw-gui
     :documentation "Open file"
     :pointer-documentation "Open the content file")
    (object)
  (uiop:launch-program (format nil "xdg-open ~a" (coleslaw::content-file object))))

(clim:define-presentation-action act-kill-content
    (coleslaw::content nil coleslaw-gui
     :documentation "Kill file"
     :pointer-documentation "Kill the content file")
    (object)
  (clim:with-application-frame (frame)
    (with-current-directory (dir (blog-key (current-blog frame)))
      (uiop:launch-program (format nil "rm ~a" (coleslaw::content-file object))))
    (clim:execute-frame-command frame `(com-update ,(current-blog frame)))))

(clim:define-presentation-action act-inspect
    ((or coleslaw::blog coleslaw::content coleslaw::feed coleslaw::index) nil coleslaw-gui
     :gesture nil
     :documentation "Inspect content"
     :pointer-documentation "Inspect site content")
  (object)
  (clouseau:inspect object :new-process t))

A difference between actions and commands is that actions are not expected to change the internal model, so they don't progress the display loop. Now we may click on a post and the default program that opens the file will be launched. We may also right-click on the content value and inspect it with clouseau.

In this section I've mentioned the following topics:

the textual view may be extended with graphical capabilities (i.e colors)
display function is a function that creates presentations on the stream
presentation translators may be used to call a command from a presentation
presentation method present may be nested inside another one
presentation types are used as specializers in presentation methods
it is possible to present on the stream a command along with arguments
presentation actions, unlike commands, are executed immedietely

Big ball of mud

Previously we've extended the application by specifying a new display function. Now we will extend it further by adding a web server to preview a blog.

(clim:define-application-frame durk (coleslaw-gui)
  ((acceptor :initarg :acceptor :accessor acceptor))
  (:panes
   (app :application :display-function 'display :default-view +fancy-view+)
   (int :interactor :height 100))
  (:reinitialize-frames t)
  (:command-table (durk :inherit-from (coleslaw-gui)))
  (:default-initargs :acceptor nil))

;;; We could enable and disable commands by calilng (SETF CLIM:COMMAND-ENABLED).
(defmethod clim:command-enabled (name (frame durk))
  (case name
    (com-stop-acceptor (hunchentoot:started-p (acceptor frame)))
    (com-start-acceptor (not (hunchentoot:started-p (acceptor frame))))
    (otherwise (call-next-method))))

(defmethod clim:adopt-frame :after (fm (self durk))
  (format *debug-io* "Booting up.~%")
  (setf (acceptor self) (make-instance 'hunchentoot:easy-acceptor :port 4242))
  (setf hunchentoot:*dispatch-table*
        (list (hunchentoot:create-static-file-dispatcher-and-handler "/" "/tmp/coleslaw/index.html")
              (hunchentoot:create-folder-dispatcher-and-handler "/" "/tmp/coleslaw/"))))

(defmethod clim:disown-frame :before (fm (self durk))
  (format *debug-io* "Cleaning up.~%")
  (when (hunchentoot:started-p (acceptor self))
    (hunchentoot:stop (acceptor self))))

(define-durk-command (com-start-acceptor)
    ((self 'hunchentoot:acceptor :gesture :select))
  (format *debug-io* "Starting acceptor.~%")
  (hunchentoot:start self))

(define-durk-command (com-stop-acceptor)
    ((self 'hunchentoot:acceptor :gesture :select))
  (format *debug-io* "Stopping acceptor.~%")
  (hunchentoot:stop self))

Here's the key part: instead of defining single method for presenting the frame, we define a :before method that presents named commands and the acceptor:

(clim:define-presentation-method clim:present :before ((self durk) (type durk) stream view &rest args)
  (declare (ignore args))
  (clim:formatting-item-list (stream)
    (clim:map-over-command-table-names
     (lambda (name command)
       (declare (ignore name))
       (clim:formatting-cell (stream)
         (clim:surrounding-output-with-border (stream)
          (clim:present command 'clim:command :stream stream))))
     (clim:find-command-table 'durk)))
  (terpri stream)
  (present* (acceptor self) stream)
  (terpri stream))

(clim:define-presentation-method clim:present
    ((self hunchentoot:acceptor) (type hunchentoot:acceptor) stream view &rest args)
  (declare (ignore view args))
  (clim:with-drawing-options (stream :ink (if (hunchentoot:started-p self)
                                              clim:+dark-green+
                                              clim:+dark-red+))
    (format stream "~a~%" self)))

In this section I mentioned the following topics:

presentation methods may have auxiliary methods like :after
we may extend existing applications by tweaking presentation methods and view
it is possible to enable and disable commands depending on the frame state
the frame life cycle starts when it is adopted, and ends when it is disowned
we may mix formatting macros, drawing options and stream output freely

And voila, now we can preview the blog:

Closing thoughts

In this post we've covered many CLIM features that are useful for writing applications. Some takeaways are:

commands have a straightforward interpretation compatible with CLI
command tables encapsulate commands and may inherit from each other
frames encapsulate the dynamic context and organize windows
presentations allow for associating a presentation type with an object
presentation types may be used to specialize numerous presentation methods
views provide an easy way to customize the interface depending on context
presentation translators may be used to coerce object to the input context
presentation actions allow for triggering immediate handlers
commands may be conditionally disabled
the display function may be extended by specializing the function present

Adding an ad-hoc GUI to existing libraries amounts for not so many lines of code and is moderately easy task. You may find the source code of this tutorial here:

/static/misc/coleslaw-gui.lisp

While the tool is rather on the simplistic side, I'm already using it to preview and manage a few of my blogs. Some extensions are due, but they'd rather make the tutorial more complex - contrary to the intention of this post.

Happy hacking,
Daniel

Writing an ad hoc GUI for Coleslaw