Tidier widget trees

[Neil Jerram]

Programming in guile-gnome is of course generally great fun, but there
is one aspect of it that I have found quite frustrating - namely, the
untidiness of the code that tends to emerge when creating a
non-trivial widget tree.

I think a large cause of this untidiness is the need for a temporary
variable whenever one is dealing with a container class.  For example,
a <gtk-vbox> typically requires

- one statement to create it

     (define vbox1 (make <gtk-vbox>))

- one statement to add or pack it into its container

     (add container vbox1)

- N statements to add or pack each of its own children

     (pack-start vbox1 ...)
     (pack-start vbox1 ...)
     
But then after that, vbox1 is probably never used again.

To address (or conceal) this, I've now written a macro that allows me
to create a widget tree like this ...

(let ((ok-button #f))
  (add window
       (create-widget <gtk-vbox>
                      (pack-start #:expand #t
                                  #:fill #t
                                  <gtk-scrolled-window>
                                  (add <gtk-text-view>))
                      (pack-start <gtk-label> #:label "Hello there!")
                      (pack-start <gtk-hbox>
                                  #:spacing 10
                                  (pack-end <gtk-button> #:label "Quit"
                                            (connect 'clicked
                                                     (lambda _ 
(gtk-main-quit))))
                                  (pack-end <gtk-button> #:label "Cancel")
                                  (pack-end <gtk-button> #:label "OK"
                                            (name ok-button)))))
  (connect ok-button
           'clicked
           (lambda _ (display "OK!\n"))))

... which I find a lot neater.  (My definition of create-widget is
appended below, in case anyone would like to use it.)

The point of this email is that I was wondering if other guile-gnome
users had similar thoughts, and/or if others have already built up a
similar macro / pseudo-language for specifying a widget tree.

Regards,
     Neil


(define (split-leading-keys spec)
  (let loop ((keys '())
             (spec spec))
    (if (or (null? spec)
            (not (keyword? (car spec))))
        (list (reverse keys) spec)
        (loop (cons* (cadr spec) (car spec) keys)
              (cddr spec)))))

(define-macro (create-widget class . rest)
  (apply (lambda (keys children)
           `(let ((w (make ,class ,@keys)))
              ,@(map (lambda (child-spec)
                       (case (car child-spec)
                         ((add)
                          (apply (lambda (keys rest)
                                   `(add/keys w (create-widget ,@rest) ,@keys))
                                 (split-leading-keys (cdr child-spec))))
                         ((pack-start)
                          (apply (lambda (keys rest)
                                   `(pack-start/keys w (create-widget ,@rest) 
,@keys))
                                 (split-leading-keys (cdr child-spec))))
                         ((pack-end)
                          (apply (lambda (keys rest)
                                   `(pack-end/keys w (create-widget ,@rest) 
,@keys))
                                 (split-leading-keys (cdr child-spec))))
                         ((name)
                          `(set! ,(cadr child-spec) w))
                         ((connect)
                          `(connect w ,@(cdr child-spec)))))
                     children)
              w))
         (split-leading-keys rest)))

(define (get-key-val keys key default)
  (cond ((memq key keys) => cadr)
        (else default)))

(define (add/keys w child . keys)
  (add w child))

(define (pack-start/keys w child . keys)
  (pack-start w
              child
              (get-key-val keys #:expand #f)
              (get-key-val keys #:fill #f)
              (get-key-val keys #:padding 0)))

(define (pack-end/keys w child . keys)
  (pack-end w
            child
            (get-key-val keys #:expand #f)
            (get-key-val keys #:fill #f)
            (get-key-val keys #:padding 0)))