Mass Deface
-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