Attachment "tkchat-tile.patch" to
ticket [892659ffff]
added by
patthoyts
2004-03-16 17:40:33.
--- tkchat.tcl Tue Mar 16 10:23:41 2004
+++ tkchat-tile.tcl Tue Mar 16 10:36:02 2004
@@ -36,6 +36,26 @@
}
}
+if {[catch {package require tile}]} {
+ foreach cmd {button checkbutton radiobutton scrollbar \
+ frame labelframe label scale menubutton} {
+ interp alias {} t$cmd {} $cmd
+ }
+} else {
+ # Try finding the demo pixmap themes...
+ foreach lib [info loaded] {
+ foreach {path pkg} $lib {}
+ if {$pkg == "Tile"} {
+ set path [file join [file dirname $path] demos]
+ if {[file exists $path]} {
+ set ::auto_path [concat $path $::auto_path]
+ [package unknown] Tcl [package provide Tcl]
+ }
+ break
+ }
+ }
+}
+
# Under windows, we can use DDE to open urls
if {$tcl_platform(platform) == "windows"} {
package require dde
@@ -44,7 +64,7 @@
package forget app-tkchat ;# Workaround until I can convince people
;# that apps are not packages. :) DGP
package provide app-tkchat \
- [regexp -inline {\d+(?:\.\d+)?} {$Revision: 1.151 $}]
+ [regexp -inline {\d+(?:\.\d+)?} {$Revision: 1.150 $}]
# Maybe exec a user defined preload script at startup (to set Tk options,
# for example.
@@ -69,7 +89,7 @@
variable HOST http://mini.net
variable HEADUrl {http://cvs.sourceforge.net/viewcvs.py/tcllib/tclapps/apps/tkchat/tkchat.tcl?rev=HEAD}
- variable rcsid {$Id: tkchat.tcl,v 1.151 2004/03/16 10:23:41 patthoyts Exp $}
+ variable rcsid {$Id: tkchat.tcl,v 1.150 2004/03/16 09:30:10 patthoyts Exp $}
variable MSGS
set MSGS(entered) [list \
@@ -350,15 +370,15 @@
set i 0
variable HistQueryNum [llength $loglist]
foreach l $loglist {
- grid [radiobutton $t.rb$i -text "$l ($logsize($l))" \
+ grid [tradiobutton $t.rb$i -text "$l ($logsize($l))" \
-val $i -var ::tkchat::HistQueryNum] \
-sticky w -padx 15 -pady 0
incr i
}
- grid [radiobutton $t.rb$i -text "None" \
+ grid [tradiobutton $t.rb$i -text "None" \
-val $i -var ::tkchat::HistQueryNum] \
-sticky w -padx 15 -pady 0
- grid [button $t.ok -text Ok -width 8 -command [list destroy $t] \
+ grid [tbutton $t.ok -text Ok -width 8 -command [list destroy $t] \
-default active] \
-sticky e -padx 5 -pady 10
grid columnconfigure $t 0 -weight 1
@@ -589,7 +609,7 @@
wm transient .pause .
pack [label .pause.m -text \
"The session is paused,\nno updates will occur."]
- button .pause.r -text "Resume" \
+ tbutton .pause.r -text "Resume" \
-command { ::tkchat::pause off ; wm withdraw .pause }
pack .pause.r -padx 5 -pady 10
bind .pause <Destroy> [list ::tkchat::pause off]
@@ -1709,7 +1729,7 @@
}
$t.txt insert end "\n"
$t.txt config -state disabled
- button $t.close -text Close -command [list destroy $t]
+ tbutton $t.close -text Close -command [list destroy $t]
focus $t.close
pack $t.close -side right
}
@@ -1933,6 +1953,54 @@
}
+# -------------------------------------------------------------------------
+# Theme support (using the tile package)
+
+proc ::tkchat::CreateThemeMenu {parent} {
+ global Options
+ if {![info exists ::THEMELIST]} { GetThemes }
+ foreach {theme name} $::THEMELIST {
+ $parent add radiobutton -label $name \
+ -variable ::Options(Theme) \
+ -value $theme -command [list ::tkchat::SetTheme $theme]
+ }
+}
+
+proc ::tkchat::GetThemes {} {
+ global THEMELIST
+ set THEMELIST {
+ {} "Classic"
+ alt "Revitalized"
+ step "OpenStep"
+ winnative "Windows native"
+ xpnative "XP Native"
+ }
+ array set THEMES $THEMELIST
+
+ # Add in any available loadable themes.
+ foreach pkg [package names] {
+ if {![string match tile::theme::* $pkg]} { continue }
+ set name [lindex [split $pkg :] end]
+ if {![info exists THEMES($name)]} {
+ lappend THEMELIST $name \
+ [set THEMES($name) [string totitle $name]]
+ }
+ }
+}
+
+# Set theme, but permit delayed loading of the pixmap themes.
+proc ::tkchat::SetTheme {theme} {
+ global Options
+ if {[lsearch -exact [package names] tile::theme::$theme] >= 0} {
+ package require tile::theme::$theme
+ }
+ if {![catch {style theme use $theme} msg]} {
+ set ::Options(Theme) $theme
+ }
+}
+
+# -------------------------------------------------------------------------
+
proc ::tkchat::CreateGUI {} {
global Options
@@ -2004,6 +2072,13 @@
$m add command -label "Options ..." -underline 0 \
-command ::tkchat::EditOptions
+ if {[package provide tile] != {}} {
+ $m add separator
+ $m add cascade -label "Theme" \
+ -menu [menu $m.theme -tearoff 0] -underline 0
+ CreateThemeMenu $m.theme
+ }
+
$m add separator
$m add cascade -label "Refresh Frequency" \
@@ -2197,7 +2272,7 @@
if {[info command ::panedwindow] != {} && $Options(UsePane)} {
set UsePane 1
panedwindow .pane -sashpad 4 -sashrelief ridge
- frame .txtframe
+ tframe .txtframe
} else {
set UsePane 0
}
@@ -2207,7 +2282,7 @@
-font FNT -relief sunken -bd 2 -wrap word \
-yscroll "::tkchat::scroll_set .sbar" \
-state disabled -cursor left_ptr -height 1
- scrollbar .sbar -command ".txt yview"
+ tscrollbar .sbar -command ".txt yview"
# user display
text .names -background "#[getColor MainBG]" \
-foreground "#[getColor MainFG]" \
@@ -2215,8 +2290,8 @@
-cursor left_ptr -height 1 -wrap word
# bottom frame for entry
- frame .btm
- button .ml -text ">>" -command ::tkchat::showExtra
+ tframe .btm
+ tbutton .ml -text ">>" -command ::tkchat::showExtra
entry .eMsg
bind .eMsg <Return> ::tkchat::userPost
bind .eMsg <KP_Enter> ::tkchat::userPost
@@ -2225,9 +2300,9 @@
bind .eMsg <Key-Tab> {::tkchat::nickComplete ; break}
text .tMsg -height 6 -font FNT
bind .tMsg <Key-Tab> {::tkchat::nickComplete ; break}
- button .post -text "Post" -command ::tkchat::userPost
+ tbutton .post -text "Post" -command ::tkchat::userPost
#button .refresh -text "Refresh" -command {pause off}
- menubutton .mb -indicator on -pady 4 \
+ tmenubutton .mb -indicator on -pady 4 \
-menu .mb.mnu -textvar Options(MsgTo)
menu .mb.mnu -tearoff 0
.mb.mnu add command -label "All Users" \
@@ -2375,7 +2450,7 @@
set parent [winfo parent $w]
for {set n 0} {[winfo exists $parent.f$n]} {incr n} {}
- set f [frame $parent.f$n]
+ set f [tframe $parent.f$n]
set vs [$sbcmd $f.vs -orient vertical -command [list $w yview]]
$w configure -yscrollcommand [list $vs set]
raise $w $f
@@ -2401,7 +2476,7 @@
wm withdraw $w
wm transient $w .
wm title $w "About TkChat $rcsVersion"
- button $w.b -text Dismiss -command [list wm withdraw $w]
+ tbutton $w.b -text Dismiss -command [list wm withdraw $w]
text $w.text -height 30 -bd 1 -width 100
pack $w.b -fill x -side bottom
pack $w.text -fill both -side left -expand 1
@@ -2409,7 +2484,7 @@
$w.text tag config title -justify center -font {Courier -18 bold}
$w.text tag config h1 -justify left -font {Sans -12 bold}
$w.text insert 1.0 "About TkChat v$rcsVersion" title \
- "\n\nCopyright (C) 2001 Bruce B Hartweg <[email protected]>" \
+ "\n\nCopyright \u00a9 2001 Bruce B Hartweg <[email protected]>" \
center "\n$rcsid\n\n" center
$w.text insert end "Commands\n" h1 \
@@ -2956,26 +3031,26 @@
wm withdraw .logon
wm transient .logon .
wm title .logon "Logon to the Tcl'ers Chat"
- checkbutton .logon.prx -text "Use Proxy" -var Options(UseProxy) \
+ tcheckbutton .logon.prx -text "Use Proxy" -var Options(UseProxy) \
-underline 7
- label .logon.lph -text "Proxy Host" -underline 6
- label .logon.lpp -text "Proxy Port" -underline 6
+ tlabel .logon.lph -text "Proxy Host" -underline 6
+ tlabel .logon.lpp -text "Proxy Port" -underline 6
entry .logon.eph -textvar Options(ProxyHost)
entry .logon.epp -textvar Options(ProxyPort)
- label .logon.lpan -text "Proxy Auth Username" -underline 11
- label .logon.lpap -text "Proxy Auth Password" -underline 13
+ tlabel .logon.lpan -text "Proxy Auth Username" -underline 11
+ tlabel .logon.lpap -text "Proxy Auth Password" -underline 13
entry .logon.epan -textvar Options(ProxyUsername)
entry .logon.epap -textvar Options(ProxyPassword) -show {*}
- label .logon.lnm -text "Chat Username" -underline 9
- label .logon.lpw -text "Chat Password" -underline 6
+ tlabel .logon.lnm -text "Chat Username" -underline 9
+ tlabel .logon.lpw -text "Chat Password" -underline 6
entry .logon.enm -textvar Options(Username)
entry .logon.epw -textvar Options(Password) -show *
- checkbutton .logon.rpw -text "Remember Chat Password" \
+ tcheckbutton .logon.rpw -text "Remember Chat Password" \
-var Options(SavePW) -underline 0
- checkbutton .logon.atc -text "Auto-connect" -var Options(AutoConnect) \
+ tcheckbutton .logon.atc -text "Auto-connect" -var Options(AutoConnect) \
-underline 5
- button .logon.ok -text "Logon" -command "set LOGON 1" -width 8 -underline 0
- button .logon.cn -text "Quit" -width 8 -underline 0 \
+ tbutton .logon.ok -text "Logon" -command "set LOGON 1" -width 8 -underline 0
+ tbutton .logon.cn -text "Quit" -width 8 -underline 0 \
-command [namespace origin quit]
bind .logon <Alt-x> {.logon.prx invoke}
@@ -3025,6 +3100,17 @@
logonChat
}
+proc ::tkchat::SetState {w state} {
+ set tilewidgets [list TScrollbar TLabel TFrame TLabelFrame TButton \
+ TCheckbutton TRadiobutton TScale]
+ if {[lsearch -exact $tilewidgets [winfo class $w]] != -1} {
+ if {$state == "normal"} { set state !disabled }
+ $w state $state
+ } else {
+ $w configure -state $state
+ }
+}
+
proc ::tkchat::optSet {args} {
global Options
if {$Options(UseProxy)} {
@@ -3033,12 +3119,12 @@
set s disabled
}
foreach w {lph lpp eph epp lpan epan lpap epap} {
- .logon.$w config -state $s
+ SetState .logon.$w $s ;#.logon.$w config -state $s
}
if {$Options(SavePW)} {
- .logon.atc config -state normal
+ SetState .logon.atc normal ;#.logon.atc config -state normal
} else {
- .logon.atc config -state disabled
+ SetState .logon.atc disabled ;#.logon.atc config -state disabled
set Options(AutoConnect) 0
}
}
@@ -3147,23 +3233,23 @@
incr buildRow_seq
}
set seq $buildRow_seq
- label $f.nm$seq -text "$disp" -anchor w -font NAME -padx 0 -pady 0
- radiobutton $f.def$seq -text "default" \
+ tlabel $f.nm$seq -text "$disp" -anchor w -font NAME -padx 0 -pady 0
+ tradiobutton $f.def$seq -text "default" \
-var DlgData(Color,$idx,Which) \
-val Web -fg "#$DlgData(Color,$idx,Web)" \
-selectcolor "#$DlgData(Color,$idx,Web)" \
-indicatoron 0 -padx 0 -pady 0 -font FNT
- radiobutton $f.inv$seq -text "inverted" \
+ tradiobutton $f.inv$seq -text "inverted" \
-var DlgData(Color,$idx,Which) \
-val Inv -fg "#$DlgData(Color,$idx,Inv)" \
-selectcolor "#$DlgData(Color,$idx,Inv)" \
-indicatoron 0 -padx 0 -pady 0 -font FNT
- radiobutton $f.ovr$seq -text "custom" \
+ tradiobutton $f.ovr$seq -text "custom" \
-var DlgData(Color,$idx,Which) \
-val Mine -fg "#$DlgData(Color,$idx,Mine)"\
-selectcolor "#$DlgData(Color,$idx,Mine)" \
-indicatoron 0 -padx 0 -pady 0 -font FNT
- button $f.clr$seq -text "..." -padx 0 -pady 0 -font FNT \
+ tbutton $f.clr$seq -text "..." -padx 0 -pady 0 -font FNT \
-command [list ::tkchat::newColor $f.ovr$seq $idx]
grid $f.nm$seq $f.def$seq $f.inv$seq $f.ovr$seq $f.clr$seq \
-padx 2 -pady 2 -sticky ew
@@ -3178,16 +3264,16 @@
wm title $t "Edit Macros"
listbox $t.lst -yscroll "$t.scr set" -font FNT -selectmode extended
- scrollbar $t.scr -command "$t.lst yview"
- label $t.lbl1 -text "Macro:" -font NAME
+ tscrollbar $t.scr -command "$t.lst yview"
+ tlabel $t.lbl1 -text "Macro:" -font NAME
entry $t.mac -width 10 -font FNT -validate all -vcmd {regexp -- {^\S*$} %P}
bind $t.mac <Return> "focus $t.txt"
- label $t.lbl2 -text "Text:" -font NAME
+ tlabel $t.lbl2 -text "Text:" -font NAME
entry $t.txt -width 40 -font FNT
bind $t.txt <Return> "$t.sav invoke"
bind $t.lst <Double-1> "::tkchat::MacroSel %W @%x,%y"
- button $t.sav -text Save -command "::tkchat::MacroSave $t"
- button $t.del -text Delete -command "::tkchat::MacroKill $t.lst"
+ tbutton $t.sav -text Save -command "::tkchat::MacroSave $t"
+ tbutton $t.del -text Delete -command "::tkchat::MacroKill $t.lst"
set help "Macros are invoked whenever the first word in the posted\n"
append help "message matches a defined macro name. Instead of the\n"
append help "original message being sent, the Text from the macro\n"
@@ -3277,10 +3363,11 @@
wm withdraw $t
wm title $t "Color Settings"
- label $t.l1 -text "Posting Color" -font NAME
+ tlabel $t.l1 -text "Posting Color" -font NAME
label $t.l2 -text "Example Text" -background white \
-foreground \#$DlgData(MyColor) -font ACT
- button $t.myclr -text "Change..." -font FNT -command {
+
+ tbutton $t.myclr -text "Change..." -font FNT -command {
set tmp [tk_chooseColor \
-title "Select Your User Color" \
-initialcolor \#$::DlgData(MyColor)]
@@ -3290,20 +3377,20 @@
}
}
- label $t.l3 -text "Display Color Overrides" -font NAME
- frame $t.f -relief sunken -bd 2 -height 300
+ tlabel $t.l3 -text "Display Color Overrides" -font NAME
+ tframe $t.f -relief sunken -border 2 ;#TILE -height 300
canvas $t.f.cvs -yscrollcommand [list $t.f.scr set] \
- -width 10 -height 300 -highlightthickness 0 -bd 0
- scrollbar $t.f.scr -command [list $t.f.cvs yview]
+ -width 10 -height 300 -highlightthickness 0 -border 0
+ tscrollbar $t.f.scr -command [list $t.f.cvs yview]
pack $t.f.cvs -side left -expand 1 -fill both
pack $t.f.scr -side left -fill y
- set f [frame $t.f.cvs.frm]
+ set f [tframe $t.f.cvs.frm]
$t.f.cvs create window 0 0 -anchor nw -window $f
bind $f <Configure> {
[winfo parent %W] config -width [expr {%w+5}] -scrollregion [list 0 0 %w %h]
}
foreach {key str} {Web "All\nDefault" Inv "All\nInverted" Mine "All\nCustom"} {
- button $f.all$key -text $str -padx 0 -pady 0 -font SYS -command \
+ tbutton $f.all$key -text $str -font SYS -command \
[string map [list %val% $key] {
foreach idx [array names DlgData *,Which] {
set DlgData($idx) %val%
@@ -3326,10 +3413,10 @@
buildRow $f $nick $nick
}
}
- frame $t.f2
- button $t.f2.ok -width 8 -text "OK" -command {set DlgDone ok} -font SYS
- button $t.f2.app -width 8 -text "Apply" -command {set DlgDone apply} -font SYS
- button $t.f2.can -width 8 -text "Cancel" -command {set DlgDone cancel} -font SYS
+ tframe $t.f2
+ tbutton $t.f2.ok -width 8 -text "OK" -command {set DlgDone ok} -font SYS
+ tbutton $t.f2.app -width 8 -text "Apply" -command {set DlgDone apply} -font SYS
+ tbutton $t.f2.can -width 8 -text "Cancel" -command {set DlgDone cancel} -font SYS
pack $t.f2.ok $t.f2.app $t.f2.can -side left -expand 1 -fill none
grid $t.l1 $t.l2 $t.myclr x -padx 1 -pady 3 -sticky {}
@@ -4233,19 +4320,19 @@
wm withdraw $w
bind $w <Double-Button-3> [list wm withdraw $w]
wm protocol $w WM_DELETE_WINDOW [list wm withdraw $w]
- frame $w.main
- frame $w.top
+ tframe $w.main
+ tframe $w.top
entry $w.top.ent -bg white -textvariable [namespace current]::Query
- button $w.top.but -text "ask LEO" -command [namespace code askLEO]
+ tbutton $w.top.but -text "ask LEO" -command [namespace code askLEO]
bind $w.top.ent <Return> [list $w.top.but invoke]
pack $w.top.ent -expand yes -fill x -side left
pack $w.top.but -expand no -fill none -side left
pack $w.top -fill x -in $w.main
- frame $w.bot
- scrollbar $w.bot.scry -command [list $w.bot.text yview]
- scrollbar $w.bot.scrx -orient horizontal -command [list $w.bot.text xview]
+ tframe $w.bot
+ tscrollbar $w.bot.scry -command [list $w.bot.text yview]
+ tscrollbar $w.bot.scrx -orient horizontal -command [list $w.bot.text xview]
text $w.bot.text -wrap no -font fixed -state disabled \
-yscrollcommand [list $w.bot.scry set] -xscrollcommand [list $w.bot.scrx set]
grid $w.bot.text -row 0 -column 0 -sticky nsew
@@ -4918,21 +5005,21 @@
}
set dlg [toplevel .userinfo]
- set f [frame $dlg.f -bd 0]
+ set f [tframe $dlg.f -bd 0]
foreach {key text} {realname "Real name" email Email country Country \
city City age Age url "Homepage URL" \
photo_url "Picture URL" icq_uin "ICQ uin"} {
- set l [label $f.l$key -text $text -anchor nw]
+ set l [tlabel $f.l$key -text $text -anchor nw]
set e [entry $f.e$key \
-textvariable [namespace current]::UserInfo($key) \
-bd 1 -background white]
grid configure $l $e -sticky news -padx 1 -pady 1
}
- set l [label $f.lstuff -text "Anything else" -anchor nw]
- set e [frame $f.estuff -bd 0]
+ set l [tlabel $f.lstuff -text "Anything else" -anchor nw]
+ set e [tframe $f.estuff -bd 0]
set et [text $e.text -height 6 -bd 1 -background white]
- set es [scrollbar $e.scroll -bd 1 -command [list $et yview]]
+ set es [tscrollbar $e.scroll -bd 1 -command [list $et yview]]
$et configure -yscrollcommand [list $es set]
catch {$et insert 0.0 $UserInfo(stuff)}
grid configure $et $es -sticky news
@@ -4943,10 +5030,10 @@
grid columnconfigure $f 1 -weight 1
grid rowconfigure $f 8 -weight 1
- set btns [frame $dlg.buttons -bd 1]
- button $btns.ok -text Save -width 10 \
+ set btns [tframe $dlg.buttons -bd 1]
+ tbutton $btns.ok -text Save -width 10 \
-command [list set [namespace current]::UserInfoBtn 1]
- button $btns.cancel -text Cancel -width 10 \
+ tbutton $btns.cancel -text Cancel -width 10 \
-command [list set [namespace current]::UserInfoBtn 0]
pack $btns.cancel $btns.ok -side right
@@ -5264,7 +5351,7 @@
wm withdraw $dlg
wm title $dlg "Tkchat Options"
- set bf [labelframe $dlg.bf -text "Preferred browser" -padx 1 -pady 1]
+ set bf [tlabelframe $dlg.bf -text "Preferred browser" -padx 1 -pady 1]
message $bf.m -justify left -width 320 \
-text "Provide the command used to launch your web browser. For\
instance /opt/bin/mozilla or xterm -e links. The URL to\
@@ -5272,7 +5359,7 @@
mozilla-type browsers we will call the -remote option to\
try to use a previously existing browser."
entry $bf.e -textvariable ::tkchat::EditOptions(BROWSER)
- button $bf.b -text "..." -command {
+ tbutton $bf.b -text "..." -command {
if {[set file [tk_getOpenFile]] != {}} {
set ::tkchat::EditOptions(BROWSER) $file
}
@@ -5283,17 +5370,17 @@
grid rowconfigure $bf 0 -weight 1
grid columnconfigure $bf 0 -weight 1
- set sf [labelframe $dlg.sf -text "Tk style" -padx 1 -pady 1]
+ set sf [tlabelframe $dlg.sf -text "Tk style" -padx 1 -pady 1]
message $sf.m -justify left -width 320 \
-text "The Tk style selection available here will apply when you \
next restart tkchat."
- radiobutton $sf.as -text "ActiveState" -underline 0 \
+ tradiobutton $sf.as -text "ActiveState" -underline 0 \
-variable ::tkchat::EditOptions(Style) -value as_style
- radiobutton $sf.gtk -text "GTK look" -underline 0 \
+ tradiobutton $sf.gtk -text "GTK look" -underline 0 \
-variable ::tkchat::EditOptions(Style) -value gtklook
- radiobutton $sf.any -text "Any" -underline 1 \
+ tradiobutton $sf.any -text "Any" -underline 1 \
-variable ::tkchat::EditOptions(Style) -value any
- radiobutton $sf.def -text "Tk default" -underline 0 \
+ tradiobutton $sf.def -text "Tk default" -underline 0 \
-variable ::tkchat::EditOptions(Style) -value tk
if {[catch {package require as::style}]} {
@@ -5305,9 +5392,9 @@
grid rowconfigure $bf 0 -weight 1
grid columnconfigure $bf 0 -weight 1
- button $dlg.ok -text OK \
+ tbutton $dlg.ok -text OK \
-command [list set ::tkchat::EditOptions(Result) 1]
- button $dlg.cancel -text Cancel \
+ tbutton $dlg.cancel -text Cancel \
-command [list set ::tkchat::EditOptions(Result) 0]
grid $bf - -sticky news -padx 2 -pady 2
