# Tcl ignores the next line -*- tcl -*- \
exec wish "$0" -- "$@"
-# Copyright © 2005-2014 Paul Mackerras. All rights reserved.
+# Copyright © 2005-2016 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.
proc reloadcommits {} {
global curview viewcomplete selectedline currentid thickerline
global showneartags treediffs commitinterest cached_commitrow
- global targetid
+ global targetid commitinfo
set selid {}
if {$selectedline ne {}} {
getallcommits
}
clear_display
+ unset -nocomplain commitinfo
unset -nocomplain commitinterest
unset -nocomplain cached_commitrow
unset -nocomplain targetid
proc closevarcs {v} {
global varctok varccommits varcid parents children
- global cmitlisted commitidx vtokmod
+ global cmitlisted commitidx vtokmod curview numcommits
set missing_parents 0
set scripts {}
}
lappend varccommits($v,$b) $p
incr commitidx($v)
+ if {$v == $curview} {
+ set numcommits $commitidx($v)
+ }
set scripts [check_interest $p $scripts]
}
}
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 lime]
+ set progressitem [$progresscanv create rect -1 0 0 $h -fill "#00ff00"]
set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
}
set ctext .bleft.bottom.ctext
text $ctext -background $bgcolor -foreground $fgcolor \
- -state disabled -font textfont \
+ -state disabled -undo 0 -font textfont \
-yscrollcommand scrolltext -wrap none \
-xscrollcommand ".bleft.bottom.sbhorizontal set"
if {$have_tk85} {
message $w.m -text [mc "
Gitk - a commit viewer for git
-Copyright \u00a9 2005-2014 Paul Mackerras
+Copyright \u00a9 2005-2016 Paul Mackerras
Use and redistribute under the terms of the GNU General Public License"] \
-justify center -aspect 400 -border 2 -bg $bgcolor -relief groove
0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
}
-image create bitmap reficon-H -background black -foreground lime \
+image create bitmap reficon-H -background black -foreground "#00ff00" \
-data $rectdata -maskdata $rectmask
image create bitmap reficon-o -background black -foreground "#ddddff" \
-data $rectdata -maskdata $rectmask
# append some text to the ctext widget, and make any SHA1 ID
# that we know about be a clickable link.
+# Also look for URLs of the form "http[s]://..." and make them web links.
proc appendwithlinks {text tags} {
global ctext linknum curview
setlink $linkid link$linknum
incr linknum
}
+ set wlinks [regexp -indices -all -inline -line \
+ {https?://[^[:space:]]+} $text]
+ foreach l $wlinks {
+ set s2 [lindex $l 0]
+ set e2 [lindex $l 1]
+ set url [string range $text $s2 $e2]
+ incr e2
+ $ctext tag delete link$linknum
+ $ctext tag add link$linknum "$start + $s2 c" "$start + $e2 c"
+ setwlink $url link$linknum
+ incr linknum
+ }
}
proc setlink {id lk} {
}
}
+proc setwlink {url lk} {
+ global ctext
+ global linkfgcolor
+ global web_browser
+
+ if {$web_browser eq {}} return
+ $ctext tag conf $lk -foreground $linkfgcolor -underline 1
+ $ctext tag bind $lk <1> [list browseweb $url]
+ $ctext tag bind $lk <Enter> {linkcursor %W 1}
+ $ctext tag bind $lk <Leave> {linkcursor %W -1}
+}
+
proc appendshortlink {id {pre {}} {post {}}} {
global ctext linknum
}
}
+proc browseweb {url} {
+ global web_browser
+
+ if {$web_browser eq {}} return
+ # Use eval here in case $web_browser is a command plus some arguments
+ if {[catch {eval exec $web_browser [list $url] &} err]} {
+ error_popup "[mc "Error starting web browser:"] $err"
+ }
+}
+
proc viewnextline {dir} {
global canv linespc
$ctext conf -state normal
while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
+ # Older diff read. Abort it.
catch {close $bdf}
+ if {$ids != $diffids} {
+ array unset blobdifffd $ids
+ }
return 0
}
parseblobdiffline $ids $line
blobdiffmaybeseehere [eof $bdf]
if {[eof $bdf]} {
catch {close $bdf}
+ array unset blobdifffd $ids
return 0
}
return [expr {$nr >= 1000? 2: 1}]
}
proc branchdia {top valvar uivar} {
- global NS
+ global NS commitinfo
upvar $valvar val $uivar ui
catch {destroy $top}
$top.sha1 insert 0 $val(id)
$top.sha1 conf -state readonly
grid $top.id $top.sha1 -sticky w
+ ${NS}::entry $top.head -width 60
+ $top.head insert 0 [lindex $commitinfo($val(id)) 0]
+ $top.head conf -state readonly
+ grid x $top.head -sticky ew
+ grid columnconfigure $top 1 -weight 1
${NS}::label $top.nlab -text [mc "Name:"]
${NS}::entry $top.name -width 40
$top.name insert 0 $val(name)
# context menu for a head
proc headmenu {x y id head} {
- global headmenuid headmenuhead headctxmenu mainhead
+ global headmenuid headmenuhead headctxmenu mainhead headids
stopfinding
set headmenuid $id
set headmenuhead $head
array set state {0 normal 1 normal 2 normal}
if {[string match "remotes/*" $head]} {
- array set state {0 disabled 1 disabled 2 disabled}
+ set localhead [string range $head [expr [string last / $head] + 1] end]
+ if {[info exists headids($localhead)]} {
+ set state(0) disabled
+ }
+ array set state {1 disabled 2 disabled}
}
if {$head eq $mainhead} {
array set state {0 disabled 2 disabled}
global showlocalchanges
# check the tree is clean first??
+ set newhead $headmenuhead
+ set command [list | git checkout]
+ if {[string match "remotes/*" $newhead]} {
+ set remote $newhead
+ set newhead [string range $newhead [expr [string last / $newhead] + 1] end]
+ # The following check is redundant - the menu option should
+ # be disabled to begin with...
+ if {[info exists headids($newhead)]} {
+ error_popup [mc "A local branch named %s exists already" $newhead]
+ return
+ }
+ lappend command -b $newhead --track $remote
+ } else {
+ lappend command $newhead
+ }
+ lappend command 2>@1
nowbusy checkout [mc "Checking out"]
update
dohidelocalchanges
if {[catch {
- set fd [open [list | git checkout $headmenuhead 2>@1] r]
+ set fd [open $command r]
} err]} {
notbusy checkout
error_popup $err
dodiffindex
}
} else {
- filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
+ filerun $fd [list readcheckoutstat $fd $newhead $headmenuid]
}
}
proc readcheckoutstat {fd newhead newheadid} {
- global mainhead mainheadid headids showlocalchanges progresscoords
+ global mainhead mainheadid headids idheads showlocalchanges progresscoords
global viewmainheadid curview
if {[gets $fd line] >= 0} {
notbusy checkout
if {[catch {close $fd} err]} {
error_popup $err
+ return
}
set oldmainid $mainheadid
+ if {! [info exists headids($newhead)]} {
+ set headids($newhead) $newheadid
+ lappend idheads($newheadid) $newhead
+ addedhead $newheadid $newhead
+ }
set mainhead $newhead
set mainheadid $newheadid
set viewmainheadid($curview) $newheadid
proc prefspage_general {notebook} {
global NS maxwidth maxgraphpct showneartags showlocalchanges
global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
- global hideremotes want_ttk have_ttk maxrefs
+ global hideremotes want_ttk have_ttk maxrefs web_browser
set page [create_prefs_page $notebook.general]
pack configure $page.extdifff.l -padx 10
grid x $page.extdifff $page.extdifft -sticky ew
+ ${NS}::entry $page.webbrowser -textvariable web_browser
+ ${NS}::frame $page.webbrowserf
+ ${NS}::label $page.webbrowserf.l -text [mc "Web browser" ]
+ pack $page.webbrowserf.l -side left
+ pack configure $page.webbrowserf.l -padx 10
+ grid x $page.webbrowserf $page.webbrowser -sticky ew
+
${NS}::label $page.lgen -text [mc "General options"]
grid $page.lgen - -sticky w -pady 10
${NS}::checkbutton $page.want_ttk -variable want_ttk \
set extdifftool "meld"
}
-set colors {lime red blue magenta darkgrey brown orange}
+set colors {"#00ff00" red blue magenta darkgrey brown orange}
if {[tk windowingsystem] eq "win32"} {
set uicolor SystemButtonFace
set uifgcolor SystemButtonText
set bgcolor SystemWindow
set fgcolor SystemWindowText
set selectbgcolor SystemHighlight
+ set web_browser "cmd /c start"
} else {
set uicolor grey85
set uifgcolor black
set bgcolor white
set fgcolor black
set selectbgcolor gray85
+ if {[tk windowingsystem] eq "aqua"} {
+ set web_browser "open"
+ } else {
+ set web_browser "xdg-open"
+ }
}
set diffcolors {red "#00a000" blue}
set diffcontext 3
-set mergecolors {red blue lime purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
+set mergecolors {red blue "#00ff00" purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
set ignorespace 0
set worddiff ""
set markbgcolor "#e0e0ff"
-set headbgcolor lime
+set headbgcolor "#00ff00"
set headfgcolor black
set headoutlinecolor black
set remotebgcolor #ffddaa
set linehoveroutlinecolor black
set mainheadcirclecolor yellow
set workingfilescirclecolor red
-set indexcirclecolor lime
+set indexcirclecolor "#00ff00"
set circlecolors {white blue gray blue blue}
set linkfgcolor blue
set circleoutlinecolor $fgcolor
filesepbgcolor filesepfgcolor linehoverbgcolor linehoverfgcolor
linehoveroutlinecolor mainheadcirclecolor workingfilescirclecolor
indexcirclecolor circlecolors linkfgcolor circleoutlinecolor
+ web_browser
}
foreach var $config_variables {
config_init_trace $var