Writing Ltk extensions

It is difficult to give a fully generic set of instructions how to write Ltk extensions, as some part of it depends on the package that is to be wrapped, but at the example of the tix extension set, a very common case can be shown. For sake of brevity, here only the creation of a partial implementation of the tixBalloon widget is demonstrated.

The first step is to create a Lisp package to host the extension library:

(defpackage "LTK-TIX"
  (:use "COMMON-LISP"
        "LTK")
  (:export
        "BALLOON"
        "BALLOON-BIND"))

(in-package ltk-tix)

It creates a package called ltk-tix, based on common-lisp, and of course ltk. It exports two symbols balloon for the widget class to create and balloon-bind a function defined on this widget.

As the usage of the Tix extension requires a tcl statement to be run before any widget is used, the proper way for this would be to put it onto the *init-wish-hook* which is run after the startup of wish:

(eval-when (:load-toplevel)
  (setf *init-wish-hook* (append *init-wish-hook*
                                 (list (lambda ()
                                   (send-wish "package require Tix"))
                                 ))))

Now we need to create the Lisp class that wraps the balloon widget. First we need a class definition:

(defclass balloon (widget)
  ())

Unless there are some special storage needs, an empty sub-class of widget is all one needs. What is still missing, is the Tk code to actually create the widget. It is put in the initialize-instance after-method for the widget class. This is easy to do when we look how the widget is created on the Tk side:

tixBalloon pathname

where pathname is the path string describing the widget to be created. This translates into Lisp code as:

(defmethod initialize-instance :after ((b balloon) &key)
  (format-wish "tixBalloon ~a" (path b)))

path is an accessor function created for the widget class. The corresponding slot is automatically filled in the initialize-instance method for the widget class. Now we can create instances of the balloon widget, what is left to do is to define the methods upon it.

We want to implement the bind command upon the balloon widget. First lets again look at the Tk side of it:

pathname bind widget options

pathname is the path of the balloon widget, widget is another widget for which the balloon help should be displayed and options are additional command options. The following options should be implemented:

-msg text Sets the displayed message to text.

-balloonmsg text Sets the balloon message to text.

-statusmsg text Sets the statusbar message to text.

To implement it, we need to define a generic function: ²

(defgeneric balloon-bind (b w &key msg balloonmsg statusmsg))

We call this balloon-bind to avoid name conflicts with the function bind defined by the Ltk package. It is a generic function of two parameters, the balloon widget and the widget the message should be bound to. The message is to be specified by the keyword parameters. The actual implementation of the generic function is very straight forward and looks like this:

(defmethod balloon-bind ((balloon balloon) (widget widget) 
                             &key msg balloonmsg statusmsg)
  (format-wish "~a bind ~a~@[ -msg {~a}~]~
                          ~@[ -balloonmsg {~a}~]~
                          ~@[ -statusmsg {~a}~]" 
      (path balloon) (path widget) msg balloonmsg statusmsg))

Format wish is a wrapper around the format function, that sends the output to wish and automaticalls flushes the output buffer, so that the statement is directly executed by wish. It is worth noting, that the Lisp format function has some very nice options, allowing us to elegantly implement the optional keyword arguments. The ~@[ ~] format directive peeks at the next argument in the list and only when it is non-nil, the format code inside is executed, otherwise, this argument will be consumed. As unspecified keyword argumends are set to nil, if no argument is specified this nicely fits to this format directive. So ~@[ -msg {~a}~] will output nothing, if the argument msg is not given at the invokation of balloon-bind, or print `` -msg xxx'', where xxx is the content specified for the msg argument.