undef/git-commit-vandalism
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge commit 'git-gui/master'

Browse Source 
* commit 'git-gui/master': (36 commits)
  git-gui: Change prior tree SHA-1 verification to use git_read
  git-gui: Include a space in Cygwin shortcut command lines
  git-gui: Use sh.exe in Cygwin shortcuts
  git-gui: Paper bag fix for Cygwin shortcut creation
  git-gui: Improve the Windows and Mac OS X shortcut creators
  git-gui: Teach console widget to use git_read
  git-gui: Perform our own magic shbang detection on Windows
  git-gui: Treat `git version` as `git --version`
  git-gui: Assume unfound commands are known by git wrapper
  git-gui: Correct gitk installation location
  git-gui: Always use absolute path to all git executables
  git-gui: Show a progress meter for checking out files
  git-gui: Change the main window progress bar to use status_bar
  git-gui: Extract blame viewer status bar into mega-widget
  git-gui: Allow double-click in checkout dialog to start checkout
  git-gui: Default selection to first matching ref
  git-gui: Unabbreviate commit SHA-1s prior to display
  git-gui: Refactor branch switch to support detached head
  git-gui: Refactor our ui_status_value update technique
  git-gui: Better handling of detached HEAD
  ...
This commit is contained in:
Junio C Hamano 2007-07-12 14:14:51 -07:00
commit b9dcf846e2
23 changed files with 2213 additions and 891 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

467
git-gui/git-gui.sh
View File

@ -117,6 +117,7 @@ set _gitdir {}
set _gitexec {}
set _reponame {}
set _iscygwin {}
set _search_path {}
proc appname {} {
global _appname
@ -128,7 +129,7 @@ proc gitdir {args} {
if {$args eq {}} {
return $_gitdir
}
return [eval [concat [list file join $_gitdir] $args]]
return [eval [list file join $_gitdir] $args]
}
proc gitexec {args} {
@ -137,11 +138,19 @@ proc gitexec {args} {
if {[catch {set _gitexec [git --exec-path]} err]} {
error "Git not installed?\n\n$err"
}
if {[is_Cygwin]} {
set _gitexec [exec cygpath \
--windows \
--absolute \
$_gitexec]
} else {
set _gitexec [file normalize $_gitexec]
}
}
if {$args eq {}} {
return $_gitexec
}
return [eval [concat [list file join $_gitexec] $args]]
return [eval [list file join $_gitexec] $args]
}
proc reponame {} {
@ -237,7 +246,7 @@ proc load_config {include_global} {
array unset global_config
if {$include_global} {
catch {
set fd_rc [open "| git config --global --list" r]
set fd_rc [git_read config --global --list]
while {[gets $fd_rc line] >= 0} {
if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
if {[is_many_config $name]} {
@ -253,7 +262,7 @@ proc load_config {include_global} {
array unset repo_config
catch {
set fd_rc [open "| git config --list" r]
set fd_rc [git_read config --list]
while {[gets $fd_rc line] >= 0} {
if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
if {[is_many_config $name]} {
@ -280,19 +289,220 @@ proc load_config {include_global} {
##
## handy utils
proc git {args} {
return [eval exec git $args]
proc _git_cmd {name} {
global _git_cmd_path
if {[catch {set v $_git_cmd_path($name)}]} {
switch -- $name {
version -
--version -
--exec-path { return [list $::_git $name] }
}
set p [gitexec git-$name$::_search_exe]
if {[file exists $p]} {
set v [list $p]
} elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
# Try to determine what sort of magic will make
# git-$name go and do its thing, because native
# Tcl on Windows doesn't know it.
#
set p [gitexec git-$name]
set f [open $p r]
set s [gets $f]
close $f
switch -glob -- $s {
#!*sh { set i sh }
#!*perl { set i perl }
#!*python { set i python }
default { error "git-$name is not supported: $s" }
}
upvar #0 _$i interp
if {![info exists interp]} {
set interp [_which $i]
}
if {$interp eq {}} {
error "git-$name requires $i (not in PATH)"
}
set v [list $interp $p]
} else {
# Assume it is builtin to git somehow and we
# aren't actually able to see a file for it.
#
set v [list $::_git $name]
}
set _git_cmd_path($name) $v
}
return $v
}
proc current-branch {} {
set ref {}
proc _which {what} {
global env _search_exe _search_path
if {$_search_path eq {}} {
if {[is_Cygwin]} {
set _search_path [split [exec cygpath \
--windows \
--path \
--absolute \
$env(PATH)] {;}]
set _search_exe .exe
} elseif {[is_Windows]} {
set _search_path [split $env(PATH) {;}]
set _search_exe .exe
} else {
set _search_path [split $env(PATH) :]
set _search_exe {}
}
}
foreach p $_search_path {
set p [file join $p $what$_search_exe]
if {[file exists $p]} {
return [file normalize $p]
}
}
return {}
}
proc git {args} {
set opt [list exec]
while {1} {
switch -- [lindex $args 0] {
--nice {
global _nice
if {$_nice ne {}} {
lappend opt $_nice
}
}
default {
break
}
}
set args [lrange $args 1 end]
}
set cmdp [_git_cmd [lindex $args 0]]
set args [lrange $args 1 end]
return [eval $opt $cmdp $args]
}
proc _open_stdout_stderr {cmd} {
if {[catch {
set fd [open $cmd r]
} err]} {
if { [lindex $cmd end] eq {2>@1}
&& $err eq {can not find channel named "1"}
} {
# Older versions of Tcl 8.4 don't have this 2>@1 IO
# redirect operator. Fallback to |& cat for those.
# The command was not actually started, so its safe
# to try to start it a second time.
#
set fd [open [concat \
[lrange $cmd 0 end-1] \
[list |& cat] \
] r]
} else {
error $err
}
}
return $fd
}
proc git_read {args} {
set opt [list |]
while {1} {
switch -- [lindex $args 0] {
--nice {
global _nice
if {$_nice ne {}} {
lappend opt $_nice
}
}
--stderr {
lappend args 2>@1
}
default {
break
}
}
set args [lrange $args 1 end]
}
set cmdp [_git_cmd [lindex $args 0]]
set args [lrange $args 1 end]
return [_open_stdout_stderr [concat $opt $cmdp $args]]
}
proc git_write {args} {
set opt [list |]
while {1} {
switch -- [lindex $args 0] {
--nice {
global _nice
if {$_nice ne {}} {
lappend opt $_nice
}
}
default {
break
}
}
set args [lrange $args 1 end]
}
set cmdp [_git_cmd [lindex $args 0]]
set args [lrange $args 1 end]
return [open [concat $opt $cmdp $args] w]
}
proc sq {value} {
regsub -all ' $value "'\\''" value
return "'$value'"
}
proc load_current_branch {} {
global current_branch is_detached
set fd [open [gitdir HEAD] r]
if {[gets $fd ref] <16
|| ![regsub {^ref: refs/heads/} $ref {} ref]} {
if {[gets $fd ref] < 1} {
set ref {}
}
close $fd
return $ref
set pfx {ref: refs/heads/}
set len [string length $pfx]
if {[string equal -length $len $pfx $ref]} {
# We're on a branch. It might not exist. But
# HEAD looks good enough to be a branch.
#
set current_branch [string range $ref $len end]
set is_detached 0
} else {
# Assume this is a detached head.
#
set current_branch HEAD
set is_detached 1
}
}
auto_load tk_optionMenu
@ -304,37 +514,92 @@ proc tk_optionMenu {w varName args} {
return $m
}
######################################################################
##
## find git
set _git [_which git]
if {$_git eq {}} {
catch {wm withdraw .}
error_popup "Cannot find git in PATH."
exit 1
}
set _nice [_which nice]
######################################################################
##
## version check
set req_maj 1
set req_min 5
if {[catch {set v [git --version]} err]} {
if {[catch {set _git_version [git --version]} err]} {
catch {wm withdraw .}
error_popup "Cannot determine Git version:
$err
[appname] requires Git $req_maj.$req_min or later."
[appname] requires Git 1.5.0 or later."
exit 1
}
if {[regexp {^git version (\d+)\.(\d+)} $v _junk act_maj act_min]} {
if {$act_maj < $req_maj
|| ($act_maj == $req_maj && $act_min < $req_min)} {
catch {wm withdraw .}
error_popup "[appname] requires Git $req_maj.$req_min or later.
You are using $v."
exit 1
}
} else {
if {![regsub {^git version } $_git_version {} _git_version]} {
catch {wm withdraw .}
error_popup "Cannot parse Git version string:\n\n$v"
error_popup "Cannot parse Git version string:\n\n$_git_version"
exit 1
}
regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
regsub {\.rc[0-9]+$} $_git_version {} _git_version
proc git-version {args} {
global _git_version
switch [llength $args] {
0 {
return $_git_version
}
2 {
set op [lindex $args 0]
set vr [lindex $args 1]
set cm [package vcompare $_git_version $vr]
return [expr $cm $op 0]
}
4 {
set type [lindex $args 0]
set name [lindex $args 1]
set parm [lindex $args 2]
set body [lindex $args 3]
if {($type ne {proc} && $type ne {method})} {
error "Invalid arguments to git-version"
}
if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
error "Last arm of $type $name must be default"
}
foreach {op vr cb} [lrange $body 0 end-2] {
if {[git-version $op $vr]} {
return [uplevel [list $type $name $parm $cb]]
}
}
return [uplevel [list $type $name $parm [lindex $body end]]]
}
default {
error "git-version >= x"
}
}
}
if {[git-version < 1.5]} {
catch {wm withdraw .}
error_popup "[appname] requires Git 1.5.0 or later.
You are using [git-version]:
[git --version]"
exit 1
}
unset -nocomplain v _junk act_maj act_min req_maj req_min
######################################################################
##
@ -381,7 +646,6 @@ set _reponame [lindex [file split \
set current_diff_path {}
set current_diff_side {}
set diff_actions [list]
set ui_status_value {Initializing...}
set HEAD {}
set PARENT {}
@ -389,6 +653,7 @@ set MERGE_HEAD [list]
set commit_type {}
set empty_tree {}
set current_branch {}
set is_detached 0
set current_diff_path {}
set selected_commit_type new
@ -438,7 +703,7 @@ proc repository_state {ctvar hdvar mhvar} {
set mh [list]
set current_branch [current-branch]
load_current_branch
if {[catch {set hd [git rev-parse --verify HEAD]}]} {
set hd {}
set ct initial
@ -474,7 +739,7 @@ proc PARENT {} {
proc rescan {after {honor_trustmtime 1}} {
global HEAD PARENT MERGE_HEAD commit_type
global ui_index ui_workdir ui_status_value ui_comm
global ui_index ui_workdir ui_comm
global rescan_active file_states
global repo_config
@ -504,22 +769,17 @@ proc rescan {after {honor_trustmtime 1}} {
$ui_comm edit modified false
}
if {[is_enabled branch]} {
load_all_heads
populate_branch_menu
}
if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
rescan_stage2 {} $after
} else {
set rescan_active 1
set ui_status_value {Refreshing file status...}
set cmd [list git update-index]
lappend cmd -q
lappend cmd --unmerged
lappend cmd --ignore-missing
lappend cmd --refresh
set fd_rf [open "| $cmd" r]
ui_status {Refreshing file status...}
set fd_rf [git_read update-index \
-q \
--unmerged \
--ignore-missing \
--refresh \
]
fconfigure $fd_rf -blocking 0 -translation binary
fileevent $fd_rf readable \
[list rescan_stage2 $fd_rf $after]
@ -527,7 +787,6 @@ proc rescan {after {honor_trustmtime 1}} {
}
proc rescan_stage2 {fd after} {
global ui_status_value
global rescan_active buf_rdi buf_rdf buf_rlo
if {$fd ne {}} {
@ -536,8 +795,7 @@ proc rescan_stage2 {fd after} {
close $fd
}
set ls_others [list | git ls-files --others -z \
--exclude-per-directory=.gitignore]
set ls_others [list --exclude-per-directory=.gitignore]
set info_exclude [gitdir info exclude]
if {[file readable $info_exclude]} {
lappend ls_others "--exclude-from=$info_exclude"
@ -548,10 +806,10 @@ proc rescan_stage2 {fd after} {
set buf_rlo {}
set rescan_active 3
set ui_status_value {Scanning for modified files ...}
set fd_di [open "| git diff-index --cached -z [PARENT]" r]
set fd_df [open "| git diff-files -z" r]
set fd_lo [open $ls_others r]
ui_status {Scanning for modified files ...}
set fd_di [git_read diff-index --cached -z [PARENT]]
set fd_df [git_read diff-files -z]
set fd_lo [eval git_read ls-files --others -z $ls_others]
fconfigure $fd_di -blocking 0 -translation binary -encoding binary
fconfigure $fd_df -blocking 0 -translation binary -encoding binary
@ -708,6 +966,14 @@ proc mapdesc {state path} {
return $r
}
proc ui_status {msg} {
$::main_status show $msg
}
proc ui_ready {{test {}}} {
$::main_status show {Ready.} $test
}
proc escape_path {path} {
regsub -all {\\} $path "\\\\" path
regsub -all "\n" $path "\\n" path
@ -1059,26 +1325,18 @@ proc incr_font_size {font {amt 1}} {
set starting_gitk_msg {Starting gitk... please wait...}
proc do_gitk {revs} {
global env ui_status_value starting_gitk_msg
# -- Always start gitk through whatever we were loaded with. This
# lets us bypass using shell process on Windows systems.
#
set cmd [list [info nameofexecutable]]
lappend cmd [gitexec gitk]
if {$revs ne {}} {
append cmd { }
append cmd $revs
}
if {[catch {eval exec $cmd &} err]} {
error_popup "Failed to start gitk:\n\n$err"
set exe [file join [file dirname $::_git] gitk]
set cmd [list [info nameofexecutable] $exe]
if {! [file exists $exe]} {
error_popup "Unable to start gitk:\n\n$exe does not exist"
} else {
set ui_status_value $starting_gitk_msg
eval exec $cmd $revs &
ui_status $::starting_gitk_msg
after 10000 {
if {$ui_status_value eq $starting_gitk_msg} {
set ui_status_value {Ready.}
}
ui_ready $starting_gitk_msg
}
}
}
@ -1127,7 +1385,7 @@ proc do_quit {} {
}
proc do_rescan {} {
rescan {set ui_status_value {Ready.}}
rescan ui_ready
}
proc do_commit {} {
@ -1162,12 +1420,12 @@ proc toggle_or_diff {w x y} {
update_indexinfo \
"Unstaging [short_path $path] from commit" \
[list $path] \
[concat $after {set ui_status_value {Ready.}}]
[concat $after [list ui_ready]]
} elseif {$w eq $ui_workdir} {
update_index \
"Adding [short_path $path]" \
[list $path] \
[concat $after {set ui_status_value {Ready.}}]
[concat $after [list ui_ready]]
}
} else {
show_diff $path $w $lno
@ -1294,6 +1552,7 @@ set default_config(merge.verbosity) 2
set default_config(user.name) {}
set default_config(user.email) {}
set default_config(gui.matchtrackingbranch) false
set default_config(gui.pruneduringfetch) false
set default_config(gui.trustmtime) false
set default_config(gui.diffcontext) 5
@ -1451,18 +1710,24 @@ if {[is_enabled branch]} {
menu .mbar.branch
.mbar.branch add command -label {Create...} \
-command do_create_branch \
-command branch_create::dialog \
-accelerator $M1T-N
lappend disable_on_lock [list .mbar.branch entryconf \
[.mbar.branch index last] -state]
.mbar.branch add command -label {Checkout...} \
-command branch_checkout::dialog \
-accelerator $M1T-O
lappend disable_on_lock [list .mbar.branch entryconf \
[.mbar.branch index last] -state]
.mbar.branch add command -label {Rename...} \
-command branch_rename::dialog
lappend disable_on_lock [list .mbar.branch entryconf \
[.mbar.branch index last] -state]
.mbar.branch add command -label {Delete...} \
-command do_delete_branch
-command branch_delete::dialog
lappend disable_on_lock [list .mbar.branch entryconf \
[.mbar.branch index last] -state]
@ -1557,7 +1822,8 @@ if {[is_enabled transport]} {
menu .mbar.push
.mbar.push add command -label {Push...} \
-command do_push_anywhere
-command do_push_anywhere \
-accelerator $M1T-P
.mbar.push add command -label {Delete...} \
-command remote_branch_delete::dialog
}
@ -1583,20 +1849,19 @@ if {[is_MacOSX]} {
#
if {[is_Cygwin] && [file exists /usr/local/miga/lib/gui-miga]} {
proc do_miga {} {
global ui_status_value
if {![lock_index update]} return
set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
set miga_fd [open "|$cmd" r]
fconfigure $miga_fd -blocking 0
fileevent $miga_fd readable [list miga_done $miga_fd]
set ui_status_value {Running miga...}
ui_status {Running miga...}
}
proc miga_done {fd} {
read $fd 512
if {[eof $fd]} {
close $fd
unlock_index
rescan [list set ui_status_value {Ready.}]
rescan ui_ready
}
}
.mbar add cascade -label Tools -menu .mbar.tools
@ -1676,8 +1941,19 @@ switch -- $subcommand {
browser {
set subcommand_args {rev?}
switch [llength $argv] {
0 { set current_branch [current-branch] }
1 { set current_branch [lindex $argv 0] }
0 { load_current_branch }
1 {
set current_branch [lindex $argv 0]
if {[regexp {^[0-9a-f]{1,39}$} $current_branch]} {
if {[catch {
set current_branch \
[git rev-parse --verify $current_branch]
} err]} {
puts stderr $err
exit 1
}
}
}
default usage
}
browser::new $current_branch
@ -1710,8 +1986,16 @@ blame {
unset is_path
if {$head eq {}} {
set current_branch [current-branch]
load_current_branch
} else {
if {[regexp {^[0-9a-f]{1,39}$} $head]} {
if {[catch {
set head [git rev-parse --verify $head]
} err]} {
puts stderr $err
exit 1
}
}
set current_branch $head
}
@ -1847,6 +2131,10 @@ pack .vpane.lower.commarea.buttons.commit -side top -fill x
lappend disable_on_lock \
{.vpane.lower.commarea.buttons.commit conf -state}
button .vpane.lower.commarea.buttons.push -text {Push} \
-command do_push_anywhere
pack .vpane.lower.commarea.buttons.push -side top -fill x
# -- Commit Message Buffer
#
frame .vpane.lower.commarea.buffer
@ -2115,12 +2403,9 @@ unset ui_diff_applyhunk
# -- Status Bar
#
label .status -textvariable ui_status_value \
-anchor w \
-justify left \
-borderwidth 1 \
-relief sunken
set main_status [::status_bar::new .status]
pack .status -anchor w -side bottom -fill x
$main_status show {Initializing...}
# -- Load geometry
#
@ -2171,13 +2456,19 @@ bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
bind $ui_diff <Button-1> {focus %W}
if {[is_enabled branch]} {
bind . <$M1B-Key-n> do_create_branch
bind . <$M1B-Key-N> do_create_branch
bind . <$M1B-Key-n> branch_create::dialog
bind . <$M1B-Key-N> branch_create::dialog
bind . <$M1B-Key-o> branch_checkout::dialog
bind . <$M1B-Key-O> branch_checkout::dialog
}
if {[is_enabled transport]} {
bind . <$M1B-Key-p> do_push_anywhere
bind . <$M1B-Key-P> do_push_anywhere
}
bind all <Key-F5> do_rescan
bind all <$M1B-Key-r> do_rescan
bind all <$M1B-Key-R> do_rescan
bind . <Key-F5> do_rescan
bind . <$M1B-Key-r> do_rescan
bind . <$M1B-Key-R> do_rescan
bind . <$M1B-Key-s> do_signoff
bind . <$M1B-Key-S> do_signoff
bind . <$M1B-Key-i> do_add_all
@ -2255,9 +2546,7 @@ user.email settings into your personal
#
if {[is_enabled transport]} {
load_all_remotes
load_all_heads
populate_branch_menu
populate_fetch_menu
populate_push_menu
}

90
git-gui/lib/blame.tcl
View File

@ -21,7 +21,7 @@ field w_amov ; # text column: annotations + move tracking
field w_asim ; # text column: annotations (simple computation)
field w_file ; # text column: actual file data
field w_cviewer ; # pane showing commit message
field status ; # text variable bound to status bar
field status ; # status mega-widget instance
field old_height ; # last known height of $w.file_pane
# Tk UI colors
@ -33,6 +33,13 @@ variable group_colors {
#ececec
}
# Switches for original location detection
#
variable original_options [list -C -C]
if {[git-version >= 1.5.3]} {
lappend original_options -w ; # ignore indentation changes
}
# Current blame data; cleared/reset on each load
#
field commit ; # input commit to blame
@ -235,14 +242,7 @@ constructor new {i_commit i_path} {
pack $w.file_pane.cm.sbx -side bottom -fill x
pack $w_cviewer -expand 1 -fill both
frame $w.status \
-borderwidth 1 \
-relief sunken
label $w.status.l \
-textvariable @status \
-anchor w \
-justify left
pack $w.status.l -side left
set status [::status_bar::new $w.status]
menu $w.ctxm -tearoff 0
$w.ctxm add command \
@ -304,8 +304,9 @@ constructor new {i_commit i_path} {
set req_w [winfo reqwidth $top]
set req_h [winfo reqheight $top]
set scr_h [expr {[winfo screenheight $top] - 100}]
if {$req_w < 600} {set req_w 600}
if {$req_h < 400} {set req_h 400}
if {$req_h < $scr_h} {set req_h $scr_h}
set g "${req_w}x${req_h}"
wm geometry $top $g
update
@ -352,19 +353,6 @@ method _load {jump} {
set total_lines 0
}
if {[winfo exists $w.status.c]} {
$w.status.c coords bar 0 0 0 20
} else {
canvas $w.status.c \
-width 100 \
-height [expr {int([winfo reqheight $w.status.l] * 0.6)}] \
-borderwidth 1 \
-relief groove \
-highlightt 0
$w.status.c create rectangle 0 0 0 20 -tags bar -fill navy
pack $w.status.c -side right
}
if {$history eq {}} {
$w_back conf -state disabled
} else {
@ -378,13 +366,12 @@ method _load {jump} {
set amov_data [list [list]]
set asim_data [list [list]]
set status "Loading $commit:[escape_path $path]..."
$status show "Reading $commit:[escape_path $path]..."
$w_path conf -text [escape_path $path]
if {$commit eq {}} {
set fd [open $path r]
} else {
set cmd [list git cat-file blob "$commit:$path"]
set fd [open "| $cmd" r]
set fd [git_read cat-file blob "$commit:$path"]
}
fconfigure $fd -blocking 0 -translation lf -encoding binary
fileevent $fd readable [cb _read_file $fd $jump]
@ -487,30 +474,28 @@ method _read_file {fd jump} {
} ifdeleted { catch {close $fd} }
method _exec_blame {cur_w cur_d options cur_s} {
set cmd [list]
if {![is_Windows] || [is_Cygwin]} {
lappend cmd nice
}
lappend cmd git blame
set cmd [concat $cmd $options]
lappend cmd --incremental
lappend options --incremental
if {$commit eq {}} {
lappend cmd --contents $path
lappend options --contents $path
} else {
lappend cmd $commit
lappend options $commit
}
lappend cmd -- $path
set fd [open "| $cmd" r]
lappend options -- $path
set fd [eval git_read --nice blame $options]
fconfigure $fd -blocking 0 -translation lf -encoding binary
fileevent $fd readable [cb _read_blame $fd $cur_w $cur_d $cur_s]
fileevent $fd readable [cb _read_blame $fd $cur_w $cur_d]
set current_fd $fd
set blame_lines 0
_status $this $cur_s
$status start \
"Loading$cur_s annotations..." \
{lines annotated}
}
method _read_blame {fd cur_w cur_d cur_s} {
method _read_blame {fd cur_w cur_d} {
upvar #0 $cur_d line_data
variable group_colors
variable original_options
if {$fd ne $current_fd} {
catch {close $fd}
@ -547,6 +532,10 @@ method _read_blame {fd cur_w cur_d cur_s} {
set a_name {}
catch {set a_name $header($cmit,author)}
while {$a_name ne {}} {
if {$author_abbr ne {}
&& [string index $a_name 0] eq {'}} {
regsub {^'[^']+'\s+} $a_name {} a_name
}
if {![regexp {^([[:upper:]])} $a_name _a]} break
append author_abbr $_a
unset _a
@ -680,30 +669,17 @@ method _read_blame {fd cur_w cur_d cur_s} {
close $fd
if {$cur_w eq $w_asim} {
_exec_blame $this $w_amov @amov_data \
[list -M -C -C] \
$original_options \
{ original location}
} else {
set current_fd {}
set status {Annotation complete.}
destroy $w.status.c
$status stop {Annotation complete.}
}
} else {
_status $this $cur_s
$status update $blame_lines $total_lines
}
} ifdeleted { catch {close $fd} }
method _status {cur_s} {
set have $blame_lines
set total $total_lines
set pdone 0
if {$total} {set pdone [expr {100 * $have / $total}]}
set status [format \
"Loading%s annotations... %i of %i lines annotated (%2i%%)" \
$cur_s $have $total $pdone]
$w.status.c coords bar 0 0 $pdone 20
}
method _click {cur_w pos} {
set lno [lindex [split [$cur_w index $pos] .] 0]
_showcommit $this $cur_w $lno
@ -784,7 +760,7 @@ method _showcommit {cur_w lno} {
if {[catch {set msg $header($cmit,message)}]} {
set msg {}
catch {
set fd [open "| git cat-file commit $cmit" r]
set fd [git_read cat-file commit $cmit]
fconfigure $fd -encoding binary -translation lf
if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
set enc utf-8

562
git-gui/lib/branch.tcl
View File

@ -2,573 +2,37 @@
# Copyright (C) 2006, 2007 Shawn Pearce
proc load_all_heads {} {
global all_heads
global some_heads_tracking
set rh refs/heads
set rh_len [expr {[string length $rh] + 1}]
set all_heads [list]
set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
set fd [git_read for-each-ref --format=%(refname) $rh]
while {[gets $fd line] > 0} {
if {[is_tracking_branch $line]} continue
if {![regsub ^refs/heads/ $line {} name]} continue
lappend all_heads $name
if {!$some_heads_tracking || ![is_tracking_branch $line]} {
lappend all_heads [string range $line $rh_len end]
}
}
close $fd
set all_heads [lsort $all_heads]
return [lsort $all_heads]
}
proc load_all_tags {} {
set all_tags [list]
set fd [open "| git for-each-ref --format=%(refname) refs/tags" r]
set fd [git_read for-each-ref \
--sort=-taggerdate \
--format=%(refname) \
refs/tags]
while {[gets $fd line] > 0} {
if {![regsub ^refs/tags/ $line {} name]} continue
lappend all_tags $name
}
close $fd
return [lsort $all_tags]
}
proc populate_branch_menu {} {
global all_heads disable_on_lock
set m .mbar.branch
set last [$m index last]
for {set i 0} {$i <= $last} {incr i} {
if {[$m type $i] eq {separator}} {
$m delete $i last
set new_dol [list]
foreach a $disable_on_lock {
if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
lappend new_dol $a
}
}
set disable_on_lock $new_dol
break
}
}
if {$all_heads ne {}} {
$m add separator
}
foreach b $all_heads {
$m add radiobutton \
-label $b \
-command [list switch_branch $b] \
-variable current_branch \
-value $b
lappend disable_on_lock \
[list $m entryconf [$m index last] -state]
}
}
proc do_create_branch_action {w} {
global all_heads null_sha1 repo_config
global create_branch_checkout create_branch_revtype
global create_branch_head create_branch_trackinghead
global create_branch_name create_branch_revexp
global create_branch_tag
set newbranch $create_branch_name
if {$newbranch eq {}
|| $newbranch eq $repo_config(gui.newbranchtemplate)} {
tk_messageBox \
-icon error \
-type ok \
-title [wm title $w] \
-parent $w \
-message "Please supply a branch name."
focus $w.desc.name_t
return
}
if {![catch {git show-ref --verify -- "refs/heads/$newbranch"}]} {
tk_messageBox \
-icon error \
-type ok \
-title [wm title $w] \
-parent $w \
-message "Branch '$newbranch' already exists."
focus $w.desc.name_t
return
}
if {[catch {git check-ref-format "heads/$newbranch"}]} {
tk_messageBox \
-icon error \
-type ok \
-title [wm title $w] \
-parent $w \
-message "We do not like '$newbranch' as a branch name."
focus $w.desc.name_t
return
}
set rev {}
switch -- $create_branch_revtype {
head {set rev $create_branch_head}
tracking {set rev $create_branch_trackinghead}
tag {set rev $create_branch_tag}
expression {set rev $create_branch_revexp}
}
if {[catch {set cmt [git rev-parse --verify "${rev}^0"]}]} {
tk_messageBox \
-icon error \
-type ok \
-title [wm title $w] \
-parent $w \
-message "Invalid starting revision: $rev"
return
}
if {[catch {
git update-ref \
-m "branch: Created from $rev" \
"refs/heads/$newbranch" \
$cmt \
$null_sha1
} err]} {
tk_messageBox \
-icon error \
-type ok \
-title [wm title $w] \
-parent $w \
-message "Failed to create '$newbranch'.\n\n$err"
return
}
lappend all_heads $newbranch
set all_heads [lsort $all_heads]
populate_branch_menu
destroy $w
if {$create_branch_checkout} {
switch_branch $newbranch
}
return $all_tags
}
proc radio_selector {varname value args} {
upvar #0 $varname var
set var $value
}
trace add variable create_branch_head write \
[list radio_selector create_branch_revtype head]
trace add variable create_branch_trackinghead write \
[list radio_selector create_branch_revtype tracking]
trace add variable create_branch_tag write \
[list radio_selector create_branch_revtype tag]
trace add variable delete_branch_head write \
[list radio_selector delete_branch_checktype head]
trace add variable delete_branch_trackinghead write \
[list radio_selector delete_branch_checktype tracking]
proc do_create_branch {} {
global all_heads current_branch repo_config
global create_branch_checkout create_branch_revtype
global create_branch_head create_branch_trackinghead
global create_branch_name create_branch_revexp
global create_branch_tag
set w .branch_editor
toplevel $w
wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
label $w.header -text {Create New Branch} \
-font font_uibold
pack $w.header -side top -fill x
frame $w.buttons
button $w.buttons.create -text Create \
-default active \
-command [list do_create_branch_action $w]
pack $w.buttons.create -side right
button $w.buttons.cancel -text {Cancel} \
-command [list destroy $w]
pack $w.buttons.cancel -side right -padx 5
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
labelframe $w.desc -text {Branch Description}
label $w.desc.name_l -text {Name:}
entry $w.desc.name_t \
-borderwidth 1 \
-relief sunken \
-width 40 \
-textvariable create_branch_name \
-validate key \
-validatecommand {
if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
return 1
}
grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
grid columnconfigure $w.desc 1 -weight 1
pack $w.desc -anchor nw -fill x -pady 5 -padx 5
labelframe $w.from -text {Starting Revision}
if {$all_heads ne {}} {
radiobutton $w.from.head_r \
-text {Local Branch:} \
-value head \
-variable create_branch_revtype
eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
grid $w.from.head_r $w.from.head_m -sticky w
}
set all_trackings [all_tracking_branches]
if {$all_trackings ne {}} {
set create_branch_trackinghead [lindex $all_trackings 0]
radiobutton $w.from.tracking_r \
-text {Tracking Branch:} \
-value tracking \
-variable create_branch_revtype
eval tk_optionMenu $w.from.tracking_m \
create_branch_trackinghead \
$all_trackings
grid $w.from.tracking_r $w.from.tracking_m -sticky w
}
set all_tags [load_all_tags]
if {$all_tags ne {}} {
set create_branch_tag [lindex $all_tags 0]
radiobutton $w.from.tag_r \
-text {Tag:} \
-value tag \
-variable create_branch_revtype
eval tk_optionMenu $w.from.tag_m create_branch_tag $all_tags
grid $w.from.tag_r $w.from.tag_m -sticky w
}
radiobutton $w.from.exp_r \
-text {Revision Expression:} \
-value expression \
-variable create_branch_revtype
entry $w.from.exp_t \
-borderwidth 1 \
-relief sunken \
-width 50 \
-textvariable create_branch_revexp \
-validate key \
-validatecommand {
if {%d == 1 && [regexp {\s} %S]} {return 0}
if {%d == 1 && [string length %S] > 0} {
set create_branch_revtype expression
}
return 1
}
grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
grid columnconfigure $w.from 1 -weight 1
pack $w.from -anchor nw -fill x -pady 5 -padx 5
labelframe $w.postActions -text {Post Creation Actions}
checkbutton $w.postActions.checkout \
-text {Checkout after creation} \
-variable create_branch_checkout
pack $w.postActions.checkout -anchor nw
pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
set create_branch_checkout 1
set create_branch_head $current_branch
set create_branch_revtype head
set create_branch_name $repo_config(gui.newbranchtemplate)
set create_branch_revexp {}
bind $w <Visibility> "
grab $w
$w.desc.name_t icursor end
focus $w.desc.name_t
"
bind $w <Key-Escape> "destroy $w"
bind $w <Key-Return> "do_create_branch_action $w;break"
wm title $w "[appname] ([reponame]): Create Branch"
tkwait window $w
}
proc do_delete_branch_action {w} {
global all_heads
global delete_branch_checktype delete_branch_head delete_branch_trackinghead
set check_rev {}
switch -- $delete_branch_checktype {
head {set check_rev $delete_branch_head}
tracking {set check_rev $delete_branch_trackinghead}
always {set check_rev {:none}}
}
if {$check_rev eq {:none}} {
set check_cmt {}
} elseif {[catch {set check_cmt [git rev-parse --verify "${check_rev}^0"]}]} {
tk_messageBox \
-icon error \
-type ok \
-title [wm title $w] \
-parent $w \
-message "Invalid check revision: $check_rev"
return
}
set to_delete [list]
set not_merged [list]
foreach i [$w.list.l curselection] {
set b [$w.list.l get $i]
if {[catch {set o [git rev-parse --verify $b]}]} continue
if {$check_cmt ne {}} {
if {$b eq $check_rev} continue
if {[catch {set m [git merge-base $o $check_cmt]}]} continue
if {$o ne $m} {
lappend not_merged $b
continue
}
}
lappend to_delete [list $b $o]
}
if {$not_merged ne {}} {
set msg "The following branches are not completely merged into $check_rev:
- [join $not_merged "\n - "]"
tk_messageBox \
-icon info \
-type ok \
-title [wm title $w] \
-parent $w \
-message $msg
}
if {$to_delete eq {}} return
if {$delete_branch_checktype eq {always}} {
set msg {Recovering deleted branches is difficult.
Delete the selected branches?}
if {[tk_messageBox \
-icon warning \
-type yesno \
-title [wm title $w] \
-parent $w \
-message $msg] ne yes} {
return
}
}
set failed {}
foreach i $to_delete {
set b [lindex $i 0]
set o [lindex $i 1]
if {[catch {git update-ref -d "refs/heads/$b" $o} err]} {
append failed " - $b: $err\n"
} else {
set x [lsearch -sorted -exact $all_heads $b]
if {$x >= 0} {
set all_heads [lreplace $all_heads $x $x]
}
}
}
if {$failed ne {}} {
tk_messageBox \
-icon error \
-type ok \
-title [wm title $w] \
-parent $w \
-message "Failed to delete branches:\n$failed"
}
set all_heads [lsort $all_heads]
populate_branch_menu
destroy $w
}
proc do_delete_branch {} {
global all_heads tracking_branches current_branch
global delete_branch_checktype delete_branch_head delete_branch_trackinghead
set w .branch_editor
toplevel $w
wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
label $w.header -text {Delete Local Branch} \
-font font_uibold
pack $w.header -side top -fill x
frame $w.buttons
button $w.buttons.create -text Delete \
-command [list do_delete_branch_action $w]
pack $w.buttons.create -side right
button $w.buttons.cancel -text {Cancel} \
-command [list destroy $w]
pack $w.buttons.cancel -side right -padx 5
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
labelframe $w.list -text {Local Branches}
listbox $w.list.l \
-height 10 \
-width 70 \
-selectmode extended \
-yscrollcommand [list $w.list.sby set]
foreach h $all_heads {
if {$h ne $current_branch} {
$w.list.l insert end $h
}
}
scrollbar $w.list.sby -command [list $w.list.l yview]
pack $w.list.sby -side right -fill y
pack $w.list.l -side left -fill both -expand 1
pack $w.list -fill both -expand 1 -pady 5 -padx 5
labelframe $w.validate -text {Delete Only If}
radiobutton $w.validate.head_r \
-text {Merged Into Local Branch:} \
-value head \
-variable delete_branch_checktype
eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
grid $w.validate.head_r $w.validate.head_m -sticky w
set all_trackings [all_tracking_branches]
if {$all_trackings ne {}} {
set delete_branch_trackinghead [lindex $all_trackings 0]
radiobutton $w.validate.tracking_r \
-text {Merged Into Tracking Branch:} \
-value tracking \
-variable delete_branch_checktype
eval tk_optionMenu $w.validate.tracking_m \
delete_branch_trackinghead \
$all_trackings
grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
}
radiobutton $w.validate.always_r \
-text {Always (Do not perform merge checks)} \
-value always \
-variable delete_branch_checktype
grid $w.validate.always_r -columnspan 2 -sticky w
grid columnconfigure $w.validate 1 -weight 1
pack $w.validate -anchor nw -fill x -pady 5 -padx 5
set delete_branch_head $current_branch
set delete_branch_checktype head
bind $w <Visibility> "grab $w; focus $w"
bind $w <Key-Escape> "destroy $w"
wm title $w "[appname] ([reponame]): Delete Branch"
tkwait window $w
}
proc switch_branch {new_branch} {
global HEAD commit_type current_branch repo_config
if {![lock_index switch]} return
# -- Our in memory state should match the repository.
#
repository_state curType curHEAD curMERGE_HEAD
if {[string match amend* $commit_type]
&& $curType eq {normal}
&& $curHEAD eq $HEAD} {
} elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
info_popup {Last scanned state does not match repository state.
Another Git program has modified this repository since the last scan. A rescan must be performed before the current branch can be changed.
The rescan will be automatically started now.
}
unlock_index
rescan {set ui_status_value {Ready.}}
return
}
# -- Don't do a pointless switch.
#
if {$current_branch eq $new_branch} {
unlock_index
return
}
if {$repo_config(gui.trustmtime) eq {true}} {
switch_branch_stage2 {} $new_branch
} else {
set ui_status_value {Refreshing file status...}
set cmd [list git update-index]
lappend cmd -q
lappend cmd --unmerged
lappend cmd --ignore-missing
lappend cmd --refresh
set fd_rf [open "| $cmd" r]
fconfigure $fd_rf -blocking 0 -translation binary
fileevent $fd_rf readable \
[list switch_branch_stage2 $fd_rf $new_branch]
}
}
proc switch_branch_stage2 {fd_rf new_branch} {
global ui_status_value HEAD
if {$fd_rf ne {}} {
read $fd_rf
if {![eof $fd_rf]} return
close $fd_rf
}
set ui_status_value "Updating working directory to '$new_branch'..."
set cmd [list git read-tree]
lappend cmd -m
lappend cmd -u
lappend cmd --exclude-per-directory=.gitignore
lappend cmd $HEAD
lappend cmd $new_branch
set fd_rt [open "| $cmd" r]
fconfigure $fd_rt -blocking 0 -translation binary
fileevent $fd_rt readable \
[list switch_branch_readtree_wait $fd_rt $new_branch]
}
proc switch_branch_readtree_wait {fd_rt new_branch} {
global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
global current_branch
global ui_comm ui_status_value
# -- We never get interesting output on stdout; only stderr.
#
read $fd_rt
fconfigure $fd_rt -blocking 1
if {![eof $fd_rt]} {
fconfigure $fd_rt -blocking 0
return
}
# -- The working directory wasn't in sync with the index and
# we'd have to overwrite something to make the switch. A
# merge is required.
#
if {[catch {close $fd_rt} err]} {
regsub {^fatal: } $err {} err
warn_popup "File level merge required.
$err
Staying on branch '$current_branch'."
set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
unlock_index
return
}
# -- Update the symbolic ref. Core git doesn't even check for failure
# here, it Just Works(tm). If it doesn't we are in some really ugly
# state that is difficult to recover from within git-gui.
#
if {[catch {git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
error_popup "Failed to set current branch.
This working directory is only partially switched. We successfully updated your files, but failed to update an internal Git file.
This should not have occurred. [appname] will now close and give up.
$err"
do_quit
return
}
# -- Update our repository state. If we were previously in amend mode
# we need to toss the current buffer and do a full rescan to update
# our file lists. If we weren't in amend mode our file lists are
# accurate and we can avoid the rescan.
#
unlock_index
set selected_commit_type new
if {[string match amend* $commit_type]} {
$ui_comm delete 0.0 end
$ui_comm edit reset
$ui_comm edit modified false
rescan {set ui_status_value "Checked out branch '$current_branch'."}
} else {
repository_state commit_type HEAD MERGE_HEAD
set PARENT $HEAD
set ui_status_value "Checked out branch '$current_branch'."
}
}

89
git-gui/lib/branch_checkout.tcl Normal file
View File

@ -0,0 +1,89 @@
# git-gui branch checkout support
# Copyright (C) 2007 Shawn Pearce
class branch_checkout {
field w ; # widget path
field w_rev ; # mega-widget to pick the initial revision
field opt_fetch 1; # refetch tracking branch if used?
field opt_detach 0; # force a detached head case?
constructor dialog {} {
make_toplevel top w
wm title $top "[appname] ([reponame]): Checkout Branch"
if {$top ne {.}} {
wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
}
label $w.header -text {Checkout Branch} -font font_uibold
pack $w.header -side top -fill x
frame $w.buttons
button $w.buttons.create -text Checkout \
-default active \
-command [cb _checkout]
pack $w.buttons.create -side right
button $w.buttons.cancel -text {Cancel} \
-command [list destroy $w]
pack $w.buttons.cancel -side right -padx 5
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
set w_rev [::choose_rev::new $w.rev {Revision}]
$w_rev bind_listbox <Double-Button-1> [cb _checkout]
pack $w.rev -anchor nw -fill both -expand 1 -pady 5 -padx 5
labelframe $w.options -text {Options}
checkbutton $w.options.fetch \
-text {Fetch Tracking Branch} \
-variable @opt_fetch
pack $w.options.fetch -anchor nw
checkbutton $w.options.detach \
-text {Detach From Local Branch} \
-variable @opt_detach
pack $w.options.detach -anchor nw
pack $w.options -anchor nw -fill x -pady 5 -padx 5
bind $w <Visibility> [cb _visible]
bind $w <Key-Escape> [list destroy $w]
bind $w <Key-Return> [cb _checkout]\;break
tkwait window $w
}
method _checkout {} {
set spec [$w_rev get_tracking_branch]
if {$spec ne {} && $opt_fetch} {
set new {}
} elseif {[catch {set new [$w_rev commit_or_die]}]} {
return
}
if {$opt_detach} {
set ref {}
} else {
set ref [$w_rev get_local_branch]
}
set co [::checkout_op::new [$w_rev get] $new $ref]
$co parent $w
$co enable_checkout 1
if {$spec ne {} && $opt_fetch} {
$co enable_fetch $spec
}
if {[$co run]} {
destroy $w
} else {
$w_rev focus_filter
}
}
method _visible {} {
grab $w
$w_rev focus_filter
}
}

220
git-gui/lib/branch_create.tcl Normal file
View File

@ -0,0 +1,220 @@
# git-gui branch create support
# Copyright (C) 2006, 2007 Shawn Pearce
class branch_create {
field w ; # widget path
field w_rev ; # mega-widget to pick the initial revision
field w_name ; # new branch name widget
field name {}; # name of the branch the user has chosen
field name_type user; # type of branch name to use
field opt_merge ff; # type of merge to apply to existing branch
field opt_checkout 1; # automatically checkout the new branch?
field opt_fetch 1; # refetch tracking branch if used?
field reset_ok 0; # did the user agree to reset?
constructor dialog {} {
global repo_config
make_toplevel top w
wm title $top "[appname] ([reponame]): Create Branch"
if {$top ne {.}} {
wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
}
label $w.header -text {Create New Branch} -font font_uibold
pack $w.header -side top -fill x
frame $w.buttons
button $w.buttons.create -text Create \
-default active \
-command [cb _create]
pack $w.buttons.create -side right
button $w.buttons.cancel -text {Cancel} \
-command [list destroy $w]
pack $w.buttons.cancel -side right -padx 5
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
labelframe $w.desc -text {Branch Name}
radiobutton $w.desc.name_r \
-anchor w \
-text {Name:} \
-value user \
-variable @name_type
set w_name $w.desc.name_t
entry $w_name \
-borderwidth 1 \
-relief sunken \
-width 40 \
-textvariable @name \
-validate key \
-validatecommand [cb _validate %d %S]
grid $w.desc.name_r $w_name -sticky we -padx {0 5}
radiobutton $w.desc.match_r \
-anchor w \
-text {Match Tracking Branch Name} \
-value match \
-variable @name_type
grid $w.desc.match_r -sticky we -padx {0 5} -columnspan 2
grid columnconfigure $w.desc 1 -weight 1
pack $w.desc -anchor nw -fill x -pady 5 -padx 5
set w_rev [::choose_rev::new $w.rev {Starting Revision}]
pack $w.rev -anchor nw -fill both -expand 1 -pady 5 -padx 5
labelframe $w.options -text {Options}
frame $w.options.merge
label $w.options.merge.l -text {Update Existing Branch:}
pack $w.options.merge.l -side left
radiobutton $w.options.merge.no \
-text No \
-value none \
-variable @opt_merge
pack $w.options.merge.no -side left
radiobutton $w.options.merge.ff \
-text {Fast Forward Only} \
-value ff \
-variable @opt_merge
pack $w.options.merge.ff -side left
radiobutton $w.options.merge.reset \
-text {Reset} \
-value reset \
-variable @opt_merge
pack $w.options.merge.reset -side left
pack $w.options.merge -anchor nw
checkbutton $w.options.fetch \
-text {Fetch Tracking Branch} \
-variable @opt_fetch
pack $w.options.fetch -anchor nw
checkbutton $w.options.checkout \
-text {Checkout After Creation} \
-variable @opt_checkout
pack $w.options.checkout -anchor nw
pack $w.options -anchor nw -fill x -pady 5 -padx 5
trace add variable @name_type write [cb _select]
set name $repo_config(gui.newbranchtemplate)
if {[is_config_true gui.matchtrackingbranch]} {
set name_type match
}
bind $w <Visibility> [cb _visible]
bind $w <Key-Escape> [list destroy $w]
bind $w <Key-Return> [cb _create]\;break
tkwait window $w
}
method _create {} {
global repo_config
global M1B
set spec [$w_rev get_tracking_branch]
switch -- $name_type {
user {
set newbranch $name
}
match {
if {$spec eq {}} {
tk_messageBox \
-icon error \
-type ok \
-title [wm title $w] \
-parent $w \
-message "Please select a tracking branch."
return
}
if {![regsub ^refs/heads/ [lindex $spec 2] {} newbranch]} {
tk_messageBox \
-icon error \
-type ok \
-title [wm title $w] \
-parent $w \
-message "Tracking branch [$w get] is not a branch in the remote repository."
return
}
}
}
if {$newbranch eq {}
|| $newbranch eq $repo_config(gui.newbranchtemplate)} {
tk_messageBox \
-icon error \
-type ok \
-title [wm title $w] \
-parent $w \
-message "Please supply a branch name."
focus $w_name
return
}
if {[catch {git check-ref-format "heads/$newbranch"}]} {
tk_messageBox \
-icon error \
-type ok \
-title [wm title $w] \
-parent $w \
-message "'$newbranch' is not an acceptable branch name."
focus $w_name
return
}
if {$spec ne {} && $opt_fetch} {
set new {}
} elseif {[catch {set new [$w_rev commit_or_die]}]} {
return
}
set co [::checkout_op::new \
[$w_rev get] \
$new \
refs/heads/$newbranch]
$co parent $w
$co enable_create 1
$co enable_merge $opt_merge
$co enable_checkout $opt_checkout
if {$spec ne {} && $opt_fetch} {
$co enable_fetch $spec
}
if {[$co run]} {
destroy $w
} else {
focus $w_name
}
}
method _validate {d S} {
if {$d == 1} {
if {[regexp {[~^:?*\[\0- ]} $S]} {
return 0
}
if {[string length $S] > 0} {
set name_type user
}
}
return 1
}
method _select {args} {
if {$name_type eq {match}} {
$w_rev pick_tracking_branch
}
}
method _visible {} {
grab $w
if {$name_type eq {user}} {
$w_name icursor end
focus $w_name
}
}
}

149
git-gui/lib/branch_delete.tcl Normal file
View File

@ -0,0 +1,149 @@
# git-gui branch delete support
# Copyright (C) 2007 Shawn Pearce
class branch_delete {
field w ; # widget path
field w_heads ; # listbox of local head names
field w_check ; # revision picker for merge test
field w_delete ; # delete button
constructor dialog {} {
global current_branch
make_toplevel top w
wm title $top "[appname] ([reponame]): Delete Branch"
if {$top ne {.}} {
wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
}
label $w.header -text {Delete Local Branch} -font font_uibold
pack $w.header -side top -fill x
frame $w.buttons
set w_delete $w.buttons.delete
button $w_delete \
-text Delete \
-default active \
-state disabled \
-command [cb _delete]
pack $w_delete -side right
button $w.buttons.cancel \
-text {Cancel} \
-command [list destroy $w]
pack $w.buttons.cancel -side right -padx 5
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
labelframe $w.list -text {Local Branches}
set w_heads $w.list.l
listbox $w_heads \
-height 10 \
-width 70 \
-selectmode extended \
-exportselection false \
-yscrollcommand [list $w.list.sby set]
scrollbar $w.list.sby -command [list $w.list.l yview]
pack $w.list.sby -side right -fill y
pack $w.list.l -side left -fill both -expand 1
pack $w.list -fill both -expand 1 -pady 5 -padx 5
set w_check [choose_rev::new \
$w.check \
{Delete Only If Merged Into} \
]
$w_check none {Always (Do not perform merge test.)}
pack $w.check -anchor nw -fill x -pady 5 -padx 5
foreach h [load_all_heads] {
if {$h ne $current_branch} {
$w_heads insert end $h
}
}
bind $w_heads <<ListboxSelect>> [cb _select]
bind $w <Visibility> "
grab $w
focus $w
"
bind $w <Key-Escape> [list destroy $w]
bind $w <Key-Return> [cb _delete]\;break
tkwait window $w
}
method _select {} {
if {[$w_heads curselection] eq {}} {
$w_delete configure -state disabled
} else {
$w_delete configure -state normal
}
}
method _delete {} {
if {[catch {set check_cmt [$w_check commit_or_die]}]} {
return
}
set to_delete [list]
set not_merged [list]
foreach i [$w_heads curselection] {
set b [$w_heads get $i]
if {[catch {
set o [git rev-parse --verify "refs/heads/$b"]
}]} continue
if {$check_cmt ne {}} {
if {[catch {set m [git merge-base $o $check_cmt]}]} continue
if {$o ne $m} {
lappend not_merged $b
continue
}
}
lappend to_delete [list $b $o]
}
if {$not_merged ne {}} {
set msg "The following branches are not completely merged into [$w_check get]:
- [join $not_merged "\n - "]"
tk_messageBox \
-icon info \
-type ok \
-title [wm title $w] \
-parent $w \
-message $msg
}
if {$to_delete eq {}} return
if {$check_cmt eq {}} {
set msg {Recovering deleted branches is difficult.
Delete the selected branches?}
if {[tk_messageBox \
-icon warning \
-type yesno \
-title [wm title $w] \
-parent $w \
-message $msg] ne yes} {
return
}
}
set failed {}
foreach i $to_delete {
set b [lindex $i 0]
set o [lindex $i 1]
if {[catch {git update-ref -d "refs/heads/$b" $o} err]} {
append failed " - $b: $err\n"
}
}
if {$failed ne {}} {
tk_messageBox \
-icon error \
-type ok \
-title [wm title $w] \
-parent $w \
-message "Failed to delete branches:\n$failed"
}
destroy $w
}
}

14
git-gui/lib/branch_rename.tcl
View File

@ -8,7 +8,7 @@ field oldname
field newname
constructor dialog {} {
global all_heads current_branch
global current_branch
make_toplevel top w
wm title $top "[appname] ([reponame]): Rename Branch"
@ -34,7 +34,7 @@ constructor dialog {} {
frame $w.rename
label $w.rename.oldname_l -text {Branch:}
eval tk_optionMenu $w.rename.oldname_m @oldname $all_heads
eval tk_optionMenu $w.rename.oldname_m @oldname [load_all_heads]
label $w.rename.newname_l -text {New Name:}
entry $w.rename.newname_t \
@ -64,7 +64,7 @@ constructor dialog {} {
}
method _rename {} {
global all_heads current_branch
global current_branch
if {$oldname eq {}} {
tk_messageBox \
@ -118,14 +118,6 @@ method _rename {} {
return
}
set oldidx [lsearch -exact -sorted $all_heads $oldname]
if {$oldidx >= 0} {
set all_heads [lreplace $all_heads $oldidx $oldidx]
}
lappend all_heads $newname
set all_heads [lsort $all_heads]
populate_branch_menu
if {$current_branch eq $oldname} {
set current_branch $newname
}

25
git-gui/lib/browser.tcl
View File

@ -11,6 +11,8 @@ field browser_status {Starting...}
field browser_stack {}
field browser_busy 1
field ls_buf {}; # Buffered record output from ls-tree
constructor new {commit} {
global cursor_ptr M1B
make_toplevel top w
@ -160,7 +162,7 @@ method _click {was_double_click pos} {
}
method _ls {tree_id {name {}}} {
set browser_buffer {}
set ls_buf {}
set browser_files {}
set browser_busy 1
@ -178,24 +180,25 @@ method _ls {tree_id {name {}}} {
lappend browser_stack [list $tree_id $name]
$w conf -state disabled
set cmd [list git ls-tree -z $tree_id]
set fd [open "| $cmd" r]
set fd [git_read ls-tree -z $tree_id]
fconfigure $fd -blocking 0 -translation binary -encoding binary
fileevent $fd readable [cb _read $fd]
}
method _read {fd} {
append browser_buffer [read $fd]
set pck [split $browser_buffer "\0"]
set browser_buffer [lindex $pck end]
append ls_buf [read $fd]
set pck [split $ls_buf "\0"]
set ls_buf [lindex $pck end]
set n [llength $browser_files]
$w conf -state normal
foreach p [lrange $pck 0 end-1] {
set info [split $p "\t"]
set path [lindex $info 1]
set info [split [lindex $info 0] { }]
set type [lindex $info 1]
set tab [string first "\t" $p]
if {$tab == -1} continue
set info [split [string range $p 0 [expr {$tab - 1}]] { }]
set path [string range $p [expr {$tab + 1}] end]
set type [lindex $info 1]
set object [lindex $info 2]
switch -- $type {
@ -225,7 +228,7 @@ method _read {fd} {
close $fd
set browser_status Ready.
set browser_busy 0
unset browser_buffer
set ls_buf {}
if {$n > 0} {
$w tag add in_sel 1.0 2.0
focus -force $w

579
git-gui/lib/checkout_op.tcl Normal file
View File

@ -0,0 +1,579 @@
# git-gui commit checkout support
# Copyright (C) 2007 Shawn Pearce
class checkout_op {
field w {}; # our window (if we have one)
field w_cons {}; # embedded console window object
field new_expr ; # expression the user saw/thinks this is
field new_hash ; # commit SHA-1 we are switching to
field new_ref ; # ref we are updating/creating
field parent_w .; # window that started us
field merge_type none; # type of merge to apply to existing branch
field fetch_spec {}; # refetch tracking branch if used?
field checkout 1; # actually checkout the branch?
field create 0; # create the branch if it doesn't exist?
field reset_ok 0; # did the user agree to reset?
field fetch_ok 0; # did the fetch succeed?
field readtree_d {}; # buffered output from read-tree
field update_old {}; # was the update-ref call deferred?
field reflog_msg {}; # log message for the update-ref call
constructor new {expr hash {ref {}}} {
set new_expr $expr
set new_hash $hash
set new_ref $ref
return $this
}
method parent {path} {
set parent_w [winfo toplevel $path]
}
method enable_merge {type} {
set merge_type $type
}
method enable_fetch {spec} {
set fetch_spec $spec
}
method enable_checkout {co} {
set checkout $co
}
method enable_create {co} {
set create $co
}
method run {} {
if {$fetch_spec ne {}} {
global M1B
# We were asked to refresh a single tracking branch
# before we get to work. We should do that before we
# consider any ref updating.
#
set fetch_ok 0
set l_trck [lindex $fetch_spec 0]
set remote [lindex $fetch_spec 1]
set r_head [lindex $fetch_spec 2]
regsub ^refs/heads/ $r_head {} r_name
_toplevel $this {Refreshing Tracking Branch}
set w_cons [::console::embed \
$w.console \
"Fetching $r_name from $remote"]
pack $w.console -fill both -expand 1
$w_cons exec \
[list git fetch $remote +$r_head:$l_trck] \
[cb _finish_fetch]
bind $w <$M1B-Key-w> break
bind $w <$M1B-Key-W> break
bind $w <Visibility> "
[list grab $w]
[list focus $w]
"
wm protocol $w WM_DELETE_WINDOW [cb _noop]
tkwait window $w
if {!$fetch_ok} {
delete_this
return 0
}
}
if {$new_ref ne {}} {
# If we have a ref we need to update it before we can
# proceed with a checkout (if one was enabled).
#
if {![_update_ref $this]} {
delete_this
return 0
}
}
if {$checkout} {
_checkout $this
return 1
}
delete_this
return 1
}
method _noop {} {}
method _finish_fetch {ok} {
if {$ok} {
set l_trck [lindex $fetch_spec 0]
if {[catch {set new_hash [git rev-parse --verify "$l_trck^0"]} err]} {
set ok 0
$w_cons insert "fatal: Cannot resolve $l_trck"
$w_cons insert $err
}
}
$w_cons done $ok
set w_cons {}
wm protocol $w WM_DELETE_WINDOW {}
if {$ok} {
destroy $w
set w {}
} else {
button $w.close -text Close -command [list destroy $w]
pack $w.close -side bottom -anchor e -padx 10 -pady 10
}
set fetch_ok $ok
}
method _update_ref {} {
global null_sha1 current_branch
set ref $new_ref
set new $new_hash
set is_current 0
set rh refs/heads/
set rn [string length $rh]
if {[string equal -length $rn $rh $ref]} {
set newbranch [string range $ref $rn end]
if {$current_branch eq $newbranch} {
set is_current 1
}
} else {
set newbranch $ref
}
if {[catch {set cur [git rev-parse --verify "$ref^0"]}]} {
# Assume it does not exist, and that is what the error was.
#
if {!$create} {
_error $this "Branch '$newbranch' does not exist."
return 0
}
set reflog_msg "branch: Created from $new_expr"
set cur $null_sha1
} elseif {$create && $merge_type eq {none}} {
# We were told to create it, but not do a merge.
# Bad. Name shouldn't have existed.
#
_error $this "Branch '$newbranch' already exists."
return 0
} elseif {!$create && $merge_type eq {none}} {
# We aren't creating, it exists and we don't merge.
# We are probably just a simple branch switch.
# Use whatever value we just read.
#
set new $cur
set new_hash $cur
} elseif {$new eq $cur} {
# No merge would be required, don't compute anything.
#
} else {
set mrb {}
catch {set mrb [git merge-base $new $cur]}
switch -- $merge_type {
ff {
if {$mrb eq $new} {
# The current branch is actually newer.
#
set new $cur
} elseif {$mrb eq $cur} {
# The current branch is older.
#
set reflog_msg "merge $new_expr: Fast-forward"
} else {
_error $this "Branch '$newbranch' already exists.\n\nIt cannot fast-forward to $new_expr.\nA merge is required."
return 0
}
}
reset {
if {$mrb eq $cur} {
# The current branch is older.
#
set reflog_msg "merge $new_expr: Fast-forward"
} else {
# The current branch will lose things.
#
if {[_confirm_reset $this $cur]} {
set reflog_msg "reset $new_expr"
} else {
return 0
}
}
}
default {
_error $this "Only 'ff' and 'reset' merge is currently supported."
return 0
}
}
}
if {$new ne $cur} {
if {$is_current} {
# No so fast. We should defer this in case
# we cannot update the working directory.
#
set update_old $cur
return 1
}
if {[catch {
git update-ref -m $reflog_msg $ref $new $cur
} err]} {
_error $this "Failed to update '$newbranch'.\n\n$err"
return 0
}
}
return 1
}
method _checkout {} {
if {[lock_index checkout_op]} {
after idle [cb _start_checkout]
} else {
_error $this "Index is already locked."
delete_this
}
}
method _start_checkout {} {
global HEAD commit_type
# -- Our in memory state should match the repository.
#
repository_state curType curHEAD curMERGE_HEAD
if {[string match amend* $commit_type]
&& $curType eq {normal}
&& $curHEAD eq $HEAD} {
} elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
info_popup {Last scanned state does not match repository state.
Another Git program has modified this repository since the last scan. A rescan must be performed before the current branch can be changed.
The rescan will be automatically started now.
}
unlock_index
rescan ui_ready
delete_this
return
}
if {[is_config_true gui.trustmtime]} {
_readtree $this
} else {
ui_status {Refreshing file status...}
set fd [git_read update-index \
-q \
--unmerged \
--ignore-missing \
--refresh \
]
fconfigure $fd -blocking 0 -translation binary
fileevent $fd readable [cb _refresh_wait $fd]
}
}
method _refresh_wait {fd} {
read $fd
if {[eof $fd]} {
close $fd
_readtree $this
}
}
method _name {} {
if {$new_ref eq {}} {
return [string range $new_hash 0 7]
}
set rh refs/heads/
set rn [string length $rh]
if {[string equal -length $rn $rh $new_ref]} {
return [string range $new_ref $rn end]
} else {
return $new_ref
}
}
method _readtree {} {
global HEAD
set readtree_d {}
$::main_status start \
"Updating working directory to '[_name $this]'..." \
{files checked out}
set fd [git_read --stderr read-tree \
-m \
-u \
-v \
--exclude-per-directory=.gitignore \
$HEAD \
$new_hash \
]
fconfigure $fd -blocking 0 -translation binary
fileevent $fd readable [cb _readtree_wait $fd]
}
method _readtree_wait {fd} {
global current_branch
set buf [read $fd]
$::main_status update_meter $buf
append readtree_d $buf
fconfigure $fd -blocking 1
if {![eof $fd]} {
fconfigure $fd -blocking 0
return
}
if {[catch {close $fd}]} {
set err $readtree_d
regsub {^fatal: } $err {} err
$::main_status stop "Aborted checkout of '[_name $this]' (file level merging is required)."
warn_popup "File level merge required.
$err
Staying on branch '$current_branch'."
unlock_index
delete_this
return
}
$::main_status stop
_after_readtree $this
}
method _after_readtree {} {
global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
global current_branch is_detached
global ui_comm
set name [_name $this]
set log "checkout: moving"
if {!$is_detached} {
append log " from $current_branch"
}
# -- Move/create HEAD as a symbolic ref. Core git does not
# even check for failure here, it Just Works(tm). If it
# doesn't we are in some really ugly state that is difficult
# to recover from within git-gui.
#
set rh refs/heads/
set rn [string length $rh]
if {[string equal -length $rn $rh $new_ref]} {
set new_branch [string range $new_ref $rn end]
append log " to $new_branch"
if {[catch {
git symbolic-ref -m $log HEAD $new_ref
} err]} {
_fatal $this $err
}
set current_branch $new_branch
set is_detached 0
} else {
append log " to $new_expr"
if {[catch {
_detach_HEAD $log $new_hash
} err]} {
_fatal $this $err
}
set current_branch HEAD
set is_detached 1
}
# -- We had to defer updating the branch itself until we
# knew the working directory would update. So now we
# need to finish that work. If it fails we're in big
# trouble.
#
if {$update_old ne {}} {
if {[catch {
git update-ref \
-m $reflog_msg \
$new_ref \
$new_hash \
$update_old
} err]} {
_fatal $this $err
}
}
if {$is_detached} {
info_popup "You are no longer on a local branch.
If you wanted to be on a branch, create one now starting from 'This Detached Checkout'."
}
# -- Update our repository state. If we were previously in
# amend mode we need to toss the current buffer and do a
# full rescan to update our file lists. If we weren't in
# amend mode our file lists are accurate and we can avoid
# the rescan.
#
unlock_index
set selected_commit_type new
if {[string match amend* $commit_type]} {
$ui_comm delete 0.0 end
$ui_comm edit reset
$ui_comm edit modified false
rescan [list ui_status "Checked out '$name'."]
} else {
repository_state commit_type HEAD MERGE_HEAD
set PARENT $HEAD
ui_status "Checked out '$name'."
}
delete_this
}
git-version proc _detach_HEAD {log new} {
>= 1.5.3 {
git update-ref --no-deref -m $log HEAD $new
}
default {
set p [gitdir HEAD]
file delete $p
set fd [open $p w]
fconfigure $fd -translation lf -encoding utf-8
puts $fd $new
close $fd
}
}
method _confirm_reset {cur} {
set reset_ok 0
set name [_name $this]
set gitk [list do_gitk [list $cur ^$new_hash]]
_toplevel $this {Confirm Branch Reset}
pack [label $w.msg1 \
-anchor w \
-justify left \
-text "Resetting '$name' to $new_expr will lose the following commits:" \
] -anchor w
set list $w.list.l
frame $w.list
text $list \
-font font_diff \
-width 80 \
-height 10 \
-wrap none \
-xscrollcommand [list $w.list.sbx set] \
-yscrollcommand [list $w.list.sby set]
scrollbar $w.list.sbx -orient h -command [list $list xview]
scrollbar $w.list.sby -orient v -command [list $list yview]
pack $w.list.sbx -fill x -side bottom
pack $w.list.sby -fill y -side right
pack $list -fill both -expand 1
pack $w.list -fill both -expand 1 -padx 5 -pady 5
pack [label $w.msg2 \
-anchor w \
-justify left \
-text {Recovering lost commits may not be easy.} \
]
pack [label $w.msg3 \
-anchor w \
-justify left \
-text "Reset '$name'?" \
]
frame $w.buttons
button $w.buttons.visualize \
-text Visualize \
-command $gitk
pack $w.buttons.visualize -side left
button $w.buttons.reset \
-text Reset \
-command "
set @reset_ok 1
destroy $w
"
pack $w.buttons.reset -side right
button $w.buttons.cancel \
-default active \
-text Cancel \
-command [list destroy $w]
pack $w.buttons.cancel -side right -padx 5
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
set fd [git_read rev-list --pretty=oneline $cur ^$new_hash]
while {[gets $fd line] > 0} {
set abbr [string range $line 0 7]
set subj [string range $line 41 end]
$list insert end "$abbr $subj\n"
}
close $fd
$list configure -state disabled
bind $w <Key-v> $gitk
bind $w <Visibility> "
grab $w
focus $w.buttons.cancel
"
bind $w <Key-Return> [list destroy $w]
bind $w <Key-Escape> [list destroy $w]
tkwait window $w
return $reset_ok
}
method _error {msg} {
if {[winfo ismapped $parent_w]} {
set p $parent_w
} else {
set p .
}
tk_messageBox \
-icon error \
-type ok \
-title [wm title $p] \
-parent $p \
-message $msg
}
method _toplevel {title} {
regsub -all {::} $this {__} w
set w .$w
if {[winfo ismapped $parent_w]} {
set p $parent_w
} else {
set p .
}
toplevel $w
wm title $w $title
wm geometry $w "+[winfo rootx $p]+[winfo rooty $p]"
}
method _fatal {err} {
error_popup "Failed to set current branch.
This working directory is only partially switched. We successfully updated your files, but failed to update an internal Git file.
This should not have occurred. [appname] will now close and give up.
$err"
exit 1
}
}

367
git-gui/lib/choose_rev.tcl Normal file
View File

@ -0,0 +1,367 @@
# git-gui revision chooser
# Copyright (C) 2006, 2007 Shawn Pearce
class choose_rev {
image create photo ::choose_rev::img_find -data {R0lGODlhEAAQAIYAAPwCBCQmJDw+PBQSFAQCBMza3NTm5MTW1HyChOT29Ozq7MTq7Kze5Kzm7Oz6/NTy9Iza5GzGzKzS1Nzy9Nz29Kzq9HTGzHTK1Lza3AwKDLzu9JTi7HTW5GTCzITO1Mzq7Hza5FTK1ESyvHzKzKzW3DQyNDyqtDw6PIzW5HzGzAT+/Dw+RKyurNTOzMTGxMS+tJSGdATCxHRydLSqpLymnLSijBweHERCRNze3Pz69PTy9Oze1OTSxOTGrMSqlLy+vPTu5OzSvMymjNTGvNS+tMy2pMyunMSefAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAe4gACCAAECA4OIiAIEBQYHBAKJgwIICQoLDA0IkZIECQ4PCxARCwSSAxITFA8VEBYXGBmJAQYLGhUbHB0eH7KIGRIMEBAgISIjJKaIJQQLFxERIialkieUGigpKRoIBCqJKyyLBwvJAioEyoICLS4v6QQwMQQyLuqLli8zNDU2BCf1lN3AkUPHDh49fAQAAEnGD1MCCALZEaSHkIUMBQS8wWMIkSJGhBzBmFEGgRsBUqpMiSgdAD+BAAAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7}
field w ; # our megawidget path
field w_list ; # list of currently filtered specs
field w_filter ; # filter entry for $w_list
field c_expr {}; # current revision expression
field filter ; # current filter string
field revtype head; # type of revision chosen
field cur_specs [list]; # list of specs for $revtype
field spec_head ; # list of all head specs
field spec_trck ; # list of all tracking branch specs
field spec_tag ; # list of all tag specs
constructor new {path {title {}}} {
global current_branch is_detached
set w $path
if {$title ne {}} {
labelframe $w -text $title
} else {
frame $w
}
bind $w <Destroy> [cb _delete %W]
if {$is_detached} {
radiobutton $w.detachedhead_r \
-anchor w \
-text {This Detached Checkout} \
-value HEAD \
-variable @revtype
grid $w.detachedhead_r -sticky we -padx {0 5} -columnspan 2
}
radiobutton $w.expr_r \
-text {Revision Expression:} \
-value expr \
-variable @revtype
entry $w.expr_t \
-borderwidth 1 \
-relief sunken \
-width 50 \
-textvariable @c_expr \
-validate key \
-validatecommand [cb _validate %d %S]
grid $w.expr_r $w.expr_t -sticky we -padx {0 5}
frame $w.types
radiobutton $w.types.head_r \
-text {Local Branch} \
-value head \
-variable @revtype
pack $w.types.head_r -side left
radiobutton $w.types.trck_r \
-text {Tracking Branch} \
-value trck \
-variable @revtype
pack $w.types.trck_r -side left
radiobutton $w.types.tag_r \
-text {Tag} \
-value tag \
-variable @revtype
pack $w.types.tag_r -side left
set w_filter $w.types.filter
entry $w_filter \
-borderwidth 1 \
-relief sunken \
-width 12 \
-textvariable @filter \
-validate key \
-validatecommand [cb _filter %P]
pack $w_filter -side right
pack [label $w.types.filter_icon \
-image ::choose_rev::img_find \
] -side right
grid $w.types -sticky we -padx {0 5} -columnspan 2
frame $w.list
set w_list $w.list.l
listbox $w_list \
-font font_diff \
-width 50 \
-height 5 \
-selectmode browse \
-exportselection false \
-xscrollcommand [cb _sb_set $w.list.sbx h] \
-yscrollcommand [cb _sb_set $w.list.sby v]
pack $w_list -fill both -expand 1
grid $w.list -sticky nswe -padx {20 5} -columnspan 2
grid columnconfigure $w 1 -weight 1
if {$is_detached} {
grid rowconfigure $w 3 -weight 1
} else {
grid rowconfigure $w 2 -weight 1
}
trace add variable @revtype write [cb _select]
bind $w_filter <Key-Return> [list focus $w_list]\;break
bind $w_filter <Key-Down> [list focus $w_list]
set spec_head [list]
foreach name [load_all_heads] {
lappend spec_head [list $name refs/heads/$name]
}
set spec_trck [list]
foreach spec [all_tracking_branches] {
set name [lindex $spec 0]
regsub ^refs/(heads|remotes)/ $name {} name
lappend spec_trck [concat $name $spec]
}
set spec_tag [list]
foreach name [load_all_tags] {
lappend spec_tag [list $name refs/tags/$name]
}
if {$is_detached} { set revtype HEAD
} elseif {[llength $spec_head] > 0} { set revtype head
} elseif {[llength $spec_trck] > 0} { set revtype trck
} elseif {[llength $spec_tag ] > 0} { set revtype tag
} else { set revtype expr
}
if {$revtype eq {head} && $current_branch ne {}} {
set i 0
foreach spec $spec_head {
if {[lindex $spec 0] eq $current_branch} {
$w_list selection clear 0 end
$w_list selection set $i
break
}
incr i
}
}
return $this
}
method none {text} {
if {![winfo exists $w.none_r]} {
radiobutton $w.none_r \
-anchor w \
-value none \
-variable @revtype
grid $w.none_r -sticky we -padx {0 5} -columnspan 2
}
$w.none_r configure -text $text
}
method get {} {
switch -- $revtype {
head -
trck -
tag {
set i [$w_list curselection]
if {$i ne {}} {
return [lindex $cur_specs $i 0]
} else {
return {}
}
}
HEAD { return HEAD }
expr { return $c_expr }
none { return {} }
default { error "unknown type of revision" }
}
}
method pick_tracking_branch {} {
set revtype trck
}
method focus_filter {} {
if {[$w_filter cget -state] eq {normal}} {
focus $w_filter
}
}
method bind_listbox {event script} {
bind $w_list $event $script
}
method get_local_branch {} {
if {$revtype eq {head}} {
return [_expr $this]
} else {
return {}
}
}
method get_tracking_branch {} {
set i [$w_list curselection]
if {$i eq {} || $revtype ne {trck}} {
return {}
}
return [lrange [lindex $cur_specs $i] 1 end]
}
method get_commit {} {
set e [_expr $this]
if {$e eq {}} {
return {}
}
return [git rev-parse --verify "$e^0"]
}
method commit_or_die {} {
if {[catch {set new [get_commit $this]} err]} {
# Cleanup the not-so-friendly error from rev-parse.
#
regsub {^fatal:\s*} $err {} err
if {$err eq {Needed a single revision}} {
set err {}
}
set top [winfo toplevel $w]
set msg "Invalid revision: [get $this]\n\n$err"
tk_messageBox \
-icon error \
-type ok \
-title [wm title $top] \
-parent $top \
-message $msg
error $msg
}
return $new
}
method _expr {} {
switch -- $revtype {
head -
trck -
tag {
set i [$w_list curselection]
if {$i ne {}} {
return [lindex $cur_specs $i 1]
} else {
error "No revision selected."
}
}
expr {
if {$c_expr ne {}} {
return $c_expr
} else {
error "Revision expression is empty."
}
}
HEAD { return HEAD }
none { return {} }
default { error "unknown type of revision" }
}
}
method _validate {d S} {
if {$d == 1} {
if {[regexp {\s} $S]} {
return 0
}
if {[string length $S] > 0} {
set revtype expr
}
}
return 1
}
method _filter {P} {
if {[regexp {\s} $P]} {
return 0
}
_rebuild $this $P
return 1
}
method _select {args} {
_rebuild $this $filter
focus_filter $this
}
method _rebuild {pat} {
set ste normal
switch -- $revtype {
head { set new $spec_head }
trck { set new $spec_trck }
tag { set new $spec_tag }
expr -
HEAD -
none {
set new [list]
set ste disabled
}
}
if {[$w_list cget -state] eq {disabled}} {
$w_list configure -state normal
}
$w_list delete 0 end
if {$pat ne {}} {
set pat *${pat}*
}
set cur_specs [list]
foreach spec $new {
set txt [lindex $spec 0]
if {$pat eq {} || [string match $pat $txt]} {
lappend cur_specs $spec
$w_list insert end $txt
}
}
if {$cur_specs ne {}} {
$w_list selection clear 0 end
$w_list selection set 0
}
if {[$w_filter cget -state] ne $ste} {
$w_list configure -state $ste
$w_filter configure -state $ste
}
}
method _delete {current} {
if {$current eq $w} {
delete_this
}
}
method _sb_set {sb orient first last} {
set old_focus [focus -lastfor $w]
if {$first == 0 && $last == 1} {
if {[winfo exists $sb]} {
destroy $sb
if {$old_focus ne {}} {
update
focus $old_focus
}
}
return
}
if {![winfo exists $sb]} {
if {$orient eq {h}} {
scrollbar $sb -orient h -command [list $w_list xview]
pack $sb -fill x -side bottom -before $w_list
} else {
scrollbar $sb -orient v -command [list $w_list yview]
pack $sb -fill y -side right -before $w_list
}
if {$old_focus ne {}} {
update
focus $old_focus
}
}
$sb set $first $last
}
}

38
git-gui/lib/class.tcl
View File

@ -5,7 +5,7 @@ proc class {class body} {
if {[namespace exists $class]} {
error "class $class already declared"
}
namespace eval $class {
namespace eval $class "
variable __nextid 0
variable __sealed 0
variable __field_list {}
@ -13,10 +13,9 @@ proc class {class body} {
proc cb {name args} {
upvar this this
set args [linsert $args 0 $name $this]
return [uplevel [list namespace code $args]]
concat \[list ${class}::\$name \$this\] \$args
}
}
"
namespace eval $class $body
}
@ -51,15 +50,16 @@ proc constructor {name params body} {
set mbodyc {}
append mbodyc {set this } $class
append mbodyc {::__o[incr } $class {::__nextid]} \;
append mbodyc {namespace eval $this {}} \;
append mbodyc {::__o[incr } $class {::__nextid]::__d} \;
append mbodyc {create_this } $class \;
append mbodyc {set __this [namespace qualifiers $this]} \;
if {$__field_list ne {}} {
append mbodyc {upvar #0}
foreach n $__field_list {
set n [lindex $n 0]
append mbodyc { ${this}::} $n { } $n
regsub -all @$n\\M $body "\${this}::$n" body
append mbodyc { ${__this}::} $n { } $n
regsub -all @$n\\M $body "\${__this}::$n" body
}
append mbodyc \;
foreach n $__field_list {
@ -80,10 +80,12 @@ proc method {name params body {deleted {}} {del_body {}}} {
set params [linsert $params 0 this]
set mbodyc {}
append mbodyc {set __this [namespace qualifiers $this]} \;
switch $deleted {
{} {}
ifdeleted {
append mbodyc {if {![namespace exists $this]} }
append mbodyc {if {![namespace exists $__this]} }
append mbodyc \{ $del_body \; return \} \;
}
default {
@ -98,10 +100,12 @@ proc method {name params body {deleted {}} {del_body {}}} {
if { [regexp -all -- $n\\M $body] == 1
&& [regexp -all -- \\\$$n\\M $body] == 1
&& [regexp -all -- \\\$$n\\( $body] == 0} {
regsub -all \\\$$n\\M $body "\[set \${this}::$n\]" body
regsub -all \
\\\$$n\\M $body \
"\[set \${__this}::$n\]" body
} else {
append decl { ${this}::} $n { } $n
regsub -all @$n\\M $body "\${this}::$n" body
append decl { ${__this}::} $n { } $n
regsub -all @$n\\M $body "\${__this}::$n" body
}
}
}
@ -112,11 +116,21 @@ proc method {name params body {deleted {}} {del_body {}}} {
namespace eval $class [list proc $name $params $mbodyc]
}
proc create_this {class} {
upvar this this
namespace eval [namespace qualifiers $this] [list proc \
[namespace tail $this] \
[list name args] \
"eval \[list ${class}::\$name $this\] \$args" \
]
}
proc delete_this {{t {}}} {
if {$t eq {}} {
upvar this this
set t $this
}
set t [namespace qualifiers $t]
if {[namespace exists $t]} {namespace delete $t}
}

65
git-gui/lib/commit.tcl
View File

@ -25,7 +25,7 @@ You are currently in the middle of a merge that has not been fully completed. Y
set msg {}
set parents [list]
if {[catch {
set fd [open "| git cat-file commit $curHEAD" r]
set fd [git_read cat-file commit $curHEAD]
fconfigure $fd -encoding binary -translation lf
if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
set enc utf-8
@ -58,7 +58,7 @@ You are currently in the middle of a merge that has not been fully completed. Y
$ui_comm insert end $msg
$ui_comm edit reset
$ui_comm edit modified false
rescan {set ui_status_value {Ready.}}
rescan ui_ready
}
set GIT_COMMITTER_IDENT {}
@ -108,12 +108,12 @@ proc create_new_commit {} {
$ui_comm delete 0.0 end
$ui_comm edit reset
$ui_comm edit modified false
rescan {set ui_status_value {Ready.}}
rescan ui_ready
}
proc commit_tree {} {
global HEAD commit_type file_states ui_comm repo_config
global ui_status_value pch_error
global pch_error
if {[committer_ident] eq {}} return
if {![lock_index update]} return
@ -132,7 +132,7 @@ Another Git program has modified this repository since the last scan. A rescan
The rescan will be automatically started now.
}
unlock_index
rescan {set ui_status_value {Ready.}}
rescan ui_ready
return
}
@ -206,7 +206,7 @@ A good commit message has the following format:
return
}
set ui_status_value {Calling pre-commit hook...}
ui_status {Calling pre-commit hook...}
set pch_error {}
set fd_ph [open "| $pchook" r]
fconfigure $fd_ph -blocking 0 -translation binary
@ -215,13 +215,13 @@ A good commit message has the following format:
}
proc commit_prehook_wait {fd_ph curHEAD msg} {
global pch_error ui_status_value
global pch_error
append pch_error [read $fd_ph]
fconfigure $fd_ph -blocking 1
if {[eof $fd_ph]} {
if {[catch {close $fd_ph}]} {
set ui_status_value {Commit declined by pre-commit hook.}
ui_status {Commit declined by pre-commit hook.}
hook_failed_popup pre-commit $pch_error
unlock_index
} else {
@ -234,25 +234,23 @@ proc commit_prehook_wait {fd_ph curHEAD msg} {
}
proc commit_writetree {curHEAD msg} {
global ui_status_value
set ui_status_value {Committing changes...}
set fd_wt [open "| git write-tree" r]
ui_status {Committing changes...}
set fd_wt [git_read write-tree]
fileevent $fd_wt readable \
[list commit_committree $fd_wt $curHEAD $msg]
}
proc commit_committree {fd_wt curHEAD msg} {
global HEAD PARENT MERGE_HEAD commit_type
global all_heads current_branch
global ui_status_value ui_comm selected_commit_type
global current_branch
global ui_comm selected_commit_type
global file_states selected_paths rescan_active
global repo_config
gets $fd_wt tree_id
if {$tree_id eq {} || [catch {close $fd_wt} err]} {
error_popup "write-tree failed:\n\n$err"
set ui_status_value {Commit failed.}
ui_status {Commit failed.}
unlock_index
return
}
@ -260,7 +258,18 @@ proc commit_committree {fd_wt curHEAD msg} {
# -- Verify this wasn't an empty change.
#
if {$commit_type eq {normal}} {
set old_tree [git rev-parse "$PARENT^{tree}"]
set fd_ot [git_read cat-file commit $PARENT]
fconfigure $fd_ot -encoding binary -translation lf
set old_tree [gets $fd_ot]
close $fd_ot
if {[string equal -length 5 {tree } $old_tree]
&& [string length $old_tree] == 45} {
set old_tree [string range $old_tree 5 end]
} else {
error "Commit $PARENT appears to be corrupt"
}
if {$tree_id eq $old_tree} {
info_popup {No changes to commit.
@ -269,7 +278,7 @@ No files were modified by this commit and it was not a merge commit.
A rescan will be automatically started now.
}
unlock_index
rescan {set ui_status_value {No changes to commit.}}
rescan {ui_status {No changes to commit.}}
return
}
}
@ -294,7 +303,7 @@ A rescan will be automatically started now.
lappend cmd <$msg_p
if {[catch {set cmt_id [eval git $cmd]} err]} {
error_popup "commit-tree failed:\n\n$err"
set ui_status_value {Commit failed.}
ui_status {Commit failed.}
unlock_index
return
}
@ -316,7 +325,7 @@ A rescan will be automatically started now.
git update-ref -m $reflogm HEAD $cmt_id $curHEAD
} err]} {
error_popup "update-ref failed:\n\n$err"
set ui_status_value {Commit failed.}
ui_status {Commit failed.}
unlock_index
return
}
@ -331,7 +340,12 @@ A rescan will be automatically started now.
# -- Let rerere do its thing.
#
if {[file isdirectory [gitdir rr-cache]]} {
if {[get_config rerere.enabled] eq {}} {
set rerere [file isdirectory [gitdir rr-cache]]
} else {
set rerere [is_config_true rerere.enabled]
}
if {$rerere} {
catch {git rerere}
}
@ -356,14 +370,6 @@ A rescan will be automatically started now.
if {[is_enabled singlecommit]} do_quit
# -- Make sure our current branch exists.
#
if {$commit_type eq {initial}} {
lappend all_heads $current_branch
set all_heads [lsort -unique $all_heads]
populate_branch_menu
}
# -- Update in memory status
#
set selected_commit_type new
@ -405,6 +411,5 @@ A rescan will be automatically started now.
display_all_files
unlock_index
reshow_diff
set ui_status_value \
"Created commit [string range $cmt_id 0 7]: $subject"
ui_status "Created commit [string range $cmt_id 0 7]: $subject"
}

73
git-gui/lib/console.tcl
View File

@ -7,6 +7,7 @@ field t_short
field t_long
field w
field console_cr
field is_toplevel 1; # are we our own window?
constructor new {short_title long_title} {
set t_short $short_title
@ -15,10 +16,25 @@ constructor new {short_title long_title} {
return $this
}
constructor embed {path title} {
set t_short {}
set t_long $title
set w $path
set is_toplevel 0
_init $this
return $this
}
method _init {} {
global M1B
make_toplevel top w -autodelete 0
wm title $top "[appname] ([reponame]): $t_short"
if {$is_toplevel} {
make_toplevel top w -autodelete 0
wm title $top "[appname] ([reponame]): $t_short"
} else {
frame $w
}
set console_cr 1.0
frame $w.m
@ -31,16 +47,20 @@ method _init {} {
-background white -borderwidth 1 \
-relief sunken \
-width 80 -height 10 \
-wrap none \
-font font_diff \
-state disabled \
-xscrollcommand [list $w.m.sbx set] \
-yscrollcommand [list $w.m.sby set]
label $w.m.s -text {Working... please wait...} \
-anchor w \
-justify left \
-font font_uibold
scrollbar $w.m.sbx -command [list $w.m.t xview] -orient h
scrollbar $w.m.sby -command [list $w.m.t yview]
pack $w.m.l1 -side top -fill x
pack $w.m.s -side bottom -fill x
pack $w.m.sbx -side bottom -fill x
pack $w.m.sby -side right -fill y
pack $w.m.t -side left -fill both -expand 1
pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
@ -57,31 +77,26 @@ method _init {} {
$w.m.t tag remove sel 0.0 end
"
button $w.ok -text {Close} \
-state disabled \
-command "destroy $w"
pack $w.ok -side bottom -anchor e -pady 10 -padx 10
if {$is_toplevel} {
button $w.ok -text {Close} \
-state disabled \
-command [list destroy $w]
pack $w.ok -side bottom -anchor e -pady 10 -padx 10
bind $w <Visibility> [list focus $w]
}
bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
bind $w <Visibility> "focus $w"
}
method exec {cmd {after {}}} {
# -- Cygwin's Tcl tosses the enviroment when we exec our child.
# But most users need that so we have to relogin. :-(
#
if {[is_Cygwin]} {
set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
if {[lindex $cmd 0] eq {git}} {
set fd_f [eval git_read --stderr [lrange $cmd 1 end]]
} else {
lappend cmd 2>@1
set fd_f [_open_stdout_stderr $cmd]
}
# -- Tcl won't let us redirect both stdout and stderr to
# the same pipe. So pass it through cat...
#
set cmd [concat | $cmd |& cat]
set fd_f [open $cmd r]
fconfigure $fd_f -blocking 0 -translation binary
fileevent $fd_f readable [cb _read $fd_f $after]
}
@ -155,20 +170,32 @@ method chain {cmdlist {ok 1}} {
}
}
method insert {txt} {
if {![winfo exists $w.m.t]} {_init $this}
$w.m.t conf -state normal
$w.m.t insert end "$txt\n"
set console_cr [$w.m.t index {end -1c}]
$w.m.t conf -state disabled
}
method done {ok} {
if {$ok} {
if {[winfo exists $w.m.s]} {
$w.m.s conf -background green -text {Success}
$w.ok conf -state normal
focus $w.ok
if {$is_toplevel} {
$w.ok conf -state normal
focus $w.ok
}
}
} else {
if {![winfo exists $w.m.s]} {
_init $this
}
$w.m.s conf -background red -text {Error: Command Failed}
$w.ok conf -state normal
focus $w.ok
if {$is_toplevel} {
$w.ok conf -state normal
focus $w.ok
}
}
delete_this
}

2
git-gui/lib/database.tcl
View File

@ -2,7 +2,7 @@
# Copyright (C) 2006, 2007 Shawn Pearce
proc do_stats {} {
set fd [open "| git count-objects -v" r]
set fd [git_read count-objects -v]
while {[gets $fd line] > 0} {
if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
set stats($name) $value

26
git-gui/lib/diff.tcl
View File

@ -17,7 +17,7 @@ proc clear_diff {} {
}
proc reshow_diff {} {
global ui_status_value file_states file_lists
global file_states file_lists
global current_diff_path current_diff_side
set p $current_diff_path
@ -49,13 +49,13 @@ A rescan will be automatically started to find other files which may have the sa
clear_diff
display_file $path __
rescan {set ui_status_value {Ready.}} 0
rescan ui_ready 0
}
proc show_diff {path w {lno {}}} {
global file_states file_lists
global is_3way_diff diff_active repo_config
global ui_diff ui_status_value ui_index ui_workdir
global ui_diff ui_index ui_workdir
global current_diff_path current_diff_side current_diff_header
if {$diff_active || ![lock_index read]} return
@ -78,7 +78,7 @@ proc show_diff {path w {lno {}}} {
set current_diff_path $path
set current_diff_side $w
set current_diff_header {}
set ui_status_value "Loading diff of [escape_path $path]..."
ui_status "Loading diff of [escape_path $path]..."
# - Git won't give us the diff, there's nothing to compare to!
#
@ -92,7 +92,7 @@ proc show_diff {path w {lno {}}} {
} err ]} {
set diff_active 0
unlock_index
set ui_status_value "Unable to display [escape_path $path]"
ui_status "Unable to display [escape_path $path]"
error_popup "Error loading file:\n\n$err"
return
}
@ -127,11 +127,11 @@ proc show_diff {path w {lno {}}} {
$ui_diff conf -state disabled
set diff_active 0
unlock_index
set ui_status_value {Ready.}
ui_ready
return
}
set cmd [list | git]
set cmd [list]
if {$w eq $ui_index} {
lappend cmd diff-index
lappend cmd --cached
@ -154,10 +154,10 @@ proc show_diff {path w {lno {}}} {
lappend cmd --
lappend cmd $path
if {[catch {set fd [open $cmd r]} err]} {
if {[catch {set fd [eval git_read --nice $cmd]} err]} {
set diff_active 0
unlock_index
set ui_status_value "Unable to display [escape_path $path]"
ui_status "Unable to display [escape_path $path]"
error_popup "Error loading diff:\n\n$err"
return
}
@ -170,7 +170,7 @@ proc show_diff {path w {lno {}}} {
}
proc read_diff {fd} {
global ui_diff ui_status_value diff_active
global ui_diff diff_active
global is_3way_diff current_diff_header
$ui_diff conf -state normal
@ -256,7 +256,7 @@ proc read_diff {fd} {
close $fd
set diff_active 0
unlock_index
set ui_status_value {Ready.}
ui_ready
if {[$ui_diff index end] eq {2.0}} {
handle_empty_diff
@ -271,7 +271,7 @@ proc apply_hunk {x y} {
if {$current_diff_path eq {} || $current_diff_header eq {}} return
if {![lock_index apply_hunk]} return
set apply_cmd {git apply --cached --whitespace=nowarn}
set apply_cmd {apply --cached --whitespace=nowarn}
set mi [lindex $file_states($current_diff_path) 0]
if {$current_diff_side eq $ui_index} {
set mode unstage
@ -301,7 +301,7 @@ proc apply_hunk {x y} {
}
if {[catch {
set p [open "| $apply_cmd" w]
set p [eval git_write $apply_cmd]
fconfigure $p -translation binary -encoding binary
puts -nonewline $p $current_diff_header
puts -nonewline $p [$ui_diff get $s_lno $e_lno]

48
git-gui/lib/index.tcl
View File

@ -2,7 +2,7 @@
# Copyright (C) 2006, 2007 Shawn Pearce
proc update_indexinfo {msg pathList after} {
global update_index_cp ui_status_value
global update_index_cp
if {![lock_index update]} return
@ -12,12 +12,12 @@ proc update_indexinfo {msg pathList after} {
set batch [expr {int($totalCnt * .01) + 1}]
if {$batch > 25} {set batch 25}
set ui_status_value [format \
ui_status [format \
"$msg... %i/%i files (%.2f%%)" \
$update_index_cp \
$totalCnt \
0.0]
set fd [open "| git update-index -z --index-info" w]
set fd [git_write update-index -z --index-info]
fconfigure $fd \
-blocking 0 \
-buffering full \
@ -36,7 +36,7 @@ proc update_indexinfo {msg pathList after} {
}
proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
global update_index_cp ui_status_value
global update_index_cp
global file_states current_diff_path
if {$update_index_cp >= $totalCnt} {
@ -67,7 +67,7 @@ proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
display_file $path $new
}
set ui_status_value [format \
ui_status [format \
"$msg... %i/%i files (%.2f%%)" \
$update_index_cp \
$totalCnt \
@ -75,7 +75,7 @@ proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
}
proc update_index {msg pathList after} {
global update_index_cp ui_status_value
global update_index_cp
if {![lock_index update]} return
@ -85,12 +85,12 @@ proc update_index {msg pathList after} {
set batch [expr {int($totalCnt * .01) + 1}]
if {$batch > 25} {set batch 25}
set ui_status_value [format \
ui_status [format \
"$msg... %i/%i files (%.2f%%)" \
$update_index_cp \
$totalCnt \
0.0]
set fd [open "| git update-index --add --remove -z --stdin" w]
set fd [git_write update-index --add --remove -z --stdin]
fconfigure $fd \
-blocking 0 \
-buffering full \
@ -109,7 +109,7 @@ proc update_index {msg pathList after} {
}
proc write_update_index {fd pathList totalCnt batch msg after} {
global update_index_cp ui_status_value
global update_index_cp
global file_states current_diff_path
if {$update_index_cp >= $totalCnt} {
@ -144,7 +144,7 @@ proc write_update_index {fd pathList totalCnt batch msg after} {
display_file $path $new
}
set ui_status_value [format \
ui_status [format \
"$msg... %i/%i files (%.2f%%)" \
$update_index_cp \
$totalCnt \
@ -152,7 +152,7 @@ proc write_update_index {fd pathList totalCnt batch msg after} {
}
proc checkout_index {msg pathList after} {
global update_index_cp ui_status_value
global update_index_cp
if {![lock_index update]} return
@ -162,18 +162,18 @@ proc checkout_index {msg pathList after} {
set batch [expr {int($totalCnt * .01) + 1}]
if {$batch > 25} {set batch 25}
set ui_status_value [format \
ui_status [format \
"$msg... %i/%i files (%.2f%%)" \
$update_index_cp \
$totalCnt \
0.0]
set cmd [list git checkout-index]
lappend cmd --index
lappend cmd --quiet
lappend cmd --force
lappend cmd -z
lappend cmd --stdin
set fd [open "| $cmd " w]
set fd [git_write checkout-index \
--index \
--quiet \
--force \
-z \
--stdin \
]
fconfigure $fd \
-blocking 0 \
-buffering full \
@ -192,7 +192,7 @@ proc checkout_index {msg pathList after} {
}
proc write_checkout_index {fd pathList totalCnt batch msg after} {
global update_index_cp ui_status_value
global update_index_cp
global file_states current_diff_path
if {$update_index_cp >= $totalCnt} {
@ -217,7 +217,7 @@ proc write_checkout_index {fd pathList totalCnt batch msg after} {
}
}
set ui_status_value [format \
ui_status [format \
"$msg... %i/%i files (%.2f%%)" \
$update_index_cp \
$totalCnt \
@ -249,7 +249,7 @@ proc unstage_helper {txt paths} {
update_indexinfo \
$txt \
$pathList \
[concat $after {set ui_status_value {Ready.}}]
[concat $after [list ui_ready]]
}
}
@ -293,7 +293,7 @@ proc add_helper {txt paths} {
update_index \
$txt \
$pathList \
[concat $after {set ui_status_value {Ready to commit.}}]
[concat $after {ui_status {Ready to commit.}}]
}
}
@ -370,7 +370,7 @@ Any unadded changes will be permanently lost by the revert." \
checkout_index \
$txt \
$pathList \
[concat $after {set ui_status_value {Ready.}}]
[concat $after [list ui_ready]]
} else {
unlock_index
}

36
git-gui/lib/merge.tcl
View File

@ -28,7 +28,7 @@ Another Git program has modified this repository since the last scan. A rescan
The rescan will be automatically started now.
}
unlock_index
rescan {set ui_status_value {Ready.}}
rescan ui_ready
return 0
}
@ -79,7 +79,7 @@ proc _visualize {w list} {
}
proc _start {w list} {
global HEAD ui_status_value current_branch
global HEAD current_branch
set cmd [list git merge]
set names [_refs $w $list]
@ -121,7 +121,7 @@ Please select fewer branches. To merge more than 15 branches, merge the branche
}
set msg "Merging $current_branch, [join $names {, }]"
set ui_status_value "$msg..."
ui_status "$msg..."
set cons [console::new "Merge" $msg]
console::exec $cons $cmd \
[namespace code [list _finish $revcnt $cons]]
@ -146,18 +146,18 @@ The working directory will now be reset.
You can attempt this merge again by merging only one branch at a time." $w
set fd [open "| git read-tree --reset -u HEAD" r]
set fd [git_read read-tree --reset -u HEAD]
fconfigure $fd -blocking 0 -translation binary
fileevent $fd readable \
[namespace code [list _reset_wait $fd]]
set ui_status_value {Aborting... please wait...}
ui_status {Aborting... please wait...}
return
}
set msg {Merge failed. Conflict resolution is required.}
}
unlock_index
rescan [list set ui_status_value $msg]
rescan [list ui_status $msg]
}
proc dialog {} {
@ -167,11 +167,13 @@ proc dialog {} {
if {![_can_merge]} return
set fmt {list %(objectname) %(*objectname) %(refname) %(subject)}
set cmd [list git for-each-ref --tcl --format=$fmt]
lappend cmd refs/heads
lappend cmd refs/remotes
lappend cmd refs/tags
set fr_fd [open "| $cmd" r]
set fr_fd [git_read for-each-ref \
--tcl \
--format=$fmt \
refs/heads \
refs/remotes \
refs/tags \
]
fconfigure $fr_fd -translation binary
while {[gets $fr_fd line] > 0} {
set line [eval $line]
@ -186,7 +188,7 @@ proc dialog {} {
close $fr_fd
set to_show {}
set fr_fd [open "| git rev-list --all --not HEAD"]
set fr_fd [git_read rev-list --all --not HEAD]
while {[gets $fr_fd line] > 0} {
if {[catch {set ref $sha1($line)}]} continue
foreach n $ref {
@ -213,7 +215,9 @@ proc dialog {} {
pack $w.buttons.visualize -side left
button $w.buttons.create -text Merge -command $_start
pack $w.buttons.create -side right
button $w.buttons.cancel -text {Cancel} -command [list destroy $w]
button $w.buttons.cancel \
-text {Cancel} \
-command "unlock_index;destroy $w"
pack $w.buttons.cancel -side right -padx 5
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
@ -280,10 +284,10 @@ You must finish amending this commit.
Aborting the current $op will cause *ALL* uncommitted changes to be lost.
Continue with aborting the current $op?"] eq {yes}} {
set fd [open "| git read-tree --reset -u HEAD" r]
set fd [git_read read-tree --reset -u HEAD]
fconfigure $fd -blocking 0 -translation binary
fileevent $fd readable [namespace code [list _reset_wait $fd]]
set ui_status_value {Aborting... please wait...}
ui_status {Aborting... please wait...}
} else {
unlock_index
}
@ -306,7 +310,7 @@ proc _reset_wait {fd} {
catch {file delete [gitdir MERGE_MSG]}
catch {file delete [gitdir GITGUI_MSG]}
rescan {set ui_status_value {Abort completed. Ready.}}
rescan {ui_status {Abort completed. Ready.}}
}
}

2
git-gui/lib/option.tcl
View File

@ -95,6 +95,7 @@ $copyright" \
}
set d {}
append d "git wrapper: $::_git\n"
append d "git exec dir: [gitexec]\n"
append d "git-gui lib: $oguilib"
@ -191,6 +192,7 @@ proc do_options {} {
{b gui.trustmtime {Trust File Modification Timestamps}}
{b gui.pruneduringfetch {Prune Tracking Branches During Fetch}}
{b gui.matchtrackingbranch {Match Tracking Branches}}
{i-0..99 gui.diffcontext {Number of Diff Context Lines}}
{t gui.newbranchtemplate {New Branch Name Template}}
} {

89
git-gui/lib/remote.tcl
View File

@ -1,14 +1,13 @@
# git-gui remote management
# Copyright (C) 2006, 2007 Shawn Pearce
set some_heads_tracking 0; # assume not
proc is_tracking_branch {name} {
global tracking_branches
if {![catch {set info $tracking_branches($name)}]} {
return 1
}
foreach t [array names tracking_branches] {
if {[string match {*/\*} $t] && [string match $t $name]} {
foreach spec $tracking_branches {
set t [lindex $spec 0]
if {$t eq $name || [string match $t $name]} {
return 1
}
}
@ -18,36 +17,53 @@ proc is_tracking_branch {name} {
proc all_tracking_branches {} {
global tracking_branches
set all_trackings {}
set cmd {}
foreach name [array names tracking_branches] {
if {[regsub {/\*$} $name {} name]} {
lappend cmd $name
set all [list]
set pat [list]
set cmd [list]
foreach spec $tracking_branches {
set dst [lindex $spec 0]
if {[string range $dst end-1 end] eq {/*}} {
lappend pat $spec
lappend cmd [string range $dst 0 end-2]
} else {
regsub ^refs/(heads|remotes)/ $name {} name
lappend all_trackings $name
lappend all $spec
}
}
if {$cmd ne {}} {
set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
while {[gets $fd name] > 0} {
regsub ^refs/(heads|remotes)/ $name {} name
lappend all_trackings $name
if {$pat ne {}} {
set fd [eval git_read for-each-ref --format=%(refname) $cmd]
while {[gets $fd n] > 0} {
foreach spec $pat {
set dst [string range [lindex $spec 0] 0 end-2]
set len [string length $dst]
if {[string equal -length $len $dst $n]} {
set src [string range [lindex $spec 2] 0 end-2]
set spec [list \
$n \
[lindex $spec 1] \
$src[string range $n $len end] \
]
lappend all $spec
}
}
}
close $fd
}
return [lsort -unique $all_trackings]
return [lsort -index 0 -unique $all]
}
proc load_all_remotes {} {
global repo_config
global all_remotes tracking_branches
global all_remotes tracking_branches some_heads_tracking
set some_heads_tracking 0
set all_remotes [list]
array unset tracking_branches
set trck [list]
set rh_str refs/heads/
set rh_len [string length $rh_str]
set rm_dir [gitdir remotes]
if {[file isdirectory $rm_dir]} {
set all_remotes [glob \
@ -62,10 +78,19 @@ proc load_all_remotes {} {
while {[gets $fd line] >= 0} {
if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
$line line src dst]} continue
if {![regexp ^refs/ $dst]} {
set dst "refs/heads/$dst"
if {[string index $src 0] eq {+}} {
set src [string range $src 1 end]
}
set tracking_branches($dst) [list $name $src]
if {![string equal -length 5 refs/ $src]} {
set src $rh_str$src
}
if {![string equal -length 5 refs/ $dst]} {
set dst $rh_str$dst
}
if {[string equal -length $rh_len $rh_str $dst]} {
set some_heads_tracking 1
}
lappend trck [list $dst $name $src]
}
close $fd
}
@ -81,13 +106,23 @@ proc load_all_remotes {} {
}
foreach line $fl {
if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
if {![regexp ^refs/ $dst]} {
set dst "refs/heads/$dst"
if {[string index $src 0] eq {+}} {
set src [string range $src 1 end]
}
set tracking_branches($dst) [list $name $src]
if {![string equal -length 5 refs/ $src]} {
set src $rh_str$src
}
if {![string equal -length 5 refs/ $dst]} {
set dst $rh_str$dst
}
if {[string equal -length $rh_len $rh_str $dst]} {
set some_heads_tracking 1
}
lappend trck [list $dst $name $src]
}
}
set tracking_branches [lsort -index 0 -unique $trck]
set all_remotes [lsort -unique $all_remotes]
}

6
git-gui/lib/remote_branch_delete.tcl
View File

@ -98,10 +98,10 @@ constructor dialog {} {
button $w.heads.footer.rescan \
-text {Rescan} \
-command [cb _rescan]
pack $w.heads.footer.status -side left -fill x -expand 1
pack $w.heads.footer.status -side left -fill x
pack $w.heads.footer.rescan -side right
pack $w.heads.footer -side bottom -fill x -expand 1
pack $w.heads.footer -side bottom -fill x
pack $w.heads.sby -side right -fill y
pack $w.heads.l -side left -fill both -expand 1
pack $w.heads -fill both -expand 1 -pady 5 -padx 5
@ -296,7 +296,7 @@ method _load {cache uri} {
set full_list [list]
set head_cache($cache) [list]
set full_cache($cache) [list]
set active_ls [open "| [list git ls-remote $uri]" r]
set active_ls [git_read ls-remote $uri]
fconfigure $active_ls \
-blocking 0 \
-translation lf \

57
git-gui/lib/shortcut.tcl
View File

@ -9,11 +9,15 @@ proc do_windows_shortcut {} {
-title "[appname] ([reponame]): Create Desktop Icon" \
-initialfile "Git [reponame].bat"]
if {$fn != {}} {
if {[file extension $fn] ne {.bat}} {
set fn ${fn}.bat
}
if {[catch {
set ge [file normalize [file dirname $::_git]]
set fd [open $fn w]
puts $fd "@ECHO Entering [reponame]"
puts $fd "@ECHO Starting git-gui... please wait..."
puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
puts $fd "@SET PATH=$ge;%PATH%"
puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
puts -nonewline $fd "@\"[info nameofexecutable]\""
puts $fd " \"[file normalize $argv0]\""
@ -42,12 +46,15 @@ proc do_cygwin_shortcut {} {
-initialdir $desktop \
-initialfile "Git [reponame].bat"]
if {$fn != {}} {
if {[file extension $fn] ne {.bat}} {
set fn ${fn}.bat
}
if {[catch {
set fd [open $fn w]
set sh [exec cygpath \
--windows \
--absolute \
/bin/sh]
/bin/sh.exe]
set me [exec cygpath \
--unix \
--absolute \
@ -56,18 +63,12 @@ proc do_cygwin_shortcut {} {
--unix \
--absolute \
[gitdir]]
set gw [exec cygpath \
--windows \
--absolute \
[file dirname [gitdir]]]
regsub -all ' $me "'\\''" me
regsub -all ' $gd "'\\''" gd
puts $fd "@ECHO Entering $gw"
puts $fd "@ECHO Entering [reponame]"
puts $fd "@ECHO Starting git-gui... please wait..."
puts -nonewline $fd "@\"$sh\" --login -c \""
puts -nonewline $fd "GIT_DIR='$gd'"
puts -nonewline $fd " '$me'"
puts $fd "&\""
puts -nonewline $fd "GIT_DIR=[sq $gd]"
puts -nonewline $fd " [sq $me]"
puts $fd " &\""
close $fd
} err]} {
error_popup "Cannot write script:\n\n$err"
@ -84,6 +85,9 @@ proc do_macosx_app {} {
-initialdir [file join $env(HOME) Desktop] \
-initialfile "Git [reponame].app"]
if {$fn != {}} {
if {[file extension $fn] ne {.app}} {
set fn ${fn}.app
}
if {[catch {
set Contents [file join $fn Contents]
set MacOS [file join $Contents MacOS]
@ -117,20 +121,27 @@ proc do_macosx_app {} {
close $fd
set fd [open $exe w]
set gd [file normalize [gitdir]]
set ep [file normalize [gitexec]]
regsub -all ' $gd "'\\''" gd
regsub -all ' $ep "'\\''" ep
puts $fd "#!/bin/sh"
foreach name [array names env] {
if {[string match GIT_* $name]} {
regsub -all ' $env($name) "'\\''" v
puts $fd "export $name='$v'"
foreach name [lsort [array names env]] {
set value $env($name)
switch -- $name {
GIT_DIR { set value [file normalize [gitdir]] }
}
switch -glob -- $name {
SSH_* -
GIT_* {
puts $fd "if test \"z\$$name\" = z; then"
puts $fd " export $name=[sq $value]"
puts $fd "fi &&"
}
}
}
puts $fd "export PATH='$ep':\$PATH"
puts $fd "export GIT_DIR='$gd'"
puts $fd "exec [file normalize $argv0]"
puts $fd "export PATH=[sq [file dirname $::_git]]:\$PATH &&"
puts $fd "cd [sq [file normalize [pwd]]] &&"
puts $fd "exec \\"
puts $fd " [sq [info nameofexecutable]] \\"
puts $fd " [sq [file normalize $argv0]]"
close $fd
file attributes $exe -permissions u+x,g+x,o+x

96
git-gui/lib/status_bar.tcl Normal file
View File

@ -0,0 +1,96 @@
# git-gui status bar mega-widget
# Copyright (C) 2007 Shawn Pearce
class status_bar {
field w ; # our own window path
field w_l ; # text widget we draw messages into
field w_c ; # canvas we draw a progress bar into
field status {}; # single line of text we show
field prefix {}; # text we format into status
field units {}; # unit of progress
field meter {}; # current core git progress meter (if active)
constructor new {path} {
set w $path
set w_l $w.l
set w_c $w.c
frame $w \
-borderwidth 1 \
-relief sunken
label $w_l \
-textvariable @status \
-anchor w \
-justify left
pack $w_l -side left
bind $w <Destroy> [cb _delete %W]
return $this
}
method start {msg uds} {
if {[winfo exists $w_c]} {
$w_c coords bar 0 0 0 20
} else {
canvas $w_c \
-width 100 \
-height [expr {int([winfo reqheight $w_l] * 0.6)}] \
-borderwidth 1 \
-relief groove \
-highlightt 0
$w_c create rectangle 0 0 0 20 -tags bar -fill navy
pack $w_c -side right
}
set status $msg
set prefix $msg
set units $uds
set meter {}
}
method update {have total} {
set pdone 0
if {$total > 0} {
set pdone [expr {100 * $have / $total}]
}
set status [format "%s ... %i of %i %s (%2i%%)" \
$prefix $have $total $units $pdone]
$w_c coords bar 0 0 $pdone 20
}
method update_meter {buf} {
append meter $buf
set r [string last "\r" $meter]
if {$r == -1} {
return
}
set prior [string range $meter 0 $r]
set meter [string range $meter [expr {$r + 1}] end]
if {[regexp "\\((\\d+)/(\\d+)\\)\\s+done\r\$" $prior _j a b]} {
update $this $a $b
}
}
method stop {{msg {}}} {
destroy $w_c
if {$msg ne {}} {
set status $msg
}
}
method show {msg {test {}}} {
if {$test eq {} || $status eq $test} {
set status $msg
}
}
method _delete {current} {
if {$current eq $w} {
delete_this
}
}
}

4
git-gui/lib/transport.tcl
View File

@ -74,7 +74,7 @@ trace add variable push_remote write \
[list radio_selector push_urltype remote]
proc do_push_anywhere {} {
global all_heads all_remotes current_branch
global all_remotes current_branch
global push_urltype push_remote push_url push_thin push_tags
set w .push_setup
@ -101,7 +101,7 @@ proc do_push_anywhere {} {
-width 70 \
-selectmode extended \
-yscrollcommand [list $w.source.sby set]
foreach h $all_heads {
foreach h [load_all_heads] {
$w.source.l insert end $h
if {$h eq $current_branch} {
$w.source.l select set end