0x2620/openmedialibrary_platform_win32
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity
openmedialibrary_platform_w.../tcl/tix8.4.3/pref/WmDefault.tcl

1054 lines
33 KiB
Tcl
Raw Normal View History

update windows build to Python 3.7
2019-01-20 10:35:31 +00:00
# -*-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]
}
}
Reference in a new issue Copy permalink