gpsman 6.4.4.2-2 / usr / lib / gpsman / gendials.tcl

#
# This file is part of:
#
#  gpsman --- GPS Manager: a manager for GPS receiver data
#
# Copyright (c) 1998-2013 Miguel Filgueiras migfilg@t-online.de
#
#    This program is free software; you can redistribute it and/or modify
#      it under the terms of the GNU General Public License as published by
#      the Free Software Foundation; either version 3 of the License, or
#      (at your option) any later version.
#
#      This program is distributed in the hope that it will be useful,
#      but WITHOUT ANY WARRANTY; without even the implied warranty of
#      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#      GNU General Public License for more details.
#
#      You should have received a copy of the GNU General Public License
#      along with this program.
#
#  File: gendials.tcl
#  Last change:  6 October 2013
#
# Includes contributions by
#  - Brian Baulch (baulchb_AT_onthenet.com.au) marked "BSB contribution"
#  - Stefan Heinen (stefan.heinen_AT_djh-freeweb.de) marked "SH contribution"
#

  # creating toplevels

proc GMToplevel {w title geom trans prots binds} {
    # create a toplevel with given geometry
    #   $w      window path
    #   $title  if not empty title given as either "==TITLE" for TITLE,
    #            or as an index in TXT array
    #   $trans  if not void is path of window of which $w is a transient
    #   $prots  list with in sequence a wm protocol and a command
    #   $binds  list with in sequence an event and a command
    # return $w
    global TXT

    if { $title != "" && ! [regsub {^==} $title "" title] } {
	set title $TXT($title)
    }
    toplevel $w
    if { $title != "" } { wm title $w "$title/GPSMan" }
    wm geometry $w $geom
    if { $trans != {} } { wm transient $w $trans }
    wm group $w .
    foreach {p c} $prots { wm protocol $w $p $c }
    foreach {e c} $binds { bind $w $e $c }
    return $w
}

  # modal dialogs

proc GMMessage {mess args} {
    # create modal dialog for displaying message
    #  if $args=="wait"  return only when user acknowledges message
    #      except in command-line mode or if using the slow op window
    # single button: OK; binding: return
    global COLOUR EPOSX EPOSY TXT UNIX CMDLINE

    if { $CMDLINE } {
	puts stderr $mess
	flush stderr
	return
    }
    if { [winfo exists .slowop] } {
	SlowOpMessage $mess
	return
    }
    if { [winfo exists .mess] } {
	# add new message
	foreach s [pack slaves .mess.fr] {
	    if { $s == ".mess.fr.ok" } { break }
	    set last $s
	}
	if { ! [regexp {^\.mess\.fr\.text(.*)$} $last x n] } {
	    BUG bad last message field in .mess
	    return
	}
	if { $n == "" } {
	    set n 1
	} else {
	    if { $n == 4 } {
		.mess.fr.text4 configure -text $mess
		update idletasks
		return
	    }
	    incr n
	}
	label .mess.fr.text$n -text $mess
	pack .mess.fr.text$n -side top -pady 5 -before .mess.fr.ok
	update idletasks
	return
    }
    # this avoids bugs but may create havoc with grabs
    set gs [grab current]
    GMToplevel .mess message +$EPOSX+$EPOSY . \
        [list WM_DELETE_WINDOW  [list DestroyRGrabs .mess $gs]] \
        [list <Key-Return> [list DestroyRGrabs .mess $gs]]
    if { ! $UNIX } {
	# SH contribution
	focus .mess
    }

    frame .mess.fr -borderwidth 5 -bg $COLOUR(messbg)
    label .mess.fr.title -text "!!!" -relief sunken
    label .mess.fr.text -text $mess
    button .mess.fr.ok -text $TXT(ok) -command [list DestroyRGrabs .mess $gs]
    pack .mess.fr -side top
    # changes in packing order must be reflected above when adding
    #  new messages to existing window
    pack .mess.fr.title .mess.fr.text .mess.fr.ok -side top -pady 5
    RaiseWindow .mess
    update idletasks
    grab .mess
    if { $args == "wait" } {
	while 1 {
	    after 500
	    update
	    if { ! [winfo exists .mess] } { return }
	}
    }
    return
}

proc GMConfirm {mess} {
    # create modal dialog for asking for confirmation
    #  buttons: OK, Cancel; bindings: return, delete
    global GMResConf COLOUR EPOSX EPOSY TXT CMDLINE

    if { $CMDLINE } { return 1 }
    destroy .messres
    GMToplevel .messres message +$EPOSX+$EPOSY . \
        {WM_DELETE_WINDOW {set GMResConf 0}} \
        [list <Key-Return> {set GMResConf 1} \
	     <Key-Delete> {set GMResConf 0}]

    frame .messres.fr -borderwidth 5 -bg $COLOUR(confbg)
    label .messres.fr.title -text "???" -relief sunken
    label .messres.fr.text -text $mess
    frame .messres.fr.bs
    button .messres.fr.bs.ok -text $TXT(ok) -command { set GMResConf 1 }
    button .messres.fr.bs.cancel -text $TXT(no) -command { set GMResConf 0 }
    pack .messres.fr.bs.ok .messres.fr.bs.cancel -side left -pady 5
    pack .messres.fr.title .messres.fr.text .messres.fr.bs -side top -pady 5
    pack .messres.fr -side top
    update idletasks
    set gs [grab current]
    grab .messres
    RaiseWindow .messres
    tkwait variable GMResConf
    DestroyRGrabs .messres $gs
    update idletasks
    return $GMResConf
}

proc GMSelect {mess blist vlist} {
    # create modal dialog for selecting values from $vlist under names in
    #  $blist; if an element in $blist has the form  @LIST  then the
    #  corresponding $vlist element is a list with one less element than LIST
    # menubuttons are created for each @LIST element whose label is the
    #  first element of LIST, buttons being used for the other elements
    #  bindings: return for first, delete for last element, or their
    #   first elements in case of @LIST
    # (see proc GMChooseFrom for selection using a listbox)
    global GMResSel COLOUR EPOSX EPOSY TXT

    # assumes first and last elements of vlist are return values for
    #  Return and Delete keys, respectively

    destroy .messres
    set e [lindex $blist 0]
    if { [string first "@" $e] == 0 } {
	set e [lindex [lindex $vlist 0] 0]
    } else { set e [lindex $vlist 0] }
    GMToplevel .messres selection +$EPOSX+$EPOSY . \
        [list WM_DELETE_WINDOW  "set GMResSel [lindex $vlist 0]"] \
        [list <Key-Return> "set GMResSel $e"]

    frame .messres.fr -borderwidth 5 -bg $COLOUR(selbg)
    label .messres.fr.title -text "???" -relief sunken
    label .messres.fr.text -text $mess
    frame .messres.fr.frsel
    set max 4 ; set c 0 ; set r 0 ; set lval "" ; set menus 0
    foreach e $blist v $vlist {
	set b .messres.fr.frsel.b$r$c
	if { [regexp {^@(.+)$} $e x e] } {
	    if { [llength $e] != [llength $v]+1 } {
		BUG GMSelect bad lengths of @LIST lists
	    }
	    incr menus
	    set lval [lindex $v 0]
	    menubutton $b -text [lindex $e 0] -menu $b.m
	    menu $b.m
	    foreach x [lreplace $e 0 0] y $v {
		$b.m add command -label $x -command "set GMResSel $y"
	    }
	} else {
	    set lval $v
	    button $b -text $e -command "set GMResSel $v"
	}
	grid $b -column $c -row $r -sticky ew
	if { [incr c] >= $max } {
	    set c 0 ; incr r
	}
    }
    bind .messres <Key-Delete> "set GMResSel $lval"

    pack .messres.fr -side top
    pack .messres.fr.title .messres.fr.text .messres.fr.frsel -side top -pady 5
    set gs [grab current]
    update idletasks
    grab .messres
    if { $menus } {
	Raise .messres
    } else { RaiseWindow .messres }
    tkwait variable GMResSel
    DestroyRGrabs .messres $gs
    update idletasks
    return $GMResSel
}

proc GMChooseFrom {how mess wd blist vlist args} {
    # create modal dialog for selecting elements from list $blist
    #  with associated return values in $vlist
    #  $how in {single, many, many_0} defines number of elements that can
    #   be selected, many_0 meaning that 0 is an alternative
    # a listbox is used with width $wd
    #  $args if present is a pair with $vars $descs, suitable for use
    #   with proc GMSetupParams, so that parameters may be selected
    # buttons: OK, Cancel
    # bindings: return for commit, extended select mode on listbox,
    #  make visible by initial char on listbox
    # return list with selected values upon normal termination, and
    #  an empty list or -1 if $how==many_0
    # (see also proc GMSelect for selection of only one element with buttons)
    global GMResult DPOSX DPOSY COLOUR TXT UNIX

    set w .gmchoosefr
    if { [winfo exists $w] } { Raise $w ; bell ; return }

    GMToplevel $w "==$mess" +$DPOSX+$DPOSY . \
        {WM_DELETE_WINDOW {set GMResult cnc}} \
        [list <Key-Return> {set GMResult ok}]

    frame $w.fr -borderwidth 5 -bg $COLOUR(dialbg)
    label $w.fr.text -text $mess

    # adjust list height according to number of parameters
    set lh [expr 15-[llength [lindex $args 0]]]
    if { [set ll [llength $blist]] > $lh } {
	set ll $lh
    }
    frame $w.fr.frbx
    if { $how == "single" } {
	set mode single
    } else { set mode extended }
    listbox $w.fr.frbx.bx -height $ll -width $wd -relief flat \
	    -selectmode $mode -yscrollcommand "$w.fr.frbx.bscr set" \
	    -exportselection 0
    # SH contribution: no such bindings in non-unix systems
    if { $UNIX } {
	bind $w.fr.frbx.bx <Enter> { focus %W }
	bind $w.fr.frbx.bx <Leave> "focus $w.fr.frbx"
    }
    bind $w.fr.frbx.bx <Key> { ScrollListIndex %W %A }
    scrollbar $w.fr.frbx.bscr -command "$w.fr.frbx.bx yview"
    foreach i $blist { $w.fr.frbx.bx insert end $i }
    if { $ll == 1 } { $w.fr.frbx.bx selection set 0 }

    if { $args != "" } {
	set opts 1
	frame $w.fr.fopt
	foreach "menus es" \
	    [GMSetupParams $w.fr.fopt [lindex $args 0] [lindex $args 1]] {}
    } else { set opts 0 ; set menus 0 }

    frame $w.fr.frbt
    button $w.fr.frbt.ok -text $TXT(ok) -command { set GMResult ok }
    button $w.fr.frbt.cnc -text $TXT(cancel) -command { set GMResult cnc }

    pack $w.fr.frbt.ok $w.fr.frbt.cnc -side left -pady 5
    pack $w.fr.frbx.bx $w.fr.frbx.bscr -side left -fill y
    if { $opts } {
	pack $w.fr.text $w.fr.frbx $w.fr.fopt $w.fr.frbt -side top -pady 5
    } else {
	pack $w.fr.text $w.fr.frbx $w.fr.frbt -side top -pady 5
    }
    pack $w.fr

    update idletasks
    set gs [grab current]
    grab $w
    if { $menus } {
	Raise .fdlg
    } else { RaiseWindow .fdlg }
    while 1 {
	tkwait variable GMResult

	switch $GMResult {
	    ""  { }
	    cnc { 
		if { $how == "many_0" } { set res -1 } else { set res "" }
		break
	    }
	    ok {
		set ss [$w.fr.frbx.bx curselection]
		if { $ss == "" && $how != "many_0" } {
		    bell
		    continue
		}
		set res ""
		foreach i $ss {
		    lappend res [lindex $vlist $i]
		}
		if { $opts } {
		    GMUseEntries $w.fr.fopt $es
		}
		break
	    }
	}
    }
    DestroyRGrabs $w $gs
    update idletasks
    return $res
}

proc GMChooseParams {mess vars descs} {
    # create modal dialog for choosing parameters
    #  $vars and $descs are as described in GMSetupParams
    #  buttons: OK, Cancel
    #  bindings: return for commit
    # return 0 if cancelled
    global GMResult DPOSX DPOSY COLOUR TXT

    set w .gmchooseprsr
    if { [winfo exists $w] } { Raise $w ; bell ; return }

    GMToplevel $w "==$mess" +$DPOSX+$DPOSY . \
        {WM_DELETE_WINDOW {set GMResult cnc}} \
        [list <Key-Return> {set GMResult ok}]

    frame $w.fr -borderwidth 5 -bg $COLOUR(dialbg)
    label $w.fr.text -text $mess

    frame $w.fr.fopt
    foreach "menus es" [GMSetupParams $w.fr.fopt $vars $descs] {}

    frame $w.fr.frbt
    button $w.fr.frbt.ok -text $TXT(ok) -command { set GMResult ok }
    button $w.fr.frbt.cnc -text $TXT(cancel) -command { set GMResult cnc }

    pack $w.fr.frbt.ok $w.fr.frbt.cnc -side left -pady 5
    pack $w.fr.text $w.fr.fopt $w.fr.frbt -side top -pady 5
    pack $w.fr

    update idletasks
    set gs [grab current]
    grab $w
    if { $menus } {
	Raise .fdlg
    } else { RaiseWindow .fdlg }
    while 1 {
	tkwait variable GMResult

	switch $GMResult {
	    ""  { }
	    cnc { 
		set res 0 ; break
	    }
	    ok {
		GMUseEntries $w.fr.fopt $es
		set res 1 ; break
	    }
	}
    }
    DestroyRGrabs $w $gs
    update idletasks
    return $res
}

proc GMLogin {service} {
    # get or retrieve login information for accessing a given service
    #  $service is a unique name for the service, needed for displaying
    #    a message and indexing saved login information
    # save the login information for use in the current session if the user
    #  asks for it
    # return list with user name and password or an empty list if cancelled
    global MESS TXT GMPInfo

    if { ! [catch {set up $GMPInfo($service)}] } { return $up }
    if { [GMChooseParams [format $MESS(loginto) $service] \
	      {GMPInfo(__tmp,u) GMPInfo(__tmp,p) GMPInfo(__tmp,s)} \
	      [list =$TXT(uname) =@$TXT(pword) @$TXT(remember)]] \
	     == 0 } { return {} }
    set up [list $GMPInfo(__tmp,u) $GMPInfo(__tmp,p)]
    unset GMPInfo(__tmp,p)
    if { $GMPInfo(__tmp,s) } { set GMPInfo($service) $up }
    return $up
}

##### information window

proc DisplayInfo {mess args} {
    # display information on a dialog
    # the dialog is created if it not exists, otherwise the message
    #  will be added to it
    #  $args may be "" or  "tabs" followed by tabs list (man 3tk text) in
    #     which negative numbers are to be converted from chars to screen
    #     distances
    global CMDLINE COLOUR EPOSX EPOSY TXT FixedFont DInfo

    if { $CMDLINE } { return }

    set frt .gminfo.fr.frt
    if { ! [winfo exists .gminfo] } {
	GMToplevel .gminfo info +$EPOSX+$EPOSY {} \
	    {WM_DELETE_WINDOW {destroy .gminfo}} {}

	frame .gminfo.fr -borderwidth 5 -bg $COLOUR(messbg)
	label .gminfo.fr.title -text $TXT(info) -relief sunken

	frame $frt -relief flat -borderwidth 0
	text $frt.txt -width 80 -font $FixedFont -wrap word \
	    -exportselection 1 -yscrollcommand "$frt.tscrl set"
	bind $frt.txt <space> "$frt.txt yview scroll 1 pages ; break"
	bind $frt.txt <Key-Delete> "$frt.txt yview scroll -1 pages ; break"
	bind $frt.txt <Any-Key> break
	bind $frt.txt <Button-2> break
	scrollbar $frt.tscrl -command "$frt.txt yview"

	set frb .gminfo.fr.frb
	frame $frb -relief flat -borderwidth 0
	button $frb.save -text $TXT(save) \
	    -command "SaveDisplayInfo $frt.txt"
	button $frb.ok -text $TXT(ok) -command { destroy .gminfo }

	grid config $frt.txt -column 0 -row 1 -sticky nesw
	grid config $frt.tscrl -column 1 -row 1 -sticky nesw
	grid config $frb.save -column 0 -row 0
	grid config $frb.ok -column 1 -row 0
	pack .gminfo.fr.title $frt $frb -side top -pady 5
	pack .gminfo.fr

	# info on this window
	catch {unset DInfo}
	# to help setting tabs, make public the "ex" in pixels
	set x20 "xxxxxxxxxxxxxxxxxxxx"
	set DInfo(ex) [expr round([font measure $FixedFont $x20]/20.0)]
	# number of next free tag; tags will have names started by "itg"
	set DInfo(nxttag) 1
    }
    if { $args != "" } {
	set tags ""
	switch -- [lindex $args 0] {
	    tabs {
		set tlst ""
		foreach x [lindex $args 1] {
		    if { [regexp {^-([0-9]+)$} $x m n] } {
			# to pixels
			set x [expr $n*$DInfo(ex)]
		    }
		    lappend tlst $x
		}
		if { [catch {set tgname $DInfo($tlst)}] } {
		    set tgname itg$DInfo(nxttag)
		    incr DInfo(nxttag)
		    $frt.txt tag configure $tgname -tabs $tlst
		    set DInfo($tlst) $tgname
		}
		lappend tags $tgname
	    }
	    default {
		BUG bad args to DisplayInfo
		return
	    }
	}
	$frt.txt insert end "$mess\n" $tags
    } else { $frt.txt insert end "$mess\n" }
    $frt.txt see end
    update idletasks
    return
}

proc SaveDisplayInfo {wtxt} {
    # save text in $wtxt text widget to file
    global TXT

    if { [set txt [$wtxt get 1.0 end]] == "" || \
	     [set f [GMOpenFile $TXT(saveto) Info wapp]] == ".." } { return }
    puts $f $txt
    close $f
    return
}

### dialog window for controlling slow operations

proc SlowOpWindow {mess} {
    # create dialog for controlling slow operation
    # to be called by application before entering the main loop of the slow
    #  operation
    # within the loop there should be calls to proc SlowOpAborted that
    #  returns 1 if the operation is to be aborted, or updates the interface
    #  and returns 0  otherwise
    # any call within the loop to GMMessage will be diverted to this dialog
    # after the main loop there should be a call to proc SlowOpFinish with
    #  the unique identifier that is returned by proc SlowOpWindow
    # returns a unique identifier to be used when calling proc SlowOpWindow
    global SlowOp COLOUR MAPCOLOUR EPOSX EPOSY TXT CMDLINE USESLOWOPWINDOW \
	FixedFont

    if { $CMDLINE || ! $USESLOWOPWINDOW } { return }
    if { [winfo exists .slowop] } {
	set SlowOp(id) [clock seconds]
	set SlowOp(ids) [linsert $SlowOp(ids) 0 $SlowOp(id)]
	.slowop.fr.title configure -text $mess
	return $SlowOp(id)
    }

    set id [clock seconds]
    array set SlowOp [list aborting 0  id $id  ids $id \
			  status "$TXT(working)..." grabs [grab current]]
    # avoid completely covering other dialogs
    set pos [expr $EPOSX+150]
    GMToplevel .slowop opinprogr +$pos+$EPOSY {} \
        {WM_DELETE_WINDOW {set SlowOp(aborting) 1}} {}

    frame .slowop.fr -borderwidth 5 -bg $COLOUR(messbg)
    label .slowop.fr.title -text $mess -relief sunken

    set frs .slowop.fr.frs
    frame $frs -relief flat -borderwidth 0
    label $frs.st -textvariable SlowOp(status) -fg $MAPCOLOUR(trvwrnimportant)
    checkbutton $frs.light -disabledforeground $COLOUR(check) -state disabled

    set frt .slowop.fr.frt
    frame $frt -relief flat -borderwidth 0
    text $frt.txt -width 50 -font $FixedFont -wrap word \
	    -yscrollcommand "$frt.tscrl set"
    bind $frt.txt <space> "$frt.txt yview scroll 1 pages ; break"
    bind $frt.txt <Key-Delete> "$frt.txt yview scroll -1 pages ; break"
    bind $frt.txt <Any-Key> break
    scrollbar $frt.tscrl -command "$frt.txt yview"

    set frb .slowop.fr.frb
    frame $frb -relief flat -borderwidth 0
    button $frb.abort -text $TXT(abort) -command SlowOpAbort
    button $frb.ok -text $TXT(ok) -state disabled \
	    -command [list DestroyRGrabs .slowop $SlowOp(grabs)]

    pack $frs.st $frs.light -side left
    grid config $frt.txt -column 0 -row 1 -sticky nesw
    grid config $frt.tscrl -column 1 -row 1 -sticky nesw
    grid config $frb.abort -column 0 -row 0
    grid config $frb.ok -column 1 -row 0
    pack .slowop.fr.title $frs $frt $frb -side top -pady 5
    pack .slowop.fr
    update idletasks
    grab .slowop
    RaiseWindow .slowop
    return $id
}

proc SlowOpFinish {id mess} {
    # to be called by application when the operation ends (either normally
    #  or not)
    #  $id is unique identifier that was returned by proc SlowOpWindow
    #    if $id is not in the $SlowOp(ids) stack the message is displayed
    #    and nothing else happens
    #  $mess will be displayed if not empty
    # the dialog window will be closed only when the stack of calls to
    #  proc SlowOpWindow is empty
    # the dialog window is closed silently if there were no messages,
    #  otherwise the Ok button is activated and the user must acknowledge it
    global SlowOp TXT

    if { ! [winfo exists .slowop] } {
	if { $mess != "" } { GMMessage $mess }
	return
    }
    if { $mess != "" } { SlowOpMessage $mess }
    if { [set ix [lsearch -exact $SlowOp(ids) $id]] == -1 || \
	     [set SlowOp(ids) [lreplace $SlowOp(ids) 0 $ix]] != {} } {
	return
    }
    if { ! $SlowOp(aborting) } { set SlowOp(status) $TXT(errwarn) }
    set SlowOp(aborting) 0
    set txt .slowop.fr.frt.txt
    if { [$txt index end] == 2.0 } {
	DestroyRGrabs .slowop $SlowOp(grabs)
	return
    }
    set frb .slowop.fr.frb
    foreach b "abort ok" st "disabled normal" {
	$frb.$b configure -state $st
    }
    return
}

proc SlowOpAbort {} {
    # the user aborted the operation
    # not to be called directly from the application
    global SlowOp TXT

    set SlowOp(aborting) 1
    set SlowOp(status) $TXT(aborted)
    return
}

proc SlowOpMessage {mess} {
    # show message in slow operation dialog window
    # not to be called directly from the application

    set txt .slowop.fr.frt.txt
    $txt insert end "$mess\n"
    $txt see end
    update idletasks
    return
}    

proc SlowOpAborted {} {
    # to be called by the application to test if the operation was aborted
    # if not a call to update is made to ensure that the window is usable
    # return 1 if yes
    global SlowOp TXT

    if { ! [winfo exists .slowop] } { return 0 }
    if { $SlowOp(aborting) } {
	set SlowOp(status) $TXT(aborted)
	return 1
    }
    set frs .slowop.fr.frs
    $frs.light toggle
    update
    return 0
}

### opening files

proc GMOpenFile {act wh mode} {
    # create modal dialog for selecting and opening a file
    #  $act is string describing the action to do on the file
    #  $wh in $filetypes (see proc GMStart, setup.tcl)
    #  $mode in {r, w, wapp} with wapp meaning write or possibly append
    #  buttons: OK, Cancel
    #  binding: return and double-left for commit, left-click for select
    global GMResult COLOUR DPOSX DPOSY LISTHEIGHT File TXT MESS UNIX

    if { [set f $File($wh)] == "" || [catch {cd [file dirname $f]}] } {
	set currfile ""
    } else { set currfile [file tail $f] }
    if { $mode == "wapp" } { set mode a }

    GMToplevel .fdlg file +$DPOSX+$DPOSY . \
        {WM_DELETE_WINDOW {set GMResult cnc}} \
        [list <Key-Return> {set GMResult ok}]

    frame .fdlg.fr -borderwidth 5 -bg $COLOUR(selbg)
    label .fdlg.fr.title -text [format $MESS(fileact) $act $TXT(name$wh)] \
	    -relief sunken
    if { ! $UNIX } {
	menubutton .fdlg.fr.vols -text $TXT(volume) -menu .fdlg.fr.vols.m
	menu .fdlg.fr.vols.m
	bind .fdlg.fr.vols <Button-1> {
	    FillMenuExec .fdlg.fr.vols.m {ChangeVolume .fdlg} file volume
	}
    }
    entry .fdlg.fr.wdir -width 30
    ShowTEdit .fdlg.fr.wdir [pwd] 0

    frame .fdlg.fr.frbx
    listbox .fdlg.fr.frbx.box -height $LISTHEIGHT -width 30 \
	    -yscrollcommand ".fdlg.fr.frbx.bscr set" \
 	    -selectmode single -exportselection 1
    bind .fdlg.fr.frbx.box <Double-1> {
            global GMResult
            set GMResult [%W nearest %y]
    }
    bind .fdlg.fr.frbx.box <Button-1> {
	.fdlg.fr.fn delete 0 end
	.fdlg.fr.fn insert 0 [%W get [%W nearest %y]]
    }
    scrollbar .fdlg.fr.frbx.bscr -command ".fdlg.fr.frbx.box yview"
    FillDir .fdlg.fr.frbx.box

    entry .fdlg.fr.fn -width 30
    .fdlg.fr.fn insert 0 $currfile
    TextBindings .fdlg.fr.fn
    
    frame .fdlg.fr.bs
    button .fdlg.fr.bs.ok -text $TXT(ok) -command { set GMResult ok }
    button .fdlg.fr.bs.cnc -text $TXT(cancel) \
	    -command { set GMResult cnc }

    pack .fdlg.fr.bs.ok .fdlg.fr.bs.cnc -side left -pady 5
    pack .fdlg.fr.frbx.box .fdlg.fr.frbx.bscr -side left -fill y
    if { $UNIX } {
	pack .fdlg.fr.title .fdlg.fr.wdir .fdlg.fr.frbx .fdlg.fr.fn \
		.fdlg.fr.bs -side top -pady 5
    } else {
	pack .fdlg.fr.title .fdlg.fr.vols .fdlg.fr.wdir .fdlg.fr.frbx \
		.fdlg.fr.fn .fdlg.fr.bs -side top -pady 5
    }
    pack .fdlg.fr -side top

    update idletasks
    set gs [grab current]
    grab .fdlg
    RaiseWindow .fdlg
    while 1 {
	tkwait variable GMResult

	switch $GMResult {
	    ""  { }
	    cnc { 
		set res ".."
		break
	    }
	    ok {
		set fn [.fdlg.fr.fn get]
		set f [GMCheckFile open $fn $mode]
		if { $f != ".." } {
		    set File($wh) [file join [pwd] $fn]
		    set res $f
		    break
		}
	    }
	    0 {
		cd ..
		ShowTEdit .fdlg.fr.wdir [pwd] 0
		.fdlg.fr.frbx.box delete 0 end ; FillDir .fdlg.fr.frbx.box
		.fdlg.fr.fn delete 0 end
	    }
	    default {
		set fn [.fdlg.fr.frbx.box get $GMResult]
		set f [GMCheckFile open $fn $mode]
		if { $f != ".." } {
		    set File($wh) [file join [pwd] $fn]
		    set res $f
		    break
		}
	    }
	}
    }
    DestroyRGrabs .fdlg $gs
    update idletasks
    return $res
}

proc GMOpenFileParms {act wh mode vars vals} {
    # create modal dialog for selecting and opening a file and parameters
    # see arguments of proc GMGetFileName

    set fname [GMGetFileName $act $wh $mode $vars $vals]
    if { $fname == ".." } { return ".." }
    if { $mode == "wapp" } { set mode a }
    return [open $fname $mode]
}

proc GMGetFileName {act wh mode vars vals} {
    # create modal dialog for selecting a file name and parameters
    #  $act is string describing the action to do on the file
    #  $wh in $filetypes (see proc GMStart, setup.tcl)
    #  $mode in {r, w, wapp} with wapp meaning write or possibly append
    #  $vars is list of (global) vars to set
    #  $vals is associated list of value descriptions (see proc GMSetupParams)
    #  buttons: OK, Cancel
    #  binding: return and double-left for commit, left-click for select
    global GMResult COLOUR DPOSX DPOSY LISTHEIGHT File TXT MESS UNIX

    if { [set f $File($wh)] == "" || [catch {cd [file dirname $f]}] } {
	set currfile ""
    } else { set currfile [file tail $f] }

    GMToplevel .fdlg file +$DPOSX+$DPOSY . \
        {WM_DELETE_WINDOW {set GMResult cnc}} \
        [list <Key-Return> {set GMResult ok}]

    frame .fdlg.fr -borderwidth 5 -bg $COLOUR(selbg)
    label .fdlg.fr.title -text [format $MESS(fileact) $act $TXT(name$wh)] \
	    -relief sunken
    if { ! $UNIX } {
	menubutton .fdlg.fr.vols -text $TXT(volume) -menu .fdlg.fr.vols.m
	menu .fdlg.fr.vols.m
	bind .fdlg.fr.vols <Button-1> {
	    FillMenuExec .fdlg.fr.vols.m {ChangeVolume .fdlg} file volume
	}
    }
    entry .fdlg.fr.wdir -width 30
    ShowTEdit .fdlg.fr.wdir [pwd] 0

    # adjust list height according to number of parameters
    set lh [expr $LISTHEIGHT-[llength $vars]]
    frame .fdlg.fr.frbx
    listbox .fdlg.fr.frbx.box -height $lh -width 30 \
	    -yscrollcommand ".fdlg.fr.frbx.bscr set" \
 	    -selectmode single -exportselection 1
    bind .fdlg.fr.frbx.box <Double-1> {
            global GMResult
            set GMResult [%W nearest %y]
    }
    bind .fdlg.fr.frbx.box <Button-1> {
	.fdlg.fr.fn delete 0 end
	.fdlg.fr.fn insert 0 [%W get [%W nearest %y]]
    }
    scrollbar .fdlg.fr.frbx.bscr -command ".fdlg.fr.frbx.box yview"
    FillDir .fdlg.fr.frbx.box
    # BSB contribution: wheelmouse scrolling
    Mscroll .fdlg.fr.frbx.box

    entry .fdlg.fr.fn -width 30
    .fdlg.fr.fn insert 0 $currfile
    TextBindings .fdlg.fr.fn

    frame .fdlg.fr.fopt
    foreach "menus es" [GMSetupParams .fdlg.fr.fopt $vars $vals] {}

    frame .fdlg.fr.bs
    button .fdlg.fr.bs.ok -text $TXT(ok) -command { set GMResult ok }
    button .fdlg.fr.bs.cnc -text $TXT(cancel) \
	-command { set GMResult cnc }

    pack .fdlg.fr.bs.ok .fdlg.fr.bs.cnc -side left -pady 5
    pack .fdlg.fr.frbx.box .fdlg.fr.frbx.bscr -side left -fill y
    if { $UNIX } {
	pack .fdlg.fr.title .fdlg.fr.wdir .fdlg.fr.frbx .fdlg.fr.fn \
		.fdlg.fr.fopt .fdlg.fr.bs -side top -pady 5
    } else {
	pack .fdlg.fr.title .fdlg.fr.vols .fdlg.fr.wdir .fdlg.fr.frbx \
		.fdlg.fr.fn .fdlg.fr.fopt .fdlg.fr.bs -side top -pady 5
    }
    pack .fdlg.fr -side top

    update idletasks
    set gs [grab current]
    grab .fdlg
    if { $menus } {
	Raise .fdlg
    } else { RaiseWindow .fdlg }
    while 1 {
	tkwait variable GMResult

	switch $GMResult {
	    ""  { }
	    cnc { 
		set res ".." ; break
	    }
	    ok {
		set fn [.fdlg.fr.fn get]
		set f [GMCheckFile check $fn $mode]
		if { $f != ".." } {
		    set File($wh) [file join [pwd] $fn]
		    GMUseEntries .fdlg.fr.fopt $es
		    set res $fn
		    break
		}
	    }
	    0 {
		cd ..
		ShowTEdit .fdlg.fr.wdir [pwd] 0
		.fdlg.fr.frbx.box delete 0 end ; FillDir .fdlg.fr.frbx.box
		.fdlg.fr.fn delete 0 end
	    }
	    default {
		set fn [.fdlg.fr.frbx.box get $GMResult]
		set f [GMCheckFile check $fn $mode]
		if { $f != ".." } {
		    set File($wh) [file join [pwd] $fn]
		    GMUseEntries .fdlg.fr.fopt $es
		    set res $fn
		    break
		}
	    }
	}
    }
    DestroyRGrabs .fdlg $gs
    update idletasks
    return $res
}

proc GMCheckFile {how f mode} {
    # check name of file $f and if ok either open it and return file descriptor
    #  or return file name; otherwise return ".."
    #  $how in {open check}
    #  $mode in {r, w, wapp}
    global PERMS TXT MESS

    if { $f == "" } { bell ; return ".." }
    if { [file isdirectory $f] } {
	if { [file executable $f] } {
	    cd $f
	    ShowTEdit .fdlg.fr.wdir [pwd] 0
	    .fdlg.fr.frbx.box delete 0 end
	    FillDir .fdlg.fr.frbx.box
	    .fdlg.fr.fn delete 0 end
	} else {
	    bell
	}
    } elseif { $mode == "r" } {
	if { [file readable $f] } {
	    switch $how {
		open { return [open $f r] }
		check { return $f }
	    }
	} else { bell }
    } elseif { [file exists $f] } {
	if { [file writable $f] } {
	    if { $mode == "w" } {
		set l [list $TXT(ovwrt) $TXT(cancel)]
		set r {w 0}
	    } else {
		# appending is an option
		set l [list $TXT(ovwrt) $TXT(app) $TXT(cancel)]
		set r {w a 0}
	    }
	    if { [set m [GMSelect $MESS(filexists) $l $r]] != 0 } {
		switch $how {
		    open { return [open $f $m $PERMS] }
		    check { return $f }
		}
	    }
	} else { bell }
    } elseif { [file writable [pwd]] } {
	switch $how {
	    open {
		if { $mode == "wapp" } { set mode a }
		return [open $f $mode $PERMS]
	    }
	    check { return $f }
	}
    } else {
	bell
    }
    return ".."
}

proc ChangeVolume {w vol} {
    # file volume has changed $vol in file-selection dialog $w

    if { ! [file isdirectory $vol] } { bell ; return }
    cd $vol
    ShowTEdit .fdlg.fr.wdir [pwd] 0
    .fdlg.fr.frbx.box delete 0 end ; FillDir .fdlg.fr.frbx.box
    .fdlg.fr.fn delete 0 end
    return
}

### font selection

proc GMSelectFont {args} {
    # dialog for selecting a font
    #  $args may contain the font description to return if the
    #        default is selected; if empty "default" is returned
    # a font is defined by giving
    #   one of [font families] and
    #   the size in points or pixels, an integer > 0
    #   the weight, one of {normal bold}
    #   the slant, one of {roman italic}
    #   whether to use underline
    #   whether to use overstrike
    # return empty list if cancelled, "default" or the description
    #   in $args, or list with family, size, and other style
    #   indicators in {normal bold roman italic underline overstrike}
    #   where size follows the Tk convention (negative if in pixels)
    global GMFtDial TXT MESS LISTHEIGHT EPOSX EPOSY COLOUR

    array set GMFtDial {
	size 12
	units points
	weight normal
	slant roman
	underline 0
	overstrike 0
    }

    if { [winfo exists .gmselfont] } { destroy .gmselfont }
    set w [GMToplevel .gmselfont selfont +$EPOSX+$EPOSY . \
	       {WM_DELETE_WINDOW {set GMFtDial(act) cancel}} \
	       [list <Key-Return> {set GMFtDial(act) ok}]]

    frame $w.fr -borderwidth 5 -bg $COLOUR(selbg)
    label $w.fr.tit -text $TXT(selfont)
    set frbx $w.fr.frbx
    frame $frbx
    listbox $frbx.box -height $LISTHEIGHT -width 40 -selectmode single \
	-yscrollcommand "$frbx.bscr set" -exportselection 1
    scrollbar $frbx.bscr -command "$frbx.box yview"
    grid $frbx.box -row 0 -column 0
    grid $frbx.bscr -row 0 -column 1 -sticky ns
    grid rowconfigure $frbx 0 -weight 1
    grid columnconfigure $frbx 0 -weight 1
    foreach fam [lsort -dictionary [font families]] {
	$frbx.box insert end $fam
    }

    frame $w.fr.frp
    set vars {} ; set descs {}
    foreach v {size units weight slant underline overstrike} {
	lappend vars GMFtDial($v)
    }
    set descs [list "=$TXT(size)" \
		   "~$TXT(units)/[list points pixels]" \
		   "~$TXT(weight)/[list normal bold]" \
		   "~$TXT(slant)/[list roman italic]" \
		   "@$TXT(underline)" "@$TXT(overstrike)"]
    set pes [lindex [GMSetupParams $w.fr.frp $vars $descs] 1]

    set frbs $w.fr.frbs
    frame $frbs
    foreach x {ok default cancel} {
	button $frbs.$x -text $TXT($x) -command "set GMFtDial(act) $x"
	pack $frbs.$x -side left
    }

    pack $w.fr.tit
    pack $frbs -side bottom -pady 5
    pack $w.fr.frp -side bottom -pady 5
    # must be the last one
    pack $w.fr.frbx -fill both -expand 1 -pady 5

    grid $w.fr
    grid rowconfigure $w.fr 0 -weight 1
    grid columnconfigure $w.fr 0 -weight 1
    grid rowconfigure $w 0 -weight 1
    grid columnconfigure $w 0 -weight 1

    update idletasks
    # cannot use RaiseWindow because of menus
    set grabs [grab current]
    grab $w
    while 1 {
	tkwait variable GMFtDial(act)
	switch $GMFtDial(act) {
	    cancel {
		set res {} ; break
	    }
	    default {
		if { [set res [lindex $args 0]] == {} } {
		    set res default
		}
		break
	    }
	    ok {
		if { [set ix [$frbx.box curselection]] == {} } {
		    GMMessage $MESS(mustselftfam)
		    continue
		}
		GMUseEntries $w.fr.frp $pes
		set n [string trim $GMFtDial(size)]
		if { ! [CheckNumber GMMessage $n] } { continue }
		if { $n < 1 } {
		    GMMessage [format $MESS(xcantbey) $TXT(size) 0]
		    continue
		}
		if { $GMFtDial(units) == "pixels" } {
		    set n [expr -$n]
		}
		set res [list [$frbx.box get $ix]]
		lappend res $n
		foreach x {weight slant} { lappend res $GMFtDial($x) }
		foreach x {underline overstrike} {
		    if { $GMFtDial($x) } { lappend res $x }
		}
		break
	    }
	}
    }
    DestroyRGrabs $w $grabs
    destroy $w
    return $res
}

### utilities for dealing with parameters in a dialog

proc GMSetupParams {w vars descs} {
    # set-up widgets for setting parameters in a dialog
    #  $w is window parent
    #  $vars is list of (global) vars to set; they must have a value
    #    except those associated to entries which will be initialised to ""
    #    and to menubuttons that if undefined will be initialised to "";
    #    array elements may also be given instead of normal variables but
    #    the indices must be alphanumeric
    #  $descs is associated list of value descriptions as:
    #      @@TEXT  button creating a balloon help with $TXT(TEXT), associated
    #         variable declared as global but not used nor set
    #      @TEXT   checkbutton with label TEXT, values 0 1
    #      =@TEXT  non-echo entry with label TEXT
    #      =TEXT   entry with label TEXT
    #      !TEXT=MENUPROC/ARGS menubutton with label TEXT and menu filled by
    #         proc MENUPROC; the arguments to the MENUPROC call are:
    #                - the menu window
    #                - the command to be associated with final entries, whose
    #                arguments are the selected value and the menu window
    #                - the elements of the list ARGS
    #      |TEXT/LIST label TEXT and menubutton with text-variable for values
    #         in LIST
    #      +TEXT/LIST radiobuttons with possible values in LIST, label TEXT
    #      /TEXT|LIST radiobuttons with possible values in LIST, label TEXT
    #      ~TEXT/LIST radiobuttons with possible values in LIST but their
    #         names are in the array TXT, label TEXT
    #      LIST    radiobutton with possible values in LIST
    # LISTs above cannot have repeated elements
    # return pair with flag set if there are menubuttons, and list of entries,
    #  each as a triple, usually with path from $w to entry, the name of
    #  global (array or normal) variable to be used in "global" and complete
    #  name of variable to be used in "set"; for non-echo entries the
    #  path is prefixed by a "@"; the list can be processed by proc GMUseEntries
    global COLOUR TXT NEEntry

    set i 0 ; set es "" ; set menus 0
    foreach v $vars os $descs {
	if { [regexp {^([^(]+)[(]([^)]+)[)]$} $v x vname el] } {
	    set vid "${vname}___ARR_$el"
	} else { set vid $v ; set vname $v }
	global $vname
	frame $w.f$i
	switch -glob -- $os {
	    @@* {
		set os [string replace $os 0 1]
		set bh $w.f$i.bh$vid
		BalloonButton $bh $os
		pack $bh
	    }
	    @* {
		set os [string replace $os 0 0]
		set cb $w.f$i.c$vid
		checkbutton $cb -text $os -variable $v -anchor w \
		    -onvalue 1 -offvalue 0 -selectcolor $COLOUR(check)
		if { [set $v] } {
		    $cb select
		} else { $cb deselect }
		pack $cb
	    }
	    =* {
		if { [string index $os 1] == "@" } {
		    set z 1
		} else { set z 0 }
		set os [string replace $os 0 $z]
		set wl [label $w.f$i.l$vid -text $os]
		set ppath f$i.e$vid
		set we [entry $w.f$i.e$vid -width 30]
		TextBindings $we
		if { $z } {
		    set NEEntry($we) ""
		    bind $we <Delete> "GMNEEntry $we _ BackSpace ; break"
		    bind $we <Any-Key> "GMNEEntry $we %A %K ; break"
		    set ppath "@$ppath"
		}
		if { [catch {set $v}] } {
		    set $v ""
		} elseif { $z == 0 } { $we insert 0 [set $v] }
		pack $wl $we -side left
		lappend es [list $ppath $vname $v]
	    }
	    !* {
		set menus 1
		if { ! [regexp {^!([^=]+)=([^/]+)/(.*)$} $os \
			    m lab menuproc mpargs] } {
		    BUG Bad argument to GMSetupParams !
		}
		set mb $w.f$i.mb$vid
		menubutton $mb -text $lab -relief raised \
		    -direction below -menu $mb.m
		menu $mb.m
		eval $menuproc $mb.m GMChangeParam $mpargs
		if { [catch {set $v}] } {
		    set $v ""
		}
		set wl [label $w.f$i.l$vid -textvariable $v]
		pack $mb $wl -side left
	    }
	    |* {
		set menus 1
		if { ! [regexp {^[|]([^/]+)/(.*)$} $os \
			    m lab lst] } {
		    BUG Bad argument to GMSetupParams |
		}
		set wl [label $w.f$i.t$vid -text $lab -width 16]
		set mb $w.f$i.mb$vid
		menubutton $mb -textvariable $v -relief raised \
		    -direction below -menu $mb.m
		menu $mb.m
		foreach x $lst {
		    $mb.m add command -label $x -command "set $v $x"
		}
		pack $wl $mb -side left
	    }
	    +* -  /* -  ~* {
		set labval [string first "~" $os]
		if { ! [regexp {^.([^/]+)/(.+)$} $os m lab lst] } {
		    BUG Bad argument to GMSetupParams +/~
		    continue
		}
		
		pack [label $w.f$i.l$vid -text $lab] -side left
		set k 0
		set wrb $w.f$i.r_${vid}_0
		foreach o $lst {
		    if { $labval } {
			set lv $o
		    } else { set lv $TXT($o) }
		    set rb $w.f$i.r_${vid}_$k
		    radiobutton $rb -text $lv -variable $v \
			-value $o -anchor w -selectcolor $COLOUR(check)
		    pack $rb -side left -padx 2
		    if { [set $v] == $o } { set wrb $rb }
		    incr k
		}
		$wrb invoke
	    }
	    default {
		set k 0
		set wrb $w.f$i.rd_${vid}_0
		foreach o $os {
		    set rb $w.f$i.rd_${vid}_$k
		    radiobutton $rb -text $o -variable $v \
			-value $o -anchor w -selectcolor $COLOUR(check)
		    pack $rb -side left -padx 2
		    if { [set $v] == $o } { set wrb $rb }
		    incr k
		}
		$wrb invoke
	    }
	}
	pack $w.f$i -side top -fill x -expand 1
	incr i
    }
    return [list $menus $es]
}

proc GMNEEntry {e char ksym} {
    # keep track of characters typed in a non-echo entry $e
    # current contents are kept on global NEEntry($e) that should be unset
    #  after use
    global NEEntry PASSWDECHO

    if { $PASSWDECHO == "none" } {
	echo 0
	$e delete 0 end
    } else { set echo 1 }
    if { $ksym == "BackSpace" } {
	set NEEntry($e) [string replace $NEEntry($e) end end]
	if { $echo } { $e delete 0 }
	return
    }
    if { $ksym == $char || $ksym == "??" || [regexp {^[a-z]} $ksym] } {
	append NEEntry($e) $char
	if { $echo } { $e insert end $PASSWDECHO }
    }
    return
}

proc GMChangeParam {val varmenu args} {
    # parameter value changed by a selection in a menu
    #  $varmenu is either the menu path assumed to have a single occurrence
    #   of .mbVARID. or has the form =VARID where VARID either is the name
    #   of the global simple variable to set, or has is the string
    #   concatenation of a global array identifier, "___ARR_" and
    #   an array index
    #  $args may be TXT to force value to be $TXT($val)
    global TXT

    if { ! [regexp {^=(.+)$} $varmenu x v] } {
	regexp {\.mb([^.]+)\.} $varmenu x v
    }
    if { [regexp {^(.+)___ARR_(.+)$} $v x v ix] } {
	global $v
	append v "(" $ix ")"
    } else { global $v }
    if { $args == "TXT" } {
	set val $TXT($val)
    }
    set $v $val
    return
}

proc GMUseEntries {w es} {
    # set global variables according to entries set-up by proc GMSetupParams
    #  $w is window parent
    #  $es is list of triples usually with path from $w to entry,
    #   name of global (array or normal) variable to be used in "global" and
    #   complete name of variable to be used in "set"; for non-echo entries
    #   the path is prefixed with a "@"
    # current contents of non-echo entries are kept on global array NEEntry
    #  (see proc GMNEEntry) and corresponding elements are unset here
    global NEEntry

    foreach e $es {
	global [lindex $e 1]
	if { [string index [set ppath [lindex $e 0]] 0] == "@" } {
	    set ppath $w.[string replace $ppath 0 0]
	    set v $NEEntry($ppath)
	    unset NEEntry($ppath)
	} else { set v [$w.$ppath get] }
	set [lindex $e 2] $v
    }
    return
}

### image listbox widget

proc ImageListbox {act path args} {
    # implements a new widget whose model is a listbox but has entries
    #  with an image and possibly a text label
    #  $act is the action to perform and determines $args
    #    create  SIZE WIDTH EHEIGHT SELECTMODE ?SCROLLBAR?
    #    insert  INDEX IMAGE TEXT ?TAGS?; return either index or -1 if entry
    #      can not be inserted because IMAGE cannot be displayed and TEXT
    #      is empty
    #    delete  INDEX ?INDEX?
    #    get     INDEX ?INDEX? ; return list of texts in entries
    #    gettags INDEX ?INDEX? ; return list of tags in entries
    #    selclr  INDEX ?INDEX? ; clear selected
    #    selset  INDEX ?INDEX? ; set as selected (irrespective of SELECTMODE)
    #    cursel  "" ; return list of indices of currently selected entries
    #    getsel  "" ; return list of texts in currently selected entries
    #    getseltags "" ; return list of lists each with the tags in currently
    #      selected entries
    #    seldel  "" ; delete selected entries
    #    index   Y ; return index of entry at y-coordinate (inside listbox)
    #    destroyall "" ; destroy all image listboxes under window $path
    #  where
    #     SELECTMODE is one of {single, extended}
    #     EHEIGHT is the height for the entries in pixels (minimum used: 5)
    #     INDEX is either a numeric index from 0 or "end"
    #     TAGS is a list
    # the widget should be packed or grided by caller after being created
    # images that have more than EHEIGHT-4 in width or height are either
    #  truncated to that size if they are of type photo, or not displayed
    # information related to these widgets is stored in global array GMIBox
    # auxiliary images are created but never deleted; their names can be
    #  retrieved from GMIBox(img,*) entries
    # bindings on entries:
    #  <Button-1> deselects everything, selects entry
    #  if SELECTMODE=="extended":
    #    <Control-Button-1> toggles selection state of entry
    #    <Shift-Button-1> selects range from last selected entry to entry
    global GMIBox COLOUR

    if { $act == "destroyall" } {
	foreach n [array names GMIBox $path*,csize] {
	    regsub {,csize$} $n "" lbox
	    destroy $lbox
	}
	array unset GMIBox $path*
	return
    }
    if { [set nargs [llength $args]] != 0 } {
	foreach "a1 a2 a3 a4 a5" $args { break }
    }
    if { $act != "create" } {
	if { [catch {set csize $GMIBox($path,csize)}] } {
	    BUG trying to use non-existing ImageListbox	
	}
	set end $csize
	if { $end > 0 } { incr end -1 }
	foreach x "sel eh ew mode" {
	    set $x $GMIBox($path,$x)
	}
    }
    set res ""
    switch $act {
	create {
	    # SIZE WIDTH EHEIGHT MODE ?SCROLLBAR?
	    if { $nargs < 4 } { BUG missing args to ImageListbox create }
	    if { $a3 < 5 } { set a3 5 }
	    set height [expr $a1*$a3]
	    foreach x "csize sel eh ew mode anchor base height" \
		    v "0 {} $a3 $a2 $a4 {} 0 $height" {
		set GMIBox($path,$x) $v
	    }
	    canvas $path -height $height -width $a2 -confine 1 \
		-borderwidth 2 -relief sunken
	    if { $a5 != "" } {
		$path configure -yscrollincrement $a3 \
		    -yscrollcommand "ImageListboxScroll $path $a5" \
		    -scrollregion "0 0 $a2 $height"
		trace variable GMIBox($path,csize) w ImageListboxResize
	    }
	    $path bind entry <Shift-Button-1> \
		"ImageListboxESButton $path %y ; break"
	    $path bind entry <Control-Button-1> \
		"ImageListboxECButton $path %y ; break"
	    $path bind entry <Button-1> "ImageListboxEButton $path %y"
	}
	insert {
	    # INDEX IMAGE TEXT ?TAGS?
	    if { $nargs < 3 } { BUG missing args to ImageListbox insert }
	    set ih [expr $eh-2]
	    if { $a2 != "" && \
		     ([image width $a2] > $ih || [image height $a2] > $ih) } {
		if { [image type $a2] != "photo" } {
		    if { $a3 == "" } { return -1 }
		    set a2 ""
		} else {
		    if { [catch {set im $GMIBox(img,for,$a2)}] } {
			set im [image create photo -width $ih -height $ih]
			$im copy $a2 -from 0 0 $ih $ih
			set GMIBox(img,for,$a2) $im
		    }
		    set a2 $im
		}
	    }
	    if { $a1 != "end" } {
		set na1 [ImageListboxIndices $path $end $a1]
		if { $a1 > $na1 } {
		    # assuming given index must be an integer
		    set na1 $csize
		}
		# update selection
		set s ""
		foreach e $GMIBox($path,sel) {
		    if { $e >= $na1 } { incr e }
		    lappend s $e
		}
		set GMIBox($path,sel) $s
		# move lower entries down
		set y0 [expr $na1*$eh]
		if { $csize > 0  && $na1 < $csize } {
		    foreach it [$path find withtag entry] {
			if { [lindex [$path coords $it] 1] >= $y0 } {
			    $path move $it 0 $eh
			}
		    }
		}
	    } else { set y0 [expr $csize*$eh] }
	    $path create rectangle 1 [expr $y0+1] $ew [expr $y0+$eh] \
		-fill $COLOUR(bg) -outline $COLOUR(bg) \
		-tags [list txt entry bg "tgs=$a4"]
	    # texts are created even if empty so that they can be retrieved
	    $path create text [expr $eh+8] [expr $y0+$eh/2] -anchor w \
		-text $a3 -fill $COLOUR(fg) \
		-tags [list txt entry "txt=$a3"]
	    if { $a2 != "" } {
		$path create image 5 [expr $y0+2] -anchor nw -image $a2 \
		    -tags "img entry"
	    }
	    incr GMIBox($path,csize)
	    update idletasks
	}
	delete {
	    # INDEX ?INDEX?
	    if { $nargs < 1 } { BUG missing args to ImageListbox delete }
	    foreach "a1 a2" [ImageListboxIndices $path $end [list $a1 $a2]] {}
	    if { $a2 == "" } { set a2 $a1 }
	    if { [set ndel [expr $a2-$a1+1]] == $csize } {
		$path delete all
		set GMIBox($path,sel) ""
	    } else {
		# update selection
		set s ""
		foreach e $GMIBox($path,sel) {
		    if { $e < $a1 } {
			lappend s $e
		    } elseif { $e > $a2 } {
			lappend s [expr $e-$ndel]
		    }
		}
		set GMIBox($path,sel) $s
		# move lower entries up
		set y0 [expr $a1*$eh] ; set yn [expr ($a2+1)*$eh]
		set dy [expr -$ndel*$eh]
		foreach it [$path find withtag entry] {
		    if { [set y [lindex [$path coords $it] 1]] >= $y0 } {
			if { $y >= $yn } {
			    $path move $it 0 $dy
			} else { $path delete $it }
		    }
		}
	    }
	    set GMIBox($path,csize) [expr $csize-$ndel]
	    update idletasks
	}
	get {
	    # INDEX ?INDEX?
	    if { $nargs < 1 } { BUG missing args to ImageListbox get }
	    foreach "a1 a2" [ImageListboxIndices $path $end [list $a1 $a2]] {}
	    if { $a2 == "" } { set a2 $a1 }
	    set y0 [expr $a1*$eh] ; set yn [expr ($a2+1)*$eh]
	    set r ""
	    foreach it [$path find withtag txt] {
		if { [set y [lindex [$path coords $it] 1]] >= $y0 && \
			 $y < $yn } {
		    foreach t [$path gettags $it] {
			if { [regsub {^txt=} $t "" tx] } {
			    lappend r [list [expr round($y)] $tx]
			    break
			}
		    }
		}
	    }
	    foreach p [lsort -integer -index 0 $r] {
		lappend res [lindex $p 1]
	    }
	}
	gettags {
	    # INDEX ?INDEX?
	    if { $nargs < 1 } { BUG missing args to ImageListbox gettags }
	    foreach "a1 a2" [ImageListboxIndices $path $end [list $a1 $a2]] {}
	    if { $a2 == "" } { set a2 $a1 }
	    set y0 [expr $a1*$eh] ; set yn [expr ($a2+1)*$eh]
	    set r ""
	    foreach it [$path find withtag txt] {
		if { [set y [lindex [$path coords $it] 1]] >= $y0 && \
			 $y < $yn } {
		    foreach t [$path gettags $it] {
			if { [regsub {^tgs=} $t "" tgs] } {
			    lappend r [list [expr round($y)] $tgs]
			    break
			}
		    }
		}
	    }
	    foreach p [lsort -integer -index 0 $r] {
		lappend res [lindex $p 1]
	    }
	}
	selset {
	    # INDEX ?INDEX?
	    # add to selection, irrespective of $mode
	    # keep selection list ordered
	    if { $nargs < 1 } { BUG missing args to ImageListbox selset }
	    foreach "a1 a2" [ImageListboxIndices $path $end [list $a1 $a2]] {}
	    if { $a2 == "" } { set a2 $a1 }
	    set y0 [expr $a1*$eh+2]
	    set s ""
	    foreach ix $sel {
		if { $ix == $a1 } {
		    if { [incr a1] > $a2 } {
			set a1 1e10
		    } else { set y0 [expr $y0+$eh] }
		} else {
		    while { $a1 < $ix } {
			ImageListboxSelect sel $path $y0
			lappend s $a1
			if { [incr a1] > $a2 } {
			    set a1 1e10
			} else { set y0 [expr $y0+$eh] }
		    }
		}
		lappend s $ix
	    }
	    while { $a1 <= $a2 } {
		ImageListboxSelect sel $path $y0
		lappend s $a1
		incr a1 ; set y0 [expr $y0+$eh]
	    }
	    set GMIBox($path,sel) $s
	    update idletasks
	}
	selclr {
	    # INDEX ?INDEX?
	    # keep selection list ordered
	    if { $nargs < 1 } { BUG missing args to ImageListbox selclr }
	    foreach "a1 a2" [ImageListboxIndices $path $end [list $a1 $a2]] {}
	    if { $a2 == "" } { set a2 $a1 }
	    set s ""
	    foreach ix $sel {
		if { $ix >= $a1 && $ix <= $a2 } {
		    ImageListboxSelect clear $path [expr $ix*$eh+2]
		} else { lappend s $ix }
	    }
	    set GMIBox($path,sel) $s
	    update idletasks
	}
	cursel {
	    set res $sel
	}
	getsel {
	    set dy [expr $eh-1]
	    foreach ix $sel {
		set y0 [expr $ix*$eh]
		foreach it [$path find overlapping 0 $y0 100 [expr $y0+$dy]] {
		    foreach t [$path gettags $it] {
			if { [regsub {^txt=} $t "" tx] } {
			    lappend res $tx
			    break
			}
		    }
		}
	    }
	}
	getseltags {
	    foreach ix $sel {
		set y0 [expr ($ix+0.5)*$eh]
		foreach it [$path find overlapping 0 $y0 100 [expr $y0+4]] {
		    foreach t [$path gettags $it] {
			if { [regsub {^tgs=} $t "" tgs] } {
			    lappend res $tgs
			    break
			}
		    }
		}
	    }
	}
	seldel {
	    set dy [expr -$eh]
	    foreach ix [lsort -integer -decreasing $sel] {
		# move lower entries up
		set y0 [expr $ix*$eh] ; set yn [expr $y0+$eh]
		foreach it [$path find withtag entry] {
		    if { [set y [lindex [$path coords $it] 1]] >= $yn } {
			$path move $it 0 $dy
		    } elseif { $y >= $y0 } { $path delete $it }
		}
	    }
	    set GMIBox($path,csize) [expr $csize-[llength $sel]]
	    set GMIBox($path,sel) ""
	    update idletasks
	}
	index {
	    # Y (coordinates inside listbox)
	    if { $nargs < 1 } { BUG missing args to ImageListbox index }
	    set res [expr int($a1/$GMIBox($path,eh))+$GMIBox($path,base)]
	    if { $res > $end } { set res $end }
	}
	default { BUG calling ImageListbox with wrong action }
    }
    return $res
}

proc ImageListboxScroll {path scr pos0 posf} {
    # scrolling image listbox
    #  $scr is scrollbar
    #  $pos0, $posf are the arguments to the scrolling command
    #     percentage of vertical dimension for top and bottom positions
    global GMIBox

    set s $GMIBox($path,csize)
    set GMIBox($path,base) [expr round($s*$pos0)]
    $scr set $pos0 $posf
    return
}

proc ImageListboxResize {a aix op} {
    # called by trace when $GMIBox($path,csize) has been changed
    # resize scroll region after a change of size in image listbox
    global GMIBox

    regsub {,csize} $aix "" path
    if { ! [winfo exists $path] } { return }
    if { [set nh [expr $GMIBox($path,csize)*$GMIBox($path,eh)]] < \
	     [set max $GMIBox($path,height)] } {
	set nh $max
    }
    $path configure -scrollregion "0 0 $GMIBox($path,ew) $nh"
    return
}

proc ImageListboxSelect {act path y0} {
    # change aspect of entry when selection state changes
    #  $act in {sel, clear}
    global GMIBox COLOUR

    if { $act != "sel" } { set act "" }
    foreach it [$path find overlapping 0 $y0 100 [expr $y0+4]]] {
	if { [lsearch -exact [$path gettags $it] bg] != -1 } {
	    $path itemconfigure $it -fill $COLOUR(${act}bg)
	    break
	}
    }
    return
}

proc ImageListboxIndices {path end ixs} {
    # check indices of image-listbox widget that must be in (non-strict)
    #  increasing order
    #  $ixs is list of non-negative integers, "end", or "" (discarded)
    #  $end is either 0 or current size-1
    # return list of integers in the 0..$end range

    set r "" ; set min 0
    foreach ix $ixs {
	if { $ix == "" } { continue }
	if { $ix == "end" } {
	    set ix $end
	} elseif { ! [regexp {^[1-9]*[0-9]+$} $ix] } {
	    if { $ix != "end" } { BUG bad index for ImageListbox }
	    set ix $end
	} elseif { $ix > $end } {
	    set ix $end
	}
	if { $ix < $min } { BUG bad index for ImageListbox }
	set min $ix
	lappend r $ix
    }
    return $r
}

proc ImageListboxEButton {path y} {
    # mouse button-1 on ImageListbox entry
    global GMIBox

    if { $GMIBox($path,sel) != "" } { ImageListbox selclr $path 0 end }
    set ix [expr int($y/$GMIBox($path,eh))+$GMIBox($path,base)]
    ImageListbox selset $path $ix
    set GMIBox($path,anchor) $ix
    return
}

proc ImageListboxECButton {path y} {
    # mouse control-button-1 on ImageListbox entry
    global GMIBox

    if { $GMIBox($path,mode) != "extended" } { return }
    set ix [expr int($y/$GMIBox($path,eh))+$GMIBox($path,base)]
    if { [lsearch -exact $GMIBox($path,sel) $ix] != -1 } {
	ImageListbox selclr $path $ix
	set GMIBox($path,anchor) ""
    } else {
	ImageListbox selset $path $ix
	set GMIBox($path,anchor) $ix
    }
    return
}

proc ImageListboxESButton {path y} {
    # mouse shift-button-1 on ImageListbox entry
    global GMIBox

    if { $GMIBox($path,mode) != "extended" } { return }
    if { [set a $GMIBox($path,anchor)] == "" } {
	ImageListboxEButton $path $y
	return
    }
    if { [set ix [expr int($y/$GMIBox($path,eh))+$GMIBox($path,base)]] \
	     != $a } {
	if { $ix > $a } {
	    ImageListbox selset $path $a $ix
	} else { ImageListbox selset $path $ix $a }
    }
    set GMIBox($path,anchor) $ix
    return
}