240 lines
6.3 KiB
Tcl
240 lines
6.3 KiB
Tcl
|
proc TKGRCInit {} {uplevel #0 {
|
||
|
|
set cmdlinepos [ lsearch $argv "-f" ]
|
||
|
|
if { $cmdlinepos != -1 } {
|
||
|
|
set TKG(configfile) [lindex $argv [expr $cmdlinepos + 1]]
|
||
|
|
set TKG(rc) $TKG(configfile)
|
||
|
|
} elseif [file exists $env(HOME)/.tkgrc] {
|
||
|
|
set TKG(configfile) $env(HOME)/.tkgrc
|
||
|
|
set TKG(rc) $TKG(configfile)
|
||
|
|
} elseif [file exists $TKG(libdir)/system-tkgrc] {
|
||
|
|
set TKG(rc) $env(HOME)/.tkgrc
|
||
|
|
set TKG(configfile) $TKG(libdir)/system-tkgrc
|
||
|
|
} else {
|
||
|
|
set TKG(configfile) $env(HOME)/.tkgrc
|
||
|
|
set TKG(rc) $TKG(configfile)
|
||
|
|
}
|
||
|
|
}}
|
||
|
|
|
||
|
|
proc TKGLangInit {} {uplevel #0 {
|
||
|
|
if [file exists "~/.tkgoodstuff_$TKG(language)"] {
|
||
|
|
source "~/.tkgoodstuff_$TKG(language)"
|
||
|
|
}
|
||
|
|
if [file exists "$TKG(libdir)/tcl/$TKG(language).tcl"] {
|
||
|
|
source "$TKG(libdir)/tcl/$TKG(language).tcl";
|
||
|
|
} else {
|
||
|
|
source "$TKG(libdir)/tcl/english.tcl";
|
||
|
|
}
|
||
|
|
}}
|
||
|
|
|
||
|
|
proc TKGFvwmInit {} {uplevel #0 {
|
||
|
|
# If we're an fvwm client, load Fvwm.tcl code
|
||
|
|
if ![catch {format "%d %d" [lindex $argv 0] [lindex $argv 1]}] {
|
||
|
|
source $TKG(libdir)/tcl/Fvwm.tcl
|
||
|
|
uplevel \#0 [info body FvwmDeclare]
|
||
|
|
uplevel \#0 [info body FvwmDoOnLoad]
|
||
|
|
global TKG
|
||
|
|
lappend TKG(clients) Fvwm
|
||
|
|
}
|
||
|
|
}}
|
||
|
|
|
||
|
|
proc TKGGetPreferences {} {uplevel #0 {
|
||
|
|
if {[file exists $TKG(configfile)] && ([file size $TKG(configfile)] != 0)} {
|
||
|
|
set id [open $TKG(configfile)]
|
||
|
|
set c [read $id]
|
||
|
|
close $id
|
||
|
|
flush stdout
|
||
|
|
if {(![regexp {^# tkgoodstuff config file format ([0-9]*)} $c fv fv])\
|
||
|
|
|| [expr $fv < $TKG(configfileformatversion)]} {
|
||
|
|
TKGError "Current configuration file $TKG(configfile)
|
||
|
|
is in an old, unsupported format. Using defaults."
|
||
|
|
return
|
||
|
|
}
|
||
|
|
set i [string first {-------Configuration-------} $c]
|
||
|
|
set prefs [string range $c 0 [expr $i - 2]]
|
||
|
|
set TKG(config) [string range $c [expr $i + 28] end]
|
||
|
|
set TKGVars(TKG(config),current) $TKG(config)
|
||
|
|
set command ""
|
||
|
|
foreach line [split $prefs "\n"] {
|
||
|
|
append command "$line\n"
|
||
|
|
if ![info complete $command] {
|
||
|
|
set startline $line
|
||
|
|
continue
|
||
|
|
} else {
|
||
|
|
if [catch {eval $command} err] {
|
||
|
|
TKGError "Error in preferences. Diagnose with stack
|
||
|
|
trace and/or enter preferences manager.
|
||
|
|
Problem line:
|
||
|
|
$line
|
||
|
|
Error:
|
||
|
|
$err"
|
||
|
|
}
|
||
|
|
set command ""
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ![Empty $command] {
|
||
|
|
TKGError "Error in configuration.
|
||
|
|
A command is incomplete (perhaps the command
|
||
|
|
starting with the following line):
|
||
|
|
|
||
|
|
$line"
|
||
|
|
}
|
||
|
|
unset i c prefs
|
||
|
|
set auto_path [concat $TKG(xtraauto) $auto_path]
|
||
|
|
}
|
||
|
|
}}
|
||
|
|
|
||
|
|
proc ConfigParse {config} {
|
||
|
|
global TKG
|
||
|
|
set DATA ""
|
||
|
|
set VAR DATA
|
||
|
|
set i 0
|
||
|
|
foreach line [split $config \n] {
|
||
|
|
incr i
|
||
|
|
if ![llength $line] continue
|
||
|
|
set keyword [lindex $line 0]
|
||
|
|
set line [lreplace $line 0 0]
|
||
|
|
switch -regexp -- $keyword {
|
||
|
|
^Client$ {
|
||
|
|
lappend $VAR [list Client "Client $line"]
|
||
|
|
} ^Fill$ {
|
||
|
|
lappend $VAR [list Fill Fill]
|
||
|
|
} (^Button$|^LabelBox$|^PanelButton$|^PutPanel$|Swallow) {
|
||
|
|
set name [join $line ~]
|
||
|
|
ConfigDeclare $name $keyword
|
||
|
|
lappend $VAR [list $keyword "$keyword $line"]
|
||
|
|
} (^Stack$|^Panel$) {
|
||
|
|
set name [join $line ~]
|
||
|
|
ConfigDeclare $name $keyword
|
||
|
|
lappend $VAR [list $keyword "$keyword $line"]
|
||
|
|
lappend varstack $VAR
|
||
|
|
set VAR DATA-$i
|
||
|
|
} (^EndStack$|^EndPanel$) {
|
||
|
|
set PREVVAR [lindex $varstack end]
|
||
|
|
set varstack [lreplace $varstack end end]
|
||
|
|
set stackitem [lindex [set $PREVVAR] end]
|
||
|
|
#add list of children items to item for stack
|
||
|
|
if ![info exists $VAR] {set $VAR ""}
|
||
|
|
lappend stackitem "" [set $VAR]
|
||
|
|
unset $VAR
|
||
|
|
set VAR $PREVVAR
|
||
|
|
set $VAR [lreplace [set $VAR] end end $stackitem]
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
return $DATA
|
||
|
|
}
|
||
|
|
|
||
|
|
# varname is the array holding preferences for the item
|
||
|
|
# we load defaults for all array elements not defined (in user preferences)
|
||
|
|
proc ConfigDeclare {name type {varname ""} {typelist ""}} {
|
||
|
|
if [Empty $varname] {set varname $type$name}
|
||
|
|
if [Empty $typelist] {set typelist [list $type $name]}
|
||
|
|
global TKGVarnames TKGVars TKG $varname Prefs_taborder
|
||
|
|
if [info exists TKG(declared,$type,$name)] return
|
||
|
|
set TKG(declared,$type,$name) 1
|
||
|
|
set switches $TKG(switches,$type)
|
||
|
|
TKGSetSwitchDefaults $varname $switches 0
|
||
|
|
foreach switch $switches {
|
||
|
|
set switchvar ${varname}([lindex $switch 0])
|
||
|
|
set vartypelist [concat $typelist [lindex $switch 3]]
|
||
|
|
eval TKGDeclare $switchvar\
|
||
|
|
\{[lindex $switch 1]\}\
|
||
|
|
-typelist \$vartypelist\
|
||
|
|
[lindex $switch 2]
|
||
|
|
}
|
||
|
|
if ![Empty $typelist] {
|
||
|
|
set Prefs_taborder(:[join $typelist ,]) "Main Misc Colors Advanced Fvwm"
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
proc TKGEvalConfig {} {uplevel #0 {
|
||
|
|
set TKG(currentpanel) ""
|
||
|
|
ConfigParse $TKG(config)
|
||
|
|
set script [split $TKG(config) "\n"]
|
||
|
|
foreach line $script {
|
||
|
|
set type [lindex $line 0]
|
||
|
|
set name [lindex $line 1]
|
||
|
|
if [string match $type Client] {
|
||
|
|
uplevel \#0 "source $TKG(libdir)/tcl/$name.tcl"
|
||
|
|
if ![Empty [info procs ${name}DoOnLoad]] {
|
||
|
|
uplevel \#0 [info body ${name}DoOnLoad]
|
||
|
|
}
|
||
|
|
if ![Empty [info procs ${name}Declare]] {
|
||
|
|
uplevel \#0 [info body ${name}Declare]
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
set command ""
|
||
|
|
foreach line $script {
|
||
|
|
append command "${line}\n"
|
||
|
|
if ![info complete $command] {
|
||
|
|
set startline $line
|
||
|
|
continue
|
||
|
|
} else {
|
||
|
|
if [catch {eval $command} err] {
|
||
|
|
TKGError "Error in configuration (or possibly preferences).
|
||
|
|
Diagnose with stack trace
|
||
|
|
and/or enter preferences manager.
|
||
|
|
Problem command:
|
||
|
|
|
||
|
|
$command
|
||
|
|
|
||
|
|
Error: $err"
|
||
|
|
}
|
||
|
|
set command ""
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ![Empty $command] {
|
||
|
|
TKGError "Error in configuration.
|
||
|
|
A command is incomplete (perhaps the command
|
||
|
|
starting with the following line):
|
||
|
|
|
||
|
|
$line"
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
proc TKGResolvePreferences {} {uplevel #0 {
|
||
|
|
set i 0
|
||
|
|
while {($i < 20) && ![Empty $TKGSetHook]} {
|
||
|
|
set TKGSet1Hook $TKGSetHook
|
||
|
|
set TKGSetHook ""
|
||
|
|
TKGDoHook TKGSet1Hook
|
||
|
|
unset TKGSet1Hook
|
||
|
|
incr i
|
||
|
|
}
|
||
|
|
if {$i == 20} {
|
||
|
|
TKGError "Error in preferences: variable references
|
||
|
|
cannot be resolved (self-reference?)." exit
|
||
|
|
}
|
||
|
|
unset i TKGSetHook
|
||
|
|
}}
|
||
|
|
|
||
|
|
proc TKGLibInit {} {
|
||
|
|
global TKG
|
||
|
|
foreach pkg {Tkg Tkxpm} {
|
||
|
|
if [catch {package require $pkg} err] {
|
||
|
|
TKGError "Cannot load $TKG(libdir)/lib${pkg}.
|
||
|
|
This should have been installed during tkgoodstuff installation.
|
||
|
|
Error message was:
|
||
|
|
$err" exit
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
proc TKGInitialize {} {
|
||
|
|
global TKG TKGSetHook
|
||
|
|
set TKG(clients) ""
|
||
|
|
set TKG(stackindex) 0
|
||
|
|
set TKG(Log) "TkGoodStuff Log starting\n\n"
|
||
|
|
set TKGSetHook ""
|
||
|
|
set TKG(currentBalloon) ""
|
||
|
|
}
|
||
|
|
|
||
|
|
proc TKGInitClients {} {
|
||
|
|
global TKG
|
||
|
|
foreach client $TKG(clients) {
|
||
|
|
if ![Empty [info procs ${client}Init]] {${client}Init}
|
||
|
|
}
|
||
|
|
}
|