tkgoodstuff/tcl/elements.tcl

306 lines
8.1 KiB
Tcl
Executable File

# Code to draw and configure buttons and label-boxes
proc TKGMakeButton {name args} {
global TKG
set lcname [string tolower $name]
set lcpanel [string tolower $TKG(currentpanel)]
set pathname .${lcpanel}.$lcname
global $name-params
set $name-params(pathname) $pathname
eval [concat TKGButton $name -pathname $pathname $args]
TKGGrid $pathname
return $pathname
}
set TKG(switches,TKGButton) {
pathname
{state normal}
{mode normal}
{iconside ""}
{relief ""}
{tileimage ""}
{usebutton2 1}
{ignore 0}
{padding $TKG(padding)}
{butsep $TKG(butsep)}
{menu ""}
{usemenu3 1}
{menu3items ""}
{borderwidth $TKG(butborder)}
{textanchor ""}
{imageanchor ""}
{textweight ""}
{imageweight ""}
}
set TKG(switches,TKGButton,ms) {
{foreground $TKG(buttonforeground)}
{background $TKG(buttonbackground)}
{activeforeground $TKG(butactiveforeground)}
{activebackground $TKG(butactivebackground)}
{text ""}
{image ""}
{exec ""}
{command ""}
{balloon ""}
{staydown 1}
{trackwindow 0}
{font $TKG(combofont)}
{windowname ""}
}
# TKGButton --
# Produces and configures mode-sensitive tkgbutton widgets.
proc TKGButton {name args} {
global TKG $name-params TKG_iconSide Fvwm
upvar #0 $name-params P
# Parse arguments
set args [TKGButtonArgStuff $name $args]
set sswitches $TKG(switches,TKGButton)
set msswitches $TKG(switches,TKGButton,ms)
TKGParseArgs $name-params $args $sswitches $msswitches TKGButton
if ![info exists P(init)] {
TKGSetSwitchDefaults $name-params $TKG(switches,TKGButton)
set P(init) 1
}
if ![In $P(mode) $P(modes)] {lappend P(modes) $P(mode)}
foreach mode $P(modes) {
if ![info exists P(init,$mode)] {
TKGSetMSSwitchDefaults $name-params $TKG(switches,TKGButton,ms) $mode
set P(init,$mode) 1
}
}
# Create button if necessary, or configure
if ![winfo exists $P(pathname)] {
if ![Empty $P(menu)] {
lappend C tkgmenubutton $P(pathname) -menu $P(menu)
set P(exec,$P(mode)) ""
set P(command,$P(mode)) ""
} else {
lappend C tkgbutton $P(pathname)
}
lappend C -highlightthickness 0 -borderwidth $P(borderwidth)\
-cursor top_left_arrow\
-padx $P(padding) -pady $P(padding) -sep $P(butsep)
if {[Empty $P(relief)]} {
set P(relief) $TKG(butrelief)
}
lappend C -relief $P(relief)
} else {
lappend C $P(pathname) configure
}
# Pass switches to tkgbutton or tkgmenubutton
lappend topass foreground background activeforeground \
activebackground font windowname
if {$P(ignore)
|| !$TKG(labelsonly)
|| $TKG(iconsonly)
|| [Empty $P(text,$mode)]} {
set image $P(image,$P(mode))
} else {
set image ""
}
lappend C -image $image
if ![Empty $image] {
if [Empty $P(iconside)] {
set iconside $TKG_iconSide(current)
} else {
set iconside $P(iconside)
}
lappend C -iconside $iconside
switch -regexp $iconside {
top|bottom {
set textweight 0
set imageweight 1
set textanchor c
set imageanchor c
} left|right {
set textweight 1
set imageweight 0
set textanchor w
set imageanchor c
} default {
set textweight 1
set imageweight 1
set textanchor c
set imageanchor c
}
}
foreach switch {textweight imageweight textanchor imageanchor} {
if {[Empty $P($switch)]} {
lappend C -$switch [set $switch]
} else {
lappend C -$switch $P($switch)
}
}
}
if {![Empty $P(tileimage)]} {
if {![string match none $P(tileimage)]} {
lappend C -tileimage $P(tileimage)
}
} elseif ![Empty $TKG(buttontileimage)] {
lappend C -tileimage $TKG(buttontileimage)
}
if {$P(ignore)
|| !$TKG(iconsonly)
|| [Empty $P(image,$mode)]} {
lappend C -textvar $name-params(text,$P(mode))
} else {
set cleartextvar 1
}
if [Empty [set windowname $P(windowname,$P(mode))]] {
set windowname [file tail [lindex [subst {$P(exec,$P(mode))}] 0]]
if ![Empty $windowname] {
lappend C -windowname $windowname
}
}
upvar \#0 Fvwm_trackbuttons($windowname) tracklist
if {$P(trackwindow,$P(mode))
&& [info exists Fvwm(outid)]
&& ![Empty $windowname]} {
ListAdd tracklist $name
lappend C -staydown 0 -exec "" \
-command [concat exec $P(exec,$P(mode)) &]
} else {
if [info exists tracklist] {
ListRemove tracklist $name
if [Empty $tracklist] {unset tracklist}
}
if [Empty $P(menu)] {
lappend topass exec command staydown
}
}
foreach switch $topass {
if ![Empty $P($switch,$P(mode))] {
lappend C -$switch $P($switch,$P(mode))
}
}
eval $C
# If no text, we clear the current text if any
if [info exists cleartextvar] {
uplevel \#0 {set dummy ""}
$P(pathname) config -textvar dummy
$P(pathname) config -textvar ""
}
# Set up bindings for balloon help
if ![Empty $P(balloon,$P(mode))] {
TKGBalloonBind $P(pathname) $P(balloon,$P(mode))
}
# Bind button2 to unix command, if any.
if $P(usebutton2) {
if [Empty $P(exec,$P(mode))] {
bind $P(pathname) <2> break
} else {
bind $P(pathname) <2> \
[concat exec $P(exec,$P(mode)) >& /dev/null & \; break]
}
}
return $P(pathname)
}
proc TKGButtonArgStuff {name arglist} {
global TKG(currentpanel) TKG
if {[set i [lsearch $arglist "-imagefile"]] != -1} {
if ![Empty [lindex $arglist [expr $i + 1]]] {
SetImage ${name}-image [lindex $arglist [expr $i + 1]]
set arglist \
[lreplace $arglist [expr $i] [expr $i +1] -image ${name}-image]
} else {
set arglist \
[lreplace $arglist [expr $i] [expr $i +1]]
set j [expr [lsearch $arglist -text] + 1]
if [Empty [lindex $arglist $j]] {
set arglist [lreplace $arglist $j $j [split $name ~]]
}
}
}
if {[set i [lsearch $arglist "-tilefile"]] != -1} {
if ![Empty [lindex $arglist [expr $i + 1]]] {
SetImage ${name}-tile [lindex $arglist [expr $i + 1]]
set arglist \
[lreplace $arglist [expr $i] [expr $i +1] -tileimage ${name}-tile]
} else {
set arglist \
[lreplace $arglist [expr $i] [expr $i +1]]
}
}
foreach switch $TKG(switches,TKGButton,ms) {
set switch [lindex $switch 0]
while {[set i [lsearch $arglist "-$switch"]] != -1} {
if {[string match {{}} [lindex $arglist [expr $i + 1]]]} {
set arglist [lreplace $arglist $i [expr $i +1]]
} else {
set arglist [lreplace $arglist $i $i "-${switch}(normal)"]
}
}
}
return $arglist
}
proc TKGButtonCopyMode {name mode1 mode2} {
global TKG
upvar #0 $name-params P
foreach s $TKG(switches,TKGButton,ms) {
set s [lindex $s 0]
set P($s,$mode2) $P($s,$mode1)
}
}
set TKG(switches,TKGLabelBox) {
{text ""}
}
proc TKGLabelBox {name args} {
set name [string trim [join $name ~]]
set lcname [string tolower $name]
global TKG $name-lbparams
set lcpanel [string tolower $TKG(currentpanel)]
set window .${lcpanel}.lb$lcname
set sswitches $TKG(switches,TKGLabelBox)
TKGSetSwitchDefaults $name-lbparams $TKG(switches,TKGLabelBox)
TKGParseArgs $name-lbparams $args $sswitches {} TKGLabelBox
DEBUG "creating $window"
global [set name]_window
set [set name]_window $window
frame $window -borderwidth 3\
-highlightthickness 0 -relief ridge -cursor top_left_arrow \
-background $TKG(labelboxbackground)
if ![Empty [set $name-lbparams(text)]] {
frame $window.label\
-borderwidth 0 -highlightthickness 0
label $window.label.lbtext \
-textvariable $name-lbparams(text)\
-pady 0 -borderwidth 0 -highlightthickness 0\
-foreground $TKG(labelboxforeground) \
-background $TKG(labelboxbackground)
grid $window.label.lbtext -sticky nsew
grid $window.label -sticky nsew
TKGRowCol $window.label
TKGRowCol $window.label.lbtext
}
TKGRowCol $window
return $window
}
# Put a tkgbutton back in the panel during redraw after screenedge move
proc TKGReGrid {name} {
upvar \#0 $name-params P
global TKG_iconSide
if ![info exists P] {return 0}
grid forget $P(pathname)
if {[info exists P(iconside)] &&[Empty $P(iconside)]} {
$P(pathname) configure -iconside $TKG_iconSide(current)
}
TKGGrid $P(pathname)
return 1
}