Q)Listbox vs Scroll-Listbox

From: Jong-Won Choi <jwchoi_at_gsenl5.gsen.goldstar.co.kr>
Date: Sat Dec 30 08:18:41 1995

Hi Stkloser,

I wrote following code - it looks like work good:

-----------------------------------------------------------------
;;; Start of actual translation of the book pp.170 of Tcl/Tk book
(let ((top (make <Toplevel>)))
  (let ((colors (make <Listbox> :parent top))
        (in-port (open-input-file "/usr/lib/X11/rgb.dir")))
    (read-line in-port) ; Skip top-line
    (do ((str-line (read-line in-port) (read-line in-port)))
        ((eof-object? str-line))
        (insert colors "end" (my-get-field str-line 4)))
    (close-input-port in-port)
    (bind colors "<Double-Button-1>" `(set! (background ,(address-of colors))
                                            (selection 'get)))
    (pack colors)))
-------------------------------------------------------

But when I switched to scroll-listbox, it didn't work:

---------------------------------------------
;;; another simple extension - scroll-listbox

(let ((top (make <Toplevel>)))
  (let ((colors (make <Scroll-Listbox> :parent top))
        (in-port (open-input-file "/usr/lib/X11/rgb.dir")))
    (read-line in-port) ; Skip top-line
    (do ((str-line (read-line in-port) (read-line in-port)))
        ((eof-object? str-line))
        (insert colors "end" (my-get-field str-line 4)))
    (close-input-port in-port)
    (bind colors "<Double-Button-1>" `(set! (background ,(address-of colors))
                                            (selection 'get)))
    (pack colors)))
-----------------------------------------

What's wrong? Any ideas/comments?


If you want to try my code add following defintions:

------------------------------------------------

;;; First, we need utility functions
;;;
(define (get-field string index . punctuators)
  (let ((str-lst (str->str-list string punctuators)))
    (if (< (length str-lst) index)
        #f
      (list-ref str-lst (1- index)))))

;;; "foo bar" - > ("foo" "bar") when punctuator-lst is (#\space)
(define (str->str-list str-line punctuator-lst)
  (let loop ((chr-lst-lst (str->char-lst-lst str-line punctuator-lst))
             (result '()))
       (if (null? chr-lst-lst)
           (reverse result)
         (loop (cdr chr-lst-lst)
               (cons (apply string (car chr-lst-lst)) result)))))

;;; "foo bar" -> ((#\f #\o #\o) (#\b #\a #\r)) when punctuator-lst is (#\space)
(define (str->char-lst-lst str-line punctuator-lst)
  (let loop ((ch-lst (string->list str-line)) (result '()) (local-result '()))
       (if (null? ch-lst)
           (if (null? local-result)
               (reverse result)
             (reverse (cons (reverse local-result) result)))
         (if (member (car ch-lst) punctuator-lst)
             (if (null? local-result)
                 (loop (cdr ch-lst) result '())
               (loop (cdr ch-lst) (cons (reverse local-result) result) '()))
           (loop (cdr ch-lst) result (cons (car ch-lst) local-result))))))

;;; define a sugar
(define (my-get-field string index)
  (get-field string index #\space #\ht))

Thanks,

Jong-Won Choi

=======================++=====================================
 R&D DA DEVELOPMENT ||
     DM TEAM ||
 LG Semicon Co., Ltd. || Direct: +82 (2)526-4052
 16, Woomyeon-dong, || Fax: +82 (2)526-4136
 Seocho-gu, Seoul, || email: jwchoi_at_gsen.goldstar.co.kr
 137-140, Korea. ||
=======================++=====================================
Received on Sat Dec 30 1995 - 08:18:41 CET