Admin Control Panel v2.0

✎ Editing: WmDefault.tcl ← Back

# -*-mode: tcl; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
#
#	$Id: WmDefault.tcl,v 1.7 2008/03/17 22:47:00 hobbs Exp $
#
#	Description: Package for making Tk apps use the CDE/KDE/Gnome/Windows scheme
#	Prefix: wm_default::
#	Url: http://tix.sourceforge.net/Tixapps/
#
# Usage:
#	It should be sufficient at the beginning of a wish app to simply:
#
#	    package require wm_default
#	    wm_default::setup
#	    wm_default::addoptions
#
# 	wm_default::setup takes an optional argument - the scheme if already
#	known, one of: windows gnome kde1 kde2 cde kde
# 	wm_default::addoptions takes optional arguments - pairs of variables
#	and values to override the kde settings. e.g. 
#		wm_default::addoptions -background blue
#
# Description:
#       package for making Tk apps look nice under CDE or KDE or Windows
#
#	The stuff below attempts to use the options database and the
#	various files under ~/.dt, $DTHOME, and /usr/dt to figure out
#	the user's current font and color set.  It then uses tk's
#	palette routines to set sensible defaults, and then override
#	some of the options to try to make them look like CDE.
#
#	There really *must* be an easier way to get text background
#	colors and the radiobutton highlight colors out of the
#	options database or winfo atom...  Unfortunately, I can't
#	figure out how...

# This package is based on the cde package by D. J. Hagberg, Jr.:
# dhagberg@glatmos.com

########################################################################
#
#
 # Copyright 1998 D. J. Hagberg, Jr. and Global Atmospherics, Inc.
 #
 # Permission to use, copy, modify, and distribute this software and its
 # documentation for any purpose and without fee is hereby granted, provided
 # that the above copyright notice appear in all copies.
 # D. J. Hagberg, Jr. and Global Atmospherics, Inc. make no representations
 # about the suitability of this software for any It is provided "as is"
 # without express or implied warranty.  By use of this software the user
 # agrees to  indemnify and hold harmless D. J. Hagberg, Jr. and Global
 # Atmospherics, Inc. from any claims or liability for loss arising out
 # of such use.
########################################################################

package require Tk

proc tixDetermineWM {} {
    # Returns one of cde kde1 kde2 gnome windows or ""
    global tcl_platform env

set type ""
    if {$tcl_platform(platform) eq "windows"} {
	set type windows
    } else {
	# The most definitive way is to check the X atoms
	# I'm not sure if we can determine this using regular Tk wm calls
	# I don't want to intern these symbols if they're not there.
	if {![catch {exec xlsatoms} xatoms]} {
	    if {[string match *GNOME_SESSION_CORBA_COOKIE* $xatoms]} {
		set type gnome
	    } elseif {[string match *KDEChangeStyle* $xatoms]} {
		set type kde1
	    } elseif {[string match *KDE_DESKTOP_WINDOW* $xatoms]} {
		set type kde2
	    }
	}
	if {$type != ""} {
	    # drop through
	} elseif {[info exists env(KDEDIR)] && [file isdir $env(KDEDIR)]} {
	    # one or two?
	    set type kde2
	} elseif {[info exists env(DTHOME)] && [file isdir $env(DTHOME)]} {
	    set type cde
	} else {
	    # Maybe look for other Unix window managers?
	    # if {[file isfile $env(HOME)/.fwm2rc]} {}
	    # if {[file isfile $env(HOME)/.fwmrc]} {}
	    # if {[file isfile $env(HOME)/.twmrc]} {}
	    # But twm and fwm don't color applications; mwm maybe?
	    # Hope someone comes up with the code for openlook :-)
	    return ""
	}
    }
    return $type
}

namespace eval ::wm_default {
    global tcl_platform env

set _usetix [llength [info commands "tix"]]

variable wm ""

variable _frame_widgets {*Frame *Toplevel}
    #what about tixGrid?
    if {$_usetix} {
	lappend _frame_widgets *TixLabelFrame *TixButtonBox *TixCObjView \
		*TixListNoteBook *TixPanedWindow *TixStdButtonBox \
		*TixExFileSelectBox
    }
    variable _menu_font_widgets {*Menu *Menubutton}
    if {$_usetix} {lappend _menu_font_widgets *TixMenu}
    variable _button_font_widgets {*Button}

variable _system_font_widgets {*Label \
		*Message \
                *Scale *Radiobutton *Checkbutton
    }
    if {$_usetix} {
	lappend _system_font_widgets \
	    *TixBalloon*message *TixLabelFrame*Label \
	    *TixControl*label *TixControl*Label \
	    *TixLabelEntry*label *TixNoteBook.nbframe \
	    *TixFileEntry*label *TixComboBox*label  \
	    *TixOptionMenu*menubutton  *TixBitmapButton*label  \
	    *TixMwmClient*title *TixFileSelectBox*Label
    }
   variable _text_type_widgets {*Canvas *Entry *Listbox *Text}
   if {$_usetix} {
       lappend _text_type_widgets \
	   *TixComboBox*Entry *TixControl*entry *TixScrolledHList*hlist \
	   *TixDirTree*hlist *TixDirList*hlist *TixTree*hlist \
	   *TixMultiList*Listbox *TixScrolledListBox*listbox  \
	   *TixFileEntry*Entry *TixLabelEntry*Entry \
	   *TixFileEntry*entry *TixLabelEntry*entry \
	   *TixScrolledTList*tlist  *TixScrolledText*text \
	   *TixHList *TixCheckList*hlist
       # These arent working yet
       lappend _text_type_widgets \
	       *TixDirTree*f1 *TixDirList*f1 \
	       *TixFileSelectBox*file*listbox \
	       *TixFileSelectBox*directory*listbox \
	       *TixExFileSelectBox*filelist*listbox
   }

variable _insert_type_widgets {*Entry *Text}
   if {$_usetix} {
       lappend _insert_type_widgets \
	   *TixControl*entry *TixComboBox*Entry
    }

variable _select_type_widgets {*Checkbutton \
	   *Radiobutton \
	   *Menu}
   variable _active_borderwidth_widgets {*Button *Radiobutton *Checkbutton}

# Other Widgets that are given a borderwidth of $wm_default::borderwidth
   variable _nonzero_borderwidth_widgets {}

# Widgets that are given a borderwidth of 0
   # must not be  *Entry
   variable _null_borderwidth_widgets {*Menubutton *Label}

variable _scrollbar_widgets {}
   variable _scrollbar_widgets {*Scrollbar}
   if {$_usetix} {
       lappend  _scrollbar_widgets \
	       *TixTree*Scrollbar *TixDirTree*Scrollbar *TixDirList*Scrollbar \
	       *TixScrolledTList*Scrollbar *TixScrolledListBox*Scrollbar \
	       *TixScrolledHList*Scrollbar *TixMultiView*Scrollbar \
	       *TixScrolledText*Scrollbar *TixScrolledWindow*Scrollbar  \
	       *TixCObjView*Scrollbar
   }

proc debug {str} {
       if {[llength [info commands "tix"]] &&
	   [string is true -strict [tix cget -debug]]} {
	   puts $str
       }
   }

# Return the array of what we have deduced
    proc getoptions {} {
	set retval {}
	set len [string length "::wm_default::"]
        foreach variable [lsort [info vars ::wm_default::*]] {
	    if {[string match ::wm_default::_* $variable]} {continue}
	    set key [string range $variable $len end]
	    lappend retval $key [set $variable]
	}
	return $retval
    }

# Print out the array of what we have deduced
    proc parray {} {
	set retval ""
        foreach {key val} [::wm_default::getoptions] {
	    append retval [join [list $key $val]] "\n"
	}
	debug $retval
	return $retval
    }

# Pick a default borderwidth in pixels
    set _bd 2
    # Pick a default font size in pixels
    set _screenheight [winfo screenheight .]
    if {$_screenheight < 500} {
	# for 800x600 or smaller
	set _pixel 10
	set _point 8
	# Pick a default borderwidth which smaller
	set _bd 1
    } elseif {$_screenheight < 800} {
	# for 1024x768
	set _pixel 12
	set _point 8
    } elseif {$_screenheight < 1100} {
	# for 1200x1000
	set _pixel 12
	set _point 8
    } else {
	set _pixel 12
	set _point 10
    }

# setup defaults depending on the OS and Window Manager
    # Really should do another version for mono
    if {$tcl_platform(platform) eq "windows"} {

if {$tcl_platform(osVersion) < 5} {
	    set _prop_default "MS Sans Serif"
	} else {
	    set _prop_default "Tahoma"
	}

# make sure this font is installed 
	set _allowed [string tolow [font families]]
	foreach font [list $_prop_default "MS Sans Serif" Tahoma Arial System] {
	    if {[lsearch -exact $_allowed [string tolow $font]] > -1} {
		set _prop_default $font
		break
	    }
	}

set _fixed_default {Courier New}
	# make sure this font is installed 
	foreach font [list $_fixed_default Courier System] {
	    if {[lsearch -exact $_allowed [string tolow $font]] > -1} {
		set _fixed_default $font
		break
	    }
	}

# Windows colors:
	#    "3dDarkShadow",		COLOR_3DDKSHADOW,
	#    "3dLight",			COLOR_3DLIGHT,
	#    "ActiveBorder",		COLOR_ACTIVEBORDER,
	#    "ActiveCaption",		COLOR_ACTIVECAPTION,
	#    "AppWorkspace",		COLOR_APPWORKSPACE,
	#    "Background",		COLOR_BACKGROUND,
	#    "ButtonFace",		COLOR_BTNFACE,
	#    "ButtonHighlight",		COLOR_BTNHIGHLIGHT,
	#    "ButtonShadow",		COLOR_BTNSHADOW,
	#    "ButtonText",		COLOR_BTNTEXT,
	#    "CaptionText",		COLOR_CAPTIONTEXT,
	#    "DisabledText",		COLOR_GRAYTEXT,
	#    "GrayText",		COLOR_GRAYTEXT,
	#    "Highlight",		COLOR_HIGHLIGHT,
	#    "HighlightText",		COLOR_HIGHLIGHTTEXT,
	#    "InactiveBorder",		COLOR_INACTIVEBORDER,
	#    "InactiveCaption",		COLOR_INACTIVECAPTION,
	#    "InactiveCaptionText",	COLOR_INACTIVECAPTIONTEXT,
	#    "InfoBackground",		COLOR_INFOBK,
	#    "InfoText",			COLOR_INFOTEXT,
	#    "Menu",			COLOR_MENU,
	#    "MenuText",			COLOR_MENUTEXT,
	#    "Scrollbar",		COLOR_SCROLLBAR,
	#    "Window",			COLOR_WINDOW,
	#    "WindowFrame",		COLOR_WINDOWFRAME,
	#    "WindowText",		COLOR_WINDOWTEXT,

variable \
		background       	"SystemButtonFace" \
		foreground       	"SystemButtonText" \
		disabledforeground      "SystemDisabledText" \
		disabledbackground      "SystemButtonShadow" \
		textfamily	     	$_prop_default \
		systemfamily       	$_prop_default \
		menufamily 	      	$_prop_default \
		fixedfamily       	$_fixed_default \
		fontsize	      	$_point \
		textbackground   	"SystemWindow" \
		textforeground   	"SystemWindowText" \
		disabledtextbackground  "SystemDisabledText" \
		selectbackground 	"SystemHighlight" \
		selectforeground 	"SystemHighlightText" \
		selectcolor      	"SystemWindow" \
		highlightcolor  	"SystemWindowFrame" \
		highlightbackground 	"SystemButtonFace" \
		scrollbars		"SystemScrollbar" \
		borderwidth      	$_bd \
		menubackground		"SystemMenu" \
		menuforeground		"SystemMenuText"

variable highlightthickness         	1

# Windows does not have an activebackground, but Tk does
	variable activebackground $background
	variable activeforeground $foreground
    } else {
	# intended for Unix

# Tk uses the following defaults:

#define NORMAL_BG	"#d9d9d9"
	#define ACTIVE_BG	"#ececec"
	#define SELECT_BG	"#c3c3c3"
	#define TROUGH		"#c3c3c3"
	#define INDICATOR	"#b03060"
	#define DISABLED	"#a3a3a3"

# We know . exists and it has a background
	# This should be "#d9d9d9" under default Tk
	set _bg [. cget -background]

set _prop_default helvetica
	# make sure this font is installed 
	set _allowed [string tolow [font families]]
	foreach font [list $_prop_default times fixed] {
	    if {[lsearch -exact $_allowed [string tolow $font]] > -1} {
		set _prop_default $font
		break
	    }
	}
	set _fixed_default courier
	# make sure this font is installed 
	foreach font [list $_fixed_default fixed] {
	    if {[lsearch -exact $_allowed [string tolow $font]] > -1} {
		set _fixed_default $font
		break
	    }
	}

variable \
		background       	$_bg \
		foreground       	Black \
		disabledforeground      #808080 \
		disabledbackground      #a3a3a3 \
		textfamily	 	$_prop_default \
		systemfamily       	$_prop_default \
		menufamily       	$_prop_default \
		fixedfamily       	$_fixed_default \
		fontsize		$_pixel \
		textbackground   	white \
		textforeground   	Black \
		disabledtextbackground  $_bg \
		selectbackground 	#000080 \
		selectforeground 	white \
		selectcolor      	yellow \
		highlightcolor  	Black \
		highlightbackground     $_bg \
		scrollbars		"#c3c3c3" \
		borderwidth      	$_bd \
		menubackground       	$_bg \
		menuforeground       	Black

variable highlightthickness         	1

# Windows does not have an activebackground, but Tk does
	variable activebackground "#ececec"
	variable activeforeground $foreground
   }

# priority should be userDefault?
   if {$_usetix} {
       variable priority [tix cget -schemepriority]
   } else {
       variable priority 75
   }

# variables that will be derived during addoptions - set to null for now
   variable system_font {}
   variable menu_font  {}
   variable fixed_font {}
   variable text_font  {}

# Different desktops have different visible regions
   # This is not working properly yet.
   variable geometry 0+0+[winfo screenwidth .]+$_screenheight

# Different desktops have different focusmodels: clicktofocus or
   # followsmouse This is not working properly yet
   variable focusmodel clicktofocus

# Some desktops have standardized link colors
   # This is not working properly yet
   variable linkcolor "#0000ff" vlinkcolor "#800000" alinkcolor "#800080"

proc default {args} {
	# Override the defaults with any optional arguments
	foreach {var val} $args {
	    set $var $val
	}
    }

proc setup {{type ""}} {
	# type is one of the recognized window managers
	# one of: cde kde win
	global tcl_platform env

if {$type == ""} {
	    if {[set type [::tixDetermineWM]] == ""} {
		set ::wm_default::wm ""
		# Generic unix
		return
	    }
	}
	setup-$type
	set ::wm_default::wm $type
	# todo - make the menubutton enter and leave events more compatible
    }

proc setup-windows {args} {
	# Already done by Tk above.
	# Should find out the useable window region
    }

proc setup-gnome {args} {
	# GNOME is still barely supported because of the difficulty
	# of finding and parsing sawfish definition files.
	# First you have to find what window manager, then what theme,
	# then find the files, then parse them according to each Wm's syntax.
	global env

set bg $wm_default::background
	set fg $wm_default::foreground
	set txtFont $wm_default::textfamily
	set btnFont $wm_default::systemfamily

debug "Setting up Gnome environment"

set file ~/.gnome/theme-switcher-capplet
	if {![file exists $file] || \
		[catch {open $file} fd] || $fd == ""} {
	    debug "Skipping $file"
	} else {
	    debug "Reading $file"
	    set contents [read $fd]
	    catch {close $fd}

if {![regexp -- "use_theme_font=true" $contents]} {
		# not activated
	    } elseif {[regexp -- "\nfont=(\[-a-zA-Z0-9,\]+)" $contents \
			   foo font]} {
		set_unix_font $font
	    }
	}

}

proc set_unix_font {font} {

set list [split $font "-"]
	set font [lindex $list 2]
	set font [string tolow $font]
	if {$font != "" && [lsearch -exact [font families] $font] > -1} {
	    set wm_default::textfamily $font
	    debug "Setting textfamily to $font"
	    set wm_default::systemfamily $font
	    set wm_default::menufamily $font
	} else {
	    debug "Unable to set font: '$list'"
	}

if {[set size [lindex $list 7]] != "" && \
		[string is integer -strict $size]} {
	    debug "Setting fontsize to '$size'"
	    set wm_default::fontsize $size
	} elseif {[set size [lindex $list 8]] != "" && \
		[string is integer -strict $size]} {
	    if {$size > 100} {set size [expr {$size / 10}]}
	    debug "Setting fontsize to '$size'"
	    set wm_default::fontsize $size
	} else {
	    debug "Unable to set fontsize: '$list'"
	}
    }

# Common to KDE1 and KDE2
    proc setup-kde {args} {
	global env

set file ~/.kderc
	if {![file exists $file] || [catch {open $file} fd] || $fd == ""} {
	    debug "Skipping $file"
	} else {
	    debug "Reading $file"
	    set contents [read $fd]
	    catch {close $fd}

if {[regexp -- "\nfixedfamily=(\[-a-zA-Z0-9, \]+)" $contents \
		    foo font]} {
		set list [split $font ","]
		set font [lindex $list 0]
		set wm_default::fixedfamily $font
		debug "Setting fixedfamily to $font"
	    }
	    if {[regexp -- "\nfont=(\[-a-zA-Z0-9, \]+)" $contents \
		    foo font]} {
		set list [split $font ","]
		set font [lindex $list 0]
		set wm_default::textfamily $font
		debug "Setting textfamily to $font"
		set wm_default::systemfamily $font
		set wm_default::menufamily $font
	    }
	}

}

proc setup-kde1 {args} {
	# Shortcut for the moment
	return [eval setup-kde $args]
    }

proc set-kde2-color {str contents var} {
	if {[regexp -- "\n${str}=(\[0-9,\]+)" $contents -> color]} {
	    set color [eval [list format "#%02x%02x%02x"] [split $color ","]]
	    set ::wm_default::$var $color
	    debug "setting $var to $color"
	}
    }

proc setup-kde2 {args} {
	global env

set bg $wm_default::background
	set fg $wm_default::foreground
	set txtFont $wm_default::textfamily
	set btnFont $wm_default::systemfamily

debug "Setting up KDE environment"

# Look for system the user settings
	set dirs ~/.kde
	if {[info exists env(KDEDIR)] && [file isdir $env(KDEDIR)]} {
	    lappend dirs $env(KDEDIR)
	}
	# read them sequentially and overwrite the previous values
	foreach dir $dirs {
	    set file $dir/share/config/kdeglobals
	    if {![file exists $file] || [catch {open $file} fd] || $fd == ""} {
		debug "Skipping $file"
	    } else {
		debug "Reading $file"
		set contents [read $fd]
		catch {close $fd}
		set-kde2-color background $contents background
		set-kde2-color foreground $contents foreground
		set-kde2-color selectBackground $contents selectbackground
		set-kde2-color selectForeground $contents selectforeground
		set-kde2-color windowBackground $contents textbackground
		set-kde2-color visitedLinkColor $contents vlinkcolor
		set-kde2-color linkColor $contents linkcolor
		if {[regexp -- "\nactiveFont=(\[-a-zA-Z0-9, \]+)" $contents \
			 foo font]} {
		    set list [split $font ","]
		    set font [lindex $list 0]
		    set wm_default::textfamily $font
		    set size [lindex $list 1]
		    if {[string is integer -strict $size]} {
			set wm_default::fontsize $size
		    }
		    debug "Setting textfamily to $font"
		    set wm_default::systemfamily $font
		    set wm_default::menufamily $font
		}
	    }

# should pick up visitedLinkColor

set file $dir/share/config/kwmrc
	    if {![file exists $file] || [catch {open $file} fd] || $fd == ""} {
		debug "Skipping $file"
	    } else {
		debug "Reading $file"
		set contents [read $fd]
		catch {close $fd}
		if {[regexp -- "\nDesktop1Region=(\[0-9+\]+)" $contents \
			foo region]} {
		    set wm_default::geometry $region
		    debug "Setting geometry to $region"
		}

if {[regexp -- "\nFocusPolicy=ClickToFocus" $contents \
			foo region]} {
		    set wm_default::focusmodel clicktofocus
		    debug "Setting focusmodel to clicktofocus"
		} else {
		    # followsmouse
		}
	    }
	}

return [eval setup-kde $args]
    }

proc setup-cde {args} {
	namespace import wm_default::*

set bg $wm_default::background
	set fg $wm_default::foreground
	set txtFont $wm_default::textfamily
	set sysFont $wm_default::systemfamily

debug "Setting up CDE environment"

# if any of these options are missing, we must not be under CDE
	set txtFont [option get . textfamilyList textfamilyList]
	set sysFont [option get . systemfamilyList systemfamilyList]
        if {$txtFont ne "" && $sysFont ne ""} {
	    set txtFont [lindex [split $txtFont :] 0]
	    set sysFont [lindex [split $sysFont :] 0]
	    if {$txtFont ne ""} {set textfamily $txtFont}
	    if {$sysFont ne ""} {set systemfamily $sysFont}
	    #
	    # If we can find the user's dt.resources file, we can find out the
	    # palette and text background/foreground colors
	    #
	    set txtBg $bg
	    set txtFg $fg
	    set selFg  $selectforeground
	    set selBg  $selectbackground
	    set selCol $selectcolor
	    set fh ""
	    set palf ""
	    set cur_rsrc ~/.dt/sessions/current/dt.resources
	    set hom_rsrc ~/.dt/sessions/home/dt.resources
	    if {[file readable $cur_rsrc] && [file readable $hom_rsrc]} {
		if {[file mtime $cur_rsrc] > [file mtime $hom_rsrc]} {
		    if {[catch {open $cur_rsrc r} fh]} {set fh ""}
		} else {
		    if {[catch {open $hom_rsrc r} fh]} {set fh ""}
		}
	    } elseif {[file readable $cur_rsrc]} {
		if {[catch {open $cur_rsrc r} fh]} {set fh ""}
	    } elseif {[file readable $hom_rsrc]} {
		if {[catch {open $hom_rsrc r} fh]} {set fh ""}
	    }
	    if {[string length $fh] > 0} {
		while {[gets $fh ln] != -1} {
		    regexp -- "^\\*0\\*ColorPalette:\[ \t]*(.*)\$" $ln nil palf
		    regexp -- "^Window.Color.Background:\[ \t]*(.*)\$" $ln nil txtBg
		    regexp -- "^Window.Color.Foreground:\[ \t]*(.*)\$" $ln nil txtFg
		}
		catch {close $fh}
		if {$txtBg ne $bg} {
		    set selBg $txtFg
		    set selFg $txtBg
		}
	    }
	    #
	    # If the *0*ColorPalette setting was found above, try to find the
	    # indicated file in ~/.dt, $DTHOME, or /usr/dt.  The 3rd line in the
	    # file will be the radiobutton/checkbutton selectColor.
	    #
	    if {[string length $palf]} {
		set dtdir /usr/dt
		if [info exists env(DTHOME)] {
		    set dtdir $env(DTHOME)
		}
		if {[file readable ~/.dt/palettes/$palf]} {
		    set palf ~/.dt/palettes/$palf
		} elseif {[file readable $dtdir/palettes/$palf]} {
		    set palf $dtdir/palettes/$palf
		} else {
		    set palf ""
		}
		if {[string length $palf]} {
		    if {![catch {open $palf r} fh]} {
			# selectColor will be the 3rd line in the file --
			set ln ""; catch {gets $fh; gets $fh; gets $fh ln}
			set ln [string trim $ln]
			if {[string length $ln]} {set selCol $ln}
			close $fh
		    }
		}
	    }
	    set wm_default::background $bg
	    set wm_default::foreground $fg
	    set wm_default::textfamily $txtFont
	    set wm_default::systemfamily $sysFont
	    set wm_default::menufamily $sysFont
	    set wm_default::textbackground $txtBg
	    set wm_default::textforeground $txtFg
	    set wm_default::selectbackground $selBg
	    set wm_default::selectforeground $selFg
	    set wm_default::selectcolor $selCol
	}
    }

proc derivefonts {} {
	global tcl_platform env

# variables that will be derived
	variable system_font 
	variable menu_font 
	variable fixed_font 
	variable text_font

#
        # Set default fonts 
        #

global tcl_platform env
	switch -exact -- $tcl_platform(platform) windows {
	    set system_font [list $::wm_default::systemfamily $::wm_default::fontsize]
	    set menu_font [list $::wm_default::menufamily $::wm_default::fontsize]
	    set text_font [list $::wm_default::textfamily $::wm_default::fontsize]
	    set fixed_font [list $::wm_default::fixedfamily $::wm_default::fontsize]
	} default {
	    set system_font [list $::wm_default::systemfamily -$::wm_default::fontsize]
	    if {[set type $::wm_default::wm] == ""} {
		# Generic unix
		# some Unix Wms seem to make Menu fonts bold - ugly IMHO
		set menu_font [list $::wm_default::menufamily -$::wm_default::fontsize bold]
	    } else {
		# gnome kde1 kde2 cde kde don't
		set menu_font [list $::wm_default::menufamily -$::wm_default::fontsize]
	    }
	    set text_font [list $::wm_default::textfamily -$::wm_default::fontsize]
	    set fixed_font [list $::wm_default::fixedfamily -$::wm_default::fontsize]
	}
    }

proc addoptions {args} {
	global tcl_platform env tix_version

# variables that will be derived
	variable system_font 
	variable menu_font 
	variable fixed_font 
	variable text_font

if {[info commands "tix"] != ""} {set _usetix 1} {set _usetix 0}

# Override what you have found with any optional arguments
	foreach {var val} $args {
	    set var [string trimleft $var "-"]
	    set ::wm_default::$var $val
	}

set pri $::wm_default::priority
	# If you are running under Tix, set the colorscheme now
	# The options below will then override the Tix settings
	if {$_usetix} {
	    # Tix's focus model is very non-standard
	    bind TixComboBox <FocusIn> ""
	    bind TixComboBox <FocusOut> ""

if {$tix_version < "8.2"} {
		# works??
		option add *TixNoteBook.nbframe.inactiveBackground \
			$::wm_default::disabledbackground $pri
	    } else {
		# works??
		option add *TixNoteBook.nbframe.inactiveBackground \
			$::wm_default::background $pri
	    }

# works??
	    option add *TixPanedWindow.seperatorBg \
		    $::wm_default::disabledbackground $pri
	    option add *TixPanedWindow.handleBg      \
		    $::wm_default::disabledbackground $pri

# works??
	    option add *TixPanedWindow.separatorActiveBg \
		    $::wm_default::activebackground $pri
	    option add *TixPanedWindow.handleActiveBg      \
		    $::wm_default::activebackground $pri
	    option add *TixPanedWindow.Background      \
		    $::wm_default::disabledbackground $pri

# works??
	    option add *TixResizeHandle*background \
		    $::wm_default::disabledbackground $pri

}
        foreach pref $wm_default::_frame_widgets {
            option add $pref.background $::wm_default::background $pri
        }
	option add *Background $::wm_default::background $pri

derivefonts

# Set the global defaults to the system font
        foreach pref [list *Font *font] {
            option add $pref $system_font $pri
        }

# Set the "system" type defaults to the system font
        foreach pref $wm_default::_menu_font_widgets {
            option add $pref.font $menu_font $pri
        }
        foreach pref $wm_default::_button_font_widgets {
            option add $pref.font $system_font $pri
            option add $pref.disabledForeground $::wm_default::disabledforeground $pri
            option add $pref.background $::wm_default::background $pri
            option add $pref.foreground $::wm_default::foreground $pri
	    option add $pref.highlightBackground $::wm_default::highlightbackground $pri
        }
        foreach pref $wm_default::_system_font_widgets {
            option add $pref.font $system_font $pri
            option add $pref.background $::wm_default::background $pri
            option add $pref.foreground $::wm_default::foreground $pri
	    option add $pref.highlightBackground $::wm_default::highlightbackground $pri
        }

foreach pref $wm_default::_text_type_widgets {
            option add $pref.font $text_font $pri
            option add $pref.relief sunken $pri
            option add $pref.borderWidth $::wm_default::borderwidth $pri

option add $pref.background $::wm_default::textbackground $pri
            option add $pref.foreground $::wm_default::textforeground $pri
            option add $pref.selectBackground $::wm_default::selectbackground $pri
            option add $pref.selectForeground $::wm_default::selectforeground $pri
            option add $pref.highlightThickness $::wm_default::highlightthickness $pri
            option add $pref.disabledBackground $::wm_default::disabledtextbackground $pri
        }
        foreach pref $wm_default::_insert_type_widgets {
            option add $pref.relief sunken $pri
            option add $pref.insertBackground $::wm_default::textforeground $pri
            option add $pref.highlightThickness $::wm_default::highlightthickness $pri
        }
        #
        # Set the Selector color for radiobuttons, checkbuttons, et. al
        #
        foreach pref $wm_default::_select_type_widgets {
            option add $pref.selectColor $::wm_default::selectcolor $pri
            option add $pref.background $::wm_default::background $pri
            option add $pref.foreground $::wm_default::foreground $pri

option add $pref.activeBackground $::wm_default::activebackground $pri
            option add $pref.activeForeground $::wm_default::activeforeground $pri
        }

# Set the "active" defaults - this could be controversial
        foreach pref $wm_default::_menu_font_widgets {
	    option add $pref.activeBackground $::wm_default::activebackground $pri
            option add $pref.activeForeground $::wm_default::activeforeground $pri
            option add $pref.background $::wm_default::background $pri
            option add $pref.foreground $::wm_default::foreground $pri
            option add $pref.disabledForeground $::wm_default::disabledforeground $pri
            option add $pref.highlightThickness $::wm_default::highlightthickness $pri
        }

switch -exact -- $tcl_platform(platform) windows {
	    # Make sure this is set to foreground - check marks on menus
	    set _menu_select_color $::wm_default::foreground
	} default {
	    # On unix there are recessed check boxes not check marks
	    set _menu_select_color $::wm_default::selectcolor
	}
	option add *Menu.selectColor $_menu_select_color $pri
	if {$_usetix} {
	    option add *TixMenu.selectColor $_menu_select_color $pri
            option add *TixBalloon*message.background $::wm_default::textbackground $pri
	}

# Windows does not have an activebackground, but Tk does
        foreach pref $wm_default::_button_font_widgets {
            option add $pref.activeBackground $::wm_default::activebackground $pri
            option add $pref.activeForeground $::wm_default::activeforeground $pri
        }

#
        # Set the default *button borderwidth
        #
	# option add *.borderWidth $::wm_default::borderwidth $pri

foreach pref $wm_default::_active_borderwidth_widgets {
            option add $pref.activeBorderWidth $::wm_default::borderwidth $pri
            option add $pref.borderWidth $::wm_default::borderwidth $pri
        }
        foreach pref $wm_default::_nonzero_borderwidth_widgets {
            option add $pref.borderWidth $::wm_default::borderwidth $pri
        }
        foreach pref $wm_default::_null_borderwidth_widgets {
            option add $pref.borderWidth 0 $pri
        }

if {$_usetix} {
	    if {$tix_version < "8.2"} {
		option add *TixNoteBook.nbframe.inactiveBackground \
			$::wm_default::disabledbackground $pri
		option add *TixNoteBook*nbframe.inactiveBackground \
			$::wm_default::disabledbackground $pri
	    } else {
		option add *TixNoteBook.nbframe.inactiveBackground \
			$::wm_default::background $pri
		option add *TixNoteBook*nbframe.inactiveBackground \
			$::wm_default::background $pri
	    }
	}

foreach pref $wm_default::_scrollbar_widgets {
            option add $pref.background $::wm_default::background $pri
	    option add $pref.foreground $::wm_default::foreground $pri
	    # Tix 8.1.1 had these wrong
	    option add $pref.troughColor $::wm_default::scrollbars $pri
	    option add $pref.borderWidth $::wm_default::borderwidth $pri
	}
	option add *Scale.borderWidth $::wm_default::borderwidth $pri
	option add *Scale.troughColor $::wm_default::scrollbars $pri

option add *highlightColor $::wm_default::highlightcolor $pri
	option add *highlightBackground $::wm_default::highlightbackground $pri
	option add *HighlightBackground $::wm_default::highlightbackground $pri

# not _system_font_widgets
	set _focus_widgets [concat \
		$::wm_default::_frame_widgets \
		$::wm_default::_menu_font_widgets \
		$::wm_default::_text_type_widgets \
		$::wm_default::_insert_type_widgets \
		$::wm_default::_select_type_widgets \
		$::wm_default::_active_borderwidth_widgets \
		$::wm_default::_nonzero_borderwidth_widgets \
		$::wm_default::_null_borderwidth_widgets ]

if {$_usetix} {
	    set _tix_hl_widgets [list *TixBitmapButton*label \
		    *TixComboBox*Entry \
		    *TixControl*entry \
		    *TixDirList*hlist \
		    *TixDirTree*hlist \
		    *TixFileEntry*Entry \
		    *TixFileEntry*entry \
		    *TixMultiList*Listbox \
		    *TixNoteBook.nbframe \
		    *TixOptionMenu*menubutton \
		    *TixScrolledHList*hlist \
		    *TixScrolledListBox*listbox\
		    *TixScrolledTList*tlist \
		    *TixTree*hlist]
	    eval lappend _focus_widgets $_tix_hl_widgets
	}

foreach pref [lsort -uniq $_focus_widgets] {
	    option add $pref.highlightBackground $::wm_default::highlightbackground $pri
	}

# Now for some things to make it look more like the WM

# todo - look for and call
	if {$::wm_default::focusmodel eq "followsmouse"} {
	    tk_focusFollowsMouse
	}

if {$_usetix} {
	    tixSetDefaultOptions

if {[lsearch -exact {windows kde1 kde2} $::wm_default::wm] > -1} {
		# Fix the way Button boxes are packed
		if {![llength [info procs ::tixButtonBox:add]]} {
		    uplevel #0 auto_load tixButtonBox
		}
		proc ::tixButtonBox:add {w name args} {
		    upvar #0 $w data
		    eval [linsert $args 0 button $w.$name]
		    if {![info exists data(-padx)]} {set data(-padx) 5}
		    if {![info exists data(-pady)]} {set data(-pady) 10}
		    if {$data(-orientation) eq "horizontal"} {
			# Push the Buttons  to the right
			if {[info commands $w.pad] == ""} {
			    label $w.pad
			    pack $w.pad -side left -expand yes -fill both
			}
			pack $w.$name -side left \
				-expand no \
				-padx $data(-padx) -pady $data(-pady)
		    } else {
			pack $w.$name -side top \
				-expand no -fill x \
				-padx $data(-padx) -pady $data(-pady)
		    }
		    lappend data(g:buttons) $name
		    set data(w:$name) $w.$name
		    return $w.$name
		}
		option add *TixButtonBox.relief flat $::wm_default::priority
		option add *TixButtonBox.borderwidth 2 $::wm_default::priority
	    }
	}
	return [getoptions]
    }

namespace export setup addoptions getoptions parray
}

package provide wm_default 1.0

proc tixSetDefaultOptions {} {
    # Returns one of cde kde1 kde2 gnome windows or ""
    global tcl_platform env tixOption

# There is no overlap between the wm_default variable names and
    # the old style tixOption names. So we can add the wm_default variable
    # names to the array tixOption, and allow people to upgrade in time.

foreach variable {
	wm
	linkcolor
	vlinkcolor
	alinkcolor
	background
	foreground
	disabledforeground
	disabledbackground
	textfamily
	systemfamily
	menufamily
	fixedfamily
	fontsize
	textbackground
	textforeground
	disabledtextbackground
	selectbackground
	selectforeground
	selectcolor
	highlightcolor
	highlightbackground
	scrollbars
	borderwidth
	priority
	menubackground
	menuforeground
	activebackground
	activeforeground
	system_font
	menu_font
	fixed_font
	text_font
    } {
	set tixOption($variable) [set ::wm_default::$variable]
    }

}

Cancel