summaryrefslogtreecommitdiff
path: root/git-gui/lib
diff options
context:
space:
mode:
Diffstat (limited to 'git-gui/lib')
-rw-r--r--git-gui/lib/blame.tcl111
-rw-r--r--git-gui/lib/branch.tcl562
-rw-r--r--git-gui/lib/branch_checkout.tcl89
-rw-r--r--git-gui/lib/branch_create.tcl220
-rw-r--r--git-gui/lib/branch_delete.tcl149
-rw-r--r--git-gui/lib/branch_rename.tcl128
-rw-r--r--git-gui/lib/browser.tcl88
-rw-r--r--git-gui/lib/checkout_op.tcl588
-rw-r--r--git-gui/lib/choose_rev.tcl627
-rw-r--r--git-gui/lib/class.tcl38
-rw-r--r--git-gui/lib/commit.tcl84
-rw-r--r--git-gui/lib/console.tcl69
-rw-r--r--git-gui/lib/database.tcl29
-rw-r--r--git-gui/lib/diff.tcl27
-rw-r--r--git-gui/lib/encoding.tcl276
-rw-r--r--git-gui/lib/error.tcl7
-rw-r--r--git-gui/lib/index.tcl50
-rw-r--r--git-gui/lib/merge.tcl285
-rw-r--r--git-gui/lib/option.tcl19
-rw-r--r--git-gui/lib/remote.tcl106
-rw-r--r--git-gui/lib/remote_branch_delete.tcl347
-rw-r--r--git-gui/lib/shortcut.tcl51
-rw-r--r--git-gui/lib/status_bar.tcl96
-rw-r--r--git-gui/lib/transport.tcl20
24 files changed, 3112 insertions, 954 deletions
diff --git a/git-gui/lib/blame.tcl b/git-gui/lib/blame.tcl
index 1d2caac..9607284 100644
--- a/git-gui/lib/blame.tcl
+++ b/git-gui/lib/blame.tcl
@@ -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,13 @@ 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]
+ fconfigure $fd -eofchar {}
} 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 +475,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}
@@ -684,30 +670,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
@@ -788,7 +761,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
@@ -798,15 +771,20 @@ method _showcommit {cur_w lno} {
set enc [string tolower [string range $line 9 end]]
}
}
- set msg [encoding convertfrom $enc [read $fd]]
- set msg [string trim $msg]
+ set msg [read $fd]
close $fd
- set author_name [encoding convertfrom $enc $author_name]
- set committer_name [encoding convertfrom $enc $committer_name]
-
- set header($cmit,author) $author_name
- set header($cmit,committer) $committer_name
+ set enc [tcl_encoding $enc]
+ if {$enc ne {}} {
+ set msg [encoding convertfrom $enc $msg]
+ set author_name [encoding convertfrom $enc $author_name]
+ set committer_name [encoding convertfrom $enc $committer_name]
+ set header($cmit,author) $author_name
+ set header($cmit,committer) $committer_name
+ set header($cmit,summary) \
+ [encoding convertfrom $enc $header($cmit,summary)]
+ }
+ set msg [string trim $msg]
}
set header($cmit,message) $msg
}
@@ -901,6 +879,11 @@ method _open_tooltip {cur_w} {
set org [lindex $amov_data $lno]
}
+ if {$dat eq {}} {
+ _hide_tooltip $this
+ return
+ }
+
set cmit [lindex $dat 0]
set tooltip_commit [list $cmit]
diff --git a/git-gui/lib/branch.tcl b/git-gui/lib/branch.tcl
index 4f648b2..777eeb7 100644
--- a/git-gui/lib/branch.tcl
+++ b/git-gui/lib/branch.tcl
@@ -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'."
- }
-}
diff --git a/git-gui/lib/branch_checkout.tcl b/git-gui/lib/branch_checkout.tcl
new file mode 100644
index 0000000..72c45b4
--- /dev/null
+++ b/git-gui/lib/branch_checkout.tcl
@@ -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
+}
+
+}
diff --git a/git-gui/lib/branch_create.tcl b/git-gui/lib/branch_create.tcl
new file mode 100644
index 0000000..def615d
--- /dev/null
+++ b/git-gui/lib/branch_create.tcl
@@ -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
+ }
+}
+
+}
diff --git a/git-gui/lib/branch_delete.tcl b/git-gui/lib/branch_delete.tcl
new file mode 100644
index 0000000..c7573c6
--- /dev/null
+++ b/git-gui/lib/branch_delete.tcl
@@ -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
+}
+
+}
diff --git a/git-gui/lib/branch_rename.tcl b/git-gui/lib/branch_rename.tcl
new file mode 100644
index 0000000..1cadc31
--- /dev/null
+++ b/git-gui/lib/branch_rename.tcl
@@ -0,0 +1,128 @@
+# git-gui branch rename support
+# Copyright (C) 2007 Shawn Pearce
+
+class branch_rename {
+
+field w
+field oldname
+field newname
+
+constructor dialog {} {
+ global current_branch
+
+ make_toplevel top w
+ wm title $top "[appname] ([reponame]): Rename Branch"
+ if {$top ne {.}} {
+ wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
+ }
+
+ set oldname $current_branch
+ set newname [get_config gui.newbranchtemplate]
+
+ label $w.header -text {Rename Branch} -font font_uibold
+ pack $w.header -side top -fill x
+
+ frame $w.buttons
+ button $w.buttons.rename -text Rename \
+ -default active \
+ -command [cb _rename]
+ pack $w.buttons.rename -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
+
+ frame $w.rename
+ label $w.rename.oldname_l -text {Branch:}
+ eval tk_optionMenu $w.rename.oldname_m @oldname [load_all_heads]
+
+ label $w.rename.newname_l -text {New Name:}
+ entry $w.rename.newname_t \
+ -borderwidth 1 \
+ -relief sunken \
+ -width 40 \
+ -textvariable @newname \
+ -validate key \
+ -validatecommand {
+ if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
+ return 1
+ }
+
+ grid $w.rename.oldname_l $w.rename.oldname_m -sticky w -padx {0 5}
+ grid $w.rename.newname_l $w.rename.newname_t -sticky we -padx {0 5}
+ grid columnconfigure $w.rename 1 -weight 1
+ pack $w.rename -anchor nw -fill x -pady 5 -padx 5
+
+ bind $w <Key-Return> [cb _rename]
+ bind $w <Key-Escape> [list destroy $w]
+ bind $w <Visibility> "
+ grab $w
+ $w.rename.newname_t icursor end
+ focus $w.rename.newname_t
+ "
+ tkwait window $w
+}
+
+method _rename {} {
+ global current_branch
+
+ if {$oldname eq {}} {
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title [wm title $w] \
+ -parent $w \
+ -message "Please select a branch to rename."
+ focus $w.rename.oldname_m
+ return
+ }
+ if {$newname eq {}
+ || $newname eq [get_config gui.newbranchtemplate]} {
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title [wm title $w] \
+ -parent $w \
+ -message "Please supply a branch name."
+ focus $w.rename.newname_t
+ return
+ }
+ if {![catch {git show-ref --verify -- "refs/heads/$newname"}]} {
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title [wm title $w] \
+ -parent $w \
+ -message "Branch '$newname' already exists."
+ focus $w.rename.newname_t
+ return
+ }
+ if {[catch {git check-ref-format "heads/$newname"}]} {
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title [wm title $w] \
+ -parent $w \
+ -message "We do not like '$newname' as a branch name."
+ focus $w.rename.newname_t
+ return
+ }
+
+ if {[catch {git branch -m $oldname $newname} err]} {
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title [wm title $w] \
+ -parent $w \
+ -message "Failed to rename '$oldname'.\n\n$err"
+ return
+ }
+
+ if {$current_branch eq $oldname} {
+ set current_branch $newname
+ }
+
+ destroy $w
+}
+
+}
diff --git a/git-gui/lib/browser.tcl b/git-gui/lib/browser.tcl
index e612247..888db3c 100644
--- a/git-gui/lib/browser.tcl
+++ b/git-gui/lib/browser.tcl
@@ -3,6 +3,13 @@
class browser {
+image create photo ::browser::img_parent -data {R0lGODlhEAAQAIUAAPwCBBxSHBxOHMTSzNzu3KzCtBRGHCSKFIzCjLzSxBQ2FAxGHDzCLCyeHBQ+FHSmfAwuFBxKLDSCNMzizISyjJzOnDSyLAw+FAQSDAQeDBxWJAwmDAQOBKzWrDymNAQaDAQODAwaDDyKTFSyXFTGTEy6TAQCBAQKDAwiFBQyHAwSFAwmHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAZ1QIBwSCwaj0hiQCBICpcDQsFgGAaIguhhi0gohIsrQEDYMhiNrRfgeAQC5fMCAolIDhD2hFI5WC4YRBkaBxsOE2l/RxsHHA4dHmkfRyAbIQ4iIyQlB5NFGCAACiakpSZEJyinTgAcKSesACorgU4mJ6uxR35BACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=}
+image create photo ::browser::img_rblob -data {R0lGODlhEAAQAIUAAPwCBFxaXNze3Ly2rJSWjPz+/Ozq7GxqbJyanPT29HRydMzOzDQyNIyKjERCROTi3Pz69PTy7Pzy7PTu5Ozm3LyqlJyWlJSSjJSOhOzi1LyulPz27PTq3PTm1OzezLyqjIyKhJSKfOzaxPz29OzizLyidIyGdIyCdOTOpLymhOzavOTStMTCtMS+rMS6pMSynMSulLyedAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAaQQIAQECgajcNkQMBkDgKEQFK4LFgLhkMBIVUKroWEYlEgMLxbBKLQUBwc52HgAQ4LBo049atWQyIPA3pEdFcQEhMUFYNVagQWFxgZGoxfYRsTHB0eH5UJCJAYICEinUoPIxIcHCQkIiIllQYEGCEhJicoKYwPmiQeKisrKLFKLCwtLi8wHyUlMYwM0tPUDH5BACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=}
+image create photo ::browser::img_xblob -data {R0lGODlhEAAQAIYAAPwCBFRWVFxaXNza3OTi3Nze3Ly2tJyanPz+/Ozq7GxubNzSxMzOzMTGxHRybDQyNLy+vHRydHx6fKSipISChIyKjGxqbERCRCwuLLy6vGRiZExKTCQiJAwKDLSytLy2rJSSlHx+fDw6PKyqrBQWFPTu5Ozm3LyulLS2tCQmJAQCBPTq3Ozi1MSynCwqLAQGBOTazOzizOzezLyqjBweHNzSvOzaxKyurHRuZNzOtLymhDw+PIyCdOzWvOTOpLyidNzKtOTStLyifMTCtMS+rLyedAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAfZgACCAAEChYeGg4oCAwQFjgYBBwGKggEECJkICQoIkwADCwwNDY2mDA4Lng8QDhESsLARExQVDhYXGBkWExIaGw8cHR4SCQQfFQ8eFgUgIQEiwiMSBMYfGB4atwEXDyQd0wQlJicPKAHoFyIpJCoeDgMrLC0YKBsX6i4kL+4OMDEyZijr5oLGNxUqUCioEcPGDAwjPNyI6MEDChQjcOSwsUDHgw07RIgI4KCkAgs8cvTw8eOBogAxQtXIASTISiEuBwUYMoRIixYnZggpUgTDywdIkWJIitRPIAAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7}
+image create photo ::browser::img_tree -data {R0lGODlhEAAQAIYAAPwCBAQCBExKTBwWHMzKzOzq7ERCRExGTCwqLARqnAQ+ZHR2dKyqrNTOzHx2fCQiJMTi9NTu9HzC3AxmnAQ+XPTm7Dy67DymzITC3IzG5AxypHRydKymrMzOzOzu7BweHByy9AyGtFyy1IzG3NTu/ARupFRSVByazBR6rAyGvFyuzJTK3MTm9BR+tAxWhHS61MTi7Pz+/IymvCxulBRelAx2rHS63Pz6/PTy9PTu9Nza3ISitBRupFSixNTS1CxqnDQyNMzGzOTi5MTCxMTGxGxubGxqbLy2vLSutGRiZLy6vLSytKyurDQuNFxaXKSipDw6PAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAfDgACCAAECg4eIAAMEBQYHCImDBgkKCwwNBQIBBw4Bhw8QERITFJYEFQUFnoIPFhcYoRkaFBscHR4Ggh8gIRciEiMQJBkltCa6JyUoKSkXKhIrLCQYuQAPLS4TEyUhKb0qLzDVAjEFMjMuNBMoNcw21QY3ODkFOjs82RM1PfDzFRU3fOggcM7Fj2pAgggRokOHDx9DhhAZUqQaISBGhjwMEvEIkiIHEgUAkgSJkiNLmFSMJChAEydPGBSBwvJQgAc0/QQCACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=}
+image create photo ::browser::img_symlink -data {R0lGODlhEAAQAIQAAPwCBCwqLLSytLy+vERGRFRWVDQ2NKSmpAQCBKyurMTGxISChJyanHR2dIyKjGxubHRydGRmZIyOjFxeXHx6fAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAVbICACwWieY1CibCCsrBkMb0zchSEcNYskCtqBBzshFkOGQFk0IRqOxqPBODRHCMhCQKteRc9FI/KQWGOIyFYgkDC+gPR4snCcfRGKOIKIgSMQE31+f4OEYCZ+IQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7}
+image create photo ::browser::img_unknown -data {R0lGODlhEAAQAIUAAPwCBFxaXIyKjNTW1Nze3LS2tJyanER2RGS+VPz+/PTu5GxqbPz69BQ6BCxeLFSqRPT29HRydMzOzDQyNERmPKSypCRWHIyKhERCRDyGPKz2nESiLBxGHCyCHGxubPz6/PTy7Ozi1Ly2rKSipOzm3LyqlKSWhCRyFOzizLymhNTKtNzOvOzaxOTStPz27OzWvOTOpLSupLyedMS+rMS6pMSulLyqjLymfLyifAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAamQIAQECgajcOkYEBoDgoBQyAJOCCuiENCsWBIh9aGw9F4HCARiXciRDQoBUnlYRlcIgsMG5CxXAgMGhscBRAEBRd7AB0eBBoIgxUfICEiikSPgyMMIAokJZcBkBybJgomIaBJAZoMpyCmqkMBFCcVCrgKKAwpoSorKqchKCwtvasIFBIhLiYvLzDHsxQNMcMKLDAwMqEz3jQ1NTY3ONyrE+jp6hN+QQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7}
+
field w
field browser_commit
field browser_path
@@ -13,13 +20,13 @@ field browser_busy 1
field ls_buf {}; # Buffered record output from ls-tree
-constructor new {commit} {
+constructor new {commit {path {}}} {
global cursor_ptr M1B
make_toplevel top w
wm title $top "[appname] ([reponame]): File Browser"
set browser_commit $commit
- set browser_path $browser_commit:
+ set browser_path $browser_commit:$path
label $w.path \
-textvariable @browser_path \
@@ -73,7 +80,11 @@ constructor new {commit} {
bind $w_list <Visibility> [list focus $w_list]
set w $w_list
- _ls $this $browser_commit
+ if {$path ne {}} {
+ _ls $this $browser_commit:$path $path
+ } else {
+ _ls $this $browser_commit $path
+ }
return $this
}
@@ -173,15 +184,14 @@ method _ls {tree_id {name {}}} {
$w image create end \
-align center -padx 5 -pady 1 \
-name icon0 \
- -image file_uplevel
+ -image ::browser::img_parent
$w insert end {[Up To Parent]}
lappend browser_files parent
}
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]
}
@@ -204,14 +214,21 @@ method _read {fd} {
switch -- $type {
blob {
- set image file_mod
+ scan [lindex $info 0] %o mode
+ if {$mode == 0120000} {
+ set image ::browser::img_symlink
+ } elseif {($mode & 0100) != 0} {
+ set image ::browser::img_xblob
+ } else {
+ set image ::browser::img_rblob
+ }
}
tree {
- set image file_dir
+ set image ::browser::img_tree
append path /
}
default {
- set image file_question
+ set image ::browser::img_unknown
}
}
@@ -240,3 +257,56 @@ method _read {fd} {
}
}
+
+class browser_open {
+
+field w ; # widget path
+field w_rev ; # mega-widget to pick the initial revision
+
+constructor dialog {} {
+ make_toplevel top w
+ wm title $top "[appname] ([reponame]): Browse Branch Files"
+ if {$top ne {.}} {
+ wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
+ }
+
+ label $w.header \
+ -text {Browse Branch Files} \
+ -font font_uibold
+ pack $w.header -side top -fill x
+
+ frame $w.buttons
+ button $w.buttons.browse -text Browse \
+ -default active \
+ -command [cb _open]
+ pack $w.buttons.browse -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 _open]
+ pack $w.rev -anchor nw -fill both -expand 1 -pady 5 -padx 5
+
+ bind $w <Visibility> [cb _visible]
+ bind $w <Key-Escape> [list destroy $w]
+ bind $w <Key-Return> [cb _open]\;break
+ tkwait window $w
+}
+
+method _open {} {
+ if {[catch {$w_rev commit_or_die} err]} {
+ return
+ }
+ set name [$w_rev get]
+ destroy $w
+ browser::new $name
+}
+
+method _visible {} {
+ grab $w
+ $w_rev focus_filter
+}
+
+}
diff --git a/git-gui/lib/checkout_op.tcl b/git-gui/lib/checkout_op.tcl
new file mode 100644
index 0000000..170f737
--- /dev/null
+++ b/git-gui/lib/checkout_op.tcl
@@ -0,0 +1,588 @@
+# 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 merge_base {}; # merge base if we have another ref involved
+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
+
+ set cmd [list git fetch $remote]
+ if {$l_trck ne {}} {
+ lappend cmd +$r_head:$l_trck
+ } else {
+ lappend cmd $r_head
+ }
+
+ _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 $cmd [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 {$l_trck eq {}} {
+ set l_trck FETCH_HEAD
+ }
+ 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 {
+ catch {set merge_base [git merge-base $new $cur]}
+ if {$merge_base eq $cur} {
+ # The current branch is older.
+ #
+ set reflog_msg "merge $new_expr: Fast-forward"
+ } else {
+ switch -- $merge_type {
+ ff {
+ if {$merge_base eq $new} {
+ # The current branch is actually newer.
+ #
+ set new $cur
+ set new_hash $cur
+ } else {
+ _error $this "Branch '$newbranch' already exists.\n\nIt cannot fast-forward to $new_expr.\nA merge is required."
+ return 0
+ }
+ }
+ reset {
+ # The current branch will lose things.
+ #
+ if {[_confirm_reset $this $cur]} {
+ set reflog_msg "reset $new_expr"
+ } else {
+ return 0
+ }
+ }
+ default {
+ _error $this "Merge strategy '$merge_type' not 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 "Staging area (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 {$curHEAD eq $new_hash} {
+ _after_readtree $this
+ } elseif {[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]
+ if {$is_detached || $current_branch ne $new_branch} {
+ 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 {
+ if {$new_hash ne $HEAD} {
+ 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
+}
+
+}
diff --git a/git-gui/lib/choose_rev.tcl b/git-gui/lib/choose_rev.tcl
new file mode 100644
index 0000000..ec064b3
--- /dev/null
+++ b/git-gui/lib/choose_rev.tcl
@@ -0,0 +1,627 @@
+# 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
+field tip_data ; # array of tip commit info by refname
+field log_last ; # array of reflog date by refname
+
+field tooltip_wm {} ; # Current tooltip toplevel, if open
+field tooltip_t {} ; # Text widget in $tooltip_wm
+field tooltip_timer {} ; # Current timer event for our tooltip
+
+proc new {path {title {}}} {
+ return [_new $path 0 $title]
+}
+
+proc new_unmerged {path {title {}}} {
+ return [_new $path 1 $title]
+}
+
+constructor _new {path unmerged_only title} {
+ global current_branch is_detached
+
+ if {![info exists ::all_remotes]} {
+ load_all_remotes
+ }
+
+ 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 10 \
+ -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
+ bind $w_list <Any-Motion> [cb _show_tooltip @%x,%y]
+ bind $w_list <Any-Enter> [cb _hide_tooltip]
+ bind $w_list <Any-Leave> [cb _hide_tooltip]
+ bind $w_list <Destroy> [cb _hide_tooltip]
+
+ 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 fmt list
+ append fmt { %(refname)}
+ append fmt { [list}
+ append fmt { %(objecttype)}
+ append fmt { %(objectname)}
+ append fmt { [concat %(taggername) %(authorname)]}
+ append fmt { [concat %(taggerdate) %(authordate)]}
+ append fmt { %(subject)}
+ append fmt {] [list}
+ append fmt { %(*objecttype)}
+ append fmt { %(*objectname)}
+ append fmt { %(*authorname)}
+ append fmt { %(*authordate)}
+ append fmt { %(*subject)}
+ append fmt {]}
+ set all_refn [list]
+ set fr_fd [git_read for-each-ref \
+ --tcl \
+ --sort=-taggerdate \
+ --format=$fmt \
+ refs/heads \
+ refs/remotes \
+ refs/tags \
+ ]
+ fconfigure $fr_fd -translation lf -encoding utf-8
+ while {[gets $fr_fd line] > 0} {
+ set line [eval $line]
+ if {[lindex $line 1 0] eq {tag}} {
+ if {[lindex $line 2 0] eq {commit}} {
+ set sha1 [lindex $line 2 1]
+ } else {
+ continue
+ }
+ } elseif {[lindex $line 1 0] eq {commit}} {
+ set sha1 [lindex $line 1 1]
+ } else {
+ continue
+ }
+ set refn [lindex $line 0]
+ set tip_data($refn) [lrange $line 1 end]
+ lappend cmt_refn($sha1) $refn
+ lappend all_refn $refn
+ }
+ close $fr_fd
+
+ if {$unmerged_only} {
+ set fr_fd [git_read rev-list --all ^$::HEAD]
+ while {[gets $fr_fd sha1] > 0} {
+ if {[catch {set rlst $cmt_refn($sha1)}]} continue
+ foreach refn $rlst {
+ set inc($refn) 1
+ }
+ }
+ close $fr_fd
+ } else {
+ foreach refn $all_refn {
+ set inc($refn) 1
+ }
+ }
+
+ set spec_head [list]
+ foreach name [load_all_heads] {
+ set refn refs/heads/$name
+ if {[info exists inc($refn)]} {
+ lappend spec_head [list $name $refn]
+ }
+ }
+
+ set spec_trck [list]
+ foreach spec [all_tracking_branches] {
+ set refn [lindex $spec 0]
+ if {[info exists inc($refn)]} {
+ regsub ^refs/(heads|remotes)/ $refn {} name
+ lappend spec_trck [concat $name $spec]
+ }
+ }
+
+ set spec_tag [list]
+ foreach name [load_all_tags] {
+ set refn refs/tags/$name
+ if {[info exists inc($refn)]} {
+ lappend spec_tag [list $name $refn]
+ }
+ }
+
+ 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
+}
+
+method _show_tooltip {pos} {
+ if {$tooltip_wm ne {}} {
+ _open_tooltip $this
+ } elseif {$tooltip_timer eq {}} {
+ set tooltip_timer [after 1000 [cb _open_tooltip]]
+ }
+}
+
+method _open_tooltip {} {
+ global remote_url
+
+ set tooltip_timer {}
+ set pos_x [winfo pointerx $w_list]
+ set pos_y [winfo pointery $w_list]
+ if {[winfo containing $pos_x $pos_y] ne $w_list} {
+ _hide_tooltip $this
+ return
+ }
+
+ set pos @[join [list \
+ [expr {$pos_x - [winfo rootx $w_list]}] \
+ [expr {$pos_y - [winfo rooty $w_list]}]] ,]
+ set lno [$w_list index $pos]
+ if {$lno eq {}} {
+ _hide_tooltip $this
+ return
+ }
+
+ set spec [lindex $cur_specs $lno]
+ set refn [lindex $spec 1]
+ if {$refn eq {}} {
+ _hide_tooltip $this
+ return
+ }
+
+ if {$tooltip_wm eq {}} {
+ set tooltip_wm [toplevel $w_list.tooltip -borderwidth 1]
+ wm overrideredirect $tooltip_wm 1
+ wm transient $tooltip_wm [winfo toplevel $w_list]
+ set tooltip_t $tooltip_wm.label
+ text $tooltip_t \
+ -takefocus 0 \
+ -highlightthickness 0 \
+ -relief flat \
+ -borderwidth 0 \
+ -wrap none \
+ -background lightyellow \
+ -foreground black
+ $tooltip_t tag conf section_header -font font_uibold
+ bind $tooltip_wm <Escape> [cb _hide_tooltip]
+ pack $tooltip_t
+ } else {
+ $tooltip_t conf -state normal
+ $tooltip_t delete 0.0 end
+ }
+
+ set data $tip_data($refn)
+ if {[lindex $data 0 0] eq {tag}} {
+ set tag [lindex $data 0]
+ if {[lindex $data 1 0] eq {commit}} {
+ set cmit [lindex $data 1]
+ } else {
+ set cmit {}
+ }
+ } elseif {[lindex $data 0 0] eq {commit}} {
+ set tag {}
+ set cmit [lindex $data 0]
+ }
+
+ $tooltip_t insert end [lindex $spec 0]
+ set last [_reflog_last $this [lindex $spec 1]]
+ if {$last ne {}} {
+ $tooltip_t insert end "\n"
+ $tooltip_t insert end "updated"
+ $tooltip_t insert end " $last"
+ }
+ $tooltip_t insert end "\n"
+
+ if {$tag ne {}} {
+ $tooltip_t insert end "\n"
+ $tooltip_t insert end "tag" section_header
+ $tooltip_t insert end " [lindex $tag 1]\n"
+ $tooltip_t insert end [lindex $tag 2]
+ $tooltip_t insert end " ([lindex $tag 3])\n"
+ $tooltip_t insert end [lindex $tag 4]
+ $tooltip_t insert end "\n"
+ }
+
+ if {$cmit ne {}} {
+ $tooltip_t insert end "\n"
+ $tooltip_t insert end "commit" section_header
+ $tooltip_t insert end " [lindex $cmit 1]\n"
+ $tooltip_t insert end [lindex $cmit 2]
+ $tooltip_t insert end " ([lindex $cmit 3])\n"
+ $tooltip_t insert end [lindex $cmit 4]
+ }
+
+ if {[llength $spec] > 2} {
+ $tooltip_t insert end "\n"
+ $tooltip_t insert end "remote" section_header
+ $tooltip_t insert end " [lindex $spec 2]\n"
+ $tooltip_t insert end "url"
+ $tooltip_t insert end " $remote_url([lindex $spec 2])\n"
+ $tooltip_t insert end "branch"
+ $tooltip_t insert end " [lindex $spec 3]"
+ }
+
+ $tooltip_t conf -state disabled
+ _position_tooltip $this
+}
+
+method _reflog_last {name} {
+ if {[info exists reflog_last($name)]} {
+ return reflog_last($name)
+ }
+
+ set last {}
+ if {[catch {set last [file mtime [gitdir $name]]}]
+ && ![catch {set g [open [gitdir logs $name] r]}]} {
+ fconfigure $g -translation binary
+ while {[gets $g line] >= 0} {
+ if {[regexp {> ([1-9][0-9]*) } $line line when]} {
+ set last $when
+ }
+ }
+ close $g
+ }
+
+ if {$last ne {}} {
+ set last [clock format $last -format {%a %b %e %H:%M:%S %Y}]
+ }
+ set reflog_last($name) $last
+ return $last
+}
+
+method _position_tooltip {} {
+ set max_h [lindex [split [$tooltip_t index end] .] 0]
+ set max_w 0
+ for {set i 1} {$i <= $max_h} {incr i} {
+ set c [lindex [split [$tooltip_t index "$i.0 lineend"] .] 1]
+ if {$c > $max_w} {set max_w $c}
+ }
+ $tooltip_t conf -width $max_w -height $max_h
+
+ set req_w [winfo reqwidth $tooltip_t]
+ set req_h [winfo reqheight $tooltip_t]
+ set pos_x [expr {[winfo pointerx .] + 5}]
+ set pos_y [expr {[winfo pointery .] + 10}]
+
+ set g "${req_w}x${req_h}"
+ if {$pos_x >= 0} {append g +}
+ append g $pos_x
+ if {$pos_y >= 0} {append g +}
+ append g $pos_y
+
+ wm geometry $tooltip_wm $g
+ raise $tooltip_wm
+}
+
+method _hide_tooltip {} {
+ if {$tooltip_wm ne {}} {
+ destroy $tooltip_wm
+ set tooltip_wm {}
+ }
+ if {$tooltip_timer ne {}} {
+ after cancel $tooltip_timer
+ set tooltip_timer {}
+ }
+}
+
+}
diff --git a/git-gui/lib/class.tcl b/git-gui/lib/class.tcl
index 9d298d0..24e8cec 100644
--- a/git-gui/lib/class.tcl
+++ b/git-gui/lib/class.tcl
@@ -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}
}
diff --git a/git-gui/lib/commit.tcl b/git-gui/lib/commit.tcl
index e139f4d..f857a2f 100644
--- a/git-gui/lib/commit.tcl
+++ b/git-gui/lib/commit.tcl
@@ -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
@@ -37,9 +37,14 @@ You are currently in the middle of a merge that has not been fully completed. Y
set enc [string tolower [string range $line 9 end]]
}
}
- set msg [encoding convertfrom $enc [read $fd]]
- set msg [string trim $msg]
+ set msg [read $fd]
close $fd
+
+ set enc [tcl_encoding $enc]
+ if {$enc ne {}} {
+ set msg [encoding convertfrom $enc $msg]
+ }
+ set msg [string trim $msg]
} err]} {
error_popup "Error loading commit data for amend:\n\n$err"
return
@@ -58,7 +63,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 +113,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 +137,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
}
@@ -148,7 +153,7 @@ The rescan will be automatically started now.
U? {
error_popup "Unmerged files cannot be committed.
-File [short_path $path] has merge conflicts. You must resolve them and add the file before committing.
+File [short_path $path] has merge conflicts. You must resolve them and stage the file before committing.
"
unlock_index
return
@@ -164,7 +169,7 @@ File [short_path $path] cannot be committed by this program.
if {!$files_ready && ![string match *merge $curType]} {
info_popup {No changes to commit.
-You must add at least 1 file before you can commit.
+You must stage at least 1 file before you can commit.
}
unlock_index
return
@@ -206,22 +211,22 @@ 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
+ fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
fileevent $fd_ph readable \
[list commit_prehook_wait $fd_ph $curHEAD $msg]
}
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 +239,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 +263,7 @@ proc commit_committree {fd_wt curHEAD msg} {
# -- Verify this wasn't an empty change.
#
if {$commit_type eq {normal}} {
- set fd_ot [open "| git cat-file commit $PARENT" r]
+ 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
@@ -280,7 +283,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
}
}
@@ -289,11 +292,18 @@ A rescan will be automatically started now.
#
set msg_p [gitdir COMMIT_EDITMSG]
set msg_wt [open $msg_p w]
+ fconfigure $msg_wt -translation lf
if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
set enc utf-8
}
- fconfigure $msg_wt -encoding binary -translation binary
- puts -nonewline $msg_wt [encoding convertto $enc $msg]
+ set use_enc [tcl_encoding $enc]
+ if {$use_enc ne {}} {
+ fconfigure $msg_wt -encoding $use_enc
+ } else {
+ puts stderr "warning: Tcl does not support encoding '$enc'."
+ fconfigure $msg_wt -encoding utf-8
+ }
+ puts -nonewline $msg_wt $msg
close $msg_wt
# -- Create the commit.
@@ -305,7 +315,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
}
@@ -327,7 +337,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
}
@@ -342,7 +352,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}
}
@@ -364,17 +379,13 @@ A rescan will be automatically started now.
$ui_comm delete 0.0 end
$ui_comm edit reset
$ui_comm edit modified false
+ if {$::GITGUI_BCK_exists} {
+ catch {file delete [gitdir GITGUI_BCK]}
+ set ::GITGUI_BCK_exists 0
+ }
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
@@ -416,6 +427,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"
}
diff --git a/git-gui/lib/console.tcl b/git-gui/lib/console.tcl
index 34de5d4..6f718fb 100644
--- a/git-gui/lib/console.tcl
+++ b/git-gui/lib/console.tcl
@@ -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
@@ -61,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]
}
@@ -159,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
}
diff --git a/git-gui/lib/database.tcl b/git-gui/lib/database.tcl
index 43e4a28..0657cc2 100644
--- a/git-gui/lib/database.tcl
+++ b/git-gui/lib/database.tcl
@@ -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
@@ -87,3 +87,30 @@ proc do_fsck_objects {} {
lappend cmd --strict
console::exec $w $cmd
}
+
+proc hint_gc {} {
+ set object_limit 8
+ if {[is_Windows]} {
+ set object_limit 1
+ }
+
+ set objects_current [llength [glob \
+ -directory [gitdir objects 42] \
+ -nocomplain \
+ -tails \
+ -- \
+ *]]
+
+ if {$objects_current >= $object_limit} {
+ set objects_current [expr {$objects_current * 256}]
+ set object_limit [expr {$object_limit * 256}]
+ if {[ask_popup \
+ "This repository currently has approximately $objects_current loose objects.
+
+To maintain optimal performance it is strongly recommended that you compress the database when more than $object_limit loose objects exist.
+
+Compress the database now?"] eq yes} {
+ do_gc
+ }
+ }
+}
diff --git a/git-gui/lib/diff.tcl b/git-gui/lib/diff.tcl
index 29436b5..e09e125 100644
--- a/git-gui/lib/diff.tcl
+++ b/git-gui/lib/diff.tcl
@@ -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!
#
@@ -86,13 +86,14 @@ proc show_diff {path w {lno {}}} {
set max_sz [expr {128 * 1024}]
if {[catch {
set fd [open $path r]
+ fconfigure $fd -eofchar {}
set content [read $fd $max_sz]
close $fd
set sz [file size $path]
} 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 +128,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 +155,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 +171,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 +257,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 +272,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 +302,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]
diff --git a/git-gui/lib/encoding.tcl b/git-gui/lib/encoding.tcl
new file mode 100644
index 0000000..7f06b0d
--- /dev/null
+++ b/git-gui/lib/encoding.tcl
@@ -0,0 +1,276 @@
+# git-gui encoding support
+# Copyright (C) 2005 Paul Mackerras <paulus@samba.org>
+# (Copied from gitk, commit fd8ccbec4f0161)
+
+# This list of encoding names and aliases is distilled from
+# http://www.iana.org/assignments/character-sets.
+# Not all of them are supported by Tcl.
+set encoding_aliases {
+ { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
+ ISO646-US US-ASCII us IBM367 cp367 csASCII }
+ { ISO-10646-UTF-1 csISO10646UTF1 }
+ { ISO_646.basic:1983 ref csISO646basic1983 }
+ { INVARIANT csINVARIANT }
+ { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
+ { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
+ { NATS-SEFI iso-ir-8-1 csNATSSEFI }
+ { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
+ { NATS-DANO iso-ir-9-1 csNATSDANO }
+ { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
+ { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
+ { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
+ { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
+ { ISO-2022-KR csISO2022KR }
+ { EUC-KR csEUCKR }
+ { ISO-2022-JP csISO2022JP }
+ { ISO-2022-JP-2 csISO2022JP2 }
+ { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
+ csISO13JISC6220jp }
+ { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
+ { IT iso-ir-15 ISO646-IT csISO15Italian }
+ { PT iso-ir-16 ISO646-PT csISO16Portuguese }
+ { ES iso-ir-17 ISO646-ES csISO17Spanish }
+ { greek7-old iso-ir-18 csISO18Greek7Old }
+ { latin-greek iso-ir-19 csISO19LatinGreek }
+ { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
+ { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
+ { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
+ { ISO_5427 iso-ir-37 csISO5427Cyrillic }
+ { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
+ { BS_viewdata iso-ir-47 csISO47BSViewdata }
+ { INIS iso-ir-49 csISO49INIS }
+ { INIS-8 iso-ir-50 csISO50INIS8 }
+ { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
+ { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
+ { ISO_5428:1980 iso-ir-55 csISO5428Greek }
+ { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
+ { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
+ { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
+ csISO60Norwegian1 }
+ { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
+ { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
+ { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
+ { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
+ { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
+ { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
+ { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
+ { greek7 iso-ir-88 csISO88Greek7 }
+ { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
+ { iso-ir-90 csISO90 }
+ { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
+ { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
+ csISO92JISC62991984b }
+ { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
+ { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
+ { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
+ csISO95JIS62291984handadd }
+ { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
+ { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
+ { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
+ { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
+ CP819 csISOLatin1 }
+ { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
+ { T.61-7bit iso-ir-102 csISO102T617bit }
+ { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
+ { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
+ { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
+ { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
+ { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
+ { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
+ { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
+ { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
+ arabic csISOLatinArabic }
+ { ISO_8859-6-E csISO88596E ISO-8859-6-E }
+ { ISO_8859-6-I csISO88596I ISO-8859-6-I }
+ { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
+ greek greek8 csISOLatinGreek }
+ { T.101-G2 iso-ir-128 csISO128T101G2 }
+ { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
+ csISOLatinHebrew }
+ { ISO_8859-8-E csISO88598E ISO-8859-8-E }
+ { ISO_8859-8-I csISO88598I ISO-8859-8-I }
+ { CSN_369103 iso-ir-139 csISO139CSN369103 }
+ { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
+ { ISO_6937-2-add iso-ir-142 csISOTextComm }
+ { IEC_P27-1 iso-ir-143 csISO143IECP271 }
+ { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
+ csISOLatinCyrillic }
+ { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
+ { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
+ { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
+ { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
+ { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
+ { ISO_6937-2-25 iso-ir-152 csISO6937Add }
+ { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
+ { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
+ { ISO_10367-box iso-ir-155 csISO10367Box }
+ { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
+ { latin-lap lap iso-ir-158 csISO158Lap }
+ { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
+ { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
+ { us-dk csUSDK }
+ { dk-us csDKUS }
+ { JIS_X0201 X0201 csHalfWidthKatakana }
+ { KSC5636 ISO646-KR csKSC5636 }
+ { ISO-10646-UCS-2 csUnicode }
+ { ISO-10646-UCS-4 csUCS4 }
+ { DEC-MCS dec csDECMCS }
+ { hp-roman8 roman8 r8 csHPRoman8 }
+ { macintosh mac csMacintosh }
+ { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
+ csIBM037 }
+ { IBM038 EBCDIC-INT cp038 csIBM038 }
+ { IBM273 CP273 csIBM273 }
+ { IBM274 EBCDIC-BE CP274 csIBM274 }
+ { IBM275 EBCDIC-BR cp275 csIBM275 }
+ { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
+ { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
+ { IBM280 CP280 ebcdic-cp-it csIBM280 }
+ { IBM281 EBCDIC-JP-E cp281 csIBM281 }
+ { IBM284 CP284 ebcdic-cp-es csIBM284 }
+ { IBM285 CP285 ebcdic-cp-gb csIBM285 }
+ { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
+ { IBM297 cp297 ebcdic-cp-fr csIBM297 }
+ { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
+ { IBM423 cp423 ebcdic-cp-gr csIBM423 }
+ { IBM424 cp424 ebcdic-cp-he csIBM424 }
+ { IBM437 cp437 437 csPC8CodePage437 }
+ { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
+ { IBM775 cp775 csPC775Baltic }
+ { IBM850 cp850 850 csPC850Multilingual }
+ { IBM851 cp851 851 csIBM851 }
+ { IBM852 cp852 852 csPCp852 }
+ { IBM855 cp855 855 csIBM855 }
+ { IBM857 cp857 857 csIBM857 }
+ { IBM860 cp860 860 csIBM860 }
+ { IBM861 cp861 861 cp-is csIBM861 }
+ { IBM862 cp862 862 csPC862LatinHebrew }
+ { IBM863 cp863 863 csIBM863 }
+ { IBM864 cp864 csIBM864 }
+ { IBM865 cp865 865 csIBM865 }
+ { IBM866 cp866 866 csIBM866 }
+ { IBM868 CP868 cp-ar csIBM868 }
+ { IBM869 cp869 869 cp-gr csIBM869 }
+ { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
+ { IBM871 CP871 ebcdic-cp-is csIBM871 }
+ { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
+ { IBM891 cp891 csIBM891 }
+ { IBM903 cp903 csIBM903 }
+ { IBM904 cp904 904 csIBBM904 }
+ { IBM905 CP905 ebcdic-cp-tr csIBM905 }
+ { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
+ { IBM1026 CP1026 csIBM1026 }
+ { EBCDIC-AT-DE csIBMEBCDICATDE }
+ { EBCDIC-AT-DE-A csEBCDICATDEA }
+ { EBCDIC-CA-FR csEBCDICCAFR }
+ { EBCDIC-DK-NO csEBCDICDKNO }
+ { EBCDIC-DK-NO-A csEBCDICDKNOA }
+ { EBCDIC-FI-SE csEBCDICFISE }
+ { EBCDIC-FI-SE-A csEBCDICFISEA }
+ { EBCDIC-FR csEBCDICFR }
+ { EBCDIC-IT csEBCDICIT }
+ { EBCDIC-PT csEBCDICPT }
+ { EBCDIC-ES csEBCDICES }
+ { EBCDIC-ES-A csEBCDICESA }
+ { EBCDIC-ES-S csEBCDICESS }
+ { EBCDIC-UK csEBCDICUK }
+ { EBCDIC-US csEBCDICUS }
+ { UNKNOWN-8BIT csUnknown8BiT }
+ { MNEMONIC csMnemonic }
+ { MNEM csMnem }
+ { VISCII csVISCII }
+ { VIQR csVIQR }
+ { KOI8-R csKOI8R }
+ { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
+ { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
+ { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
+ { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
+ { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
+ { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
+ { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
+ { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
+ { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
+ { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
+ { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
+ { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
+ { IBM1047 IBM-1047 }
+ { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
+ { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
+ { UNICODE-1-1 csUnicode11 }
+ { CESU-8 csCESU-8 }
+ { BOCU-1 csBOCU-1 }
+ { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
+ { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
+ l8 }
+ { ISO-8859-15 ISO_8859-15 Latin-9 }
+ { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
+ { GBK CP936 MS936 windows-936 }
+ { JIS_Encoding csJISEncoding }
+ { Shift_JIS MS_Kanji csShiftJIS }
+ { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
+ EUC-JP }
+ { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
+ { ISO-10646-UCS-Basic csUnicodeASCII }
+ { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
+ { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
+ { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
+ { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
+ { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
+ { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
+ { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
+ { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
+ { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
+ { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
+ { Adobe-Standard-Encoding csAdobeStandardEncoding }
+ { Ventura-US csVenturaUS }
+ { Ventura-International csVenturaInternational }
+ { PC8-Danish-Norwegian csPC8DanishNorwegian }
+ { PC8-Turkish csPC8Turkish }
+ { IBM-Symbols csIBMSymbols }
+ { IBM-Thai csIBMThai }
+ { HP-Legal csHPLegal }
+ { HP-Pi-font csHPPiFont }
+ { HP-Math8 csHPMath8 }
+ { Adobe-Symbol-Encoding csHPPSMath }
+ { HP-DeskTop csHPDesktop }
+ { Ventura-Math csVenturaMath }
+ { Microsoft-Publishing csMicrosoftPublishing }
+ { Windows-31J csWindows31J }
+ { GB2312 csGB2312 }
+ { Big5 csBig5 }
+}
+
+proc tcl_encoding {enc} {
+ global encoding_aliases
+ set names [encoding names]
+ set lcnames [string tolower $names]
+ set enc [string tolower $enc]
+ set i [lsearch -exact $lcnames $enc]
+ if {$i < 0} {
+ # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
+ if {[regsub {^iso[-_]} $enc iso encx]} {
+ set i [lsearch -exact $lcnames $encx]
+ }
+ }
+ if {$i < 0} {
+ foreach l $encoding_aliases {
+ set ll [string tolower $l]
+ if {[lsearch -exact $ll $enc] < 0} continue
+ # look through the aliases for one that tcl knows about
+ foreach e $ll {
+ set i [lsearch -exact $lcnames $e]
+ if {$i < 0} {
+ if {[regsub {^iso[-_]} $e iso ex]} {
+ set i [lsearch -exact $lcnames $ex]
+ }
+ }
+ if {$i >= 0} break
+ }
+ break
+ }
+ }
+ if {$i >= 0} {
+ return [lindex $names $i]
+ }
+ return {}
+}
diff --git a/git-gui/lib/error.tcl b/git-gui/lib/error.tcl
index d0253ae..16a2218 100644
--- a/git-gui/lib/error.tcl
+++ b/git-gui/lib/error.tcl
@@ -51,12 +51,15 @@ proc ask_popup {msg} {
if {[reponame] ne {}} {
append title " ([reponame])"
}
- return [tk_messageBox \
- -parent . \
+ set cmd [list tk_messageBox \
-icon question \
-type yesno \
-title $title \
-message $msg]
+ if {[winfo ismapped .]} {
+ lappend cmd -parent .
+ }
+ eval $cmd
}
proc hook_failed_popup {hook msg} {
diff --git a/git-gui/lib/index.tcl b/git-gui/lib/index.tcl
index 4274285..f47f929 100644
--- a/git-gui/lib/index.tcl
+++ b/git-gui/lib/index.tcl
@@ -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.}}]
}
}
@@ -360,7 +360,7 @@ proc revert_helper {txt paths} {
"[appname] ([reponame])" \
"Revert changes in $s?
-Any unadded changes will be permanently lost by the revert." \
+Any unstaged changes will be permanently lost by the revert." \
question \
1 \
{Do Nothing} \
@@ -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
}
diff --git a/git-gui/lib/merge.tcl b/git-gui/lib/merge.tcl
index 889182f..5de0d82 100644
--- a/git-gui/lib/merge.tcl
+++ b/git-gui/lib/merge.tcl
@@ -1,9 +1,12 @@
# git-gui branch merge support
# Copyright (C) 2006, 2007 Shawn Pearce
-namespace eval merge {
+class merge {
+
+field w ; # top level window
+field w_rev ; # mega-widget to pick the revision to merge
-proc _can_merge {} {
+method _can_merge {} {
global HEAD commit_type file_states
if {[string match amend* $commit_type]} {
@@ -28,7 +31,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
}
@@ -42,7 +45,7 @@ The rescan will be automatically started now.
File [short_path $path] has merge conflicts.
-You must resolve them, add the file, and commit to complete the current merge. Only then can you begin another merge.
+You must resolve them, stage the file, and commit to complete the current merge. Only then can you begin another merge.
"
unlock_index
return 0
@@ -63,145 +66,93 @@ You should complete the current commit before starting a merge. Doing so will h
return 1
}
-proc _refs {w list} {
- set r {}
- foreach i [$w.source.l curselection] {
- lappend r [lindex [lindex $list $i] 0]
+method _rev {} {
+ if {[catch {$w_rev commit_or_die}]} {
+ return {}
}
- return $r
+ return [$w_rev get]
}
-proc _visualize {w list} {
- set revs [_refs $w $list]
- if {$revs eq {}} return
- lappend revs --not HEAD
- do_gitk $revs
+method _visualize {} {
+ set rev [_rev $this]
+ if {$rev ne {}} {
+ do_gitk [list $rev --not HEAD]
+ }
}
-proc _start {w list} {
- global HEAD ui_status_value current_branch
+method _start {} {
+ global HEAD current_branch remote_url
- set cmd [list git merge]
- set names [_refs $w $list]
- set revcnt [llength $names]
- append cmd { } $names
-
- if {$revcnt == 0} {
+ set name [_rev $this]
+ if {$name eq {}} {
return
- } elseif {$revcnt == 1} {
- set unit branch
- } elseif {$revcnt <= 15} {
- set unit branches
-
- if {[tk_dialog \
- $w.confirm_octopus \
- [wm title $w] \
- "Use octopus merge strategy?
-
-You are merging $revcnt branches at once. This requires using the octopus merge driver, which may not succeed if there are file-level conflicts.
-" \
- question \
- 0 \
- {Cancel} \
- {Use octopus} \
- ] != 1} return
- } else {
- tk_messageBox \
- -icon error \
- -type ok \
- -title [wm title $w] \
- -parent $w \
- -message "Too many branches selected.
+ }
-You have requested to merge $revcnt branches in an octopus merge. This exceeds Git's internal limit of 15 branches per merge.
+ set spec [$w_rev get_tracking_branch]
+ set cmit [$w_rev get_commit]
-Please select fewer branches. To merge more than 15 branches, merge the branches in batches.
-"
- return
+ set fh [open [gitdir FETCH_HEAD] w]
+ fconfigure $fh -translation lf
+ if {$spec eq {}} {
+ set remote .
+ set branch $name
+ set stitle $branch
+ } else {
+ set remote $remote_url([lindex $spec 1])
+ if {[regexp {^[^:@]*@[^:]*:/} $remote]} {
+ regsub {^[^:@]*@} $remote {} remote
+ }
+ set branch [lindex $spec 2]
+ set stitle "$branch of $remote"
}
-
- set msg "Merging $current_branch, [join $names {, }]"
- set ui_status_value "$msg..."
- set cons [console::new "Merge" $msg]
- console::exec $cons $cmd \
- [namespace code [list _finish $revcnt $cons]]
+ regsub ^refs/heads/ $branch {} branch
+ puts $fh "$cmit\t\tbranch '$branch' of $remote"
+ close $fh
+
+ set cmd [list git]
+ lappend cmd merge
+ lappend cmd --strategy=recursive
+ lappend cmd [git fmt-merge-msg <[gitdir FETCH_HEAD]]
+ lappend cmd HEAD
+ lappend cmd $cmit
+
+ set msg "Merging $current_branch and $stitle"
+ ui_status "$msg..."
+ set cons [console::new "Merge" "merge $stitle"]
+ console::exec $cons $cmd [cb _finish $cons]
wm protocol $w WM_DELETE_WINDOW {}
destroy $w
}
-proc _finish {revcnt w ok} {
- console::done $w $ok
+method _finish {cons ok} {
+ console::done $cons $ok
if {$ok} {
set msg {Merge completed successfully.}
} else {
- if {$revcnt != 1} {
- info_popup "Octopus merge failed.
-
-Your merge of $revcnt branches has failed.
-
-There are file-level conflicts between the branches which must be resolved manually.
-
-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]
- fconfigure $fd -blocking 0 -translation binary
- fileevent $fd readable \
- [namespace code [list _reset_wait $fd]]
- set ui_status_value {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]
+ delete_this
}
-proc dialog {} {
+constructor dialog {} {
global current_branch
global M1B
- 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]
- fconfigure $fr_fd -translation binary
- while {[gets $fr_fd line] > 0} {
- set line [eval $line]
- set ref [lindex $line 2]
- regsub ^refs/(heads|remotes|tags)/ $ref {} ref
- set subj($ref) [lindex $line 3]
- lappend sha1([lindex $line 0]) $ref
- if {[lindex $line 1] ne {}} {
- lappend sha1([lindex $line 1]) $ref
- }
- }
- close $fr_fd
-
- set to_show {}
- set fr_fd [open "| git rev-list --all --not HEAD"]
- while {[gets $fr_fd line] > 0} {
- if {[catch {set ref $sha1($line)}]} continue
- foreach n $ref {
- lappend to_show [list $n $line]
- }
+ if {![_can_merge $this]} {
+ delete_this
+ return
}
- close $fr_fd
- set to_show [lsort -unique $to_show]
- set w .merge_setup
- toplevel $w
- wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
+ make_toplevel top w
+ wm title $top "[appname] ([reponame]): Merge"
+ if {$top ne {.}} {
+ wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
+ }
- set _visualize [namespace code [list _visualize $w $to_show]]
- set _start [namespace code [list _start $w $to_show]]
+ set _start [cb _start]
label $w.header \
-text "Merge Into $current_branch" \
@@ -209,55 +160,51 @@ proc dialog {} {
pack $w.header -side top -fill x
frame $w.buttons
- button $w.buttons.visualize -text Visualize -command $_visualize
+ button $w.buttons.visualize \
+ -text Visualize \
+ -command [cb _visualize]
pack $w.buttons.visualize -side left
- button $w.buttons.create -text Merge -command $_start
- pack $w.buttons.create -side right
+ button $w.buttons.merge \
+ -text Merge \
+ -command $_start
+ pack $w.buttons.merge -side right
button $w.buttons.cancel \
-text {Cancel} \
- -command "unlock_index;destroy $w"
+ -command [cb _cancel]
pack $w.buttons.cancel -side right -padx 5
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
- labelframe $w.source -text {Source Branches}
- listbox $w.source.l \
- -height 10 \
- -width 70 \
- -font font_diff \
- -selectmode extended \
- -yscrollcommand [list $w.source.sby set]
- scrollbar $w.source.sby -command [list $w.source.l yview]
- pack $w.source.sby -side right -fill y
- pack $w.source.l -side left -fill both -expand 1
- pack $w.source -fill both -expand 1 -pady 5 -padx 5
-
- foreach ref $to_show {
- set n [lindex $ref 0]
- if {[string length $n] > 20} {
- set n "[string range $n 0 16]..."
- }
- $w.source.l insert end [format {%s %-20s %s} \
- [string range [lindex $ref 1] 0 5] \
- $n \
- $subj([lindex $ref 0])]
- }
-
- bind $w.source.l <Key-K> [list event generate %W <Shift-Key-Up>]
- bind $w.source.l <Key-J> [list event generate %W <Shift-Key-Down>]
- bind $w.source.l <Key-k> [list event generate %W <Key-Up>]
- bind $w.source.l <Key-j> [list event generate %W <Key-Down>]
- bind $w.source.l <Key-h> [list event generate %W <Key-Left>]
- bind $w.source.l <Key-l> [list event generate %W <Key-Right>]
- bind $w.source.l <Key-v> $_visualize
+ set w_rev [::choose_rev::new_unmerged $w.rev {Revision To Merge}]
+ pack $w.rev -anchor nw -fill both -expand 1 -pady 5 -padx 5
bind $w <$M1B-Key-Return> $_start
- bind $w <Visibility> "grab $w; focus $w.source.l"
- bind $w <Key-Escape> "unlock_index;destroy $w"
- wm protocol $w WM_DELETE_WINDOW "unlock_index;destroy $w"
- wm title $w "[appname] ([reponame]): Merge"
+ bind $w <Key-Return> $_start
+ bind $w <Key-Escape> [cb _cancel]
+ wm protocol $w WM_DELETE_WINDOW [cb _cancel]
+
+ bind $w.buttons.merge <Visibility> [cb _visible]
tkwait window $w
}
+method _visible {} {
+ grab $w
+ if {[is_config_true gui.matchtrackingbranch]} {
+ $w_rev pick_tracking_branch
+ }
+ $w_rev focus_filter
+}
+
+method _cancel {} {
+ wm protocol $w WM_DELETE_WINDOW {}
+ unlock_index
+ destroy $w
+ delete_this
+}
+
+}
+
+namespace eval merge {
+
proc reset_hard {} {
global HEAD commit_type file_states
@@ -272,20 +219,24 @@ You must finish amending this commit.
if {![lock_index abort]} return
if {[string match *merge* $commit_type]} {
- set op merge
+ set op_question "Abort merge?
+
+Aborting the current merge will cause *ALL* uncommitted changes to be lost.
+
+Continue with aborting the current merge?"
} else {
- set op commit
- }
+ set op_question "Reset changes?
- if {[ask_popup "Abort $op?
+Resetting the changes will cause *ALL* uncommitted changes to be lost.
-Aborting the current $op will cause *ALL* uncommitted changes to be lost.
+Continue with resetting the current changes?"
+ }
-Continue with aborting the current $op?"] eq {yes}} {
- set fd [open "| git read-tree --reset -u HEAD" r]
+ if {[ask_popup $op_question] eq {yes}} {
+ set fd [git_read --stderr read-tree --reset -u -v HEAD]
fconfigure $fd -blocking 0 -translation binary
fileevent $fd readable [namespace code [list _reset_wait $fd]]
- set ui_status_value {Aborting... please wait...}
+ $::main_status start {Aborting} {files reset}
} else {
unlock_index
}
@@ -294,9 +245,12 @@ Continue with aborting the current $op?"] eq {yes}} {
proc _reset_wait {fd} {
global ui_comm
- read $fd
+ $::main_status update_meter [read $fd]
+
+ fconfigure $fd -blocking 1
if {[eof $fd]} {
- close $fd
+ set fail [catch {close $fd} err]
+ $::main_status stop
unlock_index
$ui_comm delete 0.0 end
@@ -308,7 +262,12 @@ proc _reset_wait {fd} {
catch {file delete [gitdir MERGE_MSG]}
catch {file delete [gitdir GITGUI_MSG]}
- rescan {set ui_status_value {Abort completed. Ready.}}
+ if {$fail} {
+ warn_popup "Abort failed.\n\n$err"
+ }
+ rescan {ui_status {Abort completed. Ready.}}
+ } else {
+ fconfigure $fd -blocking 0
}
}
diff --git a/git-gui/lib/option.tcl b/git-gui/lib/option.tcl
index b29e14e..aa9f783 100644
--- a/git-gui/lib/option.tcl
+++ b/git-gui/lib/option.tcl
@@ -55,7 +55,7 @@ proc save_config {} {
}
proc do_about {} {
- global appvers copyright
+ global appvers copyright oguilib
global tcl_patchLevel tk_patchLevel
set w .about_dialog
@@ -94,6 +94,11 @@ $copyright" \
append v ", Tk version $tk_patchLevel"
}
+ set d {}
+ append d "git wrapper: $::_git\n"
+ append d "git exec dir: [gitexec]\n"
+ append d "git-gui lib: $oguilib"
+
label $w.vers \
-text $v \
-padx 5 -pady 5 \
@@ -103,6 +108,15 @@ $copyright" \
-relief solid
pack $w.vers -side top -fill x -padx 5 -pady 5
+ label $w.dirs \
+ -text $d \
+ -padx 5 -pady 5 \
+ -justify left \
+ -anchor w \
+ -borderwidth 1 \
+ -relief solid
+ pack $w.dirs -side top -fill x -padx 5 -pady 5
+
menu $w.ctxm -tearoff 0
$w.ctxm add command \
-label {Copy} \
@@ -174,8 +188,11 @@ proc do_options {} {
{b merge.summary {Summarize Merge Commits}}
{i-1..5 merge.verbosity {Merge Verbosity}}
+ {b merge.diffstat {Show Diffstat After Merge}}
{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}}
} {
diff --git a/git-gui/lib/remote.tcl b/git-gui/lib/remote.tcl
index 99f353e..cf9b9d5 100644
--- a/git-gui/lib/remote.tcl
+++ b/git-gui/lib/remote.tcl
@@ -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,54 @@ 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
+ global remote_url
+ 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 \
@@ -60,12 +77,25 @@ proc load_all_remotes {} {
catch {
set fd [open [file join $rm_dir $name] r]
while {[gets $fd line] >= 0} {
+ if {[regexp {^URL:[ ]*(.+)$} $line line url]} {
+ set remote_url($name) $url
+ continue
+ }
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]
+ }
+ if {![string equal -length 5 refs/ $src]} {
+ set src $rh_str$src
}
- set tracking_branches($dst) [list $name $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
}
@@ -75,19 +105,30 @@ proc load_all_remotes {} {
foreach line [array names repo_config remote.*.url] {
if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
lappend all_remotes $name
+ set remote_url($name) $repo_config(remote.$name.url)
if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
set fl {}
}
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]
+ }
+ if {![string equal -length 5 refs/ $src]} {
+ set src $rh_str$src
+ }
+ if {![string equal -length 5 refs/ $dst]} {
+ set dst $rh_str$dst
}
- set tracking_branches($dst) [list $name $src]
+ 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]
}
@@ -95,6 +136,7 @@ proc populate_fetch_menu {} {
global all_remotes repo_config
set m .mbar.fetch
+ set prune_list [list]
foreach r $all_remotes {
set enable 0
if {![catch {set a $repo_config(remote.$r.url)}]} {
@@ -115,11 +157,21 @@ proc populate_fetch_menu {} {
}
if {$enable} {
+ lappend prune_list $r
$m add command \
-label "Fetch from $r..." \
-command [list fetch_from $r]
}
}
+
+ if {$prune_list ne {}} {
+ $m add separator
+ }
+ foreach r $prune_list {
+ $m add command \
+ -label "Prune from $r..." \
+ -command [list prune_from $r]
+ }
}
proc populate_push_menu {} {
diff --git a/git-gui/lib/remote_branch_delete.tcl b/git-gui/lib/remote_branch_delete.tcl
new file mode 100644
index 0000000..c88a360
--- /dev/null
+++ b/git-gui/lib/remote_branch_delete.tcl
@@ -0,0 +1,347 @@
+# git-gui remote branch deleting support
+# Copyright (C) 2007 Shawn Pearce
+
+class remote_branch_delete {
+
+field w
+field head_m
+
+field urltype {url}
+field remote {}
+field url {}
+
+field checktype {head}
+field check_head {}
+
+field status {}
+field idle_id {}
+field full_list {}
+field head_list {}
+field active_ls {}
+field head_cache
+field full_cache
+field cached
+
+constructor dialog {} {
+ global all_remotes M1B
+
+ make_toplevel top w
+ wm title $top "[appname] ([reponame]): Delete Remote Branch"
+ if {$top ne {.}} {
+ wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
+ }
+
+ label $w.header -text {Delete Remote Branch} -font font_uibold
+ pack $w.header -side top -fill x
+
+ frame $w.buttons
+ button $w.buttons.delete -text Delete \
+ -default active \
+ -command [cb _delete]
+ pack $w.buttons.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.dest -text {From Repository}
+ if {$all_remotes ne {}} {
+ radiobutton $w.dest.remote_r \
+ -text {Remote:} \
+ -value remote \
+ -variable @urltype
+ eval tk_optionMenu $w.dest.remote_m @remote $all_remotes
+ grid $w.dest.remote_r $w.dest.remote_m -sticky w
+ if {[lsearch -sorted -exact $all_remotes origin] != -1} {
+ set remote origin
+ } else {
+ set remote [lindex $all_remotes 0]
+ }
+ set urltype remote
+ trace add variable @remote write [cb _write_remote]
+ } else {
+ set urltype url
+ }
+ radiobutton $w.dest.url_r \
+ -text {Arbitrary URL:} \
+ -value url \
+ -variable @urltype
+ entry $w.dest.url_t \
+ -borderwidth 1 \
+ -relief sunken \
+ -width 50 \
+ -textvariable @url \
+ -validate key \
+ -validatecommand {
+ if {%d == 1 && [regexp {\s} %S]} {return 0}
+ return 1
+ }
+ trace add variable @url write [cb _write_url]
+ grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
+ grid columnconfigure $w.dest 1 -weight 1
+ pack $w.dest -anchor nw -fill x -pady 5 -padx 5
+
+ labelframe $w.heads -text {Branches}
+ listbox $w.heads.l \
+ -height 10 \
+ -width 70 \
+ -listvariable @head_list \
+ -selectmode extended \
+ -yscrollcommand [list $w.heads.sby set]
+ scrollbar $w.heads.sby -command [list $w.heads.l yview]
+
+ frame $w.heads.footer
+ label $w.heads.footer.status \
+ -textvariable @status \
+ -anchor w \
+ -justify left
+ button $w.heads.footer.rescan \
+ -text {Rescan} \
+ -command [cb _rescan]
+ pack $w.heads.footer.status -side left -fill x
+ pack $w.heads.footer.rescan -side right
+
+ 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
+
+ labelframe $w.validate -text {Delete Only If}
+ radiobutton $w.validate.head_r \
+ -text {Merged Into:} \
+ -value head \
+ -variable @checktype
+ set head_m [tk_optionMenu $w.validate.head_m @check_head {}]
+ trace add variable @head_list write [cb _write_head_list]
+ trace add variable @check_head write [cb _write_check_head]
+ grid $w.validate.head_r $w.validate.head_m -sticky w
+ radiobutton $w.validate.always_r \
+ -text {Always (Do not perform merge checks)} \
+ -value always \
+ -variable @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
+
+ trace add variable @urltype write [cb _write_urltype]
+ _rescan $this
+
+ bind $w <Key-F5> [cb _rescan]
+ bind $w <$M1B-Key-r> [cb _rescan]
+ bind $w <$M1B-Key-R> [cb _rescan]
+ bind $w <Key-Return> [cb _delete]
+ bind $w <Key-Escape> [list destroy $w]
+ return $w
+}
+
+method _delete {} {
+ switch $urltype {
+ remote {set uri $remote}
+ url {set uri $url}
+ }
+
+ set cache $urltype:$uri
+ set crev {}
+ if {$checktype eq {head}} {
+ if {$check_head eq {}} {
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title [wm title $w] \
+ -parent $w \
+ -message "A branch is required for 'Merged Into'."
+ return
+ }
+ set crev $full_cache("$cache\nrefs/heads/$check_head")
+ }
+
+ set not_merged [list]
+ set need_fetch 0
+ set have_selection 0
+ set push_cmd [list git push]
+ lappend push_cmd -v
+ lappend push_cmd $uri
+
+ foreach i [$w.heads.l curselection] {
+ set ref [lindex $full_list $i]
+ if {$crev ne {}} {
+ set obj $full_cache("$cache\n$ref")
+ if {[catch {set m [git merge-base $obj $crev]}]} {
+ set need_fetch 1
+ set m {}
+ }
+ if {$obj ne $m} {
+ lappend not_merged [lindex $head_list $i]
+ continue
+ }
+ }
+
+ lappend push_cmd :$ref
+ set have_selection 1
+ }
+
+ if {$not_merged ne {}} {
+ set msg "The following branches are not completely merged into $check_head:
+
+ - [join $not_merged "\n - "]"
+
+ if {$need_fetch} {
+ append msg "
+
+One or more of the merge tests failed because you have not fetched the necessary commits. Try fetching from $uri first."
+ }
+
+ tk_messageBox \
+ -icon info \
+ -type ok \
+ -title [wm title $w] \
+ -parent $w \
+ -message $msg
+ if {!$have_selection} return
+ }
+
+ if {!$have_selection} {
+ tk_messageBox \
+ -icon error \
+ -type ok \
+ -title [wm title $w] \
+ -parent $w \
+ -message "Please select one or more branches to delete."
+ return
+ }
+
+ if {[tk_messageBox \
+ -icon warning \
+ -type yesno \
+ -title [wm title $w] \
+ -parent $w \
+ -message {Recovering deleted branches is difficult.
+
+Delete the selected branches?}] ne yes} {
+ return
+ }
+
+ destroy $w
+
+ set cons [console::new \
+ "push $uri" \
+ "Deleting branches from $uri"]
+ console::exec $cons $push_cmd
+}
+
+method _rescan {{force 1}} {
+ switch $urltype {
+ remote {set uri $remote}
+ url {set uri $url}
+ }
+
+ if {$force} {
+ unset -nocomplain cached($urltype:$uri)
+ }
+
+ if {$idle_id ne {}} {
+ after cancel $idle_id
+ set idle_id {}
+ }
+
+ _load $this $urltype:$uri $uri
+}
+
+method _write_remote {args} { set urltype remote }
+method _write_url {args} { set urltype url }
+method _write_check_head {args} { set checktype head }
+
+method _write_head_list {args} {
+ $head_m delete 0 end
+ foreach abr $head_list {
+ $head_m insert end radiobutton \
+ -label $abr \
+ -value $abr \
+ -variable @check_head
+ }
+ if {[lsearch -exact -sorted $head_list $check_head] < 0} {
+ set check_head {}
+ }
+}
+
+method _write_urltype {args} {
+ if {$urltype eq {url}} {
+ if {$idle_id ne {}} {
+ after cancel $idle_id
+ }
+ _load $this none: {}
+ set idle_id [after 1000 [cb _rescan 0]]
+ } else {
+ _rescan $this 0
+ }
+}
+
+method _load {cache uri} {
+ if {$active_ls ne {}} {
+ catch {close $active_ls}
+ }
+
+ if {$uri eq {}} {
+ $w.heads.l conf -state disabled
+ set head_list [list]
+ set full_list [list]
+ set status {No repository selected.}
+ return
+ }
+
+ if {[catch {set x $cached($cache)}]} {
+ set status "Scanning $uri..."
+ $w.heads.l conf -state disabled
+ set head_list [list]
+ set full_list [list]
+ set head_cache($cache) [list]
+ set full_cache($cache) [list]
+ set active_ls [git_read ls-remote $uri]
+ fconfigure $active_ls \
+ -blocking 0 \
+ -translation lf \
+ -encoding utf-8
+ fileevent $active_ls readable [cb _read $cache $active_ls]
+ } else {
+ set status {}
+ set full_list $full_cache($cache)
+ set head_list $head_cache($cache)
+ $w.heads.l conf -state normal
+ }
+}
+
+method _read {cache fd} {
+ if {$fd ne $active_ls} {
+ catch {close $fd}
+ return
+ }
+
+ while {[gets $fd line] >= 0} {
+ if {[string match {*^{}} $line]} continue
+ if {[regexp {^([0-9a-f]{40}) (.*)$} $line _junk obj ref]} {
+ if {[regsub ^refs/heads/ $ref {} abr]} {
+ lappend head_list $abr
+ lappend head_cache($cache) $abr
+ lappend full_list $ref
+ lappend full_cache($cache) $ref
+ set full_cache("$cache\n$ref") $obj
+ }
+ }
+ }
+
+ if {[eof $fd]} {
+ if {[catch {close $fd} err]} {
+ set status $err
+ set head_list [list]
+ set full_list [list]
+ } else {
+ set status {}
+ set cached($cache) 1
+ $w.heads.l conf -state normal
+ }
+ }
+} ifdeleted {
+ catch {close $fd}
+}
+
+}
diff --git a/git-gui/lib/shortcut.tcl b/git-gui/lib/shortcut.tcl
index a0a1b7d..c36be2f 100644
--- a/git-gui/lib/shortcut.tcl
+++ b/git-gui/lib/shortcut.tcl
@@ -13,10 +13,11 @@ proc do_windows_shortcut {} {
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]\""
@@ -53,7 +54,7 @@ proc do_cygwin_shortcut {} {
set sh [exec cygpath \
--windows \
--absolute \
- /bin/sh]
+ /bin/sh.exe]
set me [exec cygpath \
--unix \
--absolute \
@@ -62,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"
@@ -90,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]
@@ -123,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
diff --git a/git-gui/lib/status_bar.tcl b/git-gui/lib/status_bar.tcl
new file mode 100644
index 0000000..72a8fe1
--- /dev/null
+++ b/git-gui/lib/status_bar.tcl
@@ -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
+ }
+}
+
+}
diff --git a/git-gui/lib/transport.tcl b/git-gui/lib/transport.tcl
index c0e7d20..3a22bd4 100644
--- a/git-gui/lib/transport.tcl
+++ b/git-gui/lib/transport.tcl
@@ -5,9 +5,19 @@ proc fetch_from {remote} {
set w [console::new \
"fetch $remote" \
"Fetching new changes from $remote"]
- set cmd [list git fetch]
- lappend cmd $remote
- console::exec $w $cmd
+ set cmds [list]
+ lappend cmds [list exec git fetch $remote]
+ if {[is_config_true gui.pruneduringfetch]} {
+ lappend cmds [list exec git remote prune $remote]
+ }
+ console::chain $w $cmds
+}
+
+proc prune_from {remote} {
+ set w [console::new \
+ "remote prune $remote" \
+ "Pruning tracking branches deleted from $remote"]
+ console::exec $w [list git remote prune $remote]
}
proc push_to {remote} {
@@ -64,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
@@ -91,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