#
#  gpsman --- GPS Manager: a manager for GPS receiver data
#
#  Copyright (c) 1998-2009 Miguel Filgueiras (mig@ncc.up.pt) / Universidade do Porto
#
#    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 2 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: options.tcl
#  Last change:  18 December 2009
#

# when inserting new data here, define TXT(opt*)
# in lang*.tcl files

# the OPTSTRUCT list contains identifiers
#  for each identifier $i one must define $OPTTYPE($i) as one of:
#      boolean    will be shown as a checkbutton
#      nat        natural number (=nonnegative integer); as an entry
#      float      any number; as an entry
#      any        any non-empty string; as an entry
#      any_empty  any string or empty; as an entry
#      colour     a special dialog is used for selection
#      perms      file permissions; a special dialog is used for selection
#      oneof      as a radiobutton; one must define $OPTVALS($i) as a
#                  a list with the possible values
#      fixedmenu  as a menubutton; one must define $OPTMENUCONTS($i) as a
#                  a list with the possible values
#      fixedtextmenu  as "fixedmenu", but an external name is shown instead
#                 of selected value; $OPTMENUCONTS($i) must be defined as
#                 above; one must also define $OPTMENUNAMES($i) to be an
#                 array of external names and $OPTMENUPREFIX($i) that is
#                 prefixed to the selected value to index the array of
#                 external names
#      menu       as a menubutton; one must define $OPTMENUPROC($i) as the name
#                  of the proc that should be called to fill in the menu; the
#                  arguments to the call are:
#                    - the menu window
#                    - the command to be associated with final entries, whose
#                    arguments are the selected value and the menu window
#      textmenu   as "menu", but an external name is shown instead of selected
#                 value; $OPTMENUPROC($i) must be defined as above; one must
#                 also define $OPTMENUNAMES($i) to be an array of external
#                 names and $OPTMENUPREFIX($i) that is prefixed to the
#                 selected value to index the array of external names
#      font       a font description
#      array      for a set of options all of the same type; one must
#                  set $OPTELTYPE($i) to it, and $OPTELS($i) to the list
#                  of options in the set; type cannot be "perms"
#      group      as button that opens a sub-window; the options given
#                  as a list to $OPTGRPL($i) will appear in it
#      sep        not an option; used to visually separate window elements
#
# the following conventions must be adhered to:
#      - identifiers of all types but group and sep are the names
#      of global variables that will be set to selected value or
#      whose elements will be set to selected values (in case of array)
#      - arrays and groups can only appear at top level

# maximum number of widgets per column
set OPTMAXHEIGHT 10

set OPTSTRUCT {   GPSREC _GPSRecConf _Formats _sep
                  _Data _sep
	          _Interf _Geom COLOUR _MapGeom MAPCOLOUR _Fonts _sep 
                  _Files
}

set OPTTYPE(_Interf) group
set OPTGRPL(_Interf) {MWINDOWSCONF LANG ISOLATIN1 DELETE USESLOWOPWINDOW
                      BalloonHelp SHOWFILEITEMS TRNUMBERINTVL TRINFO LNSREACT}
set OPTTYPE(MWINDOWSCONF) fixedtextmenu
set OPTMENUCONTS(MWINDOWSCONF) {map lists}
set OPTMENUNAMES(MWINDOWSCONF) TXT
set OPTMENUPREFIX(MWINDOWSCONF) MWC
set OPTTYPE(LANG) fixedtextmenu
set OPTMENUCONTS(LANG) $KNOWNLANGS
set OPTMENUNAMES(LANG) TXT
set OPTMENUPREFIX(LANG) LANG
set OPTTYPE(ISOLATIN1) boolean
set OPTTYPE(DELETE) boolean
set OPTTYPE(USESLOWOPWINDOW) boolean
set OPTTYPE(BalloonHelp) boolean
set OPTTYPE(SHOWFILEITEMS) boolean
set OPTTYPE(TRNUMBERINTVL) nat
set OPTTYPE(TRINFO) fixedtextmenu
set OPTMENUCONTS(TRINFO) {number date}
set OPTMENUNAMES(TRINFO) TXT
set OPTMENUPREFIX(TRINFO) ""
set OPTTYPE(LNSREACT) boolean

set OPTTYPE(GPSREC) menu
set OPTMENUPROC(GPSREC) FillRecModelsMenu

# the _GPSRecConf description is defined by proc RecModelChange
#  in file recmodels.tcl on start up and when $GPSREC changes
# set OPTTYPE(_GPSRecConf) group

set OPTTYPE(_Data) group
set OPTGRPL(_Data) {EQNAMEDATA KEEPHIDDEN}

set OPTTYPE(EQNAMEDATA) oneof
set OPTVALS(EQNAMEDATA) {ovwrt rename}

set OPTTYPE(KEEPHIDDEN) oneof
set OPTVALS(KEEPHIDDEN) {never ask always}

set OPTTYPE(_Formats) group
set OPTGRPL(_Formats) {Datum TimeOffset DISTUNIT ALTUNIT PositionFormat
                       DateFormat DEFMAPPROJ DEFMAPPFRMT DEFMAPPFDATUM
                       ACCFORMULAE ASKPROJPARAMS}

set OPTTYPE(Datum) menu
set OPTMENUPROC(Datum) FillDatumMenu

set OPTTYPE(TimeOffset) float

set OPTTYPE(DISTUNIT) oneof
set OPTVALS(DISTUNIT) {KM NAUTMILE STATMILE}

set OPTTYPE(ALTUNIT) oneof
set OPTVALS(ALTUNIT) {M FT}

set OPTTYPE(PositionFormat) fixedmenu
set OPTMENUCONTS(PositionFormat) $PFORMATS

set OPTTYPE(DateFormat) fixedtextmenu
set OPTMENUCONTS(DateFormat) [lsort -dictionary [array names DATEW]]
set OPTMENUNAMES(DateFormat) TXT
set OPTMENUPREFIX(DateFormat) {}

set OPTTYPE(DEFMAPPROJ) fixedtextmenu
set OPTMENUCONTS(DEFMAPPROJ) $MAPKNOWNPROJS
set OPTMENUNAMES(DEFMAPPROJ) TXT
set OPTMENUPREFIX(DEFMAPPROJ) PRJ

set OPTTYPE(DEFMAPPFRMT) fixedmenu
set OPTMENUCONTS(DEFMAPPFRMT) $PFORMATS

set OPTTYPE(DEFMAPPFDATUM) menu
set OPTMENUPROC(DEFMAPPFDATUM) FillDatumMenu

set OPTTYPE(ACCFORMULAE) boolean

set OPTTYPE(ASKPROJPARAMS) boolean

set OPTTYPE(_MapGeom) group
set OPTGRPL(_MapGeom) {MAPWIDTH MAPHEIGHT ICONSIZE _sep
                       MAPSCLENGTH MAPSCALE _sep
                       DPOSRTMAP _sep DEFTRTWIDTH DEFTTRWIDTH
                       DEFTLNWIDTH}
set OPTTYPE(MAPWIDTH) nat
set OPTTYPE(MAPHEIGHT) nat
set OPTTYPE(ICONSIZE) fixedmenu
set OPTMENUCONTS(ICONSIZE) {15x15 30x30}
set OPTTYPE(MAPSCLENGTH) nat
set OPTTYPE(MAPSCALE) fixedmenu
set OPTMENUCONTS(MAPSCALE) $MAPDISTS
set OPTTYPE(DPOSRTMAP) float
set OPTTYPE(DEFTRTWIDTH) fixedmenu
set OPTMENUCONTS(DEFTRTWIDTH) {1 2 3 4 5 6 7 8}
set OPTTYPE(DEFTTRWIDTH) fixedmenu
set OPTMENUCONTS(DEFTTRWIDTH) {1 2 3 4 5 6 7 8}
set OPTTYPE(DEFTLNWIDTH) fixedmenu
set OPTMENUCONTS(DEFTLNWIDTH) {1 2 3 4 5 6 7 8}

set OPTTYPE(_Fonts) group
set OPTGRPL(_Fonts) {DEFAULTFONT FIXEDFONT MAPFONT TRAVELFONT PLOTFONT}
set OPTTYPE(DEFAULTFONT) font
set OPTTYPE(FIXEDFONT) font
set OPTTYPE(MAPFONT) font
set OPTTYPE(TRAVELFONT) font
set OPTTYPE(PLOTFONT) font

set OPTTYPE(_Geom) group
set OPTGRPL(_Geom) {MAXMENUITEMS LISTWIDTH LISTHEIGHT _sep
                    LPOSX LPOSY MPOSX MPOSY RPOSX RPOSY _sep
                    EPOSX EPOSY DPOSX DPOSY}
set OPTTYPE(MAXMENUITEMS) nat
set OPTTYPE(LISTWIDTH) nat
set OPTTYPE(LISTHEIGHT) nat
set OPTTYPE(LPOSX) nat
set OPTTYPE(LPOSY) nat
set OPTTYPE(MPOSX) nat
set OPTTYPE(MPOSY) nat
set OPTTYPE(RPOSX) nat
set OPTTYPE(RPOSY) nat
set OPTTYPE(EPOSX) nat
set OPTTYPE(EPOSY) nat
set OPTTYPE(DPOSX) nat
set OPTTYPE(DPOSY) nat

set OPTTYPE(COLOUR) array
set OPTELTYPE(COLOUR) colour
set OPTELS(COLOUR) {fg bg messbg confbg selbg dialbg offline online check
                    ballbg ballfg}

set OPTTYPE(MAPCOLOUR) array
set OPTELTYPE(MAPCOLOUR) colour
set OPTELS(MAPCOLOUR) {mapsel WP RT mkRT TR TP LN mapleg anim emptygrid
                       fullgrid trvtrk trvtrn trvcts trvcts2 trvvel_z
                       trvwrnimportant trvwrnnormal trvwrninfo}

set OPTTYPE(_Files) group
if { $UNIX } {
    set OPTGRPL(_Files) {DEFSPORT _sep}
    set OPTTYPE(DEFSPORT) any
} else { set OPTGRPL(_Files) "" }
lappend OPTGRPL(_Files) SAVESTATE DELSTATE _sep PERMS PRINTCMD PAPERSIZE \
	_sep MapGuideVersion

set OPTTYPE(SAVESTATE) oneof
set OPTVALS(SAVESTATE) {never ask always}
set OPTTYPE(DELSTATE) oneof
set OPTVALS(DELSTATE) {never ask always}
set OPTTYPE(PERMS) perms
set OPTTYPE(PRINTCMD) any_empty
set OPTTYPE(PAPERSIZE) fixedmenu
set OPTMENUCONTS(PAPERSIZE) [array names PAGEWIDTH]
set OPTTYPE(MapGuideVersion) fixedmenu
set OPTMENUCONTS(MapGuideVersion) {2002 03/04}

set OPTTYPE(_sep) sep

proc OutDatedOptions {} {
    # check if options read from preferences file are outdated
    global OPTFILEVERSION VERSION MESS GPSREC MWINDOWSCONF FONTSIZE

    # check that this is not a pre-4.0 preferences file
    if { ! [catch {set OPTFILEVERSION}] } {
	set r [string compare $OPTFILEVERSION $VERSION]
	# correct outdated values
	if { [llength $GPSREC]>1 && [lindex $GPSREC 0] == "Garmin" } {
	    # no need for Garmin receiver model after version 4.0.1
	    set GPSREC Garmin ; set r 1
	}
	if { $MWINDOWSCONF == "single" } {
	    # no longer supported after 5.2
	    set MWINDOWSCONF map ; set r 1
	}
	if { ! [catch {set FONTSIZE}] } {
	    # no longer supported after 6.4
	    set r 1
	}
	if { $r == 0 || "${VERSION}-patched" == $OPTFILEVERSION } {
	    return 0
	}
    }
    AboutInfo ""
    GMMessage $MESS(outdatedprefs)
    return 1
}

proc SetOptions {} {
    # create modal dialog for setting user options
    # return 1 on success, 0 on failure
    global USEROPTIONS OPTSTRUCT OPTTYPE MESS TXT DPOSX DPOSY COLOUR VERSION \
	    TempOpts OptOldMain OptOldSub OPTMAXHEIGHT

    # window name used elsewhere
    set w .opts
    if { [winfo exists $w] } { Raise $w ; bell ; return 0 }

    GMToplevel $w options +$DPOSX+$DPOSY . \
        {WM_DELETE_WINDOW {set TempOpts cnc ; set waitopts 0}} \
	{<Key-Return> {set TempOpts ok ; set waitopts 0}}

    frame $w.fr -borderwidth 5 -bg $COLOUR(messbg)

    set i 0 ; set es "" ; set col 0
    if { [set n [llength $OPTSTRUCT]] < $OPTMAXHEIGHT } {
	set row -1 ; set drow 0 ; set maxrow 1000
    } else {
	set row 0 ; set drow 1
	if { [set z [expr int($n/$OPTMAXHEIGHT)]] != 1.0*$n/$OPTMAXHEIGHT } {
	    incr z
	}
	if { [set maxrow [expr int($n/$z)]] != $n/$z } { incr maxrow }
    }
    foreach v $OPTSTRUCT {
	set es [ShowOption $v $v $v $OPTTYPE($v) $w.fr.f$i $es Main $row $col]
	incr i
	if { [incr row $drow] > $maxrow } {
	    set row 0 ; incr col
	}
    }

    frame $w.fr.bs
    button $w.fr.bs.ok -text $TXT(ok) \
	-command { set TempOpts ok ; set waitopts 0 }
    button $w.fr.bs.cnc -text $TXT(cancel) \
	-command { set TempOpts cnc ; set waitopts 0 }

    pack $w.fr.bs.ok $w.fr.bs.cnc -side left -pady 5
    if { $row == -1 } {
	pack $w.fr.bs $w.fr -side top
    } else {
	grid $w.fr.bs -row [incr maxrow] -column 0 -columnspan [incr col] \
		-pady 5
	pack $w.fr -side top
    }

    update idletasks
    set gs [grab current]
    grab $w
    # cannot use RaiseWindow because of the menus
    while 1 {
	tkwait variable waitopts

	switch $TempOpts {
	    ""  { }
	    cnc { 
		foreach ref [array names OptOldMain] {
		    ChangeOption $ref $OptOldMain($ref)
		}
		catch {
		    foreach ref [array names OptOldSub] {
                        ChangeOption $ref $OptOldSub($ref)
			unset OptOldSub($ref)
                    }
		}
		set res 0
		break
	    }
	    ok {
		set ok 1
		foreach e $es {
		                 # these entries cannot be for array elements
		    set v [lindex $e 1]
		    global $v
		    switch $OPTTYPE($v) {
			nat -  float -  any -
			any_empty {
			    set val [[lindex $e 0] get]
			    if { [WrongValue $OPTTYPE($v) $val] } {
				GMMessage "$TXT(wrgval) $TXT(opt$v)"
				set ok 0 ; break
			    }
			    set $v $val
			}
		    }
		}
		if { $ok } {
		    if { [catch {set f [open $USEROPTIONS w]}] } {
			GMMessage $MESS(cantwrtopt)
			set res 0
			break
		    }
		    regsub -- {-patched$} $VERSION "" version
		    puts $f ""
		    puts $f "# $MESS(written) GPSMan [NowTZ]"
		    puts $f "# $MESS(editrisk)"
		    puts $f ""
		    puts $f "set OPTFILEVERSION $version"
		    puts $f ""
		    foreach v $OPTSTRUCT { GenOption $f $v }
		    close $f
		    set res 1
		    GMMessage $MESS(goingdown)
		    break
		}
	    }
	}
    }
    DestroyRGrabs $w $gs
    update idletasks
    return $res
}

proc ShowOption {v ref val type vf es lv row col} {
    # create widgets for an identifier in options list
    #  $v is identifier (normally a variable)
    #  $ref is a reference used to keep the initial value of the option
    #  $val is a reference to the option storage to be set
    #  $tipe in {boolean, nat, float, any, colour, perms, oneof, menu,
    #   textmenu, fixedmenu, fixedtextmenu, font, array, group, sep} unless
    #    $lv!="Main" in which case it cannot be in {array, group}
    #  $vf is the parent window (frame) of the widgets to create
    #  $es is list with a pair for each created entry; the pair has the
    #    path for the entry and $ref
    #  $lv recursion level in {Main Sub New}
    #  $row is -1 if frame $vf is to be packed; otherwise frame should be
    #     grided at row $row and column $col
    global OPTVALS OPTMENUPROC OPTMENUCONTS OPTMENUNAMES OPTMENUPREFIX \
	    COLOUR TXT MAXMENUITEMS OptOld$lv OptSubMany OptMenuVar \
	    OptMenuText OptPerms

    frame $vf -relief flat -borderwidth 0
    switch $type {
	boolean {
	    global $v
	    set OptOld[set lv]($ref) [set $val]
	    checkbutton $vf.f -text $TXT(opt$ref) -variable $val \
		   -anchor w -onvalue 1 -offvalue 0 \
		   -selectcolor $COLOUR(check)
	    if { [set $val] } { $vf.f select }
	    pack $vf.f -anchor w
	}
	nat -  float -  any -
	any_empty {
	    global $v
	    set OptOld[set lv]($ref) [set $val]
	    label $vf.l -text $TXT(opt$ref)
	    entry $vf.e -width 10
	    TextBindings $vf.e
	    $vf.e insert 0 [set $val]
	    pack $vf.l -side left -anchor w
	    pack $vf.e -side left -anchor e
	    lappend es "$vf.e $ref"
	}
	oneof {
	    global $v
	    set OptOld[set lv]($ref) [set $val]
	    label $vf.l -text $TXT(opt$ref)
	    pack $vf.l -anchor w
	    set i 0
	    foreach vl $OPTVALS($v) {
		radiobutton $vf.r$i -text $TXT($vl) -variable $val \
			-value $vl -anchor w -selectcolor $COLOUR(check)
		if { [set $val] == $vl } {
		    $vf.r$i invoke
		}
		pack $vf.r$i -side left -padx 2
		incr i
	    }
	}
	menu {
	    global $v
	    set OptOld[set lv]($ref) [set $val]
	    menubutton $vf.mb -text $TXT(opt$ref) -relief raised \
		    -direction below -menu $vf.mb.m$ref
	    menu $vf.mb.m$ref
	    set OptMenuVar($vf.mb.m$ref) $ref
	    $OPTMENUPROC($v) $vf.mb.m$ref ChangeMenuOption
	    label $vf.l -text [set $val] -textvariable $val
	    pack $vf.mb $vf.l -side left -padx 2 -anchor w
	}
	textmenu {
	    global $v $OPTMENUNAMES($v)
	    set OptOld[set lv]($ref) [set $val]
	    menubutton $vf.mb -text $TXT(opt$ref) -relief raised \
		    -direction below -menu $vf.mb.m$ref
	    set mw $vf.mb.m$ref
	    menu $mw
	    set OptMenuVar($mw) $ref
	    $OPTMENUPROC($v) $mw ChangeTextMenuOption
	    set OptMenuText($mw,label) $vf.l
	    set OptMenuText($mw,names) $OPTMENUNAMES($v)
	    set OptMenuText($mw,prefix) $OPTMENUPREFIX($v)
	    label $vf.l -text \
		    [set $OPTMENUNAMES($v)($OPTMENUPREFIX($v)[set $val])]
	    pack $vf.mb $vf.l -side left -padx 2 -anchor w
	}
	fixedmenu {
	    global $v
	    set OptOld[set lv]($ref) [set $val]
	    menubutton $vf.mb -text $TXT(opt$ref) -relief raised \
		    -direction below -menu $vf.mb.m$ref
	    menu $vf.mb.m$ref
	    set OptMenuVar($vf.mb.m$ref) $ref
	    set mw $vf.mb.m$ref ; set n 0 ; set m 0
	    foreach item $OPTMENUCONTS($v) {
		if { $n > $MAXMENUITEMS } {
		    $mw add cascade -label "$TXT(more) ..." -menu $mw.m$m
		    set mw $mw.m$m ; menu $mw -tearoff 0
		    set n 0 ; incr m
		}
		$mw add command -label $item \
			-command "ChangeOption $ref [list $item]"
		incr n
	    }
	    label $vf.l -text [set $val] -textvariable $val
	    pack $vf.mb $vf.l -side left -padx 2 -anchor w
	}
	fixedtextmenu {
	    global $v $OPTMENUNAMES($v)
	    set OptOld[set lv]($ref) [set $val]
	    menubutton $vf.mb -text $TXT(opt$ref) -relief raised \
		    -direction below -menu $vf.mb.m$ref
	    set mw $vf.mb.m$ref
	    menu $mw
	    set OptMenuVar($mw) $ref
	    set OptMenuText($mw,label) $vf.l
	    set OptMenuText($mw,names) $OPTMENUNAMES($v)
	    set OptMenuText($mw,prefix) $OPTMENUPREFIX($v)
	    set n 0 ; set m 0 ; set mws $mw
	    foreach item $OPTMENUCONTS($v) {
		if { $n > $MAXMENUITEMS } {
		    $mws add cascade -label "$TXT(more) ..." -menu $mws.m$m
		    set mws $mws.m$m ; menu $mws -tearoff 0
		    set n 0 ; incr m
		}
		$mws add command -label \
			[set $OPTMENUNAMES($v)($OPTMENUPREFIX($v)$item)] \
			-command "ChangeTextMenuOption [list $item] $mw"
		incr n
	    }
	    label $vf.l -text \
		    [set $OPTMENUNAMES($v)($OPTMENUPREFIX($v)[set $val])]
	    pack $vf.mb $vf.l -side left -padx 2 -anchor w
	}
	perms {
	    global $v
	    set OptOld[set lv]($ref) [set $val]
	    label $vf.l -text $TXT(opt$ref)
	    pack $vf.l -anchor w
	    set m [Measure $TXT(others)]
	    foreach z "owner permgroup others" pz [PermsToList [set $val]] {
		frame $vf.$z -relief flat
		label $vf.$z.t -text "$TXT($z):" -width $m
		pack $vf.$z.t -side left -anchor w
		foreach o "fread fwrite fexec" p $pz {
		    checkbutton $vf.$z.c$o -text $TXT($o) -anchor w \
			    -variable OptPerms($z,$o,$ref) -onvalue 1 \
			    -offvalue 0 -selectcolor $COLOUR(check)
		    if { $p } { $vf.$z.c$o select }
		    pack $vf.$z.c$o -anchor w -side left -padx 1
		}
		pack $vf.$z -side top -anchor w
	    }
	}
	colour {
	    global $v
	    set OptOld[set lv]($ref) [set $val]
	    button $vf.b -text $TXT(opt$ref) -relief raised \
		    -command "ChooseColour $v $val $vf .opts"
	    label $vf.bc -relief groove -background [set $val] -width 2
	    pack $vf.b $vf.bc -side left
	}
	font {
	    global $v
	    set f [set $val]
	    set OptOld[set lv]($ref) $f
	    button $vf.b -text $TXT(opt$ref) -relief raised \
		    -command "ChooseFont $v $val $vf .opts"
	    if { $f == "default" } { set f $TXT(default) }
	    label $vf.l -text $f -width 40
	    pack $vf.b $vf.l -side left
	}
	group {
	    if { $lv != "Main" } {
		GMMessage "Bad option type for $v: groups only at top level"
	    } else {
		set OptSubMany($v) 0
		button $vf.b -text $TXT(opt$v) -relief raised \
			-command "ShowMoreOptions $v ; \
                                  $vf.b configure -state normal"
		pack $vf.b
	    }
	}
	array {
	    if { $lv != "Main" } {
		GMMessage "Bad option type for $v: arrays only at top level"
	    } else {
		set OptSubMany($v) 0
		button $vf.b -text $TXT(opt$v) -relief raised \
			-command "ShowOptionsArray $v ; \
			          $vf.b configure -state normal"
		pack $vf.b
	    }
	}
	sep {
	    frame $vf.sep -height 6 -bg $COLOUR(dialbg) \
		    -relief flat -borderwidth 0
	    pack $vf.sep
	}
    }
    if { $row == -1 } {
	pack $vf -side top -pady 3 -anchor w -fill x
    } else { grid $vf -row $row -column $col -pady 3 -padx 3 -sticky we }
    return $es
}

proc ShowMoreOptions {g} {
    # create sub-window for setting options in the group $g
    global OPTGRPL OPTTYPE MESS TXT DPOSX DPOSY COLOUR TempMOpts OptOldSub \
	    OptOldNew OptOldMain OptSubMany OPTMAXHEIGHT

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

    GMToplevel $w options +$DPOSX+$DPOSY .opts \
        {WM_DELETE_WINDOW {set TempOpts cnc}} \
	{<Key-Return> {set TempOpts ok}}

    frame $w.fr -relief flat -borderwidth 5 -bg $COLOUR(dialbg)

    if { $OptSubMany($g) } { set lv New } else {
	set lv Sub
	foreach v $OPTGRPL($g) {
	    if { $OPTTYPE($v) != "sep" } {
		global $v
		set OptOldMain($v) [set $v]
	    }
	}
    }
    incr OptSubMany($g)
    set i 0 ; set es "" ; set col 0
    if { [set n [llength $OPTGRPL($g)]] < $OPTMAXHEIGHT } {
	set row -1 ; set drow 0 ; set maxrow 1000
    } else {
	set row 0 ; set drow 1
	if { [set z [expr int($n/$OPTMAXHEIGHT)]] != 1.0*$n/$OPTMAXHEIGHT } {
	    incr z
	}
	if { [set maxrow [expr int($n/$z)]] != $n/$z } { incr maxrow }
    }
    foreach v $OPTGRPL($g) {
	set es [ShowOption $v $v $v $OPTTYPE($v) $w.fr.f$i $es $lv $row $col]
	incr i
	if { [incr row $drow] > $maxrow } {
	    set row 0 ; incr col
	}
    }

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

    pack $w.fr.bs.ok $w.fr.bs.cnc -side left -pady 5
    if { $row == -1 } {
	pack $w.fr.bs $w.fr -side top
    } else {
	grid $w.fr.bs -row [incr maxrow] -column 0 -columnspan [incr col] \
		-pady 5
	pack $w.fr -side top
    }

    update idletasks
    set gs [grab current]
    grab $w
    # cannot use RaiseWindow
    while 1 {
	tkwait variable TempMOpts

	switch $TempMOpts {
	    ""  { }
	    cnc { 
		foreach v [array names OptOld$lv] {
		                # these cannot be arrays
		    global $v
		    set $v [set OptOld[set lv]($v)] ; unset OptOld[set lv]($v)
		}
		break
	    }
	    ok {
		set ok 1
		foreach e $es {
		                # these entries cannot be for array elements
		    set v [lindex $e 1]
		    global $v
		    switch $OPTTYPE($v) {
			nat -  float -  any -
			any_empty {
			    set val [[lindex $e 0] get]
			    if { [WrongValue $OPTTYPE($v) $val] } {
				GMMessage "$TXT(wrgval) $TXT(opt$v)"
				set ok 0 ; break
			    }
			    set $v $val
			}
		    }
		}
		if { $ok } { break }
	    }
	}
    }
    DestroyRGrabs $w $gs
    update idletasks
    return
}

proc ShowOptionsArray {a} {
    # create sub-window for setting options in options array $a
    global OPTELTYPE OPTELS MESS TXT DPOSX DPOSY COLOUR TempAOpts OptOldSub \
	    OptOldNew OptOldMain OptSubMany $a OPTMAXHEIGHT

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

    GMToplevel $w options +$DPOSX+$DPOSY .opts \
        {WM_DELETE_WINDOW {set TempOpts cnc}} \
	{<Key-Return> {set TempOpts ok}}

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

    if { $OptSubMany($a) } { set lv New } else {
	set lv Sub
	foreach ix $OPTELS($a) {
	    set OptOldMain($a,$ix) [set [set a]($ix)]
	}
    }
    incr OptSubMany($a)
    set i 0 ; set es "" ; set col 0
    if { [set n [llength $OPTELS($a)]] < $OPTMAXHEIGHT } {
	set row -1 ; set drow 0 ; set maxrow 1000
    } else {
	set row 0 ; set drow 1
	if { [set z [expr int($n/$OPTMAXHEIGHT)]] != 1.0*$n/$OPTMAXHEIGHT } {
	    incr z
	}
	if { [set maxrow [expr int($n/$z)]] != $n/$z } { incr maxrow }
    }
    foreach ix $OPTELS($a) {
	set es [ShowOption $a $a,$ix [set a]($ix) $OPTELTYPE($a) \
		           $w.fr.f$i $es $lv $row $col]
	incr i
	if { [incr row $drow] > $maxrow } {
	    set row 0 ; incr col
	}
    }

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

    pack $w.fr.bs.ok $w.fr.bs.cnc -side left -pady 5
    if { $row == -1 } {
	pack $w.fr.bs $w.fr -side top
    } else {
	grid $w.fr.bs -row [incr maxrow] -column 0 -columnspan [incr col] \
		-pady 5
	pack $w.fr -side top
    }

    update idletasks
    set gs [grab current]
    grab $w
    # cannot use RaiseWindow
    while 1 {
	tkwait variable TempAOpts

	switch $TempAOpts {
	    cnc { 
		foreach ref [array names OptOld$lv] {
		                 # saved values of array elements
		    ChangeOption $ref [set OptOld[set lv]($ref)]
		    unset OptOld[set lv]($ref)
		}
		break
	    }
	    ok {
		set ok 1
		foreach e $es {
		                  # these are entries for array elements
		    set ref [lindex $e 1]
		    set i [expr 1+[string first , $ref]]
		    set ix [string range $ref $i end]
		    switch $OPTELTYPE($a) {
			nat -  float -  any -
			any_empty {
			    set val [[lindex $e 0] get]
			    if { [WrongValue $OPTELTYPE($a) $val] } {
				GMMessage "$TXT(wrgval) $TXT(opt$ref)"
				set ok 0 ; break
			    }
			    set [set a]($ix) $val
			}
		    }
		}
		if { $ok } { break }
	    }
	}
    }
    DestroyRGrabs $w $gs
    update idletasks
    return
}

proc ChangeMenuOption {val w} {
    # change option to value $val presented as a menu, window $w
    global OptMenuVar

    ChangeOption $OptMenuVar($w) $val
    return
}

proc ChangeTextMenuOption {val w} {
    # change option to value $val presented as a menu, window $w
    #  $w may be a submenu
    global OptMenuVar OptMenuText

    while { [catch {set OptMenuText($w,names)}] && $w != "" } {
	set w [winfo parent $w]
    }
    if { $w == "" } { BUG bad menu }
    global $OptMenuText($w,names) 

    $OptMenuText($w,label) configure -text \
	    [set $OptMenuText($w,names)($OptMenuText($w,prefix)$val)]
    ChangeOption $OptMenuVar($w) $val
    return
}

proc ChangeOption {ref val} {
    # change option with reference $ref to value $val

    if { [set i [string first , $ref]] != -1 } {
	set v [string range $ref 0 [expr $i-1]] ; incr i
	global $v
	set [set v]([string range $ref $i end]) $val
    } else {
	global $ref
	set $ref $val
    }
    return
}

proc WrongValue {type val} {
    # check if $val is of given type

    switch $type {
	nat {
	    if { [catch {set neq [expr $val!=round($val)]}] || \
		    $neq || $val<0 } { return 1 }
	}
	float {
	    if { [catch {set val [expr $val]}] } { return 1 }
	}
	any {
	    if { $val == "" } { return 1 }
	}
	any_empty { return 0 }
    }
    return 0
}

proc GenOption {f v} {
    # save option $v to file $f
    global OPTTYPE OPTGRPL OptPerms

    switch $OPTTYPE($v) {
	array {
	    global $v
	    foreach e [array names $v] {
		puts $f "set [set v]($e) \"[set [set v]($e)]\""
	    }
	}
	group {
	    foreach s $OPTGRPL($v) { GenOption $f $s }
	}
	sep {
	    puts $f ""
	}
	perms {
	    global $v
	    if { [catch {set OptPerms(owner,fread,$v)}] } {
		puts $f "set $v [set $v]"
	    } else {
		puts -nonewline $f "set $v 0"
		foreach g "owner permgroup others" {
		    set d 0
		    foreach w "fread fwrite fexec" {
			set d [expr $d+$d+$OptPerms($g,$w,$v)]
		    }
		    puts -nonewline $f $d
		}
		puts $f ""
	    }
	}
	default {
	    global $v
	    puts $f "set $v \"[set $v]\""
	}
    }
    return
}

proc ChooseColour {v val bw mw} {
    # create modal dialog for choosing a colour
    #  $v is a global variable for the option storage (it may be an array)
    #  $val is a reference to the option storage to be set (it may be
    #   the array name and index)
    #  $bw is window with button .b and label .bc to configure
    #  $mw is toplevel window using this proc
    global $v TXT TempCol ChColour ColComp DPOSX DPOSY COLOUR

    $bw.b configure -state normal
    set w .copts
    if { [winfo exists $w] } { Raise $w ; bell ; return }

    GMToplevel $w options +[expr $DPOSX+100]+[expr $DPOSY+100] $mw \
        {WM_DELETE_WINDOW {set TempOpts cnc}} \
	{<Key-Return> {set TempOpts ok}}

    frame $w.fr -borderwidth 5 -bg $COLOUR(dialbg)
    frame $w.fr.fr1
    frame $w.fr.fr1.rgb

    set x [ColourToDec [set ChColour [set $val]]]
    set ColComp(red) [lindex $x 0] ; set ColComp(green) [lindex $x 1]
    set ColComp(blue) [lindex $x 2]
    foreach c "red green blue" {
	set box [frame $w.fr.fr1.rgb.$c]
	label $box.label -text "$TXT($c):" -width 6 -anchor ne
	entry $box.entry -textvariable ColComp($c) -width 4
	TextBindings $box.entry
	bind $box.entry <Return> "RGBChange $w ; break"
	scale $box.scl -orient horizontal -from 0 -to 255 -width 8 \
		-variable ColComp($c) -showvalue 0 -command "RGBChange $w"
	pack $box.label -side left -fill y -padx 2 -pady 3
	pack $box.entry $box.scl -side left -anchor n -pady 0
	pack $box -side top -fill x -padx 0 -pady 2
    }

    set self [frame $w.fr.fr1.sel]
    label $self.lab -text "$TXT(selection):" -anchor sw
    entry $self.ent -width 16
    TextBindings $self.ent
    bind $self.ent <Return> "ColSelChange $w ; break"
    bind $self.ent <Any-Leave> "ColSelChange $w ; break"
    $self.ent insert 0 $ChColour
    frame $self.f1 -relief sunken -bd 2
    canvas $self.f1.demo -bd 0 -width 100 -height 15 -bg $ChColour

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

    pack $self.lab $self.ent -side top -fill x -padx 4 -pady 2
    pack $self.f1 -expand yes -anchor nw -fill both -padx 6 -pady 10
    pack $self.f1.demo -expand yes -fill both
    pack $w.fr.fr1.rgb $w.fr.fr1.sel -side left -fill none -anchor nw
    pack $w.fr.bs.ok $w.fr.bs.cnc -side left -pady 5
    pack $w.fr.fr1 $w.fr.bs $w.fr -side top

    update idletasks
    set gs [grab current]
    grab $w
    RaiseWindow $w
    while 1 {
	tkwait variable TempCol

	switch $TempCol {
	    cnc {
		break
	    }
	    ok {
		set $val $ChColour
		$bw.bc configure -background $ChColour
		break
	    }
	}
    }
    DestroyRGrabs $w $gs
    update idletasks
    return
}

proc RGBChange {w args} {
    # change colour after user change in RGB scales
    # sets ChColour to result
    global ChColour ColComp

    set ChColour [DecToColour $ColComp(red) $ColComp(green) $ColComp(blue)]
    $w.fr.fr1.sel.f1.demo configure -bg $ChColour
    $w.fr.fr1.sel.ent delete 0 end
    $w.fr.fr1.sel.ent insert 0 $ChColour
    return
}

proc ColSelChange {w} {
    # change colour after user selection of name
    # sets ChColour to result
    global ChColour ColComp

    if { [set x [ColourToDec [$w.fr.fr1.sel.ent get]]] == -1 } {
	$w.fr.fr1.sel.ent delete 0 end
	$w.fr.fr1.sel.ent insert 0 $ChColour
	$w.fr.fr1.sel.f1.demo configure -bg $ChColour
	update idletasks
	bell
	return
    }
    set ChColour [eval DecToColour $x]
    $w.fr.fr1.sel.ent icursor end
    $w.fr.fr1.sel.f1.demo configure -bg $ChColour
    set ColComp(red) [lindex $x 0] ; set ColComp(green) [lindex $x 1]
    set ColComp(blue) [lindex $x 2]
    return
}

proc PermsToList {p} {
    # convert octal permission to list of lists of bits
    # first digit (out of 4) of $p assumed to be always zero

    scan $p "%c%c%c%c" s a b c
    return [list [PermDigToList $a] [PermDigToList $b] [PermDigToList $c]]
}

proc PermDigToList {c} {
    # convert octal digit to binary list

    set x [expr $c-48]
    return "[expr ($x&4)!=0] [expr ($x&2)!=0] [expr $x&1]"
}

proc ChooseFont {v val bw mw} {
    # choose a font using proc GMSelectFont and configure options windows
    #  $v is a global variable for the option storage (it may be an array)
    #  $val is a reference to the option storage to be set (it may be
    #   an array name and index)
    #  $bw is window with button .b and label .l to configure
    #  $mw is toplevel window using this proc
    global $v TXT

    $bw.b configure -state normal
    if { [set f [GMSelectFont]] == "" } { return }
    set $val $f
    if { $f == "default" } { set f $TXT(default) }
    $bw.l configure -text $f
    update idletasks
    return
}

