Gabriele Cosmo
147 lines
3.4 KiB
PSL
147 lines
3.4 KiB
PSL
## SelectFont
|
|
## (Momo procedure)
|
|
# make Change Font window
|
|
##
|
|
# NOTE: proc Get_Font_List {} uses X command "xlsfonts"
|
|
# to have a list of available fonts.
|
|
# ==> This must be changed for Windows
|
|
#
|
|
## k.ohtubo(Tubocky)
|
|
##
|
|
## 1997.3.16
|
|
## Tcl/Tk version 8.0
|
|
## 1998 July 5 GEANT4 Beta-01
|
|
|
|
proc Select_Font {} {
|
|
if [winfo exists .cf] {
|
|
raise .cf
|
|
focus .cf.info.ent.font
|
|
return
|
|
}
|
|
|
|
global env
|
|
|
|
toplevel .cf -highlightthickness 0
|
|
wm title .cf "Select Font"
|
|
|
|
|
|
frame .cf.butt -highlightthickness 0
|
|
pack .cf.butt -side top -fill x
|
|
|
|
button .cf.butt.b0 -text "Change Font" -bd 3 -highlightthickness 0 \
|
|
-command {
|
|
set env(FONT) [.cf.info.ent.font get]
|
|
Change_Font $env(FONT) .
|
|
Win_Size .cf
|
|
if [winfo exists .dc] {
|
|
Change_Font $env(FONT) .dc
|
|
Win_Size .dc
|
|
}
|
|
if [winfo exists .se] {
|
|
Change_Font $env(FONT) .se
|
|
Put_Env
|
|
Win_Size .se
|
|
}
|
|
}
|
|
button .cf.butt.b1 -text Clear -bd 3 -highlightthickness 0 \
|
|
-command {
|
|
.cf.select.list see 0
|
|
.cf.select.list selection clear 0 end
|
|
focus .cf.info.ent.font
|
|
.cf.info.ent.font delete 0 end
|
|
}
|
|
button .cf.butt.b2 -text Cancel -bd 3 -highlightthickness 0 \
|
|
-command {
|
|
if [winfo exists .cf] {destroy .cf}
|
|
}
|
|
pack .cf.butt.b0 .cf.butt.b1 .cf.butt.b2 -side left
|
|
|
|
|
|
frame .cf.info -highlightthickness 0
|
|
pack .cf.info -side top -fill x
|
|
|
|
frame .cf.info.lb -highlightthickness 0
|
|
pack .cf.info.lb -side left
|
|
|
|
label .cf.info.lb.ex -text Example -anchor w \
|
|
-bd 1 -relief raised -highlightthickness 0
|
|
pack .cf.info.lb.ex -side top
|
|
|
|
label .cf.info.lb.font -text Font -anchor w \
|
|
-bd 1 -relief raised -highlightthickness 0
|
|
pack .cf.info.lb.font -side top -fill x
|
|
|
|
|
|
frame .cf.info.ent -highlightthickness 0
|
|
pack .cf.info.ent -side left -fill x -expand 1
|
|
|
|
label .cf.info.ent.ex -text "This is font style." -anchor w \
|
|
-relief sunken -highlightthickness 0
|
|
pack .cf.info.ent.ex -side top -fill x -expand 1
|
|
|
|
entry .cf.info.ent.font -highlightthickness 0
|
|
pack .cf.info.ent.font -side top -fill x -expand 1
|
|
|
|
|
|
frame .cf.select -highlightthickness 0
|
|
pack .cf.select -side top -fill both -expand 1
|
|
|
|
listbox .cf.select.list -width 80 -height 20 \
|
|
-yscrollcommand {.cf.select.scroll set} \
|
|
-highlightthickness 0
|
|
pack .cf.select.list -side left -fill both -expand 1
|
|
|
|
scrollbar .cf.select.scroll -command {.cf.select.list yview} \
|
|
-highlightthickness 0
|
|
pack .cf.select.scroll -side left -fill y
|
|
|
|
focus .cf.info.ent.font
|
|
|
|
# Binding
|
|
bind .cf.select.list <ButtonRelease> {
|
|
.cf.info.ent.font delete 0 end
|
|
set FONT [selection get]
|
|
.cf.info.ent.font insert end $FONT
|
|
catch {.cf.info.lb.ex configure -font $FONT}
|
|
catch {.cf.info.ent.ex configure -font $FONT}
|
|
|
|
global errorCode errorInfo
|
|
if {$errorCode != "NONE"} {
|
|
set errorCode NONE
|
|
}
|
|
if {$errorInfo != ""} {
|
|
set errorInfo ""
|
|
}
|
|
}
|
|
|
|
bind .cf.select.list <Double-Button> {.cf.butt.b0 invoke}
|
|
|
|
bind .cf.info.ent.font <Return> {.cf.butt.b0 invoke}
|
|
|
|
|
|
Get_Font_List
|
|
if {[lsearch [array names env] FONT] >= 0} {
|
|
Change_Font $env(FONT) .cf
|
|
}
|
|
Change_Color $env(FORE_GROUND_COLOR) $env(BACK_GROUND_COLOR) .cf
|
|
Win_Size .cf
|
|
Tab_off
|
|
Control
|
|
}
|
|
|
|
# Get Font List
|
|
# NOTE: Use X command "xlsfonts"
|
|
proc Get_Font_List {} {
|
|
if {![winfo exists .cf.select.list]} {
|
|
Message_Skeleton -icon warning -button O.K. \
|
|
-message "Warning!\nWhat's happen?"
|
|
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
|
return
|
|
}
|
|
|
|
set List [exec xlsfonts]
|
|
foreach l $List {
|
|
.cf.select.list insert end $l
|
|
}
|
|
}
|