From: Hilmar Lapp <>
Date: Tue, 14 Feb 1995 22:25:37 +0000

Hi all

seems like I'm running into the same problem as some other people in
these days.

I am currently writing an application (most likely no difference to
anyone else in this mailing list), which needs a user-friendly file
selection popup. Something that is required by many apps and that should
be a good starting point for learning how to program dialog popups.

I'd like to have two listboxes, which one of them interacting with the
other: one of them to change directories, the other to select files. That
means, double-clicking into the first should change the contents of the
second, while double-clicking into the second selects a file.

My implementation can be seen in the appendix; the binding is done using
a local lambda expression (bound to a variable) and the address-of
function (thanks for your hint a few days ago, Erick; I wouldn't have had
this idea on my own). If you try this, everything will seem to work fine,
but be a little patient and click around through various directories.
As you will see, after the 9th to 12th (this varies) directory change
there's nothing fine any more:

*** Read from string error:
eval: bad function in : "(#[unknown 18 b0068])"
**** Tk error ("") ""

After this point, the callbacks of both listboxes seem to be screwed up.

Why ? Am I doing something completely wrong ? Why doesn't this happen on
the first or second double-click ?

(Since I'm a newbie to STk, I'm asking with great caution: Is there any
possibility, that this is a bug of STk-2.1.5 ?)

virtually yours

Hilmar Lapp e-mail:
Institut f. Biologie II
Universitaet Freiburg phone : +49 761 203 2656

;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;; simple file selection ;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;; popup ;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;

;; stolen from widgetinit.stk
(define (->string obj)
  (cond ((string? obj) obj)
        ((number? obj) (number->string obj))
        ((symbol? obj) (symbol->string obj))
        ((tk-command? obj) (widget->string obj))
        ((widget? obj) (widget->string obj))
        (else (error "Cannot convert ~S to a string" obj))))

;; constructs a new widget command string out of all arguments
(define (& . wl)
        (letrec ((append-elements
                    (lambda (s l)
                       (if (null? l) s
                                (string-append s (->string (car l)))
                                (cdr l)
                (append-elements "" wl)

;; Makes the listbox lbox into a file selection listbox.
;; Binds double-click mouse button 1 to call sel-proc with the selection
;; as argument. If selection is a directory, then the directory is entered
;; before.
;; selproc must therefore be a procedure accepting at least one argument.
;; mask denotes the directory search mask and defaults to "*".
;; include? must be a procedure taking one argument and decides, whether
;; or not the file given as argument should be included into the list.
(define (select-file lbox selproc include? . mask)
        (letrec ((handle-selection
                    (lambda ()
                       (if (null? (lbox 'curselection)) #f
                           (let ((file (string-append
                                          (getcwd) "/" (selection 'get))))
                                (if (file-is-directory? file)
                                          (apply fill-file-listbox
                                               lbox file include? mask)
                                          (selproc file))
                                    (selproc file)
                (apply fill-file-listbox lbox (getcwd) include? mask)
                (bind lbox "<Double-Button-1>"
                           (address-of handle-selection))

;; some examples for the above include?
(define (include-only-files f)
        (if (file-is-directory? f) #f
(define (include-only-dirs f)
        (if (file-is-directory? f) #t

(define (fill-file-listbox lbox dir include? . mask)
        (let ((gmask (if (null? mask) "*" (car mask))))
             (if (> (string-length dir) 0) (chdir dir))
             (lbox 'delete 0 'end)
             (for-each (lambda (f)
                          (if (include? f) (lbox 'insert 'end f)))
                       (sort (glob gmask "." "..") string<?))

;; pops up a file selection window with one listbox for changing the
;; directory and another to select files
(define (simple-select-file-dialog)
        (let ((w (toplevel ".test")))
             (letrec ((file-double-click
                           (lambda (f)
                              (display f) (newline)))
                           (lambda (d)
                                           (string->widget lfile) ""
                                           include-only-files "*")
                     (sbyd (& w ".sbyd"))
                     (ldirs (& w ".ldirs"))
                     (sbyf (& w ".sbyf"))
                     (lfile (& w ".lfile")))
                     ; directories' listbox
                     (scrollbar sbyd :command (& ldirs " 'yview"))
                     (listbox ldirs :yscroll (& sbyd " 'set"))
                     ; files' listbox
                     (scrollbar sbyf :command (& lfile " 'yview"))
                     (listbox lfile :yscroll (& sbyf " 'set"))
                     ; arrange listboxes
                     (pack ldirs sbyd lfile sbyf :side "left" :fill "y")
                     ; fill the listboxes with sense
                     (select-file (string->widget ldirs)
                                  include-only-dirs "*")
                     (select-file (string->widget lfile)
                                  include-only-files "*")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; end ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Received on Tue Feb 14 1995 - 22:19:50 CET

This archive was generated by hypermail 2.3.0 : Mon Jul 21 2014 - 19:38:59 CEST