# Tcl ignores the next line -*- tcl -*- \
exec wish "$0" -- "$@"
-# Copyright © 2005-2008 Paul Mackerras. All rights reserved.
+# Copyright © 2005-2009 Paul Mackerras. All rights reserved.
# This program is free software; it may be used, copied, modified
# and distributed under the terms of the GNU General Public Licence,
# either version 2, or (at your option) any later version.
+package require Tk
+
proc gitdir {} {
global env
if {[info exists env(GIT_DIR)]} {
"--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
"--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
"--remove-empty" - "--first-parent" - "--cherry-pick" -
- "-S*" - "--pickaxe-all" - "--pickaxe-regex" {
+ "-S*" - "--pickaxe-all" - "--pickaxe-regex" -
+ "--simplify-by-decoration" {
# These mean that we get a subset of the commits
set filtered 1
lappend glflags $arg
}
lappend badrev $line
}
- }
+ }
error_popup "[mc "Error parsing revisions:"] $err"
return {}
}
if {$sdm != 2} {
lappend ret $id
} else {
- lset ret end [lindex $ret end]...$id
+ lset ret end $id...[lindex $ret end]
}
lappend pos $id
}
incr viewactive($view)
set viewcomplete($view) 0
reset_pending_select {}
- nowbusy $view "Reading"
+ nowbusy $view [mc "Reading"]
if {$showneartags} {
getallcommits
}
}
proc splitvarc {p v} {
- global varcid varcstart varccommits varctok
+ global varcid varcstart varccommits varctok vtokmod
global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
set oa $varcid($v,$p)
+ set otok [lindex $varctok($v) $oa]
set ac $varccommits($v,$oa)
set i [lsearch -exact $varccommits($v,$oa) $p]
if {$i <= 0} return
set na [llength $varctok($v)]
# "%" sorts before "0"...
- set tok "[lindex $varctok($v) $oa]%[strrep $i]"
+ set tok "$otok%[strrep $i]"
lappend varctok($v) $tok
lappend varcrow($v) {}
lappend varcix($v) {}
for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
lset vupptr($v) $b $na
}
+ if {[string compare $otok $vtokmod($v)] <= 0} {
+ modify_arc $v $oa
+ }
}
proc renumbervarc {a v} {
drawvisible
}
+proc real_children {vp} {
+ global children nullid nullid2
+
+ set kids {}
+ foreach id $children($vp) {
+ if {$id ne $nullid && $id ne $nullid2} {
+ lappend kids $id
+ }
+ }
+ return $kids
+}
+
proc first_real_child {vp} {
global children nullid nullid2
set header [string range $contents 0 [expr {$hdrend - 1}]]
set comment [string range $contents [expr {$hdrend + 2}] end]
foreach line [split $header "\n"] {
+ set line [split $line " "]
set tag [lindex $line 0]
if {$tag == "author"} {
set audate [lindex $line end-1]
- set auname [lrange $line 1 end-2]
+ set auname [join [lrange $line 1 end-2] " "]
} elseif {$tag == "committer"} {
set comdate [lindex $line end-1]
- set comname [lrange $line 1 end-2]
+ set comname [join [lrange $line 1 end-2] " "]
}
}
set headline {}
global tagids idtags headids idheads tagobjid
global otherrefids idotherrefs mainhead mainheadid
global selecthead selectheadid
+ global hideremotes
foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
catch {unset $v}
if {![string match "refs/*" $ref]} continue
set name [string range $ref 5 end]
if {[string match "remotes/*" $name]} {
- if {![string match "*/HEAD" $name]} {
+ if {![string match "*/HEAD" $name] && !$hideremotes} {
set headids($name) $id
lappend idheads($id) $name
}
unset headids($name)
}
+proc ttk_toplevel {w args} {
+ global use_ttk
+ eval [linsert $args 0 ::toplevel $w]
+ if {$use_ttk} {
+ place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
+ }
+ return $w
+}
+
proc make_transient {window origin} {
global have_tk85
}
proc show_error {w top msg} {
+ global NS
+ if {![info exists NS]} {set NS ""}
+ if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
message $w.m -text $msg -justify center -aspect 400
pack $w.m -side top -fill x -padx 20 -pady 20
- button $w.ok -text [mc OK] -command "destroy $top"
+ ${NS}::button $w.ok -default active -text [mc OK] -command "destroy $top"
pack $w.ok -side bottom -fill x
bind $top <Visibility> "grab $top; focus $top"
bind $top <Key-Return> "destroy $top"
}
proc error_popup {msg {owner .}} {
- set w .error
- toplevel $w
- make_transient $w $owner
- show_error $w $w $msg
+ if {[tk windowingsystem] eq "win32"} {
+ tk_messageBox -icon error -type ok -title [wm title .] \
+ -parent $owner -message $msg
+ } else {
+ set w .error
+ ttk_toplevel $w
+ make_transient $w $owner
+ show_error $w $w $msg
+ }
}
proc confirm_popup {msg {owner .}} {
- global confirm_ok
+ global confirm_ok NS
set confirm_ok 0
set w .confirm
- toplevel $w
+ ttk_toplevel $w
make_transient $w $owner
message $w.m -text $msg -justify center -aspect 400
pack $w.m -side top -fill x -padx 20 -pady 20
- button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
+ ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
pack $w.ok -side left -fill x
- button $w.cancel -text [mc Cancel] -command "destroy $w"
+ ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
pack $w.cancel -side right -fill x
bind $w <Visibility> "grab $w; focus $w"
bind $w <Key-Return> "set confirm_ok 1; destroy $w"
bind $w <Key-space> "set confirm_ok 1; destroy $w"
bind $w <Key-Escape> "destroy $w"
+ tk::PlaceWindow $w widget $owner
tkwait window $w
return $confirm_ok
}
proc setoptions {} {
- option add *Panedwindow.showHandle 1 startupFile
- option add *Panedwindow.sashRelief raised startupFile
+ if {[tk windowingsystem] ne "win32"} {
+ option add *Panedwindow.showHandle 1 startupFile
+ option add *Panedwindow.sashRelief raised startupFile
+ if {[tk windowingsystem] ne "aqua"} {
+ option add *Menu.font uifont startupFile
+ }
+ } else {
+ option add *Menu.TearOff 0 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
+ option add *Labelframe.font uifont startupFile
}
# Make a menu and submenus.
return [string map {&& & & {}} [mc $str]]
}
+proc makedroplist {w varname args} {
+ global use_ttk
+ if {$use_ttk} {
+ set width 0
+ foreach label $args {
+ set cx [string length $label]
+ if {$cx > $width} {set width $cx}
+ }
+ set gm [ttk::combobox $w -width $width -state readonly\
+ -textvariable $varname -values $args]
+ } else {
+ set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
+ }
+ return $gm
+}
+
proc makewindow {} {
global canv canv2 canv3 linespc charspc ctext cflist cscroll
global tabstop
global headctxmenu progresscanv progressitem progresscoords statusw
global fprogitem fprogcoord lastprogupdate progupdatepending
global rprogitem rprogcoord rownumsel numcommits
- global have_tk85
+ global have_tk85 use_ttk NS
# The "mc" arguments here are purely so that xgettext
# sees the following string as needing to be translated
- makemenu .bar {
- {mc "File" cascade {
+ set file {
+ mc "File" cascade {
{mc "Update" command updatecommits -accelerator F5}
{mc "Reload" command reloadcommits -accelerator Meta1-F5}
{mc "Reread references" command rereadrefs}
{xx "" separator}
{mc "Quit" command doquit -accelerator Meta1-Q}
}}
- {mc "Edit" cascade {
+ set edit {
+ mc "Edit" cascade {
{mc "Preferences" command doprefs}
}}
- {mc "View" cascade {
+ set view {
+ mc "View" cascade {
{mc "New view..." command {newview 0} -accelerator Shift-F4}
{mc "Edit view..." command editview -state disabled -accelerator F4}
{mc "Delete view" command delview -state disabled}
{xx "" separator}
{mc "All files" radiobutton {selectedview 0} -command {showview 0}}
}}
- {mc "Help" cascade {
+ if {[tk windowingsystem] ne "aqua"} {
+ set help {
+ mc "Help" cascade {
{mc "About gitk" command about}
{mc "Key bindings" command keys}
}}
+ set bar [list $file $edit $view $help]
+ } else {
+ proc ::tk::mac::ShowPreferences {} {doprefs}
+ proc ::tk::mac::Quit {} {doquit}
+ lset file end [lreplace [lindex $file end] end-1 end]
+ set apple {
+ xx "Apple" cascade {
+ {mc "About gitk" command about}
+ {xx "" separator}
+ }}
+ set help {
+ mc "Help" cascade {
+ {mc "Key bindings" command keys}
+ }}
+ set bar [list $apple $file $view $help]
}
+ makemenu .bar $bar
. configure -menu .bar
+ if {$use_ttk} {
+ # cover the non-themed toplevel with a themed frame.
+ place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
+ }
+
# the gui has upper and lower half, parts of a paned window.
- panedwindow .ctop -orient vertical
+ ${NS}::panedwindow .ctop -orient vertical
# possibly use assumed geometry
if {![info exists geometry(pwsash0)]} {
set geometry(topwidth) [expr {80 * $charspc}]
set geometry(botheight) [expr {15 * $linespc}]
set geometry(botwidth) [expr {50 * $charspc}]
- set geometry(pwsash0) "[expr {40 * $charspc}] 2"
- set geometry(pwsash1) "[expr {60 * $charspc}] 2"
+ set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
+ set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
}
# the upper half will have a paned window, a scroll bar to the right, and some stuff below
- frame .tf -height $geometry(topheight) -width $geometry(topwidth)
- frame .tf.histframe
- panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
+ ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
+ ${NS}::frame .tf.histframe
+ ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
+ if {!$use_ttk} {
+ .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
+ }
# create three canvases
set cscroll .tf.histframe.csb
-selectbackground $selectbgcolor \
-background $bgcolor -bd 0 -yscrollincr $linespc
.tf.histframe.pwclist add $canv3
- eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
- eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
+ if {$use_ttk} {
+ bind .tf.histframe.pwclist <Map> {
+ bind %W <Map> {}
+ .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
+ .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
+ }
+ } else {
+ eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
+ eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
+ }
# a scroll bar to rule them
- scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
+ ${NS}::scrollbar $cscroll -command {allcanvs yview}
+ if {!$use_ttk} {$cscroll configure -highlightthickness 0}
pack $cscroll -side right -fill y
bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
lappend bglist $canv $canv2 $canv3
pack .tf.histframe.pwclist -fill both -expand 1 -side left
# we have two button bars at bottom of top frame. Bar 1
- frame .tf.bar
- frame .tf.lbar -height 15
+ ${NS}::frame .tf.bar
+ ${NS}::frame .tf.lbar -height 15
set sha1entry .tf.bar.sha1
set entries $sha1entry
-command gotocommit -width 8
$sha1but conf -disabledforeground [$sha1but cget -foreground]
pack .tf.bar.sha1label -side left
- entry $sha1entry -width 40 -font textfont -textvariable sha1string
+ ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
trace add variable sha1string write sha1change
pack $sha1entry -side left -pady 2
0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
}
- button .tf.bar.leftbut -image bm-left -command goback \
+ ${NS}::button .tf.bar.leftbut -image bm-left -command goback \
-state disabled -width 26
pack .tf.bar.leftbut -side left -fill y
- button .tf.bar.rightbut -image bm-right -command goforw \
+ ${NS}::button .tf.bar.rightbut -image bm-right -command goforw \
-state disabled -width 26
pack .tf.bar.rightbut -side left -fill y
- label .tf.bar.rowlabel -text [mc "Row"]
+ ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
set rownumsel {}
- label .tf.bar.rownum -width 7 -font textfont -textvariable rownumsel \
+ ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
-relief sunken -anchor e
- label .tf.bar.rowlabel2 -text "/"
- label .tf.bar.numcommits -width 7 -font textfont -textvariable numcommits \
+ ${NS}::label .tf.bar.rowlabel2 -text "/"
+ ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
-relief sunken -anchor e
pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
-side left
+ if {!$use_ttk} {
+ foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
+ }
global selectedline
trace add variable selectedline write selectedline_change
# Status label and progress bar
set statusw .tf.bar.status
- label $statusw -width 15 -relief sunken
+ ${NS}::label $statusw -width 15 -relief sunken
pack $statusw -side left -padx 5
- set h [expr {[font metrics uifont -linespace] + 2}]
- set progresscanv .tf.bar.progress
- canvas $progresscanv -relief sunken -height $h -borderwidth 2
- set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
- set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
- set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
- pack $progresscanv -side right -expand 1 -fill x
+ if {$use_ttk} {
+ set progresscanv [ttk::progressbar .tf.bar.progress]
+ } else {
+ set h [expr {[font metrics uifont -linespace] + 2}]
+ set progresscanv .tf.bar.progress
+ canvas $progresscanv -relief sunken -height $h -borderwidth 2
+ set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
+ set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
+ set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
+ }
+ pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
set progresscoords {0 0}
set fprogcoord 0
set rprogcoord 0
set progupdatepending 0
# build up the bottom bar of upper window
- label .tf.lbar.flabel -text "[mc "Find"] "
- button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
- button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
- label .tf.lbar.flab2 -text " [mc "commit"] "
+ ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
+ ${NS}::button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
+ ${NS}::button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
+ ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
-side left -fill y
set gdttype [mc "containing:"]
- set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
+ set gm [makedroplist .tf.lbar.gdttype gdttype \
[mc "containing:"] \
[mc "touching paths:"] \
[mc "adding/removing string:"]]
set findstring {}
set fstring .tf.lbar.findstring
lappend entries $fstring
- entry $fstring -width 30 -font textfont -textvariable findstring
+ ${NS}::entry $fstring -width 30 -font textfont -textvariable findstring
trace add variable findstring write find_change
set findtype [mc "Exact"]
- set findtypemenu [tk_optionMenu .tf.lbar.findtype \
- findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
+ set findtypemenu [makedroplist .tf.lbar.findtype \
+ findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
trace add variable findtype write findcom_change
set findloc [mc "All fields"]
- tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
+ makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
[mc "Comments"] [mc "Author"] [mc "Committer"]
trace add variable findloc write find_change
pack .tf.lbar.findloc -side right
pack .tf.bar -in .tf -side bottom -fill x
pack .tf.histframe -fill both -side top -expand 1
.ctop add .tf
- .ctop paneconfigure .tf -height $geometry(topheight)
- .ctop paneconfigure .tf -width $geometry(topwidth)
+ if {!$use_ttk} {
+ .ctop paneconfigure .tf -height $geometry(topheight)
+ .ctop paneconfigure .tf -width $geometry(topwidth)
+ }
# now build up the bottom
- panedwindow .pwbottom -orient horizontal
+ ${NS}::panedwindow .pwbottom -orient horizontal
# lower left, a text box over search bar, scroll bar to the right
# if we know window height, then that will set the lower text height, otherwise
# we set lower text height which will drive window height
if {[info exists geometry(main)]} {
- frame .bleft -width $geometry(botwidth)
+ ${NS}::frame .bleft -width $geometry(botwidth)
} else {
- frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
+ ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
}
- frame .bleft.top
- frame .bleft.mid
- frame .bleft.bottom
+ ${NS}::frame .bleft.top
+ ${NS}::frame .bleft.mid
+ ${NS}::frame .bleft.bottom
- button .bleft.top.search -text [mc "Search"] -command dosearch
+ ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
pack .bleft.top.search -side left -padx 5
set sstring .bleft.top.sstring
- entry $sstring -width 20 -font textfont -textvariable searchstring
+ set searchstring ""
+ ${NS}::entry $sstring -width 20 -font textfont -textvariable searchstring
lappend entries $sstring
trace add variable searchstring write incrsearch
pack $sstring -side left -expand 1 -fill x
- radiobutton .bleft.mid.diff -text [mc "Diff"] \
+ ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
-command changediffdisp -variable diffelide -value {0 0}
- radiobutton .bleft.mid.old -text [mc "Old version"] \
+ ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
-command changediffdisp -variable diffelide -value {0 1}
- radiobutton .bleft.mid.new -text [mc "New version"] \
+ ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
-command changediffdisp -variable diffelide -value {1 0}
- label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
+ ${NS}::label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
spinbox .bleft.mid.diffcontext -width 5 -font textfont \
- -from 1 -increment 1 -to 10000000 \
+ -from 0 -increment 1 -to 10000000 \
-validate all -validatecommand "diffcontextvalidate %P" \
-textvariable diffcontextstring
.bleft.mid.diffcontext set $diffcontext
trace add variable diffcontextstring write diffcontextchange
lappend entries .bleft.mid.diffcontext
pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
- checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
+ ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
-command changeignorespace -variable ignorespace
pack .bleft.mid.ignspace -side left -padx 5
set ctext .bleft.bottom.ctext
if {$have_tk85} {
$ctext conf -tabstyle wordprocessor
}
- scrollbar .bleft.bottom.sb -command "$ctext yview"
- scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h \
- -width 10
+ ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
+ ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
pack .bleft.top -side top -fill x
pack .bleft.mid -side top -fill x
grid $ctext .bleft.bottom.sb -sticky nsew
$ctext tag conf found -back yellow
.pwbottom add .bleft
- .pwbottom paneconfigure .bleft -width $geometry(botwidth)
+ if {!$use_ttk} {
+ .pwbottom paneconfigure .bleft -width $geometry(botwidth)
+ }
# lower right
- frame .bright
- frame .bright.mode
- radiobutton .bright.mode.patch -text [mc "Patch"] \
+ ${NS}::frame .bright
+ ${NS}::frame .bright.mode
+ ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
-command reselectline -variable cmitmode -value "patch"
- radiobutton .bright.mode.tree -text [mc "Tree"] \
+ ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
-command reselectline -variable cmitmode -value "tree"
grid .bright.mode.patch .bright.mode.tree -sticky ew
pack .bright.mode -side top -fill x
-spacing1 1 -spacing3 1
lappend bglist $cflist
lappend fglist $cflist
- scrollbar .bright.sb -command "$cflist yview"
+ ${NS}::scrollbar .bright.sb -command "$cflist yview"
pack .bright.sb -side right -fill y
pack $cflist -side left -fill both -expand 1
$cflist tag configure highlight \
}
}
+ if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
+ wm state . $geometry(state)
+ }
+
if {[tk windowingsystem] eq {aqua}} {
set M1B M1
+ set ::BM "3"
} else {
set M1B Control
+ set ::BM "2"
+ }
+
+ if {$use_ttk} {
+ bind .ctop <Map> {
+ bind %W <Map> {}
+ %W sashpos 0 $::geometry(topheight)
+ }
+ bind .pwbottom <Map> {
+ bind %W <Map> {}
+ %W sashpos 0 $::geometry(botwidth)
+ }
}
bind .pwbottom <Configure> {resizecdetpanes %W %w}
set delta [expr {- (%D)}]
allcanvs yview scroll $delta units
}
+ bindall <Shift-MouseWheel> {
+ set delta [expr {- (%D)}]
+ $canv xview scroll $delta units
+ }
}
}
- bindall <2> "canvscan mark %W %x %y"
- bindall <B2-Motion> "canvscan dragto %W %x %y"
+ bindall <$::BM> "canvscan mark %W %x %y"
+ bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
bindkey <Home> selfirstline
bindkey <End> sellastline
bind . <Key-Up> "selnextline -1"
bindkey b prevfile
bindkey d "$ctext yview scroll 18 units"
bindkey u "$ctext yview scroll -18 units"
- bindkey / {dofind 1 1}
+ bindkey / {focus $fstring}
+ bindkey <Key-KP_Divide> {focus $fstring}
bindkey <Key-Return> {dofind 1 1}
bindkey ? {dofind -1 1}
bindkey f nextfile
{mc "Create new branch" command mkbranch}
{mc "Cherry-pick this commit" command cherrypick}
{mc "Reset HEAD branch to here" command resethead}
+ {mc "Mark this commit" command markhere}
+ {mc "Return to mark" command gotomark}
+ {mc "Find descendant of this and mark" command find_common_desc}
+ {mc "Compare with marked commit" command compare_commits}
}
$rowctxmenu configure -tearoff 0
proc adjustprogress {} {
global progresscanv progressitem progresscoords
global fprogitem fprogcoord lastprogupdate progupdatepending
- global rprogitem rprogcoord
+ global rprogitem rprogcoord use_ttk
+
+ if {$use_ttk} {
+ $progresscanv configure -value [expr {int($fprogcoord * 100)}]
+ return
+ }
set w [expr {[winfo width $progresscanv] - 4}]
set x0 [expr {$w * [lindex $progresscoords 0]}]
global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
global cmitmode wrapcomment datetimeformat limitdiffs
global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
- global autoselect extdifftool perfile_attrs markbgcolor
+ global autoselect extdifftool perfile_attrs markbgcolor use_ttk
+ global hideremotes want_ttk
if {$stuffsaved} return
if {![winfo viewable .]} return
catch {
set f [open "~/.gitk-new" w]
+ if {$::tcl_platform(platform) eq {windows}} {
+ file attributes "~/.gitk-new" -hidden true
+ }
puts $f [list set mainfont $mainfont]
puts $f [list set textfont $textfont]
puts $f [list set uifont $uifont]
puts $f [list set wrapcomment $wrapcomment]
puts $f [list set autoselect $autoselect]
puts $f [list set showneartags $showneartags]
+ puts $f [list set hideremotes $hideremotes]
puts $f [list set showlocalchanges $showlocalchanges]
puts $f [list set datetimeformat $datetimeformat]
puts $f [list set limitdiffs $limitdiffs]
+ puts $f [list set want_ttk $want_ttk]
puts $f [list set bgcolor $bgcolor]
puts $f [list set fgcolor $fgcolor]
puts $f [list set colors $colors]
puts $f [list set perfile_attrs $perfile_attrs]
puts $f "set geometry(main) [wm geometry .]"
+ puts $f "set geometry(state) [wm state .]"
puts $f "set geometry(topwidth) [winfo width .tf]"
puts $f "set geometry(topheight) [winfo height .tf]"
- puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
- puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
+ if {$use_ttk} {
+ puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
+ puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
+ } else {
+ puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
+ puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
+ }
puts $f "set geometry(botwidth) [winfo width .bleft]"
puts $f "set geometry(botheight) [winfo height .bleft]"
}
proc resizeclistpanes {win w} {
- global oldwidth
+ global oldwidth use_ttk
if {[info exists oldwidth($win)]} {
- set s0 [$win sash coord 0]
- set s1 [$win sash coord 1]
+ if {$use_ttk} {
+ set s0 [$win sashpos 0]
+ set s1 [$win sashpos 1]
+ } else {
+ set s0 [$win sash coord 0]
+ set s1 [$win sash coord 1]
+ }
if {$w < 60} {
set sash0 [expr {int($w/2 - 2)}]
set sash1 [expr {int($w*5/6 - 2)}]
}
}
}
- $win sash place 0 $sash0 [lindex $s0 1]
- $win sash place 1 $sash1 [lindex $s1 1]
+ if {$use_ttk} {
+ $win sashpos 0 $sash0
+ $win sashpos 1 $sash1
+ } else {
+ $win sash place 0 $sash0 [lindex $s0 1]
+ $win sash place 1 $sash1 [lindex $s1 1]
+ }
}
set oldwidth($win) $w
}
proc resizecdetpanes {win w} {
- global oldwidth
+ global oldwidth use_ttk
if {[info exists oldwidth($win)]} {
- set s0 [$win sash coord 0]
+ if {$use_ttk} {
+ set s0 [$win sashpos 0]
+ } else {
+ set s0 [$win sash coord 0]
+ }
if {$w < 60} {
set sash0 [expr {int($w*3/4 - 2)}]
} else {
set sash0 [expr {$w - 15}]
}
}
- $win sash place 0 $sash0 [lindex $s0 1]
+ if {$use_ttk} {
+ $win sashpos 0 $sash0
+ } else {
+ $win sash place 0 $sash0 [lindex $s0 1]
+ }
}
set oldwidth($win) $w
}
}
proc about {} {
- global uifont
+ global uifont NS
set w .about
if {[winfo exists $w]} {
raise $w
return
}
- toplevel $w
+ ttk_toplevel $w
wm title $w [mc "About gitk"]
make_transient $w .
message $w.m -text [mc "
Gitk - a commit viewer for git
-Copyright © 2005-2008 Paul Mackerras
+Copyright \u00a9 2005-2009 Paul Mackerras
Use and redistribute under the terms of the GNU General Public License"] \
-justify center -aspect 400 -border 2 -bg white -relief groove
pack $w.m -side top -fill x -padx 2 -pady 2
- button $w.ok -text [mc "Close"] -command "destroy $w" -default active
+ ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
pack $w.ok -side bottom
bind $w <Visibility> "focus $w.ok"
bind $w <Key-Escape> "destroy $w"
bind $w <Key-Return> "destroy $w"
+ tk::PlaceWindow $w widget .
}
proc keys {} {
+ global NS
set w .keys
if {[winfo exists $w]} {
raise $w
} else {
set M1T Ctrl
}
- toplevel $w
+ ttk_toplevel $w
wm title $w [mc "Gitk key bindings"]
make_transient $w .
message $w.m -text "
[mc "<%s-F> Find" $M1T]
[mc "<%s-G> Move to next find hit" $M1T]
[mc "<Return> Move to next find hit"]
-[mc "/ Move to next find hit, or redo find"]
+[mc "/ Focus the search box"]
[mc "? Move to previous find hit"]
[mc "f Scroll diff view to next file"]
[mc "<%s-S> Search for next hit in diff view" $M1T]
" \
-justify left -bg white -border 2 -relief groove
pack $w.m -side top -fill both -padx 2 -pady 2
- button $w.ok -text [mc "Close"] -command "destroy $w" -default active
+ ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
bind $w <Key-Escape> [list destroy $w]
pack $w.ok -side bottom
bind $w <Visibility> "focus $w.ok"
set gdttype [mc "touching paths:"]
}
+proc gitknewtmpdir {} {
+ global diffnum gitktmpdir gitdir
+
+ if {![info exists gitktmpdir]} {
+ set gitktmpdir [file join [file dirname $gitdir] \
+ [format ".gitk-tmp.%s" [pid]]]
+ if {[catch {file mkdir $gitktmpdir} err]} {
+ error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
+ unset gitktmpdir
+ return {}
+ }
+ set diffnum 0
+ }
+ incr diffnum
+ set diffdir [file join $gitktmpdir $diffnum]
+ if {[catch {file mkdir $diffdir} err]} {
+ error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
+ return {}
+ }
+ return $diffdir
+}
+
proc save_file_from_commit {filename output what} {
global nullfile
}
proc external_diff {} {
- global gitktmpdir nullid nullid2
+ global nullid nullid2
global flist_menu_file
global diffids
- global diffnum
- global gitdir extdifftool
+ global extdifftool
if {[llength $diffids] == 1} {
# no reference commit given
}
# make sure that several diffs wont collide
- if {![info exists gitktmpdir]} {
- set gitktmpdir [file join [file dirname $gitdir] \
- [format ".gitk-tmp.%s" [pid]]]
- if {[catch {file mkdir $gitktmpdir} err]} {
- error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
- unset gitktmpdir
- return
- }
- set diffnum 0
- }
- incr diffnum
- set diffdir [file join $gitktmpdir $diffnum]
- if {[catch {file mkdir $diffdir} err]} {
- error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
- return
- }
+ set diffdir [gitknewtmpdir]
+ if {$diffdir eq {}} return
# gather files to diff
set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
if {$difffromfile ne {} && $difftofile ne {}} {
- set cmd [concat | [shellsplit $extdifftool] \
- [list $difffromfile $difftofile]]
- if {[catch {set fl [open $cmd r]} err]} {
+ set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
+ if {[catch {set fl [open |$cmd r]} err]} {
file delete -force $diffdir
error_popup "$extdifftool: [mc "command failed:"] $err"
} else {
return {}
}
+# Turn an absolute path into one relative to the current directory
+proc make_relative {f} {
+ set elts [file split $f]
+ set here [file split [pwd]]
+ set ei 0
+ set hi 0
+ set res {}
+ foreach d $here {
+ if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
+ lappend res ".."
+ } else {
+ incr ei
+ }
+ incr hi
+ }
+ set elts [concat $res [lrange $elts $ei end]]
+ return [eval file join $elts]
+}
+
proc external_blame {parent_idx {line {}}} {
- global flist_menu_file
+ global flist_menu_file gitdir
global nullid nullid2
global parentlist selectedline currentid
if {$line ne {} && $line > 1} {
lappend cmdline "--line=$line"
}
- lappend cmdline $base_commit $flist_menu_file
+ set f [file join [file dirname $gitdir] $flist_menu_file]
+ # Unfortunately it seems git gui blame doesn't like
+ # being given an absolute path...
+ set f [make_relative $f]
+ lappend cmdline $base_commit $f
if {[catch {eval exec $cmdline &} err]} {
error_popup "[mc "git gui blame: command failed:"] $err"
}
error_popup [mc "Error reading index: %s" $err]
return
}
+ } else {
+ set id $parents($curview,$currentid)
}
} else {
set id [lindex $parents($curview,$currentid) $pi]
} else {
lappend blameargs $id
}
- lappend blameargs -- $flist_menu_file
+ lappend blameargs -- [file join [file dirname $gitdir] $flist_menu_file]
if {[catch {
set f [open $blameargs r]
} err]} {
}
set known_view_options {
- {perm b . {} {mc "Remember this view"}}
- {args t50= + {} {mc "Commits to include (arguments to git log):"}}
- {all b * "--all" {mc "Use all refs"}}
- {dorder b . {"--date-order" "-d"} {mc "Strictly sort by date"}}
- {lright b . "--left-right" {mc "Mark branch sides"}}
- {since t15 + {"--since=*" "--after=*"} {mc "Since date:"}}
- {until t15 . {"--until=*" "--before=*"} {mc "Until date:"}}
- {limit t10 + "--max-count=*" {mc "Max count:"}}
- {skip t10 . "--skip=*" {mc "Skip:"}}
- {first b . "--first-parent" {mc "Limit to first parent"}}
- {cmd t50= + {} {mc "Command to generate more commits to include:"}}
+ {perm b . {} {mc "Remember this view"}}
+ {reflabel l + {} {mc "References (space separated list):"}}
+ {refs t15 .. {} {mc "Branches & tags:"}}
+ {allrefs b *. "--all" {mc "All refs"}}
+ {branches b . "--branches" {mc "All (local) branches"}}
+ {tags b . "--tags" {mc "All tags"}}
+ {remotes b . "--remotes" {mc "All remote-tracking branches"}}
+ {commitlbl l + {} {mc "Commit Info (regular expressions):"}}
+ {author t15 .. "--author=*" {mc "Author:"}}
+ {committer t15 . "--committer=*" {mc "Committer:"}}
+ {loginfo t15 .. "--grep=*" {mc "Commit Message:"}}
+ {allmatch b .. "--all-match" {mc "Matches all Commit Info criteria"}}
+ {changes_l l + {} {mc "Changes to Files:"}}
+ {pickaxe_s r0 . {} {mc "Fixed String"}}
+ {pickaxe_t r1 . "--pickaxe-regex" {mc "Regular Expression"}}
+ {pickaxe t15 .. "-S*" {mc "Search string:"}}
+ {datelabel l + {} {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
+ {since t15 .. {"--since=*" "--after=*"} {mc "Since:"}}
+ {until t15 . {"--until=*" "--before=*"} {mc "Until:"}}
+ {limit_lbl l + {} {mc "Limit and/or skip a number of revisions (positive integer):"}}
+ {limit t10 *. "--max-count=*" {mc "Number to show:"}}
+ {skip t10 . "--skip=*" {mc "Number to skip:"}}
+ {misc_lbl l + {} {mc "Miscellaneous options:"}}
+ {dorder b *. {"--date-order" "-d"} {mc "Strictly sort by date"}}
+ {lright b . "--left-right" {mc "Mark branch sides"}}
+ {first b . "--first-parent" {mc "Limit to first parent"}}
+ {smplhst b . "--simplify-by-decoration" {mc "Simple history"}}
+ {args t50 *. {} {mc "Additional arguments to git log:"}}
+ {allpaths path + {} {mc "Enter files and directories to include, one per line:"}}
+ {cmd t50= + {} {mc "Command to generate more commits to include:"}}
}
proc encode_view_opts {n} {
if {$patterns eq {}} continue
set pattern [lindex $patterns 0]
- set val $newviewopts($n,[lindex $opt 0])
-
if {[lindex $opt 1] eq "b"} {
+ set val $newviewopts($n,[lindex $opt 0])
if {$val} {
lappend rargs $pattern
}
+ } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
+ regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
+ set val $newviewopts($n,$button_id)
+ if {$val eq $value} {
+ lappend rargs $pattern
+ }
} else {
+ set val $newviewopts($n,[lindex $opt 0])
set val [string trim $val]
if {$val ne {}} {
set pfix [string range $pattern 0 end-1]
}
}
}
+ set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
return [concat $rargs [shellsplit $newviewopts($n,args)]]
}
global known_view_options newviewopts
foreach opt $known_view_options {
+ set id [lindex $opt 0]
if {[lindex $opt 1] eq "b"} {
+ # Checkboxes
+ set val 0
+ } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
+ # Radiobuttons
+ regexp {^(.*_)} $id uselessvar id
set val 0
} else {
+ # Text fields
set val {}
}
- set newviewopts($n,[lindex $opt 0]) $val
+ set newviewopts($n,$id) $val
}
set oargs [list]
+ set refargs [list]
foreach arg $view_args {
if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
&& ![info exists found(limit)]} {
if {[info exists found($id)]} continue
foreach pattern [lindex $opt 3] {
if {![string match $pattern $arg]} continue
- if {[lindex $opt 1] ne "b"} {
+ if {[lindex $opt 1] eq "b"} {
+ # Check buttons
+ set val 1
+ } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
+ # Radio buttons
+ regexp {^(.*_)} $id uselessvar id
+ set val $num
+ } else {
+ # Text input fields
set size [string length $pattern]
set val [string range $arg [expr {$size-1}] end]
- } else {
- set val 1
}
set newviewopts($n,$id) $val
set found($id) 1
if {[info exists val]} break
}
if {[info exists val]} continue
- lappend oargs $arg
+ if {[regexp {^-} $arg]} {
+ lappend oargs $arg
+ } else {
+ lappend refargs $arg
+ }
}
+ set newviewopts($n,refs) [shellarglist $refargs]
set newviewopts($n,args) [shellarglist $oargs]
}
set newviewopts($curview,perm) $viewperm($curview)
set newviewopts($curview,cmd) $viewargscmd($curview)
decode_view_opts $curview $viewargs($curview)
- vieweditor $top $curview "Gitk: edit view $viewname($curview)"
+ vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
}
proc vieweditor {top n title} {
global newviewname newviewopts viewfiles bgcolor
- global known_view_options
+ global known_view_options NS
- toplevel $top
- wm title $top $title
+ ttk_toplevel $top
+ wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
make_transient $top .
# View name
- frame $top.nfr
- label $top.nl -text [mc "Name"]
- entry $top.name -width 20 -textvariable newviewname($n)
+ ${NS}::frame $top.nfr
+ ${NS}::label $top.nl -text [mc "View Name"]
+ ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
pack $top.nfr -in $top -fill x -pady 5 -padx 3
- pack $top.nl -in $top.nfr -side left -padx {0 30}
- pack $top.name -in $top.nfr -side left
+ pack $top.nl -in $top.nfr -side left -padx {0 5}
+ pack $top.name -in $top.nfr -side left -padx {0 25}
# View options
set cframe $top.nfr
if {$flags eq "+" || $flags eq "*"} {
set cframe $top.fr$cnt
incr cnt
- frame $cframe
+ ${NS}::frame $cframe
pack $cframe -in $top -fill x -pady 3 -padx 3
set cexpand [expr {$flags eq "*"}]
+ } elseif {$flags eq ".." || $flags eq "*."} {
+ set cframe $top.fr$cnt
+ incr cnt
+ ${NS}::frame $cframe
+ pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
+ set cexpand [expr {$flags eq "*."}]
} else {
set lxpad 5
}
- if {$type eq "b"} {
- checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
+ if {$type eq "l"} {
+ ${NS}::label $cframe.l_$id -text $title
+ pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
+ } elseif {$type eq "b"} {
+ ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
+ pack $cframe.c_$id -in $cframe -side left \
+ -padx [list $lxpad 0] -expand $cexpand -anchor w
+ } elseif {[regexp {^r(\d+)$} $type type sz]} {
+ regexp {^(.*_)} $id uselessvar button_id
+ ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
pack $cframe.c_$id -in $cframe -side left \
-padx [list $lxpad 0] -expand $cexpand -anchor w
} elseif {[regexp {^t(\d+)$} $type type sz]} {
- message $cframe.l_$id -aspect 1500 -text $title
- entry $cframe.e_$id -width $sz -background $bgcolor \
+ ${NS}::label $cframe.l_$id -text $title
+ ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
-textvariable newviewopts($n,$id)
pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
} elseif {[regexp {^t(\d+)=$} $type type sz]} {
- message $cframe.l_$id -aspect 1500 -text $title
- entry $cframe.e_$id -width $sz -background $bgcolor \
+ ${NS}::label $cframe.l_$id -text $title
+ ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
-textvariable newviewopts($n,$id)
pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
pack $cframe.e_$id -in $cframe -side top -fill x
+ } elseif {$type eq "path"} {
+ ${NS}::label $top.l -text $title
+ pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
+ text $top.t -width 40 -height 5 -background $bgcolor -font uifont
+ if {[info exists viewfiles($n)]} {
+ foreach f $viewfiles($n) {
+ $top.t insert end $f
+ $top.t insert end "\n"
+ }
+ $top.t delete {end - 1c} end
+ $top.t mark set insert 0.0
+ }
+ pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
}
}
- # Path list
- message $top.l -aspect 1500 \
- -text [mc "Enter files and directories to include, one per line:"]
- pack $top.l -in $top -side top -pady [list 7 0] -anchor w -padx 3
- text $top.t -width 40 -height 5 -background $bgcolor -font uifont
- if {[info exists viewfiles($n)]} {
- foreach f $viewfiles($n) {
- $top.t insert end $f
- $top.t insert end "\n"
- }
- $top.t delete {end - 1c} end
- $top.t mark set insert 0.0
- }
- pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
- frame $top.buts
- button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
- button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
- button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
+ ${NS}::frame $top.buts
+ ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
+ ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
+ ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
bind $top <Control-Return> [list newviewok $top $n]
bind $top <F5> [list newviewok $top $n 1]
bind $top <Escape> [list destroy $top]
}
proc bolden {id font} {
- global canv linehtag currentid boldids need_redisplay
+ global canv linehtag currentid boldids need_redisplay markedid
# need_redisplay = 1 means the display is stale and about to be redrawn
if {$need_redisplay} return
-fill [$canv cget -selectbackground]]
$canv lower $t
}
+ if {[info exists markedid] && $id eq $markedid} {
+ make_idmark $id
+ }
}
proc bolden_name {id font} {
global cmitlisted commitinfo rowidlist parentlist
global rowtextx idpos idtags idheads idotherrefs
global linehtag linentag linedtag selectedline
- global canvxmax boldids boldnameids fgcolor
+ global canvxmax boldids boldnameids fgcolor markedid
global mainheadid nullid nullid2 circleitem circlecolors ctxbut
# listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
if {$selectedline == $row} {
make_secsel $id
}
+ if {[info exists markedid] && $markedid eq $id} {
+ make_idmark $id
+ }
set xr [expr {$xt + [font measure $font $headline]}]
if {$xr > $canvxmax} {
set canvxmax $xr
optimize_rows $ro1 0 $r2
if {$need_redisplay || $nrows_drawn > 2000} {
clear_display
- drawvisible
}
# make the lines join to already-drawn rows either side
}
}
+proc appendshortlink {id {pre {}} {post {}}} {
+ global ctext linknum
+
+ $ctext insert end $pre
+ $ctext tag delete link$linknum
+ $ctext insert end [string range $id 0 7] link$linknum
+ $ctext insert end $post
+ setlink $id link$linknum
+ incr linknum
+}
+
proc makelink {id} {
global pendinglinks
}
}
if {[llength $tags] > $maxrefs} {
- $ctext insert $pos "many ([llength $tags])"
+ $ctext insert $pos "[mc "many"] ([llength $tags])"
} else {
set tags [lsort -index 0 -decreasing $tags]
set sep {}
$canv3 lower $t
}
+proc make_idmark {id} {
+ global linehtag canv fgcolor
+
+ if {![info exists linehtag($id)]} return
+ $canv delete markid
+ set t [eval $canv create rect [$canv bbox $linehtag($id)] \
+ -tags markid -outline $fgcolor]
+ $canv raise $t
+}
+
proc selectline {l isnew {desired_loc {}}} {
global canv ctext commitinfo selectedline
global canvy0 linespc parents children curview
make_secsel $id
if {$isnew} {
- addtohistory [list selbyid $id]
+ addtohistory [list selbyid $id 0] savecmitpos
}
$sha1entry delete 0 end
$sha1entry insert 0 $id
if {$autoselect} {
- $sha1entry selection from 0
- $sha1entry selection to end
+ $sha1entry selection range 0 end
}
rhighlight_sel $id
}
}
-proc addtohistory {cmd} {
+proc addtohistory {cmd {saveproc {}}} {
global history historyindex curview
- set elt [list $curview $cmd]
+ unset_posvars
+ save_position
+ set elt [list $curview $cmd $saveproc {}]
if {$historyindex > 0
&& [lindex $history [expr {$historyindex - 1}]] == $elt} {
return
.tf.bar.rightbut conf -state disabled
}
+# save the scrolling position of the diff display pane
+proc save_position {} {
+ global historyindex history
+
+ if {$historyindex < 1} return
+ set hi [expr {$historyindex - 1}]
+ set fn [lindex $history $hi 2]
+ if {$fn ne {}} {
+ lset history $hi 3 [eval $fn]
+ }
+}
+
+proc unset_posvars {} {
+ global last_posvars
+
+ if {[info exists last_posvars]} {
+ foreach {var val} $last_posvars {
+ global $var
+ catch {unset $var}
+ }
+ unset last_posvars
+ }
+}
+
proc godo {elt} {
- global curview
+ global curview last_posvars
set view [lindex $elt 0]
set cmd [lindex $elt 1]
+ set pv [lindex $elt 3]
if {$curview != $view} {
showview $view
}
+ unset_posvars
+ foreach {var val} $pv {
+ global $var
+ set $var $val
+ }
+ set last_posvars $pv
eval $cmd
}
focus .
if {$historyindex > 1} {
+ save_position
incr historyindex -1
godo [lindex $history [expr {$historyindex - 1}]]
.tf.bar.rightbut conf -state normal
focus .
if {$historyindex < [llength $history]} {
+ save_position
set cmd [lindex $history $historyindex]
incr historyindex
godo $cmd
global diffcontextstring diffcontext
if {[string is integer -strict $diffcontextstring]} {
- if {$diffcontextstring > 0} {
+ if {$diffcontextstring >= 0} {
set diffcontext $diffcontextstring
reselectline
}
global ignorespace
global limitdiffs vfilelimit curview
global diffencoding targetline diffnparents
+ global git_version
- set cmd [diffcmd $ids "-p -C --cc --no-commit-id -U$diffcontext"]
+ set textconv {}
+ if {[package vcompare $git_version "1.6.1"] >= 0} {
+ set textconv "--textconv"
+ }
+ set cmd [diffcmd $ids "-p $textconv -C --cc --no-commit-id -U$diffcontext"]
if {$ignorespace} {
append cmd " -w"
}
set diffnparents 0
set diffinhdr 0
set diffencoding [get_path_encoding {}]
- fconfigure $bdf -blocking 0 -encoding binary
+ fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
set blobdifffd($ids) $bdf
filerun $bdf [list getblobdiffline $bdf $diffids]
}
+proc savecmitpos {} {
+ global ctext cmitmode
+
+ if {$cmitmode eq "tree"} {
+ return {}
+ }
+ return [list target_scrollpos [$ctext index @0,0]]
+}
+
+proc savectextpos {} {
+ global ctext
+
+ return [list target_scrollpos [$ctext index @0,0]]
+}
+
+proc maybe_scroll_ctext {ateof} {
+ global ctext target_scrollpos
+
+ if {![info exists target_scrollpos]} return
+ if {!$ateof} {
+ set nlines [expr {[winfo height $ctext]
+ / [font metrics textfont -linespace]}]
+ if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
+ }
+ $ctext yview $target_scrollpos
+ unset target_scrollpos
+}
+
proc setinlist {var i val} {
global $var
$ctext conf -state normal
while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
- close $bdf
+ catch {close $bdf}
return 0
}
if {![string compare -length 5 "diff " $line]} {
$ctext insert end "$line\n" filesep
} else {
- set line [encoding convertfrom $diffencoding $line]
+ set line [string map {\x1A ^Z} \
+ [encoding convertfrom $diffencoding $line]]
# parse the prefix - one ' ', '-' or '+' for each parent
set prefix [string range $line 0 [expr {$diffnparents - 1}]]
set tag [expr {$diffnparents > 1? "m": "d"}]
if {[info exists seehere]} {
mark_ctext_line [lindex [split $seehere .] 0]
}
+ maybe_scroll_ctext [eof $bdf]
$ctext conf -state disabled
if {[eof $bdf]} {
- close $bdf
+ catch {close $bdf}
return 0
}
return [expr {$nr >= 1000? 2: 1}]
}
set id [lindex $matches 0]
}
+ } else {
+ if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
+ error_popup [mc "Revision %s is not known" $sha1string]
+ return
+ }
}
}
if {[commitinview $id $curview]} {
if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
set msg [mc "SHA1 id %s is not known" $sha1string]
} else {
- set msg [mc "Tag/Head %s is not known" $sha1string]
+ set msg [mc "Revision %s is not in the current view" $sha1string]
}
error_popup $msg
}
}
if {$isnew} {
- addtohistory [list lineclick $x $y $id 0]
+ addtohistory [list lineclick $x $y $id 0] savectextpos
}
# fill the details pane with info about this line
$ctext conf -state normal
$ctext insert end "\n\t[mc "Date"]:\t$date\n"
}
}
+ maybe_scroll_ctext 1
$ctext conf -state disabled
init_flist {}
}
}
}
-proc selbyid {id} {
+proc selbyid {id {isnew 1}} {
global curview
if {[commitinview $id $curview]} {
- selectline [rowofcommit $id] 1
+ selectline [rowofcommit $id] $isnew
}
}
proc rowmenu {x y id} {
global rowctxmenu selectedline rowmenuid curview
- global nullid nullid2 fakerowmenu mainhead
+ global nullid nullid2 fakerowmenu mainhead markedid
stopfinding
set rowmenuid $id
if {$id ne $nullid && $id ne $nullid2} {
set menu $rowctxmenu
if {$mainhead ne {}} {
- $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
+ $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
} else {
$menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
}
+ if {[info exists markedid] && $markedid ne $id} {
+ $menu entryconfigure 9 -state normal
+ $menu entryconfigure 10 -state normal
+ $menu entryconfigure 11 -state normal
+ } else {
+ $menu entryconfigure 9 -state disabled
+ $menu entryconfigure 10 -state disabled
+ $menu entryconfigure 11 -state disabled
+ }
} else {
set menu $fakerowmenu
}
tk_popup $menu $x $y
}
+proc markhere {} {
+ global rowmenuid markedid canv
+
+ set markedid $rowmenuid
+ make_idmark $markedid
+}
+
+proc gotomark {} {
+ global markedid
+
+ if {[info exists markedid]} {
+ selbyid $markedid
+ }
+}
+
+proc replace_by_kids {l r} {
+ global curview children
+
+ set id [commitonrow $r]
+ set l [lreplace $l 0 0]
+ foreach kid $children($curview,$id) {
+ lappend l [rowofcommit $kid]
+ }
+ return [lsort -integer -decreasing -unique $l]
+}
+
+proc find_common_desc {} {
+ global markedid rowmenuid curview children
+
+ if {![info exists markedid]} return
+ if {![commitinview $markedid $curview] ||
+ ![commitinview $rowmenuid $curview]} return
+ #set t1 [clock clicks -milliseconds]
+ set l1 [list [rowofcommit $markedid]]
+ set l2 [list [rowofcommit $rowmenuid]]
+ while 1 {
+ set r1 [lindex $l1 0]
+ set r2 [lindex $l2 0]
+ if {$r1 eq {} || $r2 eq {}} break
+ if {$r1 == $r2} {
+ selectline $r1 1
+ break
+ }
+ if {$r1 > $r2} {
+ set l1 [replace_by_kids $l1 $r1]
+ } else {
+ set l2 [replace_by_kids $l2 $r2]
+ }
+ }
+ #set t2 [clock clicks -milliseconds]
+ #puts "took [expr {$t2-$t1}]ms"
+}
+
+proc compare_commits {} {
+ global markedid rowmenuid curview children
+
+ if {![info exists markedid]} return
+ if {![commitinview $markedid $curview]} return
+ addtohistory [list do_cmp_commits $markedid $rowmenuid]
+ do_cmp_commits $markedid $rowmenuid
+}
+
+proc getpatchid {id} {
+ global patchids
+
+ if {![info exists patchids($id)]} {
+ set cmd [diffcmd [list $id] {-p --root}]
+ # trim off the initial "|"
+ set cmd [lrange $cmd 1 end]
+ if {[catch {
+ set x [eval exec $cmd | git patch-id]
+ set patchids($id) [lindex $x 0]
+ }]} {
+ set patchids($id) "error"
+ }
+ }
+ return $patchids($id)
+}
+
+proc do_cmp_commits {a b} {
+ global ctext curview parents children patchids commitinfo
+
+ $ctext conf -state normal
+ clear_ctext
+ init_flist {}
+ for {set i 0} {$i < 100} {incr i} {
+ set skipa 0
+ set skipb 0
+ if {[llength $parents($curview,$a)] > 1} {
+ appendshortlink $a [mc "Skipping merge commit "] "\n"
+ set skipa 1
+ } else {
+ set patcha [getpatchid $a]
+ }
+ if {[llength $parents($curview,$b)] > 1} {
+ appendshortlink $b [mc "Skipping merge commit "] "\n"
+ set skipb 1
+ } else {
+ set patchb [getpatchid $b]
+ }
+ if {!$skipa && !$skipb} {
+ set heada [lindex $commitinfo($a) 0]
+ set headb [lindex $commitinfo($b) 0]
+ if {$patcha eq "error"} {
+ appendshortlink $a [mc "Error getting patch ID for "] \
+ [mc " - stopping\n"]
+ break
+ }
+ if {$patchb eq "error"} {
+ appendshortlink $b [mc "Error getting patch ID for "] \
+ [mc " - stopping\n"]
+ break
+ }
+ if {$patcha eq $patchb} {
+ if {$heada eq $headb} {
+ appendshortlink $a [mc "Commit "]
+ appendshortlink $b " == " " $heada\n"
+ } else {
+ appendshortlink $a [mc "Commit "] " $heada\n"
+ appendshortlink $b [mc " is the same patch as\n "] \
+ " $headb\n"
+ }
+ set skipa 1
+ set skipb 1
+ } else {
+ $ctext insert end "\n"
+ appendshortlink $a [mc "Commit "] " $heada\n"
+ appendshortlink $b [mc " differs from\n "] \
+ " $headb\n"
+ $ctext insert end [mc "Diff of commits:\n\n"]
+ $ctext conf -state disabled
+ update
+ diffcommits $a $b
+ return
+ }
+ }
+ if {$skipa} {
+ set kids [real_children $curview,$a]
+ if {[llength $kids] != 1} {
+ $ctext insert end "\n"
+ appendshortlink $a [mc "Commit "] \
+ [mc " has %s children - stopping\n" [llength $kids]]
+ break
+ }
+ set a [lindex $kids 0]
+ }
+ if {$skipb} {
+ set kids [real_children $curview,$b]
+ if {[llength $kids] != 1} {
+ appendshortlink $b [mc "Commit "] \
+ [mc " has %s children - stopping\n" [llength $kids]]
+ break
+ }
+ set b [lindex $kids 0]
+ }
+ }
+ $ctext conf -state disabled
+}
+
+proc diffcommits {a b} {
+ global diffcontext diffids blobdifffd diffinhdr
+
+ set tmpdir [gitknewtmpdir]
+ set fna [file join $tmpdir "commit-[string range $a 0 7]"]
+ set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
+ if {[catch {
+ exec git diff-tree -p --pretty $a >$fna
+ exec git diff-tree -p --pretty $b >$fnb
+ } err]} {
+ error_popup [mc "Error writing commit to file: %s" $err]
+ return
+ }
+ if {[catch {
+ set fd [open "| diff -U$diffcontext $fna $fnb" r]
+ } err]} {
+ error_popup [mc "Error diffing commits: %s" $err]
+ return
+ }
+ set diffids [list commits $a $b]
+ set blobdifffd($diffids) $fd
+ set diffinhdr 0
+ filerun $fd [list getblobdiffline $fd $diffids]
+}
+
proc diffvssel {dirn} {
global rowmenuid selectedline
set oldid $rowmenuid
set newid [commitonrow $selectedline]
}
- addtohistory [list doseldiff $oldid $newid]
+ addtohistory [list doseldiff $oldid $newid] savectextpos
doseldiff $oldid $newid
}
}
proc mkpatch {} {
- global rowmenuid currentid commitinfo patchtop patchnum
+ global rowmenuid currentid commitinfo patchtop patchnum NS
if {![info exists currentid]} return
set oldid $currentid
set top .patch
set patchtop $top
catch {destroy $top}
- toplevel $top
+ ttk_toplevel $top
make_transient $top .
- label $top.title -text [mc "Generate patch"]
+ ${NS}::label $top.title -text [mc "Generate patch"]
grid $top.title - -pady 10
- label $top.from -text [mc "From:"]
- entry $top.fromsha1 -width 40 -relief flat
+ ${NS}::label $top.from -text [mc "From:"]
+ ${NS}::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
+ ${NS}::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 [mc "To:"]
- entry $top.tosha1 -width 40 -relief flat
+ ${NS}::label $top.to -text [mc "To:"]
+ ${NS}::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
+ ${NS}::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 [mc "Reverse"] -command mkpatchrev -padx 5
- grid $top.rev x -pady 10
- label $top.flab -text [mc "Output file:"]
- entry $top.fname -width 60
+ ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
+ grid $top.rev x -pady 10 -padx 5
+ ${NS}::label $top.flab -text [mc "Output file:"]
+ ${NS}::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
- button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
- button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
+ ${NS}::frame $top.buts
+ ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
+ ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
bind $top <Key-Return> mkpatchgo
bind $top <Key-Escape> mkpatchcan
grid $top.buts.gen $top.buts.can
}
proc mktag {} {
- global rowmenuid mktagtop commitinfo
+ global rowmenuid mktagtop commitinfo NS
set top .maketag
set mktagtop $top
catch {destroy $top}
- toplevel $top
+ ttk_toplevel $top
make_transient $top .
- label $top.title -text [mc "Create tag"]
+ ${NS}::label $top.title -text [mc "Create tag"]
grid $top.title - -pady 10
- label $top.id -text [mc "ID:"]
- entry $top.sha1 -width 40 -relief flat
+ ${NS}::label $top.id -text [mc "ID:"]
+ ${NS}::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
+ ${NS}::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 [mc "Tag name:"]
- entry $top.tag -width 60
+ ${NS}::label $top.tlab -text [mc "Tag name:"]
+ ${NS}::entry $top.tag -width 60
grid $top.tlab $top.tag -sticky w
- frame $top.buts
- button $top.buts.gen -text [mc "Create"] -command mktaggo
- button $top.buts.can -text [mc "Cancel"] -command mktagcan
+ ${NS}::frame $top.buts
+ ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
+ ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
bind $top <Key-Return> mktaggo
bind $top <Key-Escape> mktagcan
grid $top.buts.gen $top.buts.can
}
proc redrawtags {id} {
- global canv linehtag idpos currentid curview cmitlisted
+ global canv linehtag idpos currentid curview cmitlisted markedid
global canvxmax iddrawn circleitem mainheadid circlecolors
if {![commitinview $id $curview]} return
if {[info exists currentid] && $currentid == $id} {
make_secsel $id
}
+ if {[info exists markedid] && $markedid eq $id} {
+ make_idmark $id
+ }
}
proc mktagcan {} {
}
proc writecommit {} {
- global rowmenuid wrcomtop commitinfo wrcomcmd
+ global rowmenuid wrcomtop commitinfo wrcomcmd NS
set top .writecommit
set wrcomtop $top
catch {destroy $top}
- toplevel $top
+ ttk_toplevel $top
make_transient $top .
- label $top.title -text [mc "Write commit to file"]
+ ${NS}::label $top.title -text [mc "Write commit to file"]
grid $top.title - -pady 10
- label $top.id -text [mc "ID:"]
- entry $top.sha1 -width 40 -relief flat
+ ${NS}::label $top.id -text [mc "ID:"]
+ ${NS}::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
+ ${NS}::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 [mc "Command:"]
- entry $top.cmd -width 60 -textvariable wrcomcmd
+ ${NS}::label $top.clab -text [mc "Command:"]
+ ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
grid $top.clab $top.cmd -sticky w -pady 10
- label $top.flab -text [mc "Output file:"]
- entry $top.fname -width 60
+ ${NS}::label $top.flab -text [mc "Output file:"]
+ ${NS}::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
- button $top.buts.gen -text [mc "Write"] -command wrcomgo
- button $top.buts.can -text [mc "Cancel"] -command wrcomcan
+ ${NS}::frame $top.buts
+ ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
+ ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
bind $top <Key-Return> wrcomgo
bind $top <Key-Escape> wrcomcan
grid $top.buts.gen $top.buts.can
}
proc mkbranch {} {
- global rowmenuid mkbrtop
+ global rowmenuid mkbrtop NS
set top .makebranch
catch {destroy $top}
- toplevel $top
+ ttk_toplevel $top
make_transient $top .
- label $top.title -text [mc "Create new branch"]
+ ${NS}::label $top.title -text [mc "Create new branch"]
grid $top.title - -pady 10
- label $top.id -text [mc "ID:"]
- entry $top.sha1 -width 40 -relief flat
+ ${NS}::label $top.id -text [mc "ID:"]
+ ${NS}::entry $top.sha1 -width 40
$top.sha1 insert 0 $rowmenuid
$top.sha1 conf -state readonly
grid $top.id $top.sha1 -sticky w
- label $top.nlab -text [mc "Name:"]
- entry $top.name -width 40
+ ${NS}::label $top.nlab -text [mc "Name:"]
+ ${NS}::entry $top.name -width 40
grid $top.nlab $top.name -sticky w
- frame $top.buts
- button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
- button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
+ ${NS}::frame $top.buts
+ ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
+ ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
bind $top <Key-Return> [list mkbrgo $top]
bind $top <Key-Escape> "catch {destroy $top}"
grid $top.buts.go $top.buts.can
}
proc resethead {} {
- global mainhead rowmenuid confirm_ok resettype
+ global mainhead rowmenuid confirm_ok resettype NS
set confirm_ok 0
set w ".confirmreset"
- toplevel $w
+ ttk_toplevel $w
make_transient $w .
wm title $w [mc "Confirm reset"]
- message $w.m -text \
- [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
- -justify center -aspect 1000
+ ${NS}::label $w.m -text \
+ [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
pack $w.m -side top -fill x -padx 20 -pady 20
- frame $w.f -relief sunken -border 2
- message $w.f.rt -text [mc "Reset type:"] -aspect 1000
- grid $w.f.rt -sticky w
+ ${NS}::labelframe $w.f -text [mc "Reset type:"]
set resettype mixed
- radiobutton $w.f.soft -value soft -variable resettype -justify left \
+ ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
-text [mc "Soft: Leave working tree and index untouched"]
grid $w.f.soft -sticky w
- radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
+ ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
-text [mc "Mixed: Leave working tree untouched, reset index"]
grid $w.f.mixed -sticky w
- radiobutton $w.f.hard -value hard -variable resettype -justify left \
+ ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
-text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
grid $w.f.hard -sticky w
- pack $w.f -side top -fill x
- button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
+ pack $w.f -side top -fill x -padx 4
+ ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
pack $w.ok -side left -fill x -padx 20 -pady 20
- button $w.cancel -text [mc Cancel] -command "destroy $w"
+ ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
bind $w <Key-Escape> [list destroy $w]
pack $w.cancel -side right -fill x -padx 20 -pady 20
bind $w <Visibility> "grab $w; focus $w"
# Display a list of tags and heads
proc showrefs {} {
- global showrefstop bgcolor fgcolor selectbgcolor
+ global showrefstop bgcolor fgcolor selectbgcolor NS
global bglist fglist reflistfilter reflist maincursor
set top .showrefs
refill_reflist
return
}
- toplevel $top
+ ttk_toplevel $top
wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
make_transient $top .
text $top.list -background $bgcolor -foreground $fgcolor \
$top.list tag configure highlight -background $selectbgcolor
lappend bglist $top.list
lappend fglist $top.list
- scrollbar $top.ysb -command "$top.list yview" -orient vertical
- scrollbar $top.xsb -command "$top.list xview" -orient horizontal
+ ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
+ ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
grid $top.list $top.ysb -sticky nsew
grid $top.xsb x -sticky ew
- frame $top.f
- label $top.f.l -text "[mc "Filter"]: "
- entry $top.f.e -width 20 -textvariable reflistfilter
+ ${NS}::frame $top.f
+ ${NS}::label $top.f.l -text "[mc "Filter"]: "
+ ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
set reflistfilter "*"
trace add variable reflistfilter write reflistfilter_change
pack $top.f.e -side right -fill x -expand 1
pack $top.f.l -side left
grid $top.f - -sticky ew -pady 2
- button $top.close -command [list destroy $top] -text [mc "Close"]
+ ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
bind $top <Key-Escape> [list destroy $top]
grid $top.close -
grid columnconfigure $top 0 -weight 1
global allparents allchildren idtags idheads nextarc
global arcnos arcids arctags arcout arcend arcstart archeads growing
global seeds allcommits cachedarcs allcupdate
-
+
set nid 0
while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
set id [lindex $line 0]
global ctext tagcontents tagids linknum tagobjid
if {$isnew} {
- addtohistory [list showtag $tag 0]
+ addtohistory [list showtag $tag 0] savectextpos
}
$ctext conf -state normal
clear_ctext
set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
}
appendwithlinks $text {}
+ maybe_scroll_ctext
$ctext conf -state disabled
init_flist {}
}
}
proc mkfontdisp {font top which} {
- global fontattr fontpref $font
+ global fontattr fontpref $font NS use_ttk
set fontpref($font) [set $font]
- button $top.${font}but -text $which -font optionfont \
+ ${NS}::button $top.${font}but -text $which \
-command [list choosefont $font $which]
- label $top.$font -relief flat -font $font \
+ if {!$use_ttk} {$top.${font}but configure -font optionfont}
+ ${NS}::label $top.$font -relief flat -font $font \
-text $fontattr($font,family) -justify left
grid x $top.${font}but $top.$font -sticky w
}
proc choosefont {font which} {
global fontparam fontlist fonttop fontattr
- global prefstop
+ global prefstop NS
set fontparam(which) $which
set fontparam(font) $font
if {![winfo exists $top]} {
font create sample
eval font config sample [font actual $font]
- toplevel $top
+ ttk_toplevel $top
make_transient $top $prefstop
wm title $top [mc "Gitk font chooser"]
- label $top.l -textvariable fontparam(which)
+ ${NS}::label $top.l -textvariable fontparam(which)
pack $top.l -side top
set fontlist [lsort [font families]]
- frame $top.f
+ ${NS}::frame $top.f
listbox $top.f.fam -listvariable fontlist \
-yscrollcommand [list $top.f.sb set]
bind $top.f.fam <<ListboxSelect>> selfontfam
- scrollbar $top.f.sb -command [list $top.f.fam yview]
+ ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
pack $top.f.sb -side right -fill y
pack $top.f.fam -side left -fill both -expand 1
pack $top.f -side top -fill both -expand 1
- frame $top.g
+ ${NS}::frame $top.g
spinbox $top.g.size -from 4 -to 40 -width 4 \
-textvariable fontparam(size) \
-validatecommand {string is integer -strict %s}
-fill black -tags text
bind $top.c <Configure> [list centertext $top.c]
pack $top.c -side top -fill x
- frame $top.buts
- button $top.buts.ok -text [mc "OK"] -command fontok -default active
- button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
+ ${NS}::frame $top.buts
+ ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
+ ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
bind $top <Key-Return> fontok
bind $top <Key-Escape> fontcan
grid $top.buts.ok $top.buts.can
}
set w $prefstop.$f
$w conf -text $fontparam(family) -font $fontpref($f)
-
+
fontcan
}
}
}
+if {[package vsatisfies [package provide Tk] 8.6]} {
+ # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
+ # function to make use of it.
+ proc choosefont {font which} {
+ tk fontchooser configure -title $which -font $font \
+ -command [list on_choosefont $font $which]
+ tk fontchooser show
+ }
+ proc on_choosefont {font which newfont} {
+ global fontparam
+ puts stderr "$font $newfont"
+ array set f [font actual $newfont]
+ set fontparam(which) $which
+ set fontparam(font) $font
+ set fontparam(family) $f(-family)
+ set fontparam(size) $f(-size)
+ set fontparam(weight) $f(-weight)
+ set fontparam(slant) $f(-slant)
+ fontok
+ }
+}
+
proc selfontfam {} {
global fonttop fontparam
}
proc doprefs {} {
- global maxwidth maxgraphpct
+ global maxwidth maxgraphpct use_ttk NS
global oldprefs prefstop showneartags showlocalchanges
global bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
global tabstop limitdiffs autoselect extdifftool perfile_attrs
+ global hideremotes want_ttk have_ttk
set top .gitkprefs
set prefstop $top
return
}
foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
- limitdiffs tabstop perfile_attrs} {
+ limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
set oldprefs($v) [set $v]
}
- toplevel $top
+ ttk_toplevel $top
wm title $top [mc "Gitk preferences"]
make_transient $top .
- label $top.ldisp -text [mc "Commit list display options"]
+ ${NS}::label $top.ldisp -text [mc "Commit list display options"]
grid $top.ldisp - -sticky w -pady 10
- label $top.spacer -text " "
- label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
- -font optionfont
+ ${NS}::label $top.spacer -text " "
+ ${NS}::label $top.maxwidthl -text [mc "Maximum graph width (lines)"]
spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
- label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
- -font optionfont
+ ${NS}::label $top.maxpctl -text [mc "Maximum graph width (% of pane)"]
spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
grid x $top.maxpctl $top.maxpct -sticky w
- frame $top.showlocal
- label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
- checkbutton $top.showlocal.b -variable showlocalchanges
- pack $top.showlocal.b $top.showlocal.l -side left
+ ${NS}::checkbutton $top.showlocal -text [mc "Show local changes"] \
+ -variable showlocalchanges
grid x $top.showlocal -sticky w
- frame $top.autoselect
- label $top.autoselect.l -text [mc "Auto-select SHA1"] -font optionfont
- checkbutton $top.autoselect.b -variable autoselect
- pack $top.autoselect.b $top.autoselect.l -side left
+ ${NS}::checkbutton $top.autoselect -text [mc "Auto-select SHA1"] \
+ -variable autoselect
grid x $top.autoselect -sticky w
+ ${NS}::checkbutton $top.hideremotes -text [mc "Hide remote refs"] \
+ -variable hideremotes
+ grid x $top.hideremotes -sticky w
- label $top.ddisp -text [mc "Diff display options"]
+ ${NS}::label $top.ddisp -text [mc "Diff display options"]
grid $top.ddisp - -sticky w -pady 10
- label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
+ ${NS}::label $top.tabstopl -text [mc "Tab spacing"]
spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
grid x $top.tabstopl $top.tabstop -sticky w
- frame $top.ntag
- label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
- checkbutton $top.ntag.b -variable showneartags
- pack $top.ntag.b $top.ntag.l -side left
+ ${NS}::checkbutton $top.ntag -text [mc "Display nearby tags"] \
+ -variable showneartags
grid x $top.ntag -sticky w
- frame $top.ldiff
- label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
- checkbutton $top.ldiff.b -variable limitdiffs
- pack $top.ldiff.b $top.ldiff.l -side left
+ ${NS}::checkbutton $top.ldiff -text [mc "Limit diffs to listed paths"] \
+ -variable limitdiffs
grid x $top.ldiff -sticky w
- frame $top.lattr
- label $top.lattr.l -text [mc "Support per-file encodings"] -font optionfont
- checkbutton $top.lattr.b -variable perfile_attrs
- pack $top.lattr.b $top.lattr.l -side left
+ ${NS}::checkbutton $top.lattr -text [mc "Support per-file encodings"] \
+ -variable perfile_attrs
grid x $top.lattr -sticky w
- entry $top.extdifft -textvariable extdifftool
- frame $top.extdifff
- label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \
- -padx 10
- button $top.extdifff.b -text [mc "Choose..."] -font optionfont \
- -command choose_extdiff
+ ${NS}::entry $top.extdifft -textvariable extdifftool
+ ${NS}::frame $top.extdifff
+ ${NS}::label $top.extdifff.l -text [mc "External diff tool" ]
+ ${NS}::button $top.extdifff.b -text [mc "Choose..."] -command choose_extdiff
pack $top.extdifff.l $top.extdifff.b -side left
- grid x $top.extdifff $top.extdifft -sticky w
+ pack configure $top.extdifff.l -padx 10
+ grid x $top.extdifff $top.extdifft -sticky ew
+
+ ${NS}::label $top.lgen -text [mc "General options"]
+ grid $top.lgen - -sticky w -pady 10
+ ${NS}::checkbutton $top.want_ttk -variable want_ttk \
+ -text [mc "Use themed widgets"]
+ if {$have_ttk} {
+ ${NS}::label $top.ttk_note -text [mc "(change requires restart)"]
+ } else {
+ ${NS}::label $top.ttk_note -text [mc "(currently unavailable)"]
+ }
+ grid x $top.want_ttk $top.ttk_note -sticky w
- label $top.cdisp -text [mc "Colors: press to choose"]
+ ${NS}::label $top.cdisp -text [mc "Colors: press to choose"]
grid $top.cdisp - -sticky w -pady 10
label $top.bg -padx 40 -relief sunk -background $bgcolor
- button $top.bgbut -text [mc "Background"] -font optionfont \
- -command [list choosecolor bgcolor {} $top.bg background setbg]
+ ${NS}::button $top.bgbut -text [mc "Background"] \
+ -command [list choosecolor bgcolor {} $top.bg [mc "background"] setbg]
grid x $top.bgbut $top.bg -sticky w
label $top.fg -padx 40 -relief sunk -background $fgcolor
- button $top.fgbut -text [mc "Foreground"] -font optionfont \
- -command [list choosecolor fgcolor {} $top.fg foreground setfg]
+ ${NS}::button $top.fgbut -text [mc "Foreground"] \
+ -command [list choosecolor fgcolor {} $top.fg [mc "foreground"] setfg]
grid x $top.fgbut $top.fg -sticky w
label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
- button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
- -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
+ ${NS}::button $top.diffoldbut -text [mc "Diff: old lines"] \
+ -command [list choosecolor diffcolors 0 $top.diffold [mc "diff old lines"] \
[list $ctext tag conf d0 -foreground]]
grid x $top.diffoldbut $top.diffold -sticky w
label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
- button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
- -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
+ ${NS}::button $top.diffnewbut -text [mc "Diff: new lines"] \
+ -command [list choosecolor diffcolors 1 $top.diffnew [mc "diff new lines"] \
[list $ctext tag conf dresult -foreground]]
grid x $top.diffnewbut $top.diffnew -sticky w
label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
- button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
+ ${NS}::button $top.hunksepbut -text [mc "Diff: hunk header"] \
-command [list choosecolor diffcolors 2 $top.hunksep \
- "diff hunk header" \
+ [mc "diff hunk header"] \
[list $ctext tag conf hunksep -foreground]]
grid x $top.hunksepbut $top.hunksep -sticky w
label $top.markbgsep -padx 40 -relief sunk -background $markbgcolor
- button $top.markbgbut -text [mc "Marked line bg"] -font optionfont \
+ ${NS}::button $top.markbgbut -text [mc "Marked line bg"] \
-command [list choosecolor markbgcolor {} $top.markbgsep \
[mc "marked line background"] \
[list $ctext tag conf omark -background]]
grid x $top.markbgbut $top.markbgsep -sticky w
label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
- button $top.selbgbut -text [mc "Select bg"] -font optionfont \
- -command [list choosecolor selectbgcolor {} $top.selbgsep background setselbg]
+ ${NS}::button $top.selbgbut -text [mc "Select bg"] \
+ -command [list choosecolor selectbgcolor {} $top.selbgsep [mc "background"] setselbg]
grid x $top.selbgbut $top.selbgsep -sticky w
- label $top.cfont -text [mc "Fonts: press to choose"]
+ ${NS}::label $top.cfont -text [mc "Fonts: press to choose"]
grid $top.cfont - -sticky w -pady 10
mkfontdisp mainfont $top [mc "Main font"]
mkfontdisp textfont $top [mc "Diff display font"]
mkfontdisp uifont $top [mc "User interface font"]
- frame $top.buts
- button $top.buts.ok -text [mc "OK"] -command prefsok -default active
- button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
+ if {!$use_ttk} {
+ foreach w {maxpctl maxwidthl showlocal autoselect tabstopl ntag
+ ldiff lattr extdifff.l extdifff.b bgbut fgbut
+ diffoldbut diffnewbut hunksepbut markbgbut selbgbut
+ want_ttk ttk_note} {
+ $top.$w configure -font optionfont
+ }
+ }
+
+ ${NS}::frame $top.buts
+ ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
+ ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
bind $top <Key-Return> prefsok
bind $top <Key-Escape> prefscan
grid $top.buts.ok $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
+ grid columnconfigure $top 2 -weight 1
bind $top <Visibility> "focus $top.buts.ok"
}
proc choose_extdiff {} {
global extdifftool
- set prog [tk_getOpenFile -title "External diff tool" -multiple false]
+ set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
if {$prog ne {}} {
set extdifftool $prog
}
}
allcanvs itemconf text -fill $c
$canv itemconf circle -outline $c
+ $canv itemconf markid -outline $c
}
proc prefscan {} {
global oldprefs prefstop
foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
- limitdiffs tabstop perfile_attrs} {
+ limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
global $v
set $v $oldprefs($v)
}
global oldprefs prefstop showneartags showlocalchanges
global fontpref mainfont textfont uifont
global limitdiffs treediffs perfile_attrs
+ global hideremotes
catch {destroy $prefstop}
unset prefstop
$limitdiffs != $oldprefs(limitdiffs)} {
reselectline
}
+ if {$hideremotes != $oldprefs(hideremotes)} {
+ rereadrefs
+ }
}
proc formatdate {d} {
} else {
set r "unspecified"
if {![catch {set line [exec git check-attr $attr -- $path]}]} {
- regexp "(.*): encoding: (.*)" $line m f r
+ regexp "(.*): $attr: (.*)" $line m f r
}
set path_attr_cache($attr,$path) $r
}
set newlist [lrange $newlist $lim end]
if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
foreach row [split $rlist "\n"] {
- if {[regexp "(.*): encoding: (.*)" $row m path value]} {
+ if {[regexp "(.*): $attr: (.*)" $row m path value]} {
if {[string index $path 0] eq "\""} {
set path [encoding convertfrom [lindex $path 0]]
}
}
}
-set mainfont {Helvetica 9}
-set textfont {Courier 9}
-set uifont {Helvetica 9 bold}
+if {[tk windowingsystem] eq "aqua"} {
+ set mainfont {{Lucida Grande} 9}
+ set textfont {Monaco 9}
+ set uifont {{Lucida Grande} 9 bold}
+} else {
+ set mainfont {Helvetica 9}
+ set textfont {Courier 9}
+ set uifont {Helvetica 9 bold}
+}
set tabstop 8
set findmergefiles 0
set maxgraphpct 50
set cmitmode "patch"
set wrapcomment "none"
set showneartags 1
+set hideremotes 0
set maxrefs 20
set maxlinelen 200
set showlocalchanges 1
set datetimeformat "%Y-%m-%d %H:%M:%S"
set autoselect 1
set perfile_attrs 0
+set want_ttk 1
-set extdifftool "meld"
+if {[tk windowingsystem] eq "aqua"} {
+ set extdifftool "opendiff"
+} else {
+ set extdifftool "meld"
+}
set colors {green red blue magenta darkgrey brown orange}
set bgcolor white
set nullfile "/dev/null"
set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
+if {![info exists have_ttk]} {
+ set have_ttk [llength [info commands ::ttk::style]]
+}
+set use_ttk [expr {$have_ttk && $want_ttk}]
+set NS [expr {$use_ttk ? "ttk" : ""}]
+
+set git_version [join [lrange [split [lindex [exec git version] end] .] 0 2] .]
set runq {}
set history {}
set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
setcoords
makewindow
+catch {
+ image create photo gitlogo -width 16 -height 16
+
+ image create photo gitlogominus -width 4 -height 2
+ gitlogominus put #C00000 -to 0 0 4 2
+ gitlogo copy gitlogominus -to 1 5
+ gitlogo copy gitlogominus -to 6 5
+ gitlogo copy gitlogominus -to 11 5
+ image delete gitlogominus
+
+ image create photo gitlogoplus -width 4 -height 4
+ gitlogoplus put #008000 -to 1 0 3 4
+ gitlogoplus put #008000 -to 0 1 4 3
+ gitlogo copy gitlogoplus -to 1 9
+ gitlogo copy gitlogoplus -to 6 9
+ gitlogo copy gitlogoplus -to 11 9
+ image delete gitlogoplus
+
+ image create photo gitlogo32 -width 32 -height 32
+ gitlogo32 copy gitlogo -zoom 2 2
+
+ wm iconphoto . -default gitlogo gitlogo32
+}
# wait for the window to become visible
tkwait visibility .
wm title . "[file tail $argv0]: [file tail [pwd]]"
+update
readrefs
if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
addviewmenu $n
}
}
+
+if {[tk windowingsystem] eq "win32"} {
+ focus -force .
+}
+
getcommits {}