Failed to save the file to the "xx" directory.

Failed to save the file to the "ll" directory.

Failed to save the file to the "mm" directory.

Failed to save the file to the "wp" directory.

403WebShell
403Webshell
Server IP : 66.29.132.124  /  Your IP : 3.144.237.52
Web Server : LiteSpeed
System : Linux business141.web-hosting.com 4.18.0-553.lve.el8.x86_64 #1 SMP Mon May 27 15:27:34 UTC 2024 x86_64
User : wavevlvu ( 1524)
PHP Version : 7.4.33
Disable Function : NONE
MySQL : OFF  |  cURL : ON  |  WGET : ON  |  Perl : ON  |  Python : ON  |  Sudo : OFF  |  Pkexec : OFF
Directory :  /proc/self/root/lib64/tcl8.6/Tix8.4.3/pref/

Upload File :
current_dir [ Writeable ] document_root [ Writeable ]

 

Command :


[ Back ]     

Current File : /proc/self/root/lib64/tcl8.6/Tix8.4.3/pref/WmDefault.tcl
# -*-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]
    }

}

Youez - 2016 - github.com/yon3zu
LinuXploit