[plt-scheme] Multi-column list box control?

From: praimon (praimon at gmail.com)
Date: Sat Aug 30 12:20:46 EDT 2008

Let me add my encouragement for such a widget. Almost
every app I use has this, often as the main interface.
Something this basic should've been a part of mred from
the beginning.

What I end up doing is simulating columns by feeding
fixed-width text to the canvas, but this leaves a lot
to be desired (no easy way to resize the columns).

Below is my initial attempt to get to first base on this.
It's been mentioned a few times that side-by-side list-boxes
could be used, but on winxp I can't eliminate the unsightly
column borders, even with border size set to zero. So I've
used side-by-side editor-canvases.

There's a couple of problems here: rows, as opposed to
columns, can't be selected. And code has to be added to
resize the headings/columns when the mouse is dragged :)
Lots of easy stuff has been omitted, like sorting the
columns when a heading is clicked and using non-editable

As you can see, I'm a complete novice - here's hoping
that someone who knows what they're doing can work up
a widget.


#lang scheme/gui

(define dir-pane%
  (class horizontal-panel%
    (init-field parent)
    (init cols)
    (define colnums cols)
    (init input)
    (define wrapped-input
      (map (lambda (li)
             (map (lambda (s)
                    (string-append s "\n")) li)) input))
    (init headings)
    (define heads headings)
    (super-new [parent parent])
    (let loop ([n 0])
        [(= n colnums) (void)]
         (letrec ([vpan (new vertical-panel% [parent this])]
                  [but (new dir-button% [parent vpan]
                            [label (list-ref heads n)])]
                  [canv (new dir-canvas% [parent vpan])]
                  [txt (new text%)])
           (send canv set-editor txt)
           (send txt insert (apply string-append
                                   (map (lambda (s) (list-ref s n))
           (loop (add1 n)))]))))

(define dir-canvas% (class editor-canvas%
                       [style '(no-border hide-hscroll hide-vscroll)])))

(define dir-button%
  (class button%
     [vert-margin 0]
     [horiz-margin 0]
     [stretchable-width #t])
    (define/override (on-subwindow-event rec ev)
      (let ([b-width (send rec get-width)])
        (cond [(or (send ev entering?) (send ev moving?))
               (when (not  ;don't understand why 'not' is needed?
                      (or (< (send ev get-x) 4) (< (- b-width (send ev
get-x)) 5)))
                 (send rec set-cursor (make-object cursor% 'size-e/w)))
               ;to do: while the arrows cursor is visible,
               ;dragging the mouse should, at the very least,
               ;resize the adjacent buttons and canvases
              [else (super on-subwindow-event rec ev)])))))

(define f (new frame% [label "dir test"]
               [width 200]
               [height 200]))
(define test (new dir-pane% [cols 3] [parent f]
                  [headings '("field 1" "field 2" "field 3")]
                  [input '(("first" "second" "third")
                           ("fourth" "fifth" "sixth")
                           ("seventh" "eighth" "ninth"))]))
(send f show #t)

Posted on the users mailing list.