diff options
Diffstat (limited to 'git-gui/lib')
| -rw-r--r-- | git-gui/lib/branch_rename.tcl | 137 | ||||
| -rw-r--r-- | git-gui/lib/option.tcl | 17 | ||||
| -rw-r--r-- | git-gui/lib/remote.tcl | 11 | ||||
| -rw-r--r-- | git-gui/lib/remote_branch_delete.tcl | 348 | ||||
| -rw-r--r-- | git-gui/lib/transport.tcl | 16 |
5 files changed, 525 insertions, 4 deletions
diff --git a/git-gui/lib/branch_rename.tcl b/git-gui/lib/branch_rename.tcl new file mode 100644 index 0000000000..54c72b980c --- /dev/null +++ b/git-gui/lib/branch_rename.tcl @@ -0,0 +1,137 @@ +# git-gui branch rename support +# Copyright (C) 2007 Shawn Pearce + +class branch_rename { + +field w +field oldname +field newname + +constructor dialog {} { + global all_heads 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 $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 + " + bind $w.header <Destroy> [list delete_this $this] + tkwait window $w +} + +method _rename {} { + global all_heads 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 + } + + set oldidx [lsearch -exact -sorted $all_heads $oldname] + if {$oldidx >= 0} { + set all_heads [lreplace $all_heads $oldidx $oldidx] + } + lappend all_heads $newname + set all_heads [lsort $all_heads] + populate_branch_menu + + if {$current_branch eq $oldname} { + set current_branch $newname + } + + destroy $w +} + +} diff --git a/git-gui/lib/option.tcl b/git-gui/lib/option.tcl index b29e14e64d..ae19a8f9cf 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,10 @@ $copyright" \ append v ", Tk version $tk_patchLevel" } + set d {} + append d "git exec dir: [gitexec]\n" + append d "git-gui lib: $oguilib" + label $w.vers \ -text $v \ -padx 5 -pady 5 \ @@ -103,6 +107,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 +187,10 @@ 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}} {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..b54824ab72 100644 --- a/git-gui/lib/remote.tcl +++ b/git-gui/lib/remote.tcl @@ -95,6 +95,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 +116,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..bc39581b86 --- /dev/null +++ b/git-gui/lib/remote_branch_delete.tcl @@ -0,0 +1,348 @@ +# 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 -expand 1 + pack $w.heads.footer.rescan -side right + + pack $w.heads.footer -side bottom -fill x -expand 1 + 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] + bind $w.header <Destroy> [list delete_this $this] + 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 [open "| [list git ls-remote $uri]" r] + 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/transport.tcl b/git-gui/lib/transport.tcl index c0e7d20fce..e8ebc6eda0 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} { |