hg-stable: comparison contrib/hgk

equal deleted inserted replaced

-:fbe43efe4a53
+:0f93bbe8deb7
 #
 # The in_mousewheel global was added to fix strange reentrancy issues.
 # The whole snipped is activated only under windows, mouse wheel
 # bindings working already under MacOSX and Linux.
+if {[catch {package require Ttk}]} {
+# use a shim
+namespace eval ttk {
+proc style args {}
+proc entry args {
+eval [linsert $args 0 ::entry] -relief flat
+}
+}
+interp alias {} ttk::button {} button
+interp alias {} ttk::frame {} frame
+interp alias {} ttk::label {} label
+interp alias {} ttk::scrollbar {} scrollbar
+interp alias {} ttk::optionMenu {} tk_optionMenu
+} else {
+proc ::ttk::optionMenu {w varName firstValue args} {
+upvar #0 $varName var
+if {![info exists var]} {
+set var $firstValue
+}
+ttk::menubutton $w -textvariable $varName -menu $w.menu \
+-direction flush
+menu $w.menu -tearoff 0
+$w.menu add radiobutton -label $firstValue -variable $varName
+foreach i $args {
+$w.menu add radiobutton -label $i -variable $varName
+}
+return $w.menu
+}
+}
 if {[tk windowingsystem] eq "win32"} {
+ttk::style theme use xpnative
 set mw_classes [list Text Listbox Table TreeCtrl]
 foreach class $mw_classes { bind $class <MouseWheel> {} }
 set in_mousewheel 0
 }
 bind all <MouseWheel> [list ::tk::MouseWheel %W %X %Y %D 0]
 # end of win32 section
+} else {
+if {[ttk::style theme use] eq "default"} {
+ttk::style theme use clam
+}
 }
 # Unify right mouse button handling.
 # See "mouse buttons on macintosh" thread on comp.lang.tcl
 set w .error
 toplevel $w
 wm transient $w .
 message $w.m -text $msg -justify center -aspect 400
 pack $w.m -side top -fill x -padx 20 -pady 20
-button $w.ok -text OK -command "destroy $w"
+ttk::button $w.ok -text OK -command "destroy $w"
 pack $w.ok -side bottom -fill x
 bind $w <Visibility> "grab $w; focus $w"
 tkwait window $w
 }
 	.ctop conf -width $geometry(width) -height $geometry(height)
 	set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
 	set geometry(ctexth) [expr {($texth - 8) /
 				    [font metrics $textfont -linespace]}]
 }
-frame .ctop.top
+ttk::frame .ctop.top
-frame .ctop.top.bar
+ttk::frame .ctop.top.bar
 pack .ctop.top.bar -side bottom -fill x
 set cscroll .ctop.top.csb
-scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
+ttk::scrollbar $cscroll -command {allcanvs yview}
 pack $cscroll -side right -fill y
 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
 pack .ctop.top.clist -side top -fill both -expand 1
 .ctop add .ctop.top
 set canv .ctop.top.clist.canv
 set sha1but .ctop.top.bar.sha1label
 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
 	-command gotocommit -width 8
 $sha1but conf -disabledforeground [$sha1but cget -foreground]
 pack .ctop.top.bar.sha1label -side left
-entry $sha1entry -width 40 -font $textfont -textvariable sha1string
+ttk::entry $sha1entry -width 40 -font $textfont -textvariable sha1string
 trace add variable sha1string write sha1change
 pack $sha1entry -side left -pady 2
 image create bitmap bm-left -data {
 	#define left_width 16
 	static unsigned char right_bits[] = {
 	0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
 	0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
 	0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
 }
-button .ctop.top.bar.leftbut -image bm-left -command goback \
+ttk::button .ctop.top.bar.leftbut -image bm-left -command goback \
 	-state disabled -width 26
 pack .ctop.top.bar.leftbut -side left -fill y
-button .ctop.top.bar.rightbut -image bm-right -command goforw \
+ttk::button .ctop.top.bar.rightbut -image bm-right -command goforw \
 	-state disabled -width 26
 pack .ctop.top.bar.rightbut -side left -fill y
-button .ctop.top.bar.findbut -text "Find" -command dofind
+ttk::button .ctop.top.bar.findbut -text "Find" -command dofind
 pack .ctop.top.bar.findbut -side left
 set findstring {}
 set fstring .ctop.top.bar.findstring
 lappend entries $fstring
-entry $fstring -width 30 -font $textfont -textvariable findstring
+ttk::entry $fstring -width 30 -font $textfont -textvariable findstring
 pack $fstring -side left -expand 1 -fill x
 set findtype Exact
-set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
+set findtypemenu [ttk::optionMenu .ctop.top.bar.findtype \
 			  findtype Exact IgnCase Regexp]
 set findloc "All fields"
-tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
+ttk::optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
 	Comments Author Committer Files Pickaxe
 pack .ctop.top.bar.findloc -side right
 pack .ctop.top.bar.findtype -side right
 # for making sure type==Exact whenever loc==Pickaxe
 trace add variable findloc write findlocchange
 panedwindow .ctop.cdet -orient horizontal
 .ctop add .ctop.cdet
-frame .ctop.cdet.left
+ttk::frame .ctop.cdet.left
 set ctext .ctop.cdet.left.ctext
 text $ctext -fg $fgcolor -bg $bgcolor -state disabled -font $textfont \
 	-width $geometry(ctextw) -height $geometry(ctexth) \
 	-yscrollcommand ".ctop.cdet.left.sb set" \
 	-xscrollcommand ".ctop.cdet.left.hb set" -wrap none
-scrollbar .ctop.cdet.left.sb -command "$ctext yview"
+ttk::scrollbar .ctop.cdet.left.sb -command "$ctext yview"
-scrollbar .ctop.cdet.left.hb -orient horizontal -command "$ctext xview"
+ttk::scrollbar .ctop.cdet.left.hb -orient horizontal -command "$ctext xview"
 pack .ctop.cdet.left.sb -side right -fill y
 pack .ctop.cdet.left.hb -side bottom -fill x
 pack $ctext -side left -fill both -expand 1
 .ctop.cdet add .ctop.cdet.left
 	$ctext tag conf mresult -font [concat $textfont bold]
 	$ctext tag conf msep -font [concat $textfont bold]
 	$ctext tag conf found -back yellow
 }
-frame .ctop.cdet.right
+ttk::frame .ctop.cdet.right
 set cflist .ctop.cdet.right.cfiles
 listbox $cflist -fg $fgcolor -bg $bgcolor \
 -selectmode extended -width $geometry(cflistw) \
 	-yscrollcommand ".ctop.cdet.right.sb set"
-scrollbar .ctop.cdet.right.sb -command "$cflist yview"
+ttk::scrollbar .ctop.cdet.right.sb -command "$cflist yview"
 pack .ctop.cdet.right.sb -side right -fill y
 pack $cflist -side left -fill both -expand 1
 .ctop.cdet add .ctop.cdet.right
 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
 Copyright � 2005 Paul Mackerras
 Use and redistribute under the terms of the GNU General Public License} \
 	    -justify center -aspect 400
 pack $w.m -side top -fill x -padx 20 -pady 20
-button $w.ok -text Close -command "destroy $w"
+ttk::button $w.ok -text Close -command "destroy $w"
 pack $w.ok -side bottom
 }
 set aunextcolor 0
 proc assignauthorcolor {name} {
 set id $lineid($l)
 set currentid $id
 $sha1entry delete 0 end
 $sha1entry insert 0 $id
-$sha1entry selection from 0
+$sha1entry selection range 0 end
-$sha1entry selection to end
 $ctext conf -state normal
 $ctext delete 0.0 end
 set linknum 0
 $ctext mark set fmark.0 0.0
 set newhead [lindex $commitinfo($newid) 0]
 set top .patch
 set patchtop $top
 catch {destroy $top}
 toplevel $top
-label $top.title -text "Generate patch"
+ttk::label $top.title -text "Generate patch"
 grid $top.title - -pady 10
-label $top.from -text "From:"
+ttk::label $top.from -text "From:"
-entry $top.fromsha1 -width 40 -relief flat
+ttk::entry $top.fromsha1 -width 40
 $top.fromsha1 insert 0 $oldid
 $top.fromsha1 conf -state readonly
 grid $top.from $top.fromsha1 -sticky w
-entry $top.fromhead -width 60 -relief flat
+ttk::entry $top.fromhead -width 60
 $top.fromhead insert 0 $oldhead
 $top.fromhead conf -state readonly
 grid x $top.fromhead -sticky w
-label $top.to -text "To:"
+ttk::label $top.to -text "To:"
-entry $top.tosha1 -width 40 -relief flat
+ttk::entry $top.tosha1 -width 40
 $top.tosha1 insert 0 $newid
 $top.tosha1 conf -state readonly
 grid $top.to $top.tosha1 -sticky w
-entry $top.tohead -width 60 -relief flat
+ttk::entry $top.tohead -width 60
 $top.tohead insert 0 $newhead
 $top.tohead conf -state readonly
 grid x $top.tohead -sticky w
-button $top.rev -text "Reverse" -command mkpatchrev -padx 5
+ttk::button $top.rev -text "Reverse" -command mkpatchrev
 grid $top.rev x -pady 10
-label $top.flab -text "Output file:"
+ttk::label $top.flab -text "Output file:"
-entry $top.fname -width 60
+ttk::entry $top.fname -width 60
 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
 incr patchnum
 grid $top.flab $top.fname -sticky w
-frame $top.buts
+ttk::frame $top.buts
-button $top.buts.gen -text "Generate" -command mkpatchgo
+ttk::button $top.buts.gen -text "Generate" -command mkpatchgo
-button $top.buts.can -text "Cancel" -command mkpatchcan
+ttk::button $top.buts.can -text "Cancel" -command mkpatchcan
 grid $top.buts.gen $top.buts.can
 grid columnconfigure $top.buts 0 -weight 1 -uniform a
 grid columnconfigure $top.buts 1 -weight 1 -uniform a
 grid $top.buts - -pady 10 -sticky ew
 focus $top.fname
 set top .maketag
 set mktagtop $top
 catch {destroy $top}
 toplevel $top
-label $top.title -text "Create tag"
+ttk::label $top.title -text "Create tag"
 grid $top.title - -pady 10
-label $top.id -text "ID:"
+ttk::label $top.id -text "ID:"
-entry $top.sha1 -width 40 -relief flat
+ttk::entry $top.sha1 -width 40
 $top.sha1 insert 0 $rowmenuid
 $top.sha1 conf -state readonly
 grid $top.id $top.sha1 -sticky w
-entry $top.head -width 60 -relief flat
+ttk::entry $top.head -width 60
 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
 $top.head conf -state readonly
 grid x $top.head -sticky w
-label $top.tlab -text "Tag name:"
+ttk::label $top.tlab -text "Tag name:"
-entry $top.tag -width 60
+ttk::entry $top.tag -width 60
 grid $top.tlab $top.tag -sticky w
-frame $top.buts
+ttk::frame $top.buts
-button $top.buts.gen -text "Create" -command mktaggo
+ttk::button $top.buts.gen -text "Create" -command mktaggo
-button $top.buts.can -text "Cancel" -command mktagcan
+ttk::button $top.buts.can -text "Cancel" -command mktagcan
 grid $top.buts.gen $top.buts.can
 grid columnconfigure $top.buts 0 -weight 1 -uniform a
 grid columnconfigure $top.buts 1 -weight 1 -uniform a
 grid $top.buts - -pady 10 -sticky ew
 focus $top.tag
 set top .writecommit
 set wrcomtop $top
 catch {destroy $top}
 toplevel $top
-label $top.title -text "Write commit to file"
+ttk::label $top.title -text "Write commit to file"
 grid $top.title - -pady 10
-label $top.id -text "ID:"
+ttk::label $top.id -text "ID:"
-entry $top.sha1 -width 40 -relief flat
+ttk::entry $top.sha1 -width 40
 $top.sha1 insert 0 $rowmenuid
 $top.sha1 conf -state readonly
 grid $top.id $top.sha1 -sticky w
-entry $top.head -width 60 -relief flat
+ttk::entry $top.head -width 60
 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
 $top.head conf -state readonly
 grid x $top.head -sticky w
-label $top.clab -text "Command:"
+ttk::label $top.clab -text "Command:"
-entry $top.cmd -width 60 -textvariable wrcomcmd
+ttk::entry $top.cmd -width 60 -textvariable wrcomcmd
 grid $top.clab $top.cmd -sticky w -pady 10
-label $top.flab -text "Output file:"
+ttk::label $top.flab -text "Output file:"
-entry $top.fname -width 60
+ttk::entry $top.fname -width 60
 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
 grid $top.flab $top.fname -sticky w
-frame $top.buts
+ttk::frame $top.buts
-button $top.buts.gen -text "Write" -command wrcomgo
+ttk::button $top.buts.gen -text "Write" -command wrcomgo
-button $top.buts.can -text "Cancel" -command wrcomcan
+ttk::button $top.buts.can -text "Cancel" -command wrcomcan
 grid $top.buts.gen $top.buts.can
 grid columnconfigure $top.buts 0 -weight 1 -uniform a
 grid columnconfigure $top.buts 1 -weight 1 -uniform a
 grid $top.buts - -pady 10 -sticky ew
 focus $top.fname

changeset 17958	0f93bbe8deb7
parent 13463	22f948c027a9
child 17960	d0d99c8bdf51