#
# user defined menu entries
#
proc userc_Make {} {
    global Config

    toplevel .user
    wm minsize .user 0 0

    message .user.t -text "User defined menu entries" -width 300 \
	    -font [option get . option_bold_font {} ] 
    pack  .user.t -side top

    frame .user.l
    label .user.l.l -text "   "
    label .user.l.com -text "Command" -width 45
    label .user.l.des -text "Description"  -width 15

    pack .user.l.l -side left
    pack .user.l.com -side left -fill x -expand yes
    pack .user.l.des -side left -fill x -expand yes
    pack .user.l -side top -fill x -expand yes

    set n 1
    foreach m [option get .top.macro.m entrylist {} ] {
	userc_lines $n $m
	incr n
    }

    frame .user.x -relief sunken -borderwidth 2
    button .user.x.save -text "Save" -command "userc_done 1"
    button .user.x.exit  -text "Exit" -command "userc_done 0"

    pack .user.x.save -side left -padx 20m -pady 5m
    pack .user.x.exit -side right -padx 20m -pady 5m
    pack .user.x -side top -fill both -expand yes
    wm geometry .user $Config(.user)
}

proc userc_lines {n m} {
    global com_user des_user

    frame .user.l$n
    label .user.l$n.l -text " $m "
    entry .user.l$n.com -relief sunken -width 45
    .user.l$n.com delete 0 999
    .user.l$n.com insert 0 $com_user($m)

    entry .user.l$n.des -relief sunken -width 15

    .user.l$n.des delete 0 999
    .user.l$n.des insert 0 $des_user($m)
    label .user.l$n.ll -text "   "
    pack  .user.l$n.l -side left
    pack  .user.l$n.com .user.l$n.des -side left -fill x -expand yes
    pack  .user.l$n.ll -side left 
    pack  .user.l$n -side top -fill x -expand yes
}

proc userc_done {save} {
    global com_user des_user

    set i 1
    .top.macro.m delete 0 last
    foreach m [option get .top.macro.m entrylist {} ] {
	set  com_user($m) [.user.l$i.com get]
	set  des_user($m) [.user.l$i.des get]
        .top.macro.m add command -label $des_user($m) -command \
                "put_extended {$com_user($m)}"
	incr i
    }

    if {$save} {
	config_save
    }
    destroy .user
}

proc userc_menu {menu} {
    global com_user des_user

    foreach m [option get $menu entrylist {} ] {
	set des_user($m) [option get $menu l_$m {}]
	set com_user($m) [option get $menu c_$m {}]
	$menu add command -label $des_user($m) -command \
		"put_extended {$com_user($m)}"
    }
}

#
#	Options
#
proc config_save_geom {} {
    config_layout
    config_save
}

proc config_layout {}  {
    global Config config_windows

    set Config(.nn) [wm geometry .]
    foreach i $config_windows {
	catch {
	    if {[winfo exists $i]} {
	    set Config($i) [wm geometry $i]
	    }
	}
    }
}

proc config_read {} {
    global nn_directory Config config_windows config_var nn_x_dir

     if [catch {option readfile "$nn_x_dir/tcl/nn-defaults" user} err] {
       tkerror "nn-defaults error: $err"
     }
    if [file exists $nn_directory/nn-defaults] {
       if [catch {option readfile "$nn_directory/nn-defaults" user} err] {
           tkerror "nn-defaults error: $err"
       }
    }

    if [file exists $nn_directory/tk-config] {
       if [catch {option readfile "$nn_directory/tk-config" user} err] {
           tkerror "tk-config error: $err"
       }
    }

    foreach i $config_windows {
	if [winfo exists $i] {
	    set Config($i) [option get  ${i} position {}]
	} else {
#           workaround for requirement for window to exist
#           before can get option
	    frame $i
	    set Config($i) [option get ${i} position {}]
	    destroy $i
	}
#	puts "$i $Config($i)"
    }
    foreach i $config_var  {
	set Config($i) [option get . $i {}]
#	puts "=$i $Config($i)"
    }
}

proc config_save {} {
    global Config nn_directory config_windows config_var
    global com_user des_user  has_exmh

    set fname "$nn_directory/tk-config"
    set f [open $fname w]

    foreach i [lsort $config_windows] {
	set s [string range $i 1 end]
	if {$Config($i) != ""} {
	    set Config($i) [config_check_geom $Config($i)]
	    puts $f "*$s.position: $Config($i)"
	}
    }
    puts $f "!!"
    foreach i [lsort $config_var] {
	puts $f "*$i: $Config($i)"
    }
    puts $f "!!"
    foreach m [option get .top.macro.m entrylist {} ] {
	puts $f "*top.macro.m.l_$m:	$des_user($m)"
	puts $f "*top.macro.m.c_$m:	$com_user($m)"
    }
    close $f
    if {$has_exmh} {
	nn_PreferencesSave
    }
}

proc config_check_geom {g} {
    scan $g "%dx%d+%d+%d" xs ys xp yp
    if {$xs < 0} {
	set xs 0
    }
    if {$ys < 0} {
	set ys 0
    }
    return [format "%dx%d+%d+%d"  $xs $ys $xp $yp]
}

#
# nn specific variable setting
#
# variables_m    - variables modified from default
# variables_prev - original value of variables
# variables_val  - value used by widgets
# variables_ch   - variables  that have changed

proc variables_Make {all} {
    global variables_local
    global variables_ch variables_m variables_val variables_prev variables_help

    set variables_local 0

    if {[info exists variables_ch]} {
	unset variables_ch
    }
    set variables_ch(1) 1
    unset variables_ch(1)
    if {[info exists variables_m]} {
	unset variables_m
    }
    set variables_m(1) 1
    unset variables_m(1)
    if {[info exists variables_val]} {
	unset variables_val
    }
    set variables_val(1) 1
    unset variables_val(1)
    if {[info exists variables_prev]} {
	unset variables_prev
    }

    if {$all} {
	set label "NN variables (all)"
    } else {
	set label "NN variables (modified)"
    }
    opt_Make variables variables "nn_variables $all" $label
}

proc variables_ent {name type tag} {
    global variables_m 
#          nn variable modified from default
    global variables_prev
#          current value nn variable
    global var_str             
#          The value of the nn variable (may have arbitrary characters)
    global variables_local
#          an nn local value enountered

    if {$var_str == "NULL"} {
	set var_str ""
    }
    set variables_prev($name) $var_str

    set local 0

    if {$tag == "m"} {
	set variables_m($name) 1
    } elseif {$tag == "p"} {
	set local 1
	if {! $variables_local} {
	    set variables_local  1
	    msg_Make "WARNING - There are local variables, if saved these will replace the corresponding global ones"
	    update
	    after 8000 {destroy .msg}
	}
    }
    opt_item variables variables $name $type "" $name $local 1
}

proc variables_done {d save} {
     global variables_ch variables_prev variables_m variables_val print

    foreach i [array names variables_ch] {
	nn_set_var $i $variables_ch($i)
#       nn_set_var doesn't return sucess or failure so
#       so need to check if variable changed
        global change_var
	if {$variables_ch($i) == [nn_get_var $i]} {
	    set variables_m($i) 1
	    set variables_prev($i) $variables_ch($i)
	    set variables_val($i) $variables_ch($i)
	} else {
	    nn_set_var $i $variables_prev($i)
	    set variables_ch($i) $variables_prev($i)
	    set variables_val($i) $variables_prev($i)
	    return
	}
    }
    if {[info exists variables_ch(printer)]} {
	set print(cmd) "cat \$file | $variables_ch(printer)"
    }
    if {$save} {
	variables_save
    }
    destroy .variables
}

proc variables_save {} {
    global nn_directory
    global variables_m variables_val

    set fname "$nn_directory/tk-init-nn"
    set f [open $fname w]
    foreach i [array names variables_m] {
	puts  $f "set $i $variables_val($i)"
    }
    close $f
}

#
# nn-tk specific option setting
#

proc options_fill {vname vlist} {
    global options_prev Config config_var options_val options_ch
    global options_type options_header options_other

    catch {
	unset options_val
	unset options_ch
    }

    foreach i $vlist   {
	set options_prev($i) $Config($i)
	if {[info exists options_type($i)]} {
	    opt_item $vname options $i $options_type($i) $options_header($i) \
		[if {[info exists options_other($i)]} {
		    set x $options_other($i)
		} else {
		    set x ""
		}]
	} else {
	    opt_item $vname options $i
	}
    }
}

proc options_done {w save} {
    global menu_mode options_ch options_prev options_val Config 

    set do_list  0
    set do_listc  0
    set do_menu  0
    if {[info exists options_ch]} {
	foreach i [array names options_ch] {
	    switch -exact -- $i {
		mono_font { more_font }
		middle_button_pos {
		    middle_buttons
		    if {$Config(middle_button_pos) == 1} {
			pack  .middle -side top -after .top
		    } elseif {$Config(middle_button_pos) == 2} {
			pack  .middle -side top -after .menu-prompt
		    } else {
			pack  .middle -side top -after .more
		    }
		}
		menu_min {
		    set options_val($i) [.$w.c.f.menu_max.mmin get]
		}
		menu_max {
		    set options_val($i) [.$w.c.f.menu_max.mmax get]
		}
		single_main {
		    set do_list 1
		}
		group_list_read {
		    set do_listc 1
		}
		group_list_unsub {
		    set do_listc 1
		}
		group_list_all {
		    set do_listc 1
		}
		group_list_width {
		    set options_val($i) [.$w.c.f.$i.s get]
		    set do_list 1
		}
		group_menu_read {
		    set do_menu 1
		}
		group_menu_unsub {
		    set do_menu 1
		}
	    }
	    set Config($i) $options_val($i)
	}
    }
    if {$save == 1} {
	config_save
    }
    set_option_values
    if {$do_list} {
	list_reset
    } elseif {$do_listc} {
	list_clear
    }
    if {$do_menu == "1"} {
	destroy .top.m.menu
	menu .top.m.menu
	foreach i [info commands .top.m.menu-*] {
	    catch {destroy $i}
	}
	grp_menu
    }
    destroy .$w
}

#
# Generic options setting code
#
proc opt_button {var l} {
    upvar #0 ${var}_ch var_ch
    upvar #0 ${var}_val var_val
    set var_ch($l)  $var_val($l)
}

proc opt_radio {var str name args} {

    set n 0
    foreach i $args {
	radiobutton $str.$n -text $i -variable ${var}_val($name) \
		-value $n -relief flat -command "opt_button $var $name"
	pack $str.$n -side top -pady 2 -padx 3 -anchor w
	incr n
    }
}

proc opt_check_int {name element op} {
    regexp {^[^_]*} $name var

    upvar #0 ${var}_val var_val
    upvar #0 ${var}_ch var_ch
    upvar #0 ${var}_prev var_prev

    if {[regexp {^[0-9\-]*$} $var_val($element)]} {
	set var_ch($element) $var_val($element)
    } else {
	set var_val($element) $var_prev($element)
    }
}

proc opt_check_key {name element op} {
    regexp {^[^_]*} $name var

    upvar #0 ${var}_val var_val
    upvar #0 ${var}_ch var_ch

    set var_ch($element) $var_val($element)
}

proc opt_check_str {name element op} {
    regexp {^[^_]*} $name var

    upvar #0 ${var}_val var_val
    upvar #0 ${var}_ch var_ch

    set var_ch($element) $var_val($element)
}

proc opt_help_item {w v name} {
    upvar #0 ${v}_help var_help 

    .$w.m.t delete 0.0 end
    if {[info exists var_help($name)]} {
	.$w.m.t insert 0.0 $var_help($name)
    }
}

proc opt_h_mmin {val} {
    global options_ch
    set options_ch(menu_max) 1

    set maxv [.var_misc.c.f.menu_max.mmax get]
    if {$maxv < $val} {
	.var_misc.c.f.menu_max.mmax set $val
    }
}

proc opt_h_mmax {val} {
    global options_ch
    set options_ch(menu_min) 1

    set minv [.var_misc.c.f.menu_max.mmin get]
    if {$minv > $val} {
	.var_misc.c.f.menu_max.mmin set $val
    } 
}

proc opt_scale {name val} {
    global $name options_ch options_prev
    if {$val != $options_prev($name)} {
	set options_ch($name) 1
    }
}

proc opt_item {w v name {type ""}  {desc ""}  {other ""} {local 0} {bonoff 0}} {
    upvar #0 ${v}_val var_val 
    #         new varlue of variable
    upvar #0 ${v}_prev var_prev 
    global butt
    #         radio button names for variable

    set var_val($name) $var_prev($name)
    if {$desc == ""} {
	set desc $name
    }

    frame .$w.c.f.$name -borderwidth 2  -relief ridge

    switch -regexp -- $type \
	bool {
	    checkbutton .$w.c.f.$name.b -variable ${v}_val($name) \
		-text $desc -command "opt_button $v $name" \
		-relief flat
	    if {$bonoff} {
		.$w.c.f.$name.b configure -offvalue off -onvalue on
	    }
	    pack  .$w.c.f.$name.b -anchor w -padx 8
	}\
	int|key {
	    label .$w.c.f.$name.m -text $desc 
	    if {[info exists butt($name)]} {
		pack  .$w.c.f.$name.m  -side top -padx 8
		eval "opt_radio $v .$w.c.f.$name $name \
		    $butt($name)"
	    } else {
		pack .$w.c.f.$name.m  -side left -padx 8
		entry  .$w.c.f.$name.e -relief sunken -width 7 \
		    -textvariable ${v}_val($name)
		pack .$w.c.f.$name.e -side right -anchor e  -padx 8
		if {$type == "int"} {
		    trace variable var_val($name) w opt_check_int
		} else {
		    trace variable var_val($name) w opt_check_key
		}
	    }
	}\
	str|spec|code {
	    label .$w.c.f.$name.m -text $desc
	    entry  .$w.c.f.$name.e -relief sunken \
		-textvariable ${v}_val($name)
	    trace variable var_val($name) w opt_check_str
	    pack  .$w.c.f.$name.m  -expand yes
	    pack  .$w.c.f.$name.e -expand yes -pady 3 -fill x -padx 8
	}\
	slider {
	    scale .$w.c.f.$name.s -label $desc  -from [lindex $other 0]\
		-to [lindex $other 1]\
		-orient horizontal -command "opt_scale $name"
	    pack .$w.c.f.$name.s -fill x
	    global ${v}_val
	    .$w.c.f.$name.s set [set ${v}_val($name)]
	}\
	panel {
	    #   special case - menu size 
	    scale .$w.c.f.$name.mmax -label "Menu panel max size" -from 1 -to 36  \
		-orient horizontal   -command "opt_h_mmax"
	    .$w.c.f.$name.mmax set $var_prev(menu_max)
	    scale .$w.c.f.$name.mmin -label "Menu pane min size" -from 1 -to 36  \
		-orient horizontal   -command "opt_h_mmin"
	    .$w.c.f.$name.mmin set $var_prev(menu_min)
	    pack .$w.c.f.$name.mmax .$w.c.f.$name.mmin -side top -fill x
	}\
	"" {
	}\
	default {
	    puts "$name TYPE=$type"
	}

    pack .$w.c.f.$name  -side top -pady 2 -expand yes \
	-anchor w -fill x
    bind  .$w.c.f.$name <Enter> \
	"opt_help_item $w $v $name" 

    if {$local} {
	.$w.c.f.$name configure -borderwidth 6 -relief sunken
    }
}

proc opt_read_help {v} {
    global help_directory ${v}_help

    set fname "$help_directory/help.$v"
    if {[file  exists $fname]} {
        set f [open $fname r]
        while {[gets $f line] >= 0} {
	    set nst [string first "\t" $line ]
	    set nss [string first " " $line ]
	    if {$nss> 0 && $nss < $nst} {
		set nst $nss
	    }
	    set nf [string last  "\t" $line ]
	    set var [string range $line 0 [incr nst -1]]
	    set comm [string range $line [incr nf] end]
	    set ${v}_help($var) $comm
	}
	close $f
    }
}

proc opt_Make {w v var_fill label} {
    global  Config $w color_bd

    if {![info exists ${v}_help]} {
	opt_read_help $v
    }

    toplevel .$w
    wm minsize .$w 0 0

    frame .$w.f

    label .$w.l -text $label -relief raised -pady 6 -bg $color_bd 
    pack .$w.l -fill both 

    frame .$w.m -relief raised -borderwidth 2 
    text .$w.m.t  -relief raised -setgrid true \
	    -height 2 -font [option get . option_bold_font {} ] -wrap word
    pack .$w.m.t  -expand yes -fill y
    pack .$w.m -fill y

    canvas .$w.c 
    frame .$w.c.f

    set id [.$w.c create window 0 0 -window .$w.c.f -anchor nw]

    scrollbar .$w.s1 -command ".$w.c yview" -relief sunk
    .$w.c config  -yscrollcommand ".$w.s1 set"

    pack .$w.s1 -in .$w.f -fill y -side right -expand yes \
	    -anchor w
    pack .$w.c -in .$w.f -expand yes -fill both \
	    -anchor w

    eval $var_fill

    pack .$w.f -expand yes -fill y

    frame .$w.x -relief sunken -borderwidth 2
    button .$w.x.save -text "Save" -command "${v}_done $w 1"
    pack  .$w.x.save  -side right -padx 1m -pady 3m
    button .$w.x.apply  -text "Apply" -command "${v}_done $w 0"
    pack .$w.x.apply -side right -padx 1m -pady 3m
    button .$w.x.cancel  -text "Cancel" -command "destroy .$w"
    pack .$w.x.cancel -side left -padx 1m -pady 3m

    pack .$w.x -side bottom -fill both

    wm geometry .$w $Config(.$w)
    update
    .$w.c configure -scrollregion [.$w.c bbox  $id]
}

