# options.tk - support file for TkMail (accessed through tclIndex)
#	    commands for user operations on TkMail settings
#
# $Header: /u/ra/raines/cvs/tk/tkmail2/options.tk,v 1.8 1995/12/14 00:49:44 raines Exp $
if $mfp(debug) {puts stderr "options.tk sourced"}

proc mfv:opt-master { } {
  global mf mfp mfopt

  set w .mf_newopt
  
  if { ![winfo exists $w] } {

    toplevel $w -class MailOpt
    wm title $w "TkMail v$mfp(version) Option Editor"
    wm minsize $w 530 360
    wm geometry $w [string trim $mf(option-editor-geom)]
    wm protocol $w WM_DELETE_WINDOW "mfv:opt-cancel $w"
    bind $w <FocusIn> "set mfp(curtop) $w"
    set mfopt(last) 0

    frame $w.list -bd 4
    label $w.list.lbl -text "Select Category"
    listbox $w.list.lb -yscroll "$w.list.scr set" -relief sunken \
	-exportselection 0 -width 16 -height 20
    scrollbar $w.list.scr -command "$w.list.lb yview" -relief raised

    bindtags $w.list.lb "Listbox $w.list.lb $w all"
    bind $w.list.lb <1> "mfv:opt-select $w"
    bind $w.list.lb <Up> "mfv:opt-select $w; focus $w.list.lb"
    bind $w.list.lb <Down> "mfv:opt-select $w; focus $w.list.lb"

    eval "$w.list.lb insert end $mfopt(choices)"
    $w.list.lb activate 0
    $w.list.lb selection anchor 0
    $w.list.lb selection set 0

    pack $w.list.lbl -side top -fill x 
    if {$mf(disp-left-scroll)} {
      pack $w.list.scr -side left -fill y
    } else {
      pack $w.list.scr -side right -fill y
    }
    pack $w.list.lb -side left -expand true -fill both
    
    frame $w.bb
    button $w.bb.apply -text "Apply"
    button $w.bb.save -text "Save" -command "mfv:opt-save $w"
    button $w.bb.reset -text "Reset" -command "mfv:opt-reset $w"
    button $w.bb.cancel -text "Dismiss" -command "mfv:opt-cancel $w"

    pack $w.bb.apply $w.bb.save $w.bb.reset $w.bb.cancel \
	 -side left -expand true -fill both

    frame $w.work -bd 3 -relief sunken
    text $w.work.help -height 4 -wrap word -relief groove \
	-bd 3 -padx 2 -pady 2
    pack $w.work.help -side bottom -expand true -fill x \
	-padx 5 -pady 5 -anchor s

    pack $w.bb -side bottom -fill x
    pack $w.list -side left -fill y
    pack $w.work -side left -expand true -fill both \
	-padx 5 -pady 5

    mfv:opt-select $w

  } else {
    if {![winfo ismapped $w]} {
      wm deiconify $w
    }
    mfv:opt-select $w 0
  }
  raise $w
}

proc mfv:opt-message { w txt } {
  $w.work.help configure -state normal
  $w.work.help delete 1.0 end
  $w.work.help insert end "\n         $txt"
  set bg [lindex [$w.work.help configure -background] 4]
  $w.work.help configure -background black -state disabled
  after 300 $w.work.help configure -background $bg
}

proc mfv:opt-cancel { w } {
  global mfp mfopt

  if $mfp(trap-exit) return

  if [mfv:opt-check-change $w] {
    if $mfopt(modified) {
      if [ut:getok -prompt "Options changed but not saved. Save now?" \
	      -master $w -oklabel Save -nolabel {Maybe Later}] {
	mfv:opt-save $w
      }
    }
    wm withdraw $w
  }
}

proc mfv:opt-reset { w } {
  global mf mfp mfopt

  set last [$w.list.lb get $mfopt(last)]
  set last [string tolower [lindex $last 0]]

  eval "mfv:opt-${last}-display $w.work.$last"

  mfv:opt-message $w {VALUES RESET}
}

proc mfv:opt-select { w {check 1}} {
  global mf mfp mfopt

  if {$check} {
    if {![mfv:opt-check-change $w]} {
      $w.list.lb selection clear 0 end
      $w.list.lb activate $mfopt(last)
      $w.list.lb selection anchor $mfopt(last)
      $w.list.lb selection set $mfopt(last)
      return
    }
  }

  set choice [$w.list.lb get [$w.list.lb curselection]]
  set choice [string tolower [lindex $choice 0]]
  if {![string length choice]} return

  set last [$w.list.lb get $mfopt(last)]
  set last [string tolower [lindex $last 0]]

  set work $w.work
  eval "mfv:opt-${choice}-display $work.$choice"

  if [winfo exists $work.$last] {
    pack forget $work.$last
  }
  $w.work.help configure -state normal
  $w.work.help delete 1.0 end
  $w.work.help configure -state disabled

  $w.bb.apply configure -command "mfv:opt-${choice}-apply $work.$choice"
  pack $work.$choice -side top -expand true -fill both
  set mfopt(last) [$w.list.lb curselection]
}

proc mfv:opt-simple-entry { name opt txt {wide 0}} {
  global mf mfopt

  frame $name
  label $name.lbl -text $txt -width $wide -anchor w
  entry $name.ent -relief sunken \
      -textvariable mfopt($opt)
  pack $name.lbl -side left
  pack $name.ent -side left -fill x -expand true -ipady 2
  mfv:opt-help-bind $name $opt
}

proc mfv:opt-simple-yesno { name opt txt } {
  global mf mfopt

  frame $name
  label $name.lbl -text $txt
  radiobutton $name.yes -text "Yes" -relief flat \
      -variable mfopt($opt) -value 1
  radiobutton $name.no -text "No" -relief flat \
      -variable mfopt($opt) -value 0
  pack $name.lbl -side left
  pack $name.yes $name.no \
      -side left -padx 5
  mfv:opt-help-bind $name $opt
}

proc mfv:opt-validate { opt } {
  global mf mfp mfd env mfopt
  
  set desc X
  if {[llength [set extopt [split $opt ","]]] > 1} {
    catch {set desc $mfd([lindex $extopt 0])}
  } else {
    catch {set desc $mfd($opt)}
  }

  if {[catch "set opttype \[string range \$desc 0 0\]"]} {
    set opttype X
  }
  set val $mfopt($opt)

  switch -regexp $opttype {

    {N} {
      if {[catch "expr $val"]} {
	append mfopt(errmsg) "ERROR: $val is not a valid number for $opt\n"
	return 1
      }
    }
    {K} {
      if {[catch "bind Text $val"]} {
	if {[catch "bind Text <${val}-a>"]} {
	  append mfopt(errmsg) "ERROR: $val is not a valid key sequence for $opt\n"
	  return 1
	}
      }
    }
    {T} {
      set cmd [string trim [lindex $val 0]]
      if {[lsearch [info commands] $cmd] == -1 && [string length $cmd]} {
	append mfopt(errmsg) "ERROR: $cmd is not a valid Tcl command for $opt\n"
	return 1
      }
    }
    {D|f} {
      set file [string trim $val]
      if {$opttype == "f"} {
	set dir [file dirname $file]
	set file [file tail $file]
      } else {set dir $file}
      if {![string length [set ndir [lindex [glob -nocomplain $dir] 0]]]} {
	append mfopt(errmsg) "ERROR: $dir is not a valid directory for $opt\n"
	return 1
      }
      if {![file isdirectory $ndir]} {
	append mfopt(errmsg) "ERROR: $ndir is not a valid directory for $opt\n"
	return 1
      }
    }
    {F} {
      set file [string trim $val]
      if {![string length [set nfile [lindex [glob -nocomplain $file] 0]]]} {
	append mfopt(errmsg) "ERROR: $file does not exist for $opt\n"
	return 1
      }
    }
    {C} {
      foreach opt {underline relief background foreground font} {
	if {[catch "$mfp(tmptxt) tag configure testtag -$opt {$mfopt(tagopt,$opt)}"]} {
	  append mfopt(errmsg) "ERROR: $mfopt(tagopt,$opt) not valid text tag for -$opt\n"
	  return 1
	}
      }
    }
  }

  return 0
}

proc mfv:opt-help-bind { w opt } {
  set class [winfo class $w]
  bind $w <Enter> "[bind $class <Any-Enter>]"
  bind $w <Enter> "+mfv:opt-set-help $w $opt"
}

proc mfv:opt-set-help { w opt } {
  global mfd
  set top [winfo toplevel $w]
  $top.work.help configure -state normal
  $top.work.help delete 1.0 end
  $top.work.help insert end [string range $mfd($opt) 2 end]
  $top.work.help configure -state disabled
}

proc mfv:opt-change-q { w } {
  global mf mfp mfopt

  set changed 0
  foreach opt $mfopt(list) {
    if {$opt == "header-config"} {
      foreach opt {underline relief background foreground font} {
	if {$mfopt(tagopt,$opt) != $mfopt(tagorig,$opt)} {
	  incr changed
	  break
	}
      }
    } elseif {$mf($opt) != $mfopt($opt)} {
      incr changed
      break
    }
  }
  
  if [llength $mfopt(text)] {
    if [lindex $mfopt(text) 2] {
      if {[string compare $mf([lindex $mfopt(text) 0]) \
	       [split [string trim [[lindex $mfopt(text) 1] get 1.0 end]] \n]] != 0} {
	incr changed
      }
    } else {
      if {[string compare $mf([lindex $mfopt(text) 0]) \
	       [[lindex $mfopt(text) 1] get 1.0 end-1c]] != 0} {
	incr changed
      }
    }
  }

  if {[$w.list.lb get $mfopt(last)] == "User"} {
    # check if text binding has undo info to tell it was modified
    global tkText 
    if [info exists tkText($w.work.user.txt,undoCnt)] {
      if {$tkText($w.work.user.txt,undoCnt) > 0} { 
	incr changed 
      }
    }
  }

  return $changed
}

proc mfv:opt-check-change { w } {
  global mf mfp mfopt

  if [mfv:opt-change-q $w] {
    return [ut:getok -prompt "Changes never applied. Continue?" \
		-master $w -oklabel Yes -nolabel No]
  } else { return 1 }
}

proc mfv:opt-universal-apply { w } {
  global mf mfp mfopt mf_openlist

  set w [winfo toplevel $w]
  set mfopt(errmsg) {}
  set errors 0

  if {![mfv:opt-change-q $w]} {
    mfv:opt-message $w {NO CHANGES TO APPLY}
    return 0
  } else {
    set mfopt(modified) 1
  }

  foreach opt $mfopt(list) {
    incr errors [mfv:opt-validate $opt]
  }
  if [string length $mfopt(errmsg)] {
    mfv:error-mesg $mfopt(errmsg)
    if $errors {return 1}
  }

  foreach opt $mfopt(list) {
    set mf($opt) $mfopt($opt)
  }

  if [llength $mfopt(text)] {
    if [lindex $mfopt(text) 2] {
      set mf([lindex $mfopt(text) 0]) \
	  [split [string trim [[lindex $mfopt(text) 1] get 1.0 end]] \n]
    } else {
      set mf([lindex $mfopt(text) 0]) \
	  [[lindex $mfopt(text) 1] get 1.0 end-1c]
    }
  }      

  foreach opt $mfopt(list) {
    switch $opt {
      {mail-system} {
	# if [catch {mfv_set mailspool [file dirname $mf(mail-system)]} res] {
	#   mfv:error-mesg "Cannot set inbox to $mf(mail-system). $res"
	#   set mf(mail-system) $mfp(inbox)
	# } else {
	#   unset mf_openlist($mfp(inbox))
	#   set mfp(inbox) [mfv_util fullpath $mf(mail-system)]
	#   set mf_openlist($mfp(inbox)) InBox
	#   mfv:checklist-remove $oldbox
	#   mfv:checklist-add $mf(mail-system)
	# }
	mfv:error-mesg "Sorry, cannot change mf(mail-system) on the fly yet.\
		You must save options and restart TkMail."
      }
      {mail-mbox} {
	mfv:error-mesg "Sorry, cannot change mf(mail-mbox) on the fly yet.\
		You must save options and restart TkMail."
      }
      {mail-tmpdir} {
	if [catch {mfv_set tmpdir $mf(mail-tmpdir)} res] {
	  mfv:error-mesg "Cannot set tmpdir to $mf(mail-tmpdir). $res"
	  set mf(mail-tmpdir) [mfv_set tmpdir]
	}
      }
      {mail-remove-empty} {
	mfv_set noempty $mf(mail-remove-empty)
      }
      {headlist-format} {
	mfv_set sumformat "%1S%3n $mf(headlist-format)"
      }
      {header-retain} {
	if [string length $mf(header-retain)] {
	  mfv_set retain $mf(header-retain)
	} else {
	  mfv_set strip $mf(header-strip)
	}
      }
      {header-strip} {
	mfv_set strip $mf(header-strip)
      }
    }
  }

  mfv:opt-message $w {SETTINGS APPLIED}
  return 0
}

proc mfv:opt-save { w {checkq 1}} {
  global mf mfp mfopt mfuser env

  if {$checkq && [mfv:opt-change-q $w]} {
    eval $mf(viewer-beep-error)
    mfv:opt-message $w {FIRST APPLY CHANGES BEFORE SAVING}
    return 0
  }

  set varlist(mf) ""
  set varlist(mfuser) ""
  set in_usersect 0
  set found_end 0

  $mfp(tmptxt) delete 1.0 end
  set i 1
  set sp "  "
  if {[file exists $mfp(setfile)] && $mfp(setfile) != ""} {

    if {[catch {exec cp $mfp(setfile) $mfp(setfile).old}]} {
      mfv:error-mesg "WARNING: Was not able to backup $mfp(setfile) to $mfp(setfile).old" $w
    }
    if {[catch {open $mfp(setfile) r} tfid]} {
      mfv:error-mesg "ERROR: $tfid" $w
      return 0
    }
    $mfp(tmptxt) insert 1.0 [read $tfid]
    catch {close $tfid}

    for {set i 1} {[$mfp(tmptxt) compare $i.0 < end]} {incr i} {
      set line [$mfp(tmptxt) get $i.0 "$i.0 lineend"]

      if {[regexp -nocase \
	       "^\[ \t]*#+\[ \t]*USER SETTINGS\[ \t]*\$" $line]} {
	set in_usersect 1
	continue
      }
      if {!$in_usersect} continue
      if {[regexp -nocase \
	       "^\[ \t]*#+\[ \t]*END OF USER SETTINGS\[ \t]*\$" $line]} {
	set found_end 1
	break
      }
      if {[regexp "^(\[ \t]*)set\[ \t]*((mf|mfuser)\\((\[-0-9a-z_]+)\\))" \
	       $line trash sp var arr name]} {
	$mfp(tmptxt) delete $i.0 "$i.0 lineend"
	if [info exists $var] {
	  set val [eval "set $var"]
	  lappend varlist($arr) $name

	  $mfp(tmptxt) mark set insert $i.0
	  $mfp(tmptxt) insert $i.0 "${sp}set $var {$val}"
	  scan [$mfp(tmptxt) index insert] %d i
	} else { incr i -1 }
      } else {
	if {![regexp "^\[ \t]*#" $line]} {
	  $mfp(tmptxt) delete $i.0 "$i.0 lineend +1 char"
	  incr i -1
	}
      }
    }

  } else {
    set mfp(setfile) $mfp(homedir)/.tkmail4rc
  }

  $mfp(tmptxt) mark set insert $i.0
  if {!$in_usersect} {
    $mfp(tmptxt) insert insert "\# USER SETTINGS\n"
    $mfp(tmptxt) insert insert "\# everything between here and the END OF USER SETTINGS\n"
    $mfp(tmptxt) insert insert "\# comment line will be rewritten on an Option Save\n"
    $mfp(tmptxt) insert insert "\# put nothing but set mf()/mfuser() commands between them\n"
  }
  foreach name [lsort [array names mf]] {
    if {[lsearch $varlist(mf) $name] == -1} {
      set val [eval "set mf($name)"]
      $mfp(tmptxt) insert insert "${sp}set mf($name) {$val}\n"
    }
  }
  if {![catch "array names mfuser" names]} {
    foreach name [lsort $names] {
      if {[lsearch $varlist(mfuser) $name] == -1} {
        set val [eval "set mfuser($name)"]
        $mfp(tmptxt) insert insert "${sp}set mfuser($name) {$val}\n"
      }
    }
  }
  if {!$found_end} {
    $mfp(tmptxt) insert insert "\# END OF USER SETTINGS\n\n"
  }

  if {[catch {open $mfp(setfile) w} tfid]} {
    mfv:error-mesg "ERROR: $tfid" $w
    return 0
  }
  puts $tfid [$mfp(tmptxt) get 1.0 end]
  catch {close $tfid}

  set mfopt(modified) 0
  if [winfo exists $w] {mfv:opt-message $w {SETTINGS SAVED}}
  return 1
}

proc mfv:opt-general-display { f } {
  global mf mfp mfopt

  set mfopt(list) [list mail-mbox mail-system mail-deliver viewer-print \
		       mail-interval mail-autosave disp-left-scroll \
		       mail-auto-incorp mail-remove-empty mail-tmpdir \
		       viewer-pipe-dir]
  set mfopt(text) {}

  foreach opt $mfopt(list) {
    set mfopt($opt) $mf($opt)
  }

  if {![winfo exists $f]} {
    frame $f

    label $f.lbl -text "General Options"
    pack $f.lbl -side top -pady 10

    mfv:opt-simple-entry $f.mbox mail-mbox \
	"Default Mail Box: " 16
    mfv:opt-simple-entry $f.spool mail-system \
	"Mail Spool File: " 16
    mfv:opt-simple-entry $f.deliver mail-deliver \
	"Deliver Program: " 16
    mfv:opt-simple-entry $f.print viewer-print \
	"Print Command: " 16
    mfv:opt-simple-entry $f.pipe viewer-pipe-dir \
	"Pipe directory: " 16
    mfv:opt-simple-entry $f.tmpdir mail-tmpdir \
	"Temp directory: " 16

    frame $f.interval
    label $f.interval.lbl -text "Milliseconds between:  New Mail checks"
    entry $f.interval.ent -relief sunken \
	-textvariable mfopt(mail-interval) -width 9
    label $f.interval.lbl2 -text "Autosaves"
    entry $f.interval.ent2 -relief sunken \
	-textvariable mfopt(mail-autosave) -width 9
    pack $f.interval.lbl -side left
    pack $f.interval.ent -side left -ipady 2 -padx 5
    pack $f.interval.lbl2 -side left
    pack $f.interval.ent2 -side left -ipady 2 -padx 5

    frame $f.bool
    checkbutton $f.bool.scroll -text "Scrollbars on left" \
	-variable mfopt(disp-left-scroll) -relief flat
    checkbutton $f.bool.auto -text "Auto Incorporate" \
	-variable mfopt(mail-auto-incorp) -relief flat -state disabled

    frame $f.bool2
    checkbutton $f.bool2.empty -text "Remove empty folders" \
	-variable mfopt(mail-remove-empty) -relief flat

    pack $f.bool.scroll $f.bool.auto -side left -padx 10 \
	-expand true -fill x
    pack $f.bool2.empty -side left -padx 10 -expand true -fill x

    pack $f.mbox $f.spool $f.deliver $f.print $f.pipe $f.tmpdir \
	$f.interval $f.bool $f.bool2 -side top -fill x -padx 10 -pady 5

    mfv:opt-help-bind $f.interval.ent mail-interval
    mfv:opt-help-bind $f.interval.ent2 mail-autosave
    mfv:opt-help-bind $f.bool.scroll disp-left-scroll
    mfv:opt-help-bind $f.bool.auto mail-auto-incorp
    mfv:opt-help-bind $f.bool2.empty mail-remove-empty

    foreach w {mbox spool deliver print pipe tmpdir} {
      mfv:bind-file-complete $f.$w.ent
    }
  }
  focus $f.mbox.ent
}

proc mfv:opt-general-apply { f } {
  mfv:opt-universal-apply $f
}

proc mfv:edit-alias-file { top } {
  # popup editor for users alias file
  global mf mfp env

  if {$mf(mail-alias-type) != "bsd"} {
    mfv:error-mesg "Please use $mf(mail-alias-type) to edit your aliases."
    return 0
  }

  set mfp(aliasfile) ""
  set w [ut:simpletext -master $top -title "TkMail Alias Edit" \
     -leftscroll $mf(disp-left-scroll) -focus $top \
     -buttons {{Print mfv:print %W tw %W.txt} {Save mfv:save-alias-file %W} {Search mfv:search-prompt %W} {Cancel}}]
  bind $w <FocusIn> "set mfp(curtop) $w"

  if {[lempty $mf(mail-alias-file)]} {
    if {$mf(mail-alias-type) == "elm"} {
      set mf(mail-alias-file) "$mfp(homedir)/.elm/aliases.text"
      $w.txt insert end "\# Alias Format: <alias> = <desc> = <addrlist>\n"
      $w.txt insert end "\# Example: soccer = List of Soccer players = tjs10@nowhere.com,"
      $w.txt insert end "david, sara@univ.edu\n"
      $w.txt insert end "\# Note: continued lines after first begin with spaces or tabs"
    } else {
      set mf(mail-alias-file) "$mfp(homedir)/.mailrc"
      $w.txt insert end "\# Alias Format: a <alias> <addrlist>\n"
      $w.txt insert end "\# Example: a soccer tjs10@nowhere.com,"
      $w.txt insert end "david, sara@univ.edu\n"
      $w.txt insert end "\# Note: continued lines end with backslash"
    }
    if {![file exists $mf(mail-alias-file)]} {
      if {[mfv:text-to-file $w.txt $mf(mail-alias-file)]} {
	mfv:error-mesg $mfp(last-error)
	return 0
      }
    } else {
      $w.txt delete 1.0 end
      if {[mfv:file-to-text $mf(mail-alias-file) $w.txt 1.0]} {
	mfv:error-mesg $mfp(last-error)
	return 0
      }
    }
    set mfp(aliasfile) $mf(mail-alias-file)
    mfv:error-mesg "WARNING: Set mf(mail-alias-file) to $mfp(aliasfile). You will need to save options for this to take effect next session."
  } else {
    # take first writable file as users personal alias file
    foreach afile $mf(mail-alias-file) {
      if {[file writable $afile]} {
	if {[mfv:file-to-text $afile $w.txt 1.0]} {
	  mfv:error-mesg $mfp(last-error)
	  return 0
	}
	set mfp(aliasfile) $afile
	break
      }
    }
  }
}

proc mfv:save-alias-file { w } {
  # save alias file from alias editor <w>
  global mf mfp

  if {[mfv:text-to-file $w.txt $mfp(aliasfile) 1]} {
    mfv:error-mesg $mfp(last-error)
    return 0
  }
  if {[mfv:parse-alias-file]} {
    return 0
  }
  destroy $w
  if {$mfp(curtop) == $w} {set mfp(curtop) $mfp(curview)}
  return 1
}