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
-----------------------------------------------------------------------------
Hilmar Lapp e-mail: hlapp_at_deep-thought.biologie.uni-freiburg.de
Institut f. Biologie II
http://www.biologie.uni-freiburg.de/~hili/hili.html
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
(append-elements
(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)
(begin
(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
#t)
)
(define (include-only-dirs f)
(if (file-is-directory? f) #t
#f)
)
(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)))
(update-files
(lambda (d)
(fill-file-listbox
(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)
update-files
include-only-dirs "*")
(select-file (string->widget lfile)
file-double-click
include-only-files "*")
)
)
)
(simple-select-file-dialog)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; end ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Received on Tue Feb 14 1995 - 22:19:50 CET