#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/saverc.tcl,v $
# $Date: 2001/06/13 07:20:28 $
# $Revision: 1.18.1.35 $
#
package provide zircon 1.18
#
proc putProc {desc cmnt name list dflt args} {
    if {$dflt} {
	set dl $args
    } {
	global defaultNet
	set dl [$defaultNet ${name}s]
	switch {} $args {} default {lappend dl $args}
    }
    switch {} $list {} default {
	switch {} $cmnt {set pc 0} default {set pc 1}
	foreach l $list {
	    switch {} $l continue
	    if {[lsearch -exact $dl $l] < 0} {
		if {$pc} {puts $desc "#\n# $cmnt\n#" ; set pc 0}
		puts $desc "$name [list $l]"
	    }
	}
    }
}
#
proc saverc {net} {
    global zircon
    switch default [set nn [$net name]] {
    	set rc [file join $zircon(prefdir) preferences]
	set rcd [list $zircon(prefdir)]
	set dflt 1
    } default {
	set rcd [file join $zircon(prefdir) netspaces]
	set rc [file join $rcd $nn]
	if {[file isdirectory $rc]} {
	    set rcd [list $zircon(prefdir) $rcd $rc]
	    set rc [file join $rc preferences]
	} {
	    set rcd [list $zircon(prefdir) $rcd]
	}
	set dflt 0
    }
    if {[file exists $rc]} {
	file stat $rc st
	set mode $st(mode)
	set rc [lindex [glob $rc] 0]
	if {[catch {filerename $rc $rc.bak} msg]} {
	    if {![askUser {} {Rename Error} "Cannot rename $rc to $rc.bak - $msg\nProceed without bak file?"]} {
	        return 0
	    }
	    set bak 0
	} {
	    set bak 1
	}
    } {
	foreach dx $rcd {
	    if {![file exists $dx]} {
		if {[catch {filemkdir $dx} msg]} {
		    tellError {} Error "Error when creating $rcd - $msg"
		    return 0
		}
	    }
	}
	set mode 0600
	set bak 0
    }
    if {[catch {open $rc w $mode} desc]} {
	tellError {} Error \
	  "Error when opening preferences file for write - $desc" 
	if {$bak} {
	    if {[catch {filerename $rc.bak $rc} msg]} {
	        tellError {} Error "Cannot rename $rc.bak to $rc - $msg"
	    }
	}
	return 0
    }
    if {[catch {doSave $dflt $net $desc} msg]} {
	catch {close $desc}
	if {[catch {filerename $rc $rc.tmp} msg]} {
	    tellError {} Error "Cannot rename $rc to $rc.tmp - $msg"
	}
	if {$bak} {
	    if {[catch {filerename $rc.bak $rc} msg]} {
	        tellError {} Error "Cannot rename $rc.bak to $rc - $msg"
	    }
	}
	bgerror $msg
	tellError {} Error "Error while saving preferences file - $msg"
	return 0
    }
    return 1
}
#
proc saveSocks {desc dflt net} {
    global defaultNet
    switch {} [set sh [$net sockshost]] {} default {
        if {!$dflt} { switch [$defaultNet sockshost] $sh return }
        set l "usesocks [list $sh]"
	switch --  [$net socksport] 1080 {} default {
	    append l " [$net socksport]"
	}
	puts $desc "$l\n#"
    }
}
#
proc doSave {dflt net desc} {
    global zircon defaults DEBUG trust RCFV defaultNet user Configure.Net
    if {$dflt} {
	puts $desc "#\n# Zircon preferences file saved - [getDate]\n#"
    } {
	puts $desc "#\n# Zircon Netspace [$net name] saved - [getDate]\n#"
    }
#
# Save things that are different from the default...
#
    puts $desc "preferences format $RCFV"
#
# save SOCKS information
#
    saveSocks $desc $dflt $net
    if {$dflt} {
	foreach z [array names defaults] {
	    switch -- $zircon($z) $defaults($z) {} default {
	        puts $desc "net zircon($z) [list $zircon($z)]"
	    }
	}
	foreach z {soundcmd cciport wwwclient} {
	    if {[info exists zircon($z)]} {
		puts $desc "net zircon($z) [list $zircon($z)]"
	    }
	}
    }
#
# Optional values
#
    saveLook $desc $net
    saveShare $desc $net
    puts $desc "#\n# Netspace Control Values\n#"
    foreach v {action leave signoff away} {
	putProc $desc "[capitalise $v] messages" $v [$net ${v}s] $dflt
    }
    global Net
    array set ndefs $Net
    foreach v [array names ndefs] {
	if {$dflt} {set dv $ndefs($v)} {set dv [$defaultNet $v]}
	switch -- [$net $v] $dv continue
	switch [set Configure.Net($v)] {
	mseconds {
		switch $v {
		testTime { # dont save this }
		default {puts $desc "net $v [expr {[$net $v] /1000}]"}
		}
	    }
	list {
		puts $desc "net $v \{"
		foreach x [$net $v] { puts $desc "    [list $x]" }
		puts $desc "\}"
	    }
	default	{ puts $desc "net $v [list [$net $v]]" }
	}
    }
    putProc $desc Nicknames nick [$net nicks] $dflt $user
    putProc $desc {IRC names} ircname [$net ircnames] $dflt %u@%h
    Server :: save $desc $net
    Service :: save $desc $net
    Friend :: save $desc $net
    set cm 0
    foreach p [$net ignores] {
	switch {} [lindex $p 1] {} default {
	    if {$cm} { puts $desc "#\n# Ignores\n#" ; set cm 0 }
	    puts $desc "ignore [list [lindex $p 0]] [list [lindex $p 1]]"
	}
    }
    foreach x {Channel Message Notice Chat} { $x :: save $desc $net }
    set cm 1
    upvar #0 OnCode$net OnCode
    foreach x [array names OnCode] {
	foreach on $OnCode($x) {
	    if {$cm} { puts $desc "#\n# On Conditions\n#" ; set cm 0 }
	    puts $desc "on $x $on"
	}
    }
    switch {} [$net bindings] {} default {
	puts $desc "#\n# Global Bindings\n#"
	foreach on [$net bindings] { puts $desc "zbind {} $on\n" }
    }
    set cm 1 
    foreach x [array names trust "$net,*"] {
	regexp -- {.*,(.*)} $x m lm
	if {$dflt} {
	    switch -- $trust($x) $trust($lm) continue
	} {
	    switch -- $trust($x) $trust($defaultNet,$lm) continue
	    switch -- $trust($x) $trust($lm) continue
	}
	if {$cm} { puts $desc "#\n# Trust settings\n#" ; set cm 0 }
	puts $desc "net trust($lm) [list $trust($x)]"
    }
    if {$dflt} {
	foreach x [Net :: list] {
	   switch $x $net {} default {puts $desc "#\nNetspace [$x name]"}
	}
    }
    close $desc
}
#
proc saveCurrent {net} {
    global defChan defMsg
    switch {} $net {set net [Net :: list]}
    foreach ns $net {
	foreach x [$ns channels] { $x configure -keep 1 }
	catch {$defChan($ns) configure -keep 0}
	foreach x [$ns messages] { $x configure -keep 1 }
	catch {$defMsg($ns) configure -keep 0}
	saverc $ns
    }
}
#
proc ditchSize {w} {
    if {[regexp -- {.*(\+.*\+.*)} [wm geometry $w] m x]} {
        return $x
    }
    return 200x100
}
#
proc saveLayout {net} {
    global zircon
    set rc [file join $zircon(prefdir) layout]
    if {[file exists $rc]} {
	file stat $rc st
	set mode $st(mode)
	set rc [lindex [glob $rc] 0]
	if {[catch {filerename $rc $rc.bak} msg]} {
	    tellError {} Error "Error when renaming $rc - $msg"
	    return 0
	}
	set bak 1
    } {
	set mode 0600
	set bak 0
    }
    if {[catch {open $rc w $mode} desc]} {
	tellError {} Error "Error when opening layout file for write - $desc"
	if {$bak} { exec mv $rc.bak $rc }
	return 0
    }
    if {[winfo exists .@inf]} {
        puts $desc "layout default info [ditchSize .@inf]"
    } {
        puts $desc {# we are integrated, so info window}
    }
    puts $desc "layout default control [ditchSize .@ctl]"
    if {[winfo exists .@dbgctl]} {
	puts $desc "layout default debug [ditchSize .@dbgctl]"
    }
    close $desc
    return 1
}
