1/usr/local/bin/wish8.6 2# TkFont 1.1 -- Copyright Neil Grant 1996, 1997 3# Bug reports, praise, and so on to grantj@sfu.ca 4 5set size 24 6set aspect "-0-100-100" 7set CurFont "fixed" 8set SizedFont "fixed" 9set Editor tkedit 10set CurFileName "" 11 12proc GetFontList { } { 13 .f1.fontlistbox delete 0 end 14 update 15 set TempFileName "/tmp/fonts.list.[pid]" 16 set TempFileName2 "/tmp/fonts.list.[pid]b" 17 18 exec xlsfonts -u -fn "*" | grep "-" | sort -t "-" +2 | uniq > $TempFileName 19 exec grep -v "0-0-75-75-" < $TempFileName > $TempFileName2 20 exec grep -v "0-0-100-100-" < $TempFileName2 > $TempFileName 21 set Chan [open $TempFileName r] 22 23 set chars 1 24 while {$chars > 0} { 25 set chars [gets $Chan onefontname] 26 .f1.fontlistbox insert end $onefontname 27 } 28 close $Chan 29 .f1.fontlistbox delete end 30 exec rm $TempFileName $TempFileName2 31} 32 33proc GetFontDirs {} { 34 global FontDirList errorCode 35 if {[catch {exec xset -q} result] && $errorCode != "NONE"} { 36 error $result 37 } 38 set lines [split $result \n] 39 set i [lsearch -exact $lines "Font Path:"] 40 if {$i == -1} { 41 error "Output of `xset -q' did not contain\ 42 `Font Path:'\n$result" 43 } 44 set dirLine [string trim [lindex $lines [incr i]]] 45 set FontDirList [split $dirLine ,] 46} 47 48proc Rehash {} { 49 update 50 toplevel .wait 51 wm geometry .wait +300+300 52 label .wait.lbl -text "Getting info..." -fg red4 53 pack .wait.lbl -in .wait 54 update 55 exec xset fp rehash 56 GetFontList 57 GetFontDirs 58 destroy .wait 59} 60 61proc CreateBindings {} { 62 bind .f1.fontlistbox <Button-1> { 63 .f1.fontlistbox selection clear 0 end 64 .f1.fontlistbox selection set [%W index @%x,%y] 65 .f1.fontlistbox selection anchor [%W index @%x,%y] 66 %W activate @%x,%y 67 set CurFont [selection get] 68 ShowFont 69 } 70 71 bind .fontname <Return> { 72 if {![winfo exists .s]} {CreateSampTextWidget} 73 .s.sample configure -font $SizedFont 74 } 75 76 bind .f1.fontlistbox <Button-3> { 77 .f1.fontlistbox selection clear 0 end 78 .f1.fontlistbox selection set [%W index @%x,%y] 79 .f1.fontlistbox selection anchor [%W index @%x,%y] 80 %W activate @%x,%y 81 set CurFont [selection get] 82 ShowChars 83 ShowFont 84 } 85 86 bind .f1.fontlistbox <Button-2> { 87 .f1.fontlistbox selection clear 0 end 88 .f1.fontlistbox selection set [%W index @%x,%y] 89 .f1.fontlistbox selection anchor [%W index @%x,%y] 90 %W activate @%x,%y 91 set CurFont [selection get] 92 ShowInfo 93 ShowFont 94 } 95} 96 97proc ShowFont {} { 98 global size CurFont SizedFont aspect 99 set tsize ${size}${aspect} 100 regsub 0-0-0-0 $CurFont $tsize SizedFont 101 if {![winfo exists .s]} {CreateSampTextWidget} 102 .s.sample configure -font $SizedFont 103} 104 105proc ShowChars {} { 106 global size CurFont SizedFont aspect 107 set tsize $size 108 if {$tsize > 24} {set tsize 24} 109 set tsize ${tsize}${aspect} 110 regsub 0-0-0-0 $CurFont $tsize SizedFont 111 exec xfd -fn $SizedFont & 112} 113 114proc FindFile {} { 115 global FontDirList CurFont CurFileName 116 set MangledFont [string range $CurFont 1 end] 117 set i 0 118 foreach i $FontDirList { 119 set result [exec /usr/local/lib/tkfont/FindFont $MangledFont $i/fonts.dir] 120 if {[string length $result]} {break} 121 } 122 set EndOfName [string first " " $result] 123 set FontFileName [string range $result 0 [expr $EndOfName-1]] 124 set $i "is in $i" 125 if {![string length $result]} { 126 set FontFileName "It's probably an alias for another font." 127 set i "This font couldn't be found." 128 } 129 set CurFileName "${i}/" 130 set CurFileName "${CurFileName}${FontFileName}" 131 if {![winfo exists .finddirresults]} { 132 toplevel .finddirresults -relief sunken 133 label .finddirresults.fname -anchor w -relief raised 134 label .finddirresults.fdir -anchor w -relief raised 135 label .finddirresults.file -anchor w -relief raised 136 label .finddirresults.size -anchor w -relief raised 137 label .finddirresults.name -anchor w -relief raised 138 frame .finddirresults.lotsabuttons 139 pack .finddirresults.fname .finddirresults.fdir .finddirresults.file \ 140 .finddirresults.size .finddirresults.name \ 141 .finddirresults.lotsabuttons -in .finddirresults -fill x -expand 1 142 button .finddirresults.lotsabuttons.ok -text Ok -command {destroy .finddirresults} 143 pack .finddirresults.lotsabuttons.ok \ 144 -side left -in .finddirresults.lotsabuttons 145 wm title .finddirresults "Font Locator" 146 wm resizable .finddirresults 0 0 147 } 148 .finddirresults.fname configure -text "Font: $CurFont" 149 .finddirresults.fdir configure -text "Directory: $i" -anchor w 150 .finddirresults.file configure -text "Filename: $FontFileName" 151 set FileSize [file size $CurFileName] 152 .finddirresults.size configure -text "File Size: $FileSize bytes" 153 .finddirresults.name configure -text [exec file -z $CurFileName] 154} 155 156proc ShowDirs {} { 157 global FontDirList 158 if {[winfo exists .dirs]} {return} 159 160 toplevel .dirs 161 listbox .dirs.dirlist -width 40 -height 11 -setgrid 1 162 frame .dirs.f1 163 radiobutton .dirs.f1.realones -text "Actual" -value 0 -variable Which 164 radiobutton .dirs.f1.aliases -text "Aliases" -value 1 -variable Which 165 pack .dirs.f1.realones -side left -in .dirs.f1 -expand 1 -fill x 166 pack .dirs.f1.aliases -side right -in .dirs.f1 -expand 1 -fill x 167 168 pack .dirs.f1 -in .dirs -fill x -side bottom 169 pack .dirs.dirlist -in .dirs -fill both -side top -expand 1 170 wm title .dirs "Font Directories" 171 set Which 0 172 173 set i 0 174 foreach i $FontDirList { 175 .dirs.dirlist insert end $i 176 } 177 178 bind .dirs.dirlist <Double-1> {Showfontdirectory $Which} 179 bind .dirs.dirlist <Double-3> { 180 .dirs.dirlist selection clear 0 end 181 .dirs.dirlist selection set [%W index @%x,%y] 182 .dirs.dirlist selection anchor [%W index @%x,%y] 183 %W activate @%x,%y 184 Editfontdirectory $Which 185 } 186} 187 188proc Editfontdirectory {whichone} { 189 global Editor 190 if {$whichone} { 191 if {[file exists [selection get]/fonts.alias]} { 192 exec $Editor [selection get]/fonts.alias & 193 } else { 194 NoAliasFileHere [selection get] 195 return 196 } 197 } else { 198 exec $Editor [selection get]/fonts.dir & 199 } 200} 201 202proc Showfontdirectory {whichone} { 203 set random [clock clicks] 204 while {[winfo exists .fontsdir${random}]} { 205 set random [clock clicks] 206 } 207 208 if {$whichone} { 209 if {[file exists [selection get]/fonts.alias]} { 210 set Chan [open [selection get]/fonts.alias r] 211 } else { 212 NoAliasFileHere [selection get] 213 return 214 } 215 } else { 216 set Chan [open [selection get]/fonts.dir r] 217 } 218 219 toplevel .fontsdir${random} 220 listbox .fontsdir${random}.lst -width 90 -setgrid 1 \ 221 -yscrollcommand ".fontsdir${random}.scrl set" 222 scrollbar .fontsdir${random}.scrl \ 223 -command ".fontsdir${random}.lst yview" 224 set chars 1 225 226 while {$chars > 0} { 227 set chars [gets $Chan onefontname] 228 .fontsdir${random}.lst insert end $onefontname 229 } 230 close $Chan 231 .fontsdir${random}.lst delete 0 232 .fontsdir${random}.lst delete end 233 pack .fontsdir${random}.scrl -in .fontsdir${random} \ 234 -side right -fill y 235 pack .fontsdir${random}.lst -in .fontsdir${random} \ 236 -side left -expand 1 -fill both 237 238 if {$whichone} { 239 wm title .fontsdir${random} [selection get]/fonts.alias 240 } else { 241 wm title .fontsdir${random} [selection get]/fonts.dir 242 } 243} 244 245proc NoAliasFileHere {dir} { 246 tk_dialog .no "Oops" "The directory $dir doesn't have an alias file." "" 0 Ok 247} 248 249proc ShowInfo {} { 250 global size SizedFont 251 set Info [exec xlsfonts -ll -fn $SizedFont] 252 if {![winfo exists .info]} { 253 toplevel .info 254 text .info.infotext -yscrollcommand ".info.yscroll set" \ 255 -setgrid 1 -font fixed 256 .info.infotext insert end $Info 257 scrollbar .info.yscroll -command ".info.infotext yview" 258 pack .info.yscroll -in .info -side right -fill y 259 pack .info.infotext -in .info -side left -expand 1 -fill both 260 wm title .info "Font Information" 261 } else { 262 .info.infotext delete 0.0 end 263 .info.infotext insert end $Info 264 } 265 .info.infotext configure -state disabled 266} 267 268proc About {} { 269 tk_dialog .about "About..." "Written by Neil Grant, 1996 & 1997" "" 0 Ok 270} 271 272proc Usage {file} { 273 if {![winfo exists .usage]} { 274 toplevel .usage 275 wm title .usage Help 276 text .usage.helptext -yscrollcommand ".usage.yscroll set" \ 277 -setgrid 1 -wrap word 278 scrollbar .usage.yscroll -command ".usage.helptext yview" 279 pack .usage.helptext -in .usage -side left -expand 1 -fill both 280 pack .usage.yscroll -in .usage -fill y -side right 281 } else { 282 .usage.helptext delete 0.0 end 283 } 284 .usage.helptext insert end [exec cat /usr/local/lib/tkfont/$file] 285 .usage.helptext mark set insert 0.0 286 .usage.helptext configure -state disabled 287} 288 289frame .toprow 290menubutton .toprow.file -text File -underline 0 -menu .toprow.file.m -relief raised -padx 3 -pady 1 291menu .toprow.file.m -bd 1 -tearoff 0 -activeborderwidth 1 292.toprow.file.m add command -label "Paste Name" -underline 0 -command {set CurFont [selection get] ; ShowFont} 293.toprow.file.m add command -label "Show Info" -underline 5 -command {ShowInfo} 294.toprow.file.m add command -label "Show Chars" -underline 5 -command {ShowChars} 295.toprow.file.m add command -label "Show Dirs" -underline 5 -command {ShowDirs} 296.toprow.file.m add command -label "Find File" -underline 0 -command {FindFile} 297.toprow.file.m add command -label "Re-read Fonts" -underline 0 -command {Rehash} 298.toprow.file.m add separator 299.toprow.file.m add command -label "Exit" -underline 1 -command exit 300menubutton .toprow.size -text Sizes -underline 0 -menu .toprow.size.m -relief raised -padx 3 -pady 1 301menu .toprow.size.m -bd 1 -tearoff 0 -activeborderwidth 1 302.toprow.size.m add radiobutton -label "12" -value 12 -variable size -command ShowFont 303.toprow.size.m add radiobutton -label "14" -value 14 -variable size -command ShowFont 304.toprow.size.m add radiobutton -label "18" -value 18 -variable size -command ShowFont 305.toprow.size.m add radiobutton -label "24" -value 24 -variable size -command ShowFont 306.toprow.size.m add radiobutton -label "36" -value 36 -variable size -command ShowFont 307.toprow.size.m add radiobutton -label "48" -value 48 -variable size -command ShowFont 308.toprow.size.m add radiobutton -label "72" -value 72 -variable size -command ShowFont 309.toprow.size.m add radiobutton -label "96" -value 96 -variable size -command ShowFont 310.toprow.size.m add radiobutton -label "144" -value 144 -variable size -command ShowFont 311menubutton .toprow.aspect -text Aspect -underline 0 -menu .toprow.aspect.m -relief raised -padx 3 -pady 1 312menu .toprow.aspect.m -bd 1 -tearoff 0 -activeborderwidth 1 313.toprow.aspect.m add radiobutton -label "Thinnest" -value "-0-70-100" -variable aspect -command ShowFont 314.toprow.aspect.m add radiobutton -label "Thinner" -value "-0-80-100" -variable aspect -command ShowFont 315.toprow.aspect.m add radiobutton -label "Thin" -value "-0-90-100" -variable aspect -command ShowFont 316.toprow.aspect.m add radiobutton -label "1:1" -value "-0-100-100" -variable aspect -command ShowFont 317.toprow.aspect.m add radiobutton -label "Wide" -value "-0-110-100" -variable aspect -command ShowFont 318.toprow.aspect.m add radiobutton -label "Wider" -value "-0-120-100" -variable aspect -command ShowFont 319.toprow.aspect.m add radiobutton -label "Widest" -value "-0-130-100" -variable aspect -command ShowFont 320menubutton .toprow.help -text Help -underline 0 -menu .toprow.help.m -relief raised -padx 3 -pady 1 321menu .toprow.help.m -bd 1 -tearoff 0 -activeborderwidth 1 322.toprow.help.m add command -label "About" -command About 323.toprow.help.m add command -label "Usage" -command {Usage HelpText.txt} 324.toprow.help.m add command -label "Bugs" -command {Usage Bugs.txt} 325.toprow.help.m add command -label "File Menu" -command {Usage FileMenu.txt} 326.toprow.help.m add command -label "Font Dirs" -command {Usage FontDirs.txt} 327.toprow.help.m add command -label "Font Types" -command {Usage FontTypes.txt} 328.toprow.help.m add command -label "Copying" -command {Usage COPYING} 329.toprow.help.m add command -label "New Features" -command {Usage WhatsNew.txt} 330button .toprow.lab -text "TkFont 1.1" -command About -pady 1 331 332proc CreateSampTextWidget { } { 333 toplevel .s 334 entry .s.sample -bd 2 -relief sunken -width 11 335 .s.sample insert 0 "Sample Text" 336 pack .s.sample -in .s -fill x 337 wm transient .s . 338 wm title .s "Sample Text" 339} 340 341frame .f1 342pack .toprow -side top -fill x 343pack .toprow.file -in .toprow -side left 344pack .toprow.size -in .toprow -side left 345pack .toprow.help -in .toprow -side right 346pack .toprow.aspect -in .toprow -side left 347pack .toprow.lab -in .toprow -side left -fill x -expand 1 348pack .f1 -side top -after .toprow -expand 1 -fill both 349listbox .f1.fontlistbox -yscrollcommand ".f1.yscroll set" -setgrid 1 -width 70 350scrollbar .f1.yscroll -command ".f1.fontlistbox yview" 351entry .fontname -bd 2 -relief sunken -textvariable SizedFont 352pack .f1.fontlistbox -in .f1 -side left -expand 1 -fill both 353pack .f1.yscroll -in .f1 -side right -before .f1.fontlistbox -fill y 354pack .fontname -side bottom -before .f1.fontlistbox -fill x 355wm title . TkFont 356 357Rehash 358CreateSampTextWidget 359CreateBindings 360