/usr/share/tkrat2.2/fontedit.tcl is in tkrat 1:2.2cvs20100105-true-dfsg-6ubuntu1.
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 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 | # fontedit.tcl --
#
# Contains code for the edit font window
#
# TkRat software and its included text is Copyright 1996-2005 by
# Martin Forssén
#
# The full text of the legal notice is contained in the file called
# COPYRIGHT, included with this distribution.
namespace eval ::tkrat::fontedit {
namespace export edit
}
# ::tkrat::fontedit::edit --
#
# Show the edit font window
#
# Arguments:
# font - Font setting to edit
# l - Label to update afterwards
# parent - Parent window
proc ::tkrat::fontedit::edit {font l parent} {
global t idCnt pref
set id doEditFont[incr idCnt]
upvar \#0 $id hd
# Initialization
set hd(done) 0
set hd(new_spec) $pref(opt,$font)
set hd(old_spec) ""
set hd(font_name) ""
if {"components" == [lindex $hd(new_spec) 0]} {
set hd(family) [lindex $hd(new_spec) 1]
set hd(size) [lindex $hd(new_spec) 2]
set hd(weight) [lindex $hd(new_spec) 3]
set hd(slant) [lindex $hd(new_spec) 4]
set hd(underline) [lindex $hd(new_spec) 5]
set hd(overstrike) [lindex $hd(new_spec) 6]
set hd(method) components
} else {
set hd(name) [lindex $hd(new_spec) 1]
set hd(method) name
set hd(family) Helvetica
set hd(size) 12
}
# Create toplevel
set w .fontedit
toplevel $w -class TkRat
wm title $w $t(edit_font)
wm transient $w $parent
# Top label
label $w.topl -text $t(use_one_method)
# Specification method frame
frame $w.s -bd 1 -relief raised
radiobutton $w.s.select -variable ${id}(method) -value components \
-command "::tkrat::fontedit::update_font_spec $id components"
label $w.s.fl -text $t(family):
set m $w.s.family.m
menubutton $w.s.family -bd 1 -relief raised -indicatoron 1 -menu $m \
-textvariable ${id}(family) -width 15
menu $m -tearoff 0
set families [lsort -dictionary [font families]]
foreach f $families {
$m add command -label $f -command \
"set ${id}(family) [list $f]; \
::tkrat::fontedit::update_font_spec $id components"
}
FixMenu $m
label $w.s.sl -text " $t(size):"
set m $w.s.size.m
menubutton $w.s.size -bd 1 -relief raised -indicatoron 1 -menu $m \
-textvariable ${id}(size) -width 3
menu $m -tearoff 0
foreach s {4 5 6 7 8 9 10 11 12 13 14 15 16 18 20 22 24 26 30 36} {
$m add command -label $s -command \
"set ${id}(size) $s; \
::tkrat::fontedit::update_font_spec $id components"
}
checkbutton $w.s.weight -text "$t(bold) " -onvalue bold -offvalue normal \
-variable ${id}(weight) \
-command "::tkrat::fontedit::update_font_spec $id components"
checkbutton $w.s.italic -text "$t(italic) " -onvalue italic \
-offvalue roman -variable ${id}(slant) \
-command "::tkrat::fontedit::update_font_spec $id components"
checkbutton $w.s.underline -text "$t(underline) " \
-variable ${id}(underline) \
-command "::tkrat::fontedit::update_font_spec $id components"
checkbutton $w.s.overstrike -text $t(overstrike) \
-variable ${id}(overstrike) \
-command "::tkrat::fontedit::update_font_spec $id components"
pack $w.s.select \
$w.s.fl $w.s.family \
$w.s.sl $w.s.size \
$w.s.weight \
$w.s.italic \
$w.s.underline \
$w.s.overstrike -side left -pady 2
# Name method frame
frame $w.n -bd 1 -relief raised
radiobutton $w.n.select -variable ${id}(method) -value name \
-command "::tkrat::fontedit::update_font_spec $id name"
label $w.n.l -text $t(name):
entry $w.n.e -width 20 -textvariable ${id}(name)
set hd(updateButton) $w.n.set
button $w.n.set -text $t(update) \
-command "::tkrat::fontedit::update_font_spec $id name" -bd 1
pack $w.n.select \
$w.n.l \
$w.n.e \
$w.n.set -side left -pady 2
trace variable hd(name) w "::tkrat::fontedit::fix_update_btn $id"
trace variable hd(method) w "::tkrat::fontedit::fix_update_btn $id"
fix_update_btn $id
# Sample text
message $w.sample -text $t(ratatosk) -aspect 200 -justify left
set hd(sample) $w.sample
# Buttons
OkButtons $w $t(ok) $t(cancel) "set ${id}(done)"
set hd(okbutton) $w.buttons.ok
# Pack things
pack $w.topl \
$w.s \
$w.n -side top -fill x -pady 2 -padx 2
pack $w.buttons -side bottom -fill x -pady 2 -padx 2
pack $w.sample -fill x -pady 2 -padx 2
# Bindings
bind $w.n.e <Tab> "::tkrat::fontedit::update_font_spec $id name"
bind $w.n.e <Return> "::tkrat::fontedit::update_font_spec $id name; break"
# Update sample font
update_font $id
# Show window and wait for completion
::tkrat::winctl::SetGeometry editFont $w
::tkrat::winctl::ModalGrab $w
pack propagate $w 0
tkwait variable ${id}(done)
# Finalization
::tkrat::winctl::RecordGeometry editFont $w
destroy $w
set pref(opt,$font) $hd(old_spec)
if {"" != $hd(font_name)} {
font delete $hd(font_name)
}
unset hd
$l configure -text [ConvertFontToText $pref(opt,$font)] \
-font [RatCreateFont $pref(opt,$font)]
}
# ::tkrat::fontedit::fix_update_btn --
#
# Set state of the update button
#
# Arguments:
# handler - Handler of font window
# args - Possibly standard trace args
proc ::tkrat::fontedit::fix_update_btn {handler args} {
upvar \#0 $handler hd
if {"" != $hd(name) && "name" == $hd(method)} {
set state normal
} else {
set state disabled
}
$hd(updateButton) configure -state $state
}
# ::tkrat::fontedit::update_font_spec --
#
# Update the shown font
#
# Arguments:
# handler - Handler of font window
# method - which method to use
proc ::tkrat::fontedit::update_font_spec {handler method} {
upvar \#0 $handler hd
if {"components" == $method} {
set hd(new_spec) [list components $hd(family) $hd(size) $hd(weight) \
$hd(slant) $hd(underline) $hd(overstrike)]
set hd(method) components
} else {
set hd(new_spec) [list name $hd(name)]
set hd(method) name
}
update_font $handler
}
# ::tkrat::fontedit::update_font --
#
# Update the sample text
#
# Arguments:
# handler - Handler of font window
proc ::tkrat::fontedit::update_font {handler} {
upvar \#0 $handler hd
global t
if {"$hd(new_spec)" == "$hd(old_spec)"} {
return
}
if {[lindex $hd(new_spec) 0] == "components"} {
if {"" == $hd(font_name)} {
set op create
set hd(font_name) fontedit
} else {
set op configure
}
font $op $hd(font_name) \
-family [lindex $hd(new_spec) 1] \
-size -[lindex $hd(new_spec) 2] \
-weight [lindex $hd(new_spec) 3] \
-slant [lindex $hd(new_spec) 4] \
-underline [lindex $hd(new_spec) 5] \
-overstrike [lindex $hd(new_spec) 6]
set fn $hd(font_name)
} else {
set fn [lindex $hd(new_spec) 1]
}
set hd(old_spec) $hd(new_spec)
if {[catch {$hd(sample) configure -font $fn} err]} {
set okstatus disabled
set msg $t(invalid_font)
set aspect 1000
$hd(sample) configure -font fixed
} else {
set okstatus normal
set msg $t(ratatosk)
set aspect 200
}
$hd(sample) configure -text $msg -aspect $aspect
$hd(okbutton) configure -state $okstatus
}
|