mirror of
https://github.com/git/git
synced 2024-08-25 10:45:59 +00:00
Merge branch 'master' of git://repo.or.cz/git-gui
* 'master' of git://repo.or.cz/git-gui: git-gui: Internalize symbolic-ref HEAD reading logic git-gui: Expose the merge.diffstat configuration option git-gui: Allow users to delete remote branches git-gui: Allow users to rename branches through 'branch -m' git-gui: Disable tearoff menus on Windows, Mac OS X git-gui: Provide fatal error if library is unavailable git-gui: Enable verbose Tcl loading earlier git-gui: Show the git-gui library path in 'About git-gui' git-gui: GUI support for running 'git remote prune <name>' git gui 0.8.0
This commit is contained in:
Junio C Hamano
commit
75d8ff138d
|
|
@ -1,7 +1,7 @@
|
|||
#!/bin/sh
|
||||
|
||||
GVF=GIT-VERSION-FILE
|
||||
DEF_VER=0.7.GITGUI
|
||||
DEF_VER=0.8.GITGUI
|
||||
|
||||
LF='
|
||||
'
|
||||
|
|
|
|||
|
|
@ -38,44 +38,7 @@ if {[catch {package require Tcl 8.4} err]
|
|||
|
||||
######################################################################
|
||||
##
|
||||
## configure our library
|
||||
|
||||
set oguilib {@@GITGUI_LIBDIR@@}
|
||||
set oguirel {@@GITGUI_RELATIVE@@}
|
||||
if {$oguirel eq {1}} {
|
||||
set oguilib [file dirname [file dirname [file normalize $argv0]]]
|
||||
set oguilib [file join $oguilib share git-gui lib]
|
||||
} elseif {[string match @@* $oguirel]} {
|
||||
set oguilib [file join [file dirname [file normalize $argv0]] lib]
|
||||
}
|
||||
set idx [file join $oguilib tclIndex]
|
||||
catch {
|
||||
set fd [open $idx r]
|
||||
if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
|
||||
set idx [list]
|
||||
while {[gets $fd n] >= 0} {
|
||||
if {$n ne {} && ![string match #* $n]} {
|
||||
lappend idx $n
|
||||
}
|
||||
}
|
||||
} else {
|
||||
set idx {}
|
||||
}
|
||||
close $fd
|
||||
}
|
||||
if {$idx ne {}} {
|
||||
set loaded [list]
|
||||
foreach p $idx {
|
||||
if {[lsearch -exact $loaded $p] >= 0} continue
|
||||
puts $p
|
||||
source [file join $oguilib $p]
|
||||
lappend loaded $p
|
||||
}
|
||||
unset loaded p
|
||||
} else {
|
||||
set auto_path [concat [list $oguilib] $auto_path]
|
||||
}
|
||||
unset -nocomplain oguilib oguirel idx fd
|
||||
## enable verbose loading?
|
||||
|
||||
if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
|
||||
unset _verbose
|
||||
|
|
@ -91,6 +54,54 @@ if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
|
|||
}
|
||||
}
|
||||
|
||||
######################################################################
|
||||
##
|
||||
## configure our library
|
||||
|
||||
set oguilib {@@GITGUI_LIBDIR@@}
|
||||
set oguirel {@@GITGUI_RELATIVE@@}
|
||||
if {$oguirel eq {1}} {
|
||||
set oguilib [file dirname [file dirname [file normalize $argv0]]]
|
||||
set oguilib [file join $oguilib share git-gui lib]
|
||||
} elseif {[string match @@* $oguirel]} {
|
||||
set oguilib [file join [file dirname [file normalize $argv0]] lib]
|
||||
}
|
||||
|
||||
set idx [file join $oguilib tclIndex]
|
||||
if {[catch {set fd [open $idx r]} err]} {
|
||||
catch {wm withdraw .}
|
||||
tk_messageBox \
|
||||
-icon error \
|
||||
-type ok \
|
||||
-title "git-gui: fatal error" \
|
||||
-message $err
|
||||
exit 1
|
||||
}
|
||||
if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
|
||||
set idx [list]
|
||||
while {[gets $fd n] >= 0} {
|
||||
if {$n ne {} && ![string match #* $n]} {
|
||||
lappend idx $n
|
||||
}
|
||||
}
|
||||
} else {
|
||||
set idx {}
|
||||
}
|
||||
close $fd
|
||||
|
||||
if {$idx ne {}} {
|
||||
set loaded [list]
|
||||
foreach p $idx {
|
||||
if {[lsearch -exact $loaded $p] >= 0} continue
|
||||
source [file join $oguilib $p]
|
||||
lappend loaded $p
|
||||
}
|
||||
unset loaded p
|
||||
} else {
|
||||
set auto_path [concat [list $oguilib] $auto_path]
|
||||
}
|
||||
unset -nocomplain oguirel idx fd
|
||||
|
||||
######################################################################
|
||||
##
|
||||
## read only globals
|
||||
|
|
@ -205,6 +216,15 @@ proc is_config_true {name} {
|
|||
}
|
||||
}
|
||||
|
||||
proc get_config {name} {
|
||||
global repo_config
|
||||
if {[catch {set v $repo_config($name)}]} {
|
||||
return {}
|
||||
} else {
|
||||
return $v
|
||||
}
|
||||
}
|
||||
|
||||
proc load_config {include_global} {
|
||||
global repo_config global_config default_config
|
||||
|
||||
|
|
@ -258,6 +278,17 @@ proc git {args} {
|
|||
return [eval exec git $args]
|
||||
}
|
||||
|
||||
proc current-branch {} {
|
||||
set ref {}
|
||||
set fd [open [gitdir HEAD] r]
|
||||
if {[gets $fd ref] <16
|
||||
|| ![regsub {^ref: refs/heads/} $ref {} ref]} {
|
||||
set ref {}
|
||||
}
|
||||
close $fd
|
||||
return $ref
|
||||
}
|
||||
|
||||
auto_load tk_optionMenu
|
||||
rename tk_optionMenu real__tkOptionMenu
|
||||
proc tk_optionMenu {w varName args} {
|
||||
|
|
@ -406,15 +437,7 @@ proc repository_state {ctvar hdvar mhvar} {
|
|||
|
||||
set mh [list]
|
||||
|
||||
if {[catch {set current_branch [git symbolic-ref HEAD]}]} {
|
||||
set current_branch {}
|
||||
} else {
|
||||
regsub ^refs/((heads|tags|remotes)/)? \
|
||||
$current_branch \
|
||||
{} \
|
||||
current_branch
|
||||
}
|
||||
|
||||
set current_branch [current-branch]
|
||||
if {[catch {set hd [git rev-parse --verify HEAD]}]} {
|
||||
set hd {}
|
||||
set ct initial
|
||||
|
|
@ -1229,6 +1252,10 @@ foreach class {Button Checkbutton Entry Label
|
|||
}
|
||||
unset class
|
||||
|
||||
if {[is_Windows] || [is_MacOSX]} {
|
||||
option add *Menu.tearOff 0
|
||||
}
|
||||
|
||||
if {[is_MacOSX]} {
|
||||
set M1B M1
|
||||
set M1T Cmd
|
||||
|
|
@ -1259,11 +1286,13 @@ proc apply_config {} {
|
|||
}
|
||||
}
|
||||
|
||||
set default_config(merge.diffstat) true
|
||||
set default_config(merge.summary) false
|
||||
set default_config(merge.verbosity) 2
|
||||
set default_config(user.name) {}
|
||||
set default_config(user.email) {}
|
||||
|
||||
set default_config(gui.pruneduringfetch) false
|
||||
set default_config(gui.trustmtime) false
|
||||
set default_config(gui.diffcontext) 5
|
||||
set default_config(gui.newbranchtemplate) {}
|
||||
|
|
@ -1425,6 +1454,11 @@ if {[is_enabled branch]} {
|
|||
lappend disable_on_lock [list .mbar.branch entryconf \
|
||||
[.mbar.branch index last] -state]
|
||||
|
||||
.mbar.branch add command -label {Rename...} \
|
||||
-command branch_rename::dialog
|
||||
lappend disable_on_lock [list .mbar.branch entryconf \
|
||||
[.mbar.branch index last] -state]
|
||||
|
||||
.mbar.branch add command -label {Delete...} \
|
||||
-command do_delete_branch
|
||||
lappend disable_on_lock [list .mbar.branch entryconf \
|
||||
|
|
@ -1522,6 +1556,8 @@ if {[is_enabled transport]} {
|
|||
menu .mbar.push
|
||||
.mbar.push add command -label {Push...} \
|
||||
-command do_push_anywhere
|
||||
.mbar.push add command -label {Delete...} \
|
||||
-command remote_branch_delete::dialog
|
||||
}
|
||||
|
||||
if {[is_MacOSX]} {
|
||||
|
|
@ -1639,14 +1675,8 @@ switch -- $subcommand {
|
|||
browser {
|
||||
set subcommand_args {rev?}
|
||||
switch [llength $argv] {
|
||||
0 {
|
||||
set current_branch [git symbolic-ref HEAD]
|
||||
regsub ^refs/((heads|tags|remotes)/)? \
|
||||
$current_branch {} current_branch
|
||||
}
|
||||
1 {
|
||||
set current_branch [lindex $argv 0]
|
||||
}
|
||||
0 { set current_branch [current-branch] }
|
||||
1 { set current_branch [lindex $argv 0] }
|
||||
default usage
|
||||
}
|
||||
browser::new $current_branch
|
||||
|
|
@ -1679,9 +1709,7 @@ blame {
|
|||
unset is_path
|
||||
|
||||
if {$head eq {}} {
|
||||
set current_branch [git symbolic-ref HEAD]
|
||||
regsub ^refs/((heads|tags|remotes)/)? \
|
||||
$current_branch {} current_branch
|
||||
set current_branch [current-branch]
|
||||
} else {
|
||||
set current_branch $head
|
||||
}
|
||||
|
|
|
|||
137
git-gui/lib/branch_rename.tcl
Normal file
137
git-gui/lib/branch_rename.tcl
Normal file
|
|
@ -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
|
||||
}
|
||||
|
||||
}
|
||||
|
|
@ -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}}
|
||||
} {
|
||||
|
|
|
|||
|
|
@ -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 {} {
|
||||
|
|
|
|||
348
git-gui/lib/remote_branch_delete.tcl
Normal file
348
git-gui/lib/remote_branch_delete.tcl
Normal file
|
|
@ -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}
|
||||
}
|
||||
|
||||
}
|
||||
|
|
@ -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} {
|
||||
|
|
|
|||
Loading…
Reference in a new issue