gitk: Restore some widget options whose defaults changed in Tk 8.5

The default options for panedwindows in Tk 8.5 make the sash
virtually invisible -- the handle is not shown and the relief is
flat.  This puts the defaults back to showing the handle and a
raised relief on the sash, as in Tk 8.4.

This uses the option command to do this, and also uses the option
command to set the default font for various UI elements to the
UI font ("uifont").

Signed-off-by: Paul Mackerras <paulus@samba.org>
This commit is contained in:
Paul Mackerras 2008-01-06 15:54:46 +11:00
parent a495e5a908
commit b039f0a62d

105
gitk
View File

@ -613,6 +613,19 @@ proc confirm_popup msg {
return $confirm_ok return $confirm_ok
} }
proc setoptions {} {
option add *Panedwindow.showHandle 1 startupFile
option add *Panedwindow.sashRelief raised startupFile
option add *Button.font uifont startupFile
option add *Checkbutton.font uifont startupFile
option add *Radiobutton.font uifont startupFile
option add *Menu.font uifont startupFile
option add *Menubutton.font uifont startupFile
option add *Label.font uifont startupFile
option add *Message.font uifont startupFile
option add *Entry.font uifont startupFile
}
proc makewindow {} { proc makewindow {} {
global canv canv2 canv3 linespc charspc ctext cflist global canv canv2 canv3 linespc charspc ctext cflist
global tabstop global tabstop
@ -631,19 +644,16 @@ proc makewindow {} {
menu .bar menu .bar
.bar add cascade -label [mc "File"] -menu .bar.file .bar add cascade -label [mc "File"] -menu .bar.file
.bar configure -font uifont
menu .bar.file menu .bar.file
.bar.file add command -label [mc "Update"] -command updatecommits .bar.file add command -label [mc "Update"] -command updatecommits
.bar.file add command -label [mc "Reread references"] -command rereadrefs .bar.file add command -label [mc "Reread references"] -command rereadrefs
.bar.file add command -label [mc "List references"] -command showrefs .bar.file add command -label [mc "List references"] -command showrefs
.bar.file add command -label [mc "Quit"] -command doquit .bar.file add command -label [mc "Quit"] -command doquit
.bar.file configure -font uifont
menu .bar.edit menu .bar.edit
.bar add cascade -label [mc "Edit"] -menu .bar.edit .bar add cascade -label [mc "Edit"] -menu .bar.edit
.bar.edit add command -label [mc "Preferences"] -command doprefs .bar.edit add command -label [mc "Preferences"] -command doprefs
.bar.edit configure -font uifont
menu .bar.view -font uifont menu .bar.view
.bar add cascade -label [mc "View"] -menu .bar.view .bar add cascade -label [mc "View"] -menu .bar.view
.bar.view add command -label [mc "New view..."] -command {newview 0} .bar.view add command -label [mc "New view..."] -command {newview 0}
.bar.view add command -label [mc "Edit view..."] -command editview \ .bar.view add command -label [mc "Edit view..."] -command editview \
@ -657,7 +667,7 @@ proc makewindow {} {
.bar add cascade -label [mc "Help"] -menu .bar.help .bar add cascade -label [mc "Help"] -menu .bar.help
.bar.help add command -label [mc "About gitk"] -command about .bar.help add command -label [mc "About gitk"] -command about
.bar.help add command -label [mc "Key bindings"] -command keys .bar.help add command -label [mc "Key bindings"] -command keys
.bar.help configure -font uifont .bar.help configure
. configure -menu .bar . configure -menu .bar
# the gui has upper and lower half, parts of a paned window. # the gui has upper and lower half, parts of a paned window.
@ -714,7 +724,7 @@ proc makewindow {} {
set entries $sha1entry set entries $sha1entry
set sha1but .tf.bar.sha1label set sha1but .tf.bar.sha1label
button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \ button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
-command gotocommit -width 8 -font uifont -command gotocommit -width 8
$sha1but conf -disabledforeground [$sha1but cget -foreground] $sha1but conf -disabledforeground [$sha1but cget -foreground]
pack .tf.bar.sha1label -side left pack .tf.bar.sha1label -side left
entry $sha1entry -width 40 -font textfont -textvariable sha1string entry $sha1entry -width 40 -font textfont -textvariable sha1string
@ -746,7 +756,7 @@ proc makewindow {} {
# Status label and progress bar # Status label and progress bar
set statusw .tf.bar.status set statusw .tf.bar.status
label $statusw -width 15 -relief sunken -font uifont label $statusw -width 15 -relief sunken
pack $statusw -side left -padx 5 pack $statusw -side left -padx 5
set h [expr {[font metrics uifont -linespace] + 2}] set h [expr {[font metrics uifont -linespace] + 2}]
set progresscanv .tf.bar.progress set progresscanv .tf.bar.progress
@ -763,10 +773,10 @@ proc makewindow {} {
set progupdatepending 0 set progupdatepending 0
# build up the bottom bar of upper window # build up the bottom bar of upper window
label .tf.lbar.flabel -text "[mc "Find"] " -font uifont label .tf.lbar.flabel -text "[mc "Find"] "
button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1} -font uifont button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1} -font uifont button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
label .tf.lbar.flab2 -text " [mc "commit"] " -font uifont label .tf.lbar.flab2 -text " [mc "commit"] "
pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \ pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
-side left -fill y -side left -fill y
set gdttype [mc "containing:"] set gdttype [mc "containing:"]
@ -775,8 +785,6 @@ proc makewindow {} {
[mc "touching paths:"] \ [mc "touching paths:"] \
[mc "adding/removing string:"]] [mc "adding/removing string:"]]
trace add variable gdttype write gdttype_change trace add variable gdttype write gdttype_change
$gm conf -font uifont
.tf.lbar.gdttype conf -font uifont
pack .tf.lbar.gdttype -side left -fill y pack .tf.lbar.gdttype -side left -fill y
set findstring {} set findstring {}
@ -788,14 +796,10 @@ proc makewindow {} {
set findtypemenu [tk_optionMenu .tf.lbar.findtype \ set findtypemenu [tk_optionMenu .tf.lbar.findtype \
findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]] findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
trace add variable findtype write findcom_change trace add variable findtype write findcom_change
.tf.lbar.findtype configure -font uifont
.tf.lbar.findtype.menu configure -font uifont
set findloc [mc "All fields"] set findloc [mc "All fields"]
tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \ tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
[mc "Comments"] [mc "Author"] [mc "Committer"] [mc "Comments"] [mc "Author"] [mc "Committer"]
trace add variable findloc write find_change trace add variable findloc write find_change
.tf.lbar.findloc configure -font uifont
.tf.lbar.findloc.menu configure -font uifont
pack .tf.lbar.findloc -side right pack .tf.lbar.findloc -side right
pack .tf.lbar.findtype -side right pack .tf.lbar.findtype -side right
pack $fstring -side left -expand 1 -fill x pack $fstring -side left -expand 1 -fill x
@ -822,22 +826,20 @@ proc makewindow {} {
frame .bleft.top frame .bleft.top
frame .bleft.mid frame .bleft.mid
button .bleft.top.search -text [mc "Search"] -command dosearch \ button .bleft.top.search -text [mc "Search"] -command dosearch
-font uifont
pack .bleft.top.search -side left -padx 5 pack .bleft.top.search -side left -padx 5
set sstring .bleft.top.sstring set sstring .bleft.top.sstring
entry $sstring -width 20 -font textfont -textvariable searchstring entry $sstring -width 20 -font textfont -textvariable searchstring
lappend entries $sstring lappend entries $sstring
trace add variable searchstring write incrsearch trace add variable searchstring write incrsearch
pack $sstring -side left -expand 1 -fill x pack $sstring -side left -expand 1 -fill x
radiobutton .bleft.mid.diff -text [mc "Diff"] -font uifont \ radiobutton .bleft.mid.diff -text [mc "Diff"] \
-command changediffdisp -variable diffelide -value {0 0} -command changediffdisp -variable diffelide -value {0 0}
radiobutton .bleft.mid.old -text [mc "Old version"] -font uifont \ radiobutton .bleft.mid.old -text [mc "Old version"] \
-command changediffdisp -variable diffelide -value {0 1} -command changediffdisp -variable diffelide -value {0 1}
radiobutton .bleft.mid.new -text [mc "New version"] -font uifont \ radiobutton .bleft.mid.new -text [mc "New version"] \
-command changediffdisp -variable diffelide -value {1 0} -command changediffdisp -variable diffelide -value {1 0}
label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: " \ label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
-font uifont
pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
spinbox .bleft.mid.diffcontext -width 5 -font textfont \ spinbox .bleft.mid.diffcontext -width 5 -font textfont \
-from 1 -increment 1 -to 10000000 \ -from 1 -increment 1 -to 10000000 \
@ -897,10 +899,8 @@ proc makewindow {} {
frame .bright.mode frame .bright.mode
radiobutton .bright.mode.patch -text [mc "Patch"] \ radiobutton .bright.mode.patch -text [mc "Patch"] \
-command reselectline -variable cmitmode -value "patch" -command reselectline -variable cmitmode -value "patch"
.bright.mode.patch configure -font uifont
radiobutton .bright.mode.tree -text [mc "Tree"] \ radiobutton .bright.mode.tree -text [mc "Tree"] \
-command reselectline -variable cmitmode -value "tree" -command reselectline -variable cmitmode -value "tree"
.bright.mode.tree configure -font uifont
grid .bright.mode.patch .bright.mode.tree -sticky ew grid .bright.mode.patch .bright.mode.tree -sticky ew
pack .bright.mode -side top -fill x pack .bright.mode -side top -fill x
set cflist .bright.cfiles set cflist .bright.cfiles
@ -1286,17 +1286,14 @@ Copyright © 2005-2006 Paul Mackerras
Use and redistribute under the terms of the GNU General Public License"] \ Use and redistribute under the terms of the GNU General Public License"] \
-justify center -aspect 400 -border 2 -bg white -relief groove -justify center -aspect 400 -border 2 -bg white -relief groove
pack $w.m -side top -fill x -padx 2 -pady 2 pack $w.m -side top -fill x -padx 2 -pady 2
$w.m configure -font uifont
button $w.ok -text [mc "Close"] -command "destroy $w" -default active button $w.ok -text [mc "Close"] -command "destroy $w" -default active
pack $w.ok -side bottom pack $w.ok -side bottom
$w.ok configure -font uifont
bind $w <Visibility> "focus $w.ok" bind $w <Visibility> "focus $w.ok"
bind $w <Key-Escape> "destroy $w" bind $w <Key-Escape> "destroy $w"
bind $w <Key-Return> "destroy $w" bind $w <Key-Return> "destroy $w"
} }
proc keys {} { proc keys {} {
global uifont
set w .keys set w .keys
if {[winfo exists $w]} { if {[winfo exists $w]} {
raise $w raise $w
@ -1350,10 +1347,8 @@ f Scroll diff view to next file
"] \ "] \
-justify left -bg white -border 2 -relief groove -justify left -bg white -border 2 -relief groove
pack $w.m -side top -fill both -padx 2 -pady 2 pack $w.m -side top -fill both -padx 2 -pady 2
$w.m configure -font uifont
button $w.ok -text [mc "Close"] -command "destroy $w" -default active button $w.ok -text [mc "Close"] -command "destroy $w" -default active
pack $w.ok -side bottom pack $w.ok -side bottom
$w.ok configure -font uifont
bind $w <Visibility> "focus $w.ok" bind $w <Visibility> "focus $w.ok"
bind $w <Key-Escape> "destroy $w" bind $w <Key-Escape> "destroy $w"
bind $w <Key-Return> "destroy $w" bind $w <Key-Return> "destroy $w"
@ -1848,7 +1843,7 @@ proc shellsplit {str} {
# Code to implement multiple views # Code to implement multiple views
proc newview {ishighlight} { proc newview {ishighlight} {
global nextviewnum newviewname newviewperm uifont newishighlight global nextviewnum newviewname newviewperm newishighlight
global newviewargs revtreeargs global newviewargs revtreeargs
set newishighlight $ishighlight set newishighlight $ishighlight
@ -1881,23 +1876,22 @@ proc editview {} {
proc vieweditor {top n title} { proc vieweditor {top n title} {
global newviewname newviewperm viewfiles global newviewname newviewperm viewfiles
global uifont
toplevel $top toplevel $top
wm title $top $title wm title $top $title
label $top.nl -text [mc "Name"] -font uifont label $top.nl -text [mc "Name"]
entry $top.name -width 20 -textvariable newviewname($n) -font uifont entry $top.name -width 20 -textvariable newviewname($n)
grid $top.nl $top.name -sticky w -pady 5 grid $top.nl $top.name -sticky w -pady 5
checkbutton $top.perm -text [mc "Remember this view"] -variable newviewperm($n) \ checkbutton $top.perm -text [mc "Remember this view"] \
-font uifont -variable newviewperm($n)
grid $top.perm - -pady 5 -sticky w grid $top.perm - -pady 5 -sticky w
message $top.al -aspect 1000 -font uifont \ message $top.al -aspect 1000 \
-text [mc "Commits to include (arguments to git rev-list):"] -text [mc "Commits to include (arguments to git rev-list):"]
grid $top.al - -sticky w -pady 5 grid $top.al - -sticky w -pady 5
entry $top.args -width 50 -textvariable newviewargs($n) \ entry $top.args -width 50 -textvariable newviewargs($n) \
-background white -font uifont -background white
grid $top.args - -sticky ew -padx 5 grid $top.args - -sticky ew -padx 5
message $top.l -aspect 1000 -font uifont \ message $top.l -aspect 1000 \
-text [mc "Enter files and directories to include, one per line:"] -text [mc "Enter files and directories to include, one per line:"]
grid $top.l - -sticky w grid $top.l - -sticky w
text $top.t -width 40 -height 10 -background white -font uifont text $top.t -width 40 -height 10 -background white -font uifont
@ -1911,10 +1905,8 @@ proc vieweditor {top n title} {
} }
grid $top.t - -sticky ew -padx 5 grid $top.t - -sticky ew -padx 5
frame $top.buts frame $top.buts
button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n] \ button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
-font uifont button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
button $top.buts.can -text [mc "Cancel"] -command [list destroy $top] \
-font uifont
grid $top.buts.ok $top.buts.can grid $top.buts.ok $top.buts.can
grid columnconfigure $top.buts 0 -weight 1 -uniform a grid columnconfigure $top.buts 0 -weight 1 -uniform a
grid columnconfigure $top.buts 1 -weight 1 -uniform a grid columnconfigure $top.buts 1 -weight 1 -uniform a
@ -6522,15 +6514,14 @@ proc showrefs {} {
grid $top.list $top.ysb -sticky nsew grid $top.list $top.ysb -sticky nsew
grid $top.xsb x -sticky ew grid $top.xsb x -sticky ew
frame $top.f frame $top.f
label $top.f.l -text "[mc "Filter"]: " -font uifont label $top.f.l -text "[mc "Filter"]: "
entry $top.f.e -width 20 -textvariable reflistfilter -font uifont entry $top.f.e -width 20 -textvariable reflistfilter
set reflistfilter "*" set reflistfilter "*"
trace add variable reflistfilter write reflistfilter_change trace add variable reflistfilter write reflistfilter_change
pack $top.f.e -side right -fill x -expand 1 pack $top.f.e -side right -fill x -expand 1
pack $top.f.l -side left pack $top.f.l -side left
grid $top.f - -sticky ew -pady 2 grid $top.f - -sticky ew -pady 2
button $top.close -command [list destroy $top] -text [mc "Close"] \ button $top.close -command [list destroy $top] -text [mc "Close"]
-font uifont
grid $top.close - grid $top.close -
grid columnconfigure $top 0 -weight 1 grid columnconfigure $top 0 -weight 1
grid rowconfigure $top 0 -weight 1 grid rowconfigure $top 0 -weight 1
@ -7842,7 +7833,7 @@ proc choosefont {font which} {
eval font config sample [font actual $font] eval font config sample [font actual $font]
toplevel $top toplevel $top
wm title $top [mc "Gitk font chooser"] wm title $top [mc "Gitk font chooser"]
label $top.l -textvariable fontparam(which) -font uifont label $top.l -textvariable fontparam(which)
pack $top.l -side top pack $top.l -side top
set fontlist [lsort [font families]] set fontlist [lsort [font families]]
frame $top.f frame $top.f
@ -7872,10 +7863,8 @@ proc choosefont {font which} {
bind $top.c <Configure> [list centertext $top.c] bind $top.c <Configure> [list centertext $top.c]
pack $top.c -side top -fill x pack $top.c -side top -fill x
frame $top.buts frame $top.buts
button $top.buts.ok -text [mc "OK"] -command fontok -default active \ button $top.buts.ok -text [mc "OK"] -command fontok -default active
-font uifont button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal \
-font uifont
grid $top.buts.ok $top.buts.can grid $top.buts.ok $top.buts.can
grid columnconfigure $top.buts 0 -weight 1 -uniform a grid columnconfigure $top.buts 0 -weight 1 -uniform a
grid columnconfigure $top.buts 1 -weight 1 -uniform a grid columnconfigure $top.buts 1 -weight 1 -uniform a
@ -7943,7 +7932,7 @@ proc doprefs {} {
global maxwidth maxgraphpct global maxwidth maxgraphpct
global oldprefs prefstop showneartags showlocalchanges global oldprefs prefstop showneartags showlocalchanges
global bgcolor fgcolor ctext diffcolors selectbgcolor global bgcolor fgcolor ctext diffcolors selectbgcolor
global uifont tabstop limitdiffs global tabstop limitdiffs
set top .gitkprefs set top .gitkprefs
set prefstop $top set prefstop $top
@ -7958,7 +7947,6 @@ proc doprefs {} {
toplevel $top toplevel $top
wm title $top [mc "Gitk preferences"] wm title $top [mc "Gitk preferences"]
label $top.ldisp -text [mc "Commit list display options"] label $top.ldisp -text [mc "Commit list display options"]
$top.ldisp configure -font uifont
grid $top.ldisp - -sticky w -pady 10 grid $top.ldisp - -sticky w -pady 10
label $top.spacer -text " " label $top.spacer -text " "
label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \ label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
@ -7976,7 +7964,6 @@ proc doprefs {} {
grid x $top.showlocal -sticky w grid x $top.showlocal -sticky w
label $top.ddisp -text [mc "Diff display options"] label $top.ddisp -text [mc "Diff display options"]
$top.ddisp configure -font uifont
grid $top.ddisp - -sticky w -pady 10 grid $top.ddisp - -sticky w -pady 10
label $top.tabstopl -text [mc "Tab spacing"] -font optionfont label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
@ -7993,7 +7980,6 @@ proc doprefs {} {
grid x $top.ldiff -sticky w grid x $top.ldiff -sticky w
label $top.cdisp -text [mc "Colors: press to choose"] label $top.cdisp -text [mc "Colors: press to choose"]
$top.cdisp configure -font uifont
grid $top.cdisp - -sticky w -pady 10 grid $top.cdisp - -sticky w -pady 10
label $top.bg -padx 40 -relief sunk -background $bgcolor label $top.bg -padx 40 -relief sunk -background $bgcolor
button $top.bgbut -text [mc "Background"] -font optionfont \ button $top.bgbut -text [mc "Background"] -font optionfont \
@ -8025,7 +8011,6 @@ proc doprefs {} {
grid x $top.selbgbut $top.selbgsep -sticky w grid x $top.selbgbut $top.selbgsep -sticky w
label $top.cfont -text [mc "Fonts: press to choose"] label $top.cfont -text [mc "Fonts: press to choose"]
$top.cfont configure -font uifont
grid $top.cfont - -sticky w -pady 10 grid $top.cfont - -sticky w -pady 10
mkfontdisp mainfont $top [mc "Main font"] mkfontdisp mainfont $top [mc "Main font"]
mkfontdisp textfont $top [mc "Diff display font"] mkfontdisp textfont $top [mc "Diff display font"]
@ -8033,9 +8018,7 @@ proc doprefs {} {
frame $top.buts frame $top.buts
button $top.buts.ok -text [mc "OK"] -command prefsok -default active button $top.buts.ok -text [mc "OK"] -command prefsok -default active
$top.buts.ok configure -font uifont
button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
$top.buts.can configure -font uifont
grid $top.buts.ok $top.buts.can grid $top.buts.ok $top.buts.can
grid columnconfigure $top.buts 0 -weight 1 -uniform a grid columnconfigure $top.buts 0 -weight 1 -uniform a
grid columnconfigure $top.buts 1 -weight 1 -uniform a grid columnconfigure $top.buts 1 -weight 1 -uniform a
@ -8511,6 +8494,8 @@ eval font create textfontbold [fontflags textfont 1]
parsefont uifont $uifont parsefont uifont $uifont
eval font create uifont [fontflags uifont] eval font create uifont [fontflags uifont]
setoptions
# check that we can find a .git directory somewhere... # check that we can find a .git directory somewhere...
if {[catch {set gitdir [gitdir]}]} { if {[catch {set gitdir [gitdir]}]} {
show_error {} . [mc "Cannot find a git repository here."] show_error {} . [mc "Cannot find a git repository here."]