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