#
# Copyright (c) 1993 Eric Schenk.
# All rights reserved.
#
# Permission is hereby granted, without written agreement and without
# license or royalty fees, to use, copy, modify, and distribute this
# software and its documentation for any purpose, provided that the
# above copyright notice and the following two paragraphs appear in
# all copies of this software.
# 
# IN NO EVENT SHALL ERIC SCHENK BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
# OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF ERIC
# SCHENK HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# ERIC SCHENK SPECIFICALLY DISCLAIMS ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND ERIC SCHENK HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#

# User preferences reading.

proc initialize_prefs {} {
    global tkwm_libpath
    # clear the resource database
    option clear
    option readfile $tkwm_libpath/widget.appdefs widgetDefault
    if {[winfo screendepth .]>"1"} {
	option readfile $tkwm_libpath/tkwm_color.appdefs startupFile
	catch {option readfile ~/.tkwm_color.appdefs startupFile}
    } else {
	option readfile $tkwm_libpath/tkwm_mono.appdefs startupFile
	catch {option readfile ~/.tkwm_mono.appdefs startupFile}
    }
}

# get a list of classes and names for the preference editor

proc pref_client_list {} {
    global window_list tkwm_prefs::classes tkwm_prefs::names tkwm_prefs::global
    if [info exists tkwm_prefs::classes] {unset tkwm_prefs::classes}
    if [info exists tkwm_prefs::names] {unset tkwm_prefs::names}
    set tkwm_prefs::global {}
    foreach i $window_list {
	upvar "#0" $i data
	lappend tkwm_prefs::global $data(res_name)
	lappend tkwm_prefs::classes([winfo class $data(res_name)]) $data(res_name)
	lappend tkwm_prefs::names([winfo name $data(res_name)]) $data(res_name)
    }
}

# lists of user mungable preferences

foreach i {-background -foreground -activebackground -activeforeground \
    -disabledforeground -activeborderwidth -font -cursor -borderwidth} {
    set menu::prefs($i) 1
}
set client::prefs {-manager -opaqueMove -opaqueResize \
    -constrained -use_WM_STATE}
set tkwm_client_frame::prefs {-cursor -titlebar -font -background \
    -borderwidth -rightbuttons -leftbuttons \
    -foreground -activeBackground -activeForeground}
set icontoplevel::prefs {-width -height -bitmap -manager -opaqueMove \
    -opaqueResize -constrained}
set tkwm_icon_frame::prefs {-cursor -titlebar -font -background \
    -foreground -activeBackground -activeForeground}

# Get the current settings
proc apply_resources {} {
    global window_list menu_list
    # Do menu preferences
    foreach i $menu_list {
	apply_resources_normal_win $i
    }
    # Do window preferences
    foreach i $window_list {
	upvar "#0" $i data
	set w $data(res_name)
	apply_resources_win $w
	if [winfo exists $w.transient-decoration] {
	    apply_resources_win $w.transient-decoration
	} else {
	    apply_resources_win $w.decoration
	}
	if ![winfo exists $w.icon] {continue}
	apply_resources_win $w.icon
	apply_resources_win $w.icon.decoration
    }
}

# some nasty hacks to speed things up a little on internal widgets
proc apply_resources_win {i} {
    upvar "#0" $i data
    upvar "#0" $data(type) type
    upvar "#0" $data(type)::prefs typenames
    set clist {}
    foreach j $typenames {
	set val [option get $i [lindex $type($j) 0] [lindex $type($j) 1]]
	if ![string match $val $data($j)] {
	    lappend clist $j $val
	}
    }
    if {$clist!=""} {eval $i config $clist}
}

proc apply_resources_normal_win {i} {
    global menu::prefs
    set res [eval $i config]
    set clist {}
    foreach j $res {
        if [info exists menu::prefs([lindex $j 0])] {
	    set val [option get $i [lindex $j 1] [lindex $j 2]]
	    if ![string match $val [lindex $j 4]] {
		lappend clist [lindex $j 0] $val
	    }
	}
    }
    if {$clist!=""} {eval $i config $clist}
}

# This routine provides for user "hooks" to allow more complex rules
# for configuration than can be dealt with using X resources alone.
# A hook procedure receives the client and the result of the resource lookup.
# A hook procedure must return a valid setting to replace the result
# or the original result itself.

proc get_resource_value {path res_name res_class} {
    global preferences
    upvar "#0" $path data
    upvar "#0" $data(root) rdata
    set hook hook[string range $path [string length $rdata(res_name)] end].$res_name
    set result [option get $data(res_name) $res_name $res_class]
    catch {set result [$hook $client $result]}
    return $result
}

# Dummy function for now. In the future this will implement
# retargeting of the resource name for clients that match
# criteria specified by the user.

proc retarget_res_name {win res_name} {
    catch {set res_name [resource_name.hook $win $res_name]}
    return $res_name
}