/usr/share/amsn/utils/framec/framec.tcl is in amsn-data 0.98.9-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 | #-----------------------------------------------------------------------
# TITLE:
# framec.tcl
#
# AUTHOR:
# Arieh Schneier
#
# DESCRIPTION:
# Widget adaptor to add a coloured frame around a widget.
# Default widget if not specified is a frame.
#
#-----------------------------------------------------------------------
# SYNOPSIS:
# framec pathName ?options?
# STANDARD OPTIONS
# (all options available to 'type')
# WIDGET SPECIFIC OPTIONS
# -background or -bg
# -bordercolor or -bc
# -borderwidth or -bw
# -innerpadx
# -innerpady
# -type
# STANDARD COMMANDS
# (all commands available to 'type')
# WIDGET SPECIFIC COMMANDS
# pathname configure ?option? ?value? ...
# pathname cget option
# pathname getinnerframe
# (other standard snit commands)
#-----------------------------------------------------------------------
package require snit
package provide framec 0.2
snit::widget framec {
component padding
component inner
option -bordercolor -default #000000 -cgetmethod getOption -configuremethod changeBorderColor
option -bc -cgetmethod getOption -configuremethod changeBorderColor
option -borderwidth -default 1 -cgetmethod getOption -configuremethod changeBorderWidth
option -bd -cgetmethod getOption -configuremethod changeBorderWidth
option -background -default #ffffff -cgetmethod getOption -configuremethod changeBackground
option -bg -cgetmethod getOption -configuremethod changeBackground
option -innerpadx -default 0 -cgetmethod getOption -configuremethod changePadWidthx
option -innerpady -default 0 -cgetmethod getOption -configuremethod changePadWidthy
option -class
option -type
delegate option * to inner except {-bordercolor -bc -borderwidth -bd -background -bg -padwidth -type -class}
delegate method * to inner
constructor {args} {
#check for type and class
set itstype frame
set itsclass ""
foreach {option value} $args {
if { [string equal $option "-type"] } {
set itstype $value
} elseif { [string equal $option "-class"] } {
set itsclass $value
}
}
$hull configure -background $options(-bordercolor) -relief solid -borderwidth 0
install padding using frame $win.padding -background $options(-background) -relief solid -borderwidth 0
if { $itsclass == "" } {
install inner using $itstype $win.inner -borderwidth 0
} else {
install inner using $itstype $win.inner -class $itsclass -borderwidth 0
}
pack $padding -padx $options(-borderwidth) -pady $options(-borderwidth) -expand true -fill both
pack $inner -padx $options(-innerpadx) -pady $options(-innerpady) -expand true -fill both -in $padding
# Apply any options passed at creation time.
$self configurelist $args
}
method getOption {option} {
if { [string equal $option "-bd"] } {
set option "-borderwidth"
} elseif { [string equal $option "-bg"] } {
set option "-background"
} elseif { [string equal $option "-bc"] } {
set option "-bordercolor"
}
return $options($option)
}
method changeBorderColor {option value} {
set options(-bordercolor) $value
$hull configure -background $value
}
method changeBorderWidth {option value} {
set options(-borderwidth) $value
pack configure $padding -padx $value -pady $value
}
method changeBackground {option value} {
set options(-background) $value
$padding configure -background $value
$inner configure -background $value
}
method changePadWidthx {option value} {
set options(-innerpadx) $value
pack configure $inner -padx $value
}
method changePadWidthy {option value} {
set options(-innerpady) $value
pack configure $inner -pady $value
}
method getinnerframe {} {
return $inner
}
}
|