LTk and listboxes

Scrolling a listbox is a common requirement in many apps. The Tk listbox widget is very useful also because one can pack huge amounts of data in it very quickly. I was planning to use it for some data display functionality. So the experimentation started with a simple scrolling listbox. The first test was this

(defun test-scroll ()

  (with-ltk

      (let* ((vs (make-instance 'scrollbar))

	     (hs (make-instance 'scrollbar :orientation "horizontal"))

	     (lb (make-instance 'listbox)))

	(progn

	  (configure vs "command" (concatenate 'string (path lb) " yview"))

	  (configure hs "command" (concatenate 'string (path lb) " xview"))

	  (configure lb "yscrollcommand" (concatenate 'string (path vs) " set"))

	  (configure lb "xscrollcommand" (concatenate 'string (path hs) " set"))

	  (listbox-append lb (apply #'* (loop for x from 1 to 100 collect x)))

	  (listbox-append lb (loop for x from 1 to 100 collect x))

	  (grid lb 0 0 :sticky "snew")

	  (grid vs 0 1 :sticky "ns")

	  (grid hs 1 0 :sticky "ew")))))

The xscrolling is redundant here but I wanted to try it anyway. Peter Herth (the author of LTk) also informed me that the PROGN is not needed. I still like to put it there anyway. So one thing I needed to try is scrolling multiple listboxes. This code has Peter's fix and the PROGN comment.

(defun test-scroll-3 ()

  (with-ltk

      (let* ((s1 (make-instance 'scrollbar))

             (lb1 (make-instance 'listbox))

             (lb2 (make-instance 'listbox)))

        (progn  ;; you do not need a progn here...

	;;; just define the tcl function by sending it to wish:

	  (ltk::send-w

	   "proc ScrollListboxes {listboxes args} {

                foreach lb $listboxes {

                        eval $lb yview $args

                }

           }")        

          ;; now configuring the scrollbar works as in tk:

          (configure s1 "command" (format nil "ScrollListboxes {~a ~a}" (path lb1) (path lb2)))

          (configure lb1 "yscrollcommand" (concatenate 'string (path s1) " set"))

          (configure lb2 "yscrollcommand" (concatenate 'string (path s1) " set"))

          (listbox-append lb1 (loop for x from 1 to 20 collect x))

          (listbox-append lb2 (loop for x from 1 to 20 collect x))

          (grid lb1 0 0 :sticky "news")

          (grid lb2 0 1 :sticky "news")

          (grid s1 0 2 :sticky "ns")

          (listbox-append lb1 (loop for x from 21 to 40 collect x))

          (listbox-append lb2 (loop for x from 21 to 40 collect x))))))

And based on this, I came up with this for data display

(defun data-display (colnames data)

  (with-ltk

      (let ((ld (length colnames)))

	(let* ((df (make-instance 'frame))

	       (lbs (loop for i from 1 to ld collect (make-instance 'listbox :master df)))

	       (sb (make-instance 'scrollbar :master df)))

	       (ltk::send-w

		"proc ScrollListboxes {listboxes args} {

                    foreach lb $listboxes {

                            eval $lb yview $args

                    }

              }")        

	       (mapcar #'(lambda (lbox)

			   (configure lbox "yscrollcommand" (concatenate 'string (path sb) " set"))) lbs)

	       (configure sb "command"

			  (format nil "ScrollListboxes {~{~a ~}}"

				  (mapcar #'(lambda (lb) (path lb)) lbs)))

	       (wm-title *tk* "Result Set")

	       (configure df "width" 800)

	       (configure df "height" 600)

	       (pack df :expand 1 :fill "both")

	       (loop for y from 0 to (1- ld) and name in colnames do

		    (let ((lbl (make-instance 'label :text name :master df)))

		      (grid lbl 0 y :sticky "w")))

	       (loop for y from 0 to (1- ld) and lbx in lbs do

		    (grid lbx 1 y))

	       (grid sb 1 ld :sticky "ns")

	       (loop for y from 0 to (1- ld) and lbx in lbs do

		    (listbox-append lbx (mapcar #'(lambda (row) (nth y row)) data)))))))

This can be called as shown below. The two args are the field names and the data. Buggy but functional.

(data-display '("foo" "bar" "baz") '((a b c) (d e f) ("blah" "blah" "blah")))

Now, if only I can figure out how to limit this from jumping of the screen and proper horizontal scrolling, it might be more useful