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} } }