diff options
Diffstat (limited to 'git-gui/lib')
| -rw-r--r-- | git-gui/lib/blame.tcl | 111 | ||||
| -rw-r--r-- | git-gui/lib/branch.tcl | 562 | ||||
| -rw-r--r-- | git-gui/lib/branch_checkout.tcl | 89 | ||||
| -rw-r--r-- | git-gui/lib/branch_create.tcl | 220 | ||||
| -rw-r--r-- | git-gui/lib/branch_delete.tcl | 149 | ||||
| -rw-r--r-- | git-gui/lib/branch_rename.tcl | 128 | ||||
| -rw-r--r-- | git-gui/lib/browser.tcl | 88 | ||||
| -rw-r--r-- | git-gui/lib/checkout_op.tcl | 588 | ||||
| -rw-r--r-- | git-gui/lib/choose_rev.tcl | 627 | ||||
| -rw-r--r-- | git-gui/lib/class.tcl | 38 | ||||
| -rw-r--r-- | git-gui/lib/commit.tcl | 84 | ||||
| -rw-r--r-- | git-gui/lib/console.tcl | 69 | ||||
| -rw-r--r-- | git-gui/lib/database.tcl | 29 | ||||
| -rw-r--r-- | git-gui/lib/diff.tcl | 27 | ||||
| -rw-r--r-- | git-gui/lib/encoding.tcl | 276 | ||||
| -rw-r--r-- | git-gui/lib/error.tcl | 7 | ||||
| -rw-r--r-- | git-gui/lib/index.tcl | 50 | ||||
| -rw-r--r-- | git-gui/lib/merge.tcl | 285 | ||||
| -rw-r--r-- | git-gui/lib/option.tcl | 19 | ||||
| -rw-r--r-- | git-gui/lib/remote.tcl | 106 | ||||
| -rw-r--r-- | git-gui/lib/remote_branch_delete.tcl | 347 | ||||
| -rw-r--r-- | git-gui/lib/shortcut.tcl | 51 | ||||
| -rw-r--r-- | git-gui/lib/status_bar.tcl | 96 | ||||
| -rw-r--r-- | git-gui/lib/transport.tcl | 20 |
24 files changed, 3112 insertions, 954 deletions
diff --git a/git-gui/lib/blame.tcl b/git-gui/lib/blame.tcl index 1d2caac283..96072847a2 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 4f648b2bc7..777eeb79c1 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 0000000000..72c45b4554 --- /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 0000000000..def615d19d --- /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 0000000000..c7573c6c72 --- /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 0000000000..1cadc31d20 --- /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 e612247c9e..888db3c889 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 0000000000..170f737f61 --- /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 0000000000..ec064b3e13 --- /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 9d298d0dcc..24e8cecea4 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 e139f4da2b..f857a2ff5b 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 34de5d4859..6f718fbac3 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 43e4a289bb..0657cc2245 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 29436b50cb..e09e1257e1 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 0000000000..7f06b0d47f --- /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 d0253ae2ff..16a22187b2 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 42742850ee..f47f9290c8 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 889182f545..5de0d82b14 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 b29e14e64d..aa9f783afd 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 99f353ed7d..cf9b9d5829 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 0000000000..c88a360db5 --- /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 a0a1b7dddd..c36be2f3cd 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 0000000000..72a8fe1fd3 --- /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 c0e7d20fce..3a22bd40d4 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 |