#
#  gpsman --- GPS Manager: a manager for GPS receiver data
#
#  Copyright (c) 2002 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:  1 February 2002
#

# 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
#      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
#      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

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

set OPTTYPE(_Interf) group
set OPTGRPL(_Interf) {MWINDOWSCONF LANG ISOLATIN1 DELETE BalloonHelp
                      TRNUMBERINTVL}
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(BalloonHelp) boolean
set OPTTYPE(TRNUMBERINTVL) nat

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

# the _GPSRecConf description may be changed by proc RecModelChange
#  in file recmodels.tcl when $GPSREC changes
set OPTTYPE(_GPSRecConf) group
set OPTGRPL(_GPSRecConf) {NAMELENGTH COMMENTLENGTH MAXWPOINTS MAXROUTES
                      MAXWPINROUTE MAXTPOINTS CREATIONDATE NOLOWERCASE
                      DEFAULTSYMBOL DEFAULTDISPOPT}
set OPTTYPE(NAMELENGTH) nat
set OPTTYPE(COMMENTLENGTH) nat
set OPTTYPE(MAXWPOINTS) nat
set OPTTYPE(MAXROUTES) nat
set OPTTYPE(MAXWPINROUTE) nat
set OPTTYPE(MAXTPOINTS) nat
set OPTTYPE(CREATIONDATE) boolean
set OPTTYPE(NOLOWERCASE) boolean
set OPTTYPE(DEFAULTSYMBOL) textmenu
set OPTMENUPROC(DEFAULTSYMBOL) FillSymbolsMenu
set OPTMENUNAMES(DEFAULTSYMBOL) TXT
set OPTMENUPREFIX(DEFAULTSYMBOL) SY
set OPTTYPE(DEFAULTDISPOPT) fixedtextmenu
set OPTMENUCONTS(DEFAULTDISPOPT) $DISPOPTS
set OPTMENUNAMES(DEFAULTDISPOPT) TXT
set OPTMENUPREFIX(DEFAULTDISPOPT) DISP

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 PositionFormat DateFormat
                       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(PositionFormat) fixedmenu
set OPTMENUCONTS(PositionFormat) $PFORMATS

set OPTTYPE(DateFormat) oneof
set OPTVALS(DateFormat) "YYYYMMDD YYYY-MM-DD MMDDYYYY DDMMMYYYY"

set OPTTYPE(ACCFORMULAE) boolean

set OPTTYPE(ASKPROJPARAMS) boolean

set OPTTYPE(_MapGeom) group
set OPTGRPL(_MapGeom) {MAPWIDTH MAPHEIGHT _sep
                       MAPSCLENGTH MAPSCALE _sep
                       DPOSRTMAP}

set OPTTYPE(_Geom) group
set OPTGRPL(_Geom) {MAXMENUITEMS LISTWIDTH LISTHEIGHT _sep
                    LPOSX LPOSY MPOSX MPOSY RPOSX RPOSY _sep
                    EPOSX EPOSY DPOSX DPOSY}
set OPTTYPE(MAPWIDTH) nat
set OPTTYPE(MAPHEIGHT) nat
set OPTTYPE(MAPSCLENGTH) nat
set OPTTYPE(MAPSCALE) fixedmenu
set OPTMENUCONTS(MAPSCALE) $MAPDISTS
set OPTTYPE(MAXMENUITEMS) 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(DPOSRTMAP) float
set OPTTYPE(LISTWIDTH) nat
set OPTTYPE(LISTHEIGHT) 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 mapleg anim emptygrid fullgrid}

set OPTTYPE(_Files) group
if { "$tcl_platform(platform)" == "unix" } {
    set OPTGRPL(_Files) {DEFSPORT _sep SAVESTATE DELSTATE _sep PERMS PAPERSIZE}
    set OPTTYPE(DEFSPORT) any
} else {
    set OPTGRPL(_Files) {SAVESTATE DELSTATE _sep PERMS PAPERSIZE}
}
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(PAPERSIZE) fixedmenu
set OPTMENUCONTS(PAPERSIZE) [array names PAGEWIDTH]

set OPTTYPE(_sep) sep

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

    if { [catch "set OPTFILEVERSION"] } {
	# this is a pre-4.0 preferences file
	AboutInfo ""
	GMMessage $MESS(outdatedprefs)
	return 1
    }
    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 { $r } {
	AboutInfo ""
	GMMessage $MESS(outdatedprefs)
	return 1
    }
    return 0
}

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

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

    toplevel $w
    wm protocol $w WM_DELETE_WINDOW { set TempOpts cnc ; set waitopts 0 }
    wm title $w "GPS Manager: $TXT(options)"
    wm transient $w .
    wm geometry $w +$DPOSX+$DPOSY
    bind $w <Key-Return> { set TempOpts ok ; set waitopts 0 }

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

    set i 0 ; set es ""
    foreach v $OPTSTRUCT {
	set es [ShowOption $v $v $v $OPTTYPE($v) $w.fr.f$i $es Main]
	incr i
    }

    frame $w.fr.bs
    button $w.fr.bs.ok -text 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
    pack $w.fr.bs $w.fr -side top

    update idletasks
    grab $w
    # RaiseWindow $w
    while 1 {
	tkwait variable waitopts

	switch $TempOpts {
	    ""  { }
	    cnc { 
		destroy $w
		foreach ref [array names OptOldMain] {
		    ChangeOption $ref $OptOldMain($ref)
		}
		catch {
		    foreach ref [array names OptOldSub] {
                        ChangeOption $ref $OptOldSub($ref)
			unset OptOldSub($ref)
                    }
		}
		update idletasks
		return 0
	        }
	    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 {
			    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)
			destroy $w
			update idletasks
			return 0
		    }
		    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
		    destroy $w
		    update idletasks
		    return 1
		}
	    }
	}
    }
}

proc ShowOption {v ref val type vf es lv} {
    # 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, 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}
    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 {
	    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
	    foreach vl $OPTVALS($v) {
		radiobutton $vf.r$vl -text $TXT($vl) -variable $val \
			-value $vl -anchor w -selectcolor $COLOUR(check)
		if { "[set $val]" == "$vl" } {
		    $vf.r$vl invoke
		}
		pack $vf.r$vl -side left -padx 2
	    }
	}
	menu {
	    global $v
	    set OptOld[set lv]($ref) [set $val]
	    menubutton $vf.mb -text $TXT(opt$ref) -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) -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) -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) -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 $ref $val $vf"
	    label $vf.bc -relief groove -background [set $val] -width 2
	    pack $vf.b $vf.bc -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
	}
    }
    pack $vf -side top -pady 3 -anchor w -fill x
    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

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

    toplevel $w
    wm protocol $w WM_DELETE_WINDOW { set TempMOpts cnc ; set waitmopts 0 }
    wm title $w "GPS Manager: $TXT(options)"
    wm transient $w .opts
    wm geometry $w +$DPOSX+$DPOSY
    bind $w <Key-Return> { set TempMOpts ok ; set waitmopts 0 }

    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 ""
    foreach v $OPTGRPL($g) {
	set es [ShowOption $v $v $v $OPTTYPE($v) $w.fr.f$i $es $lv]
	incr i
    }

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

    pack $w.fr.bs.ok $w.fr.bs.cnc -side left -pady 5
    pack $w.fr.bs $w.fr -side top

    set pw [grab current]
    update idletasks
    grab $w
    # RaiseWindow $w
    while 1 {
	tkwait variable waitmopts

	switch $TempMOpts {
	    ""  { }
	    cnc { 
		destroy $w
		if { "$pw" != "" } {
		    grab [lindex $pw 0]
		}
		foreach v [array names OptOld$lv] {
		                # these cannot be arrays
		    global $v
		    set $v [set OptOld[set lv]($v)] ; unset OptOld[set lv]($v)
		}
		update idletasks
		return
	        }
	    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 {
			    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 } {
		    destroy $w
		    if { "$pw" != "" } {
			grab [lindex $pw 0]
		    }
		    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

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

    toplevel $w
    wm protocol $w WM_DELETE_WINDOW { set TempAOpts cnc ; set waitaopts 0 }
    wm title $w "GPS Manager: $TXT(options)"
    wm transient $w .opts
    wm geometry $w +$DPOSX+$DPOSY
    bind $w <Key-Return> { set TempAOpts ok ; set waitaopts 0 }

    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 ""
    foreach ix $OPTELS($a) {
	set es [ShowOption $a $a,$ix [set a]($ix) $OPTELTYPE($a) \
		           $w.fr.f$i $es $lv]
	incr i
    }

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

    pack $w.fr.bs.ok $w.fr.bs.cnc -side left -pady 5
    pack $w.fr.bs $w.fr -side top

    set pw [grab current]
    update idletasks
    grab $w
    # RaiseWindow $w
    while 1 {
	tkwait variable waitaopts

	switch $TempAOpts {
	    ""  { }
	    cnc { 
		destroy $w
		if { "$pw" != "" } {
		    grab [lindex $pw 0]
		}
		foreach ref [array names OptOld$lv] {
		                 # saved values of array elements
		    ChangeOption $ref [set OptOld[set lv]($ref)]
		    unset OptOld[set lv]($ref)
		}
		update idletasks
		return
	        }
	    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 {
			    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 } {
		    destroy $w
		    if { "$pw" != "" } {
			grab [lindex $pw 0]
		    }
		    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
    global OptMenuVar OptMenuText
    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 }
	}
    }
    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 ref val bw} {
    # create modal dialog for choosing a colour
    #  $v is a global 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
    #  $bw is window with button and label to configure
    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 }

    toplevel $w
    wm protocol $w WM_DELETE_WINDOW { set TempCol cnc ; set waitcopts 0 }
    wm title $w "GPS Manager: $TXT(options)"
    wm transient $w .opts
    set x [expr $DPOSX+100] ; set y [expr $DPOSY+100]
    wm geometry $w +$x+$y

    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 -textvariable ChColour -width 16
    TextBindings $self.ent
    bind $self.ent <Return> "ColSelChange $w ; break"
    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 Ok -command { set TempCol ok ; set waitcopts 0 }
    button $w.fr.bs.cnc -text $TXT(cancel) \
	    -command { set TempCol cnc ; set waitcopts 0 }

    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

    set pw [grab current]
    update idletasks
    grab $w
    RaiseWindow $w
    while 1 {
	tkwait variable waitcopts

	switch $TempCol {
	    ""  { }
	    cnc {
		destroy $w
		if { "$pw" != "" } {
		    grab [lindex $pw 0]
		}
		update idletasks
		return
	    }
	    ok {
		set $val $ChColour
		$bw.bc configure -background $ChColour
		destroy $w
		if { "$pw" != "" } {
		    grab [lindex $pw 0]
		}
		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
    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 } {
	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 ColourToDec {c} {
    # convert name to RGB values
    global RGBNamed SRCDIR WorkDir

    if { [string first # $c] == 0 } {
	if {[scan $c "#%c%c%c%c%c%c" h0 h1 h2 h3 h4 h5]!=6 } { return -1 }
	set b2 0 ; set b1 0 ; set b0 0
	for { set i 0 } { $i<6 } { incr i } {
	    set v b[expr int($i/2)]
	    set $v [expr 16*[set $v]+[HexCharToDec [set h$i]]]
	}
    } else {
	if {! [array exists RGBNamed] } {
	    set d [pwd] ; cd $WorkDir
	    source [file join $SRCDIR rgb.tcl]
	    cd $d
	}
	if { "[array names RGBNamed $c]" == "" } { return -1 }
	scan $RGBNamed($c) "%d %d %d" b0 b1 b2
    }
    return "$b0 $b1 $b2"
}

proc HexCharToDec {x} {
    # convert hexadecimal character to decimal value

    if { $x < 65 } {
	return [expr $x-48]
    } elseif { $x < 97 } {
	return [expr $x-55]
    }
    return [expr $x-87]
}

proc DecToColour {c2 c1 c0} {
    # convert RGB in decimal-triplet to hexadecimal representation

    set d [expr 65536*$c2+256*$c1+$c0]
    for { set i 0 } { $i<6 } { incr i } {
	set h$i [DecToHexChar [expr $d%16]]
	set d [expr int($d/16)]
    }
    return [format "#%c%c%c%c%c%c" $h5 $h4 $h3 $h2 $h1 $h0]
}

proc DecToHexChar {d} {
    # convert RGB as decimal integer to hexadecimal representation

    if { $d < 10 } { return [expr $d+48] } else { return [expr $d+87] }
}

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]"
}
