333 lines
7.1 KiB
Tcl
333 lines
7.1 KiB
Tcl
# 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
|
|
foreach spec $tracking_branches {
|
|
set t [lindex $spec 0]
|
|
if {$t eq $name || [string match $t $name]} {
|
|
return 1
|
|
}
|
|
}
|
|
return 0
|
|
}
|
|
|
|
proc all_tracking_branches {} {
|
|
global tracking_branches
|
|
|
|
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 {
|
|
lappend all $spec
|
|
}
|
|
}
|
|
|
|
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 -index 0 -unique $all]
|
|
}
|
|
|
|
proc load_all_remotes {} {
|
|
global repo_config
|
|
global all_remotes tracking_branches some_heads_tracking
|
|
global remote_url
|
|
|
|
set some_heads_tracking 0
|
|
set all_remotes [list]
|
|
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 \
|
|
-types f \
|
|
-tails \
|
|
-nocomplain \
|
|
-directory $rm_dir *]
|
|
|
|
foreach name $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 {[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
|
|
}
|
|
if {[string equal -length $rh_len $rh_str $dst]} {
|
|
set some_heads_tracking 1
|
|
}
|
|
lappend trck [list $dst $name $src]
|
|
}
|
|
close $fd
|
|
}
|
|
}
|
|
}
|
|
|
|
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 {[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
|
|
}
|
|
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]
|
|
}
|
|
|
|
proc add_fetch_entry {r} {
|
|
global repo_config
|
|
set remote_m .mbar.remote
|
|
set fetch_m $remote_m.fetch
|
|
set prune_m $remote_m.prune
|
|
set remove_m $remote_m.remove
|
|
set enable 0
|
|
if {![catch {set a $repo_config(remote.$r.url)}]} {
|
|
if {![catch {set a $repo_config(remote.$r.fetch)}]} {
|
|
set enable 1
|
|
}
|
|
} else {
|
|
catch {
|
|
set fd [open [gitdir remotes $r] r]
|
|
while {[gets $fd n] >= 0} {
|
|
if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
|
|
set enable 1
|
|
break
|
|
}
|
|
}
|
|
close $fd
|
|
}
|
|
}
|
|
|
|
if {$enable} {
|
|
make_sure_remote_submenues_exist $remote_m
|
|
|
|
$fetch_m add command \
|
|
-label $r \
|
|
-command [list fetch_from $r]
|
|
$prune_m add command \
|
|
-label $r \
|
|
-command [list prune_from $r]
|
|
$remove_m add command \
|
|
-label $r \
|
|
-command [list remove_remote $r]
|
|
}
|
|
}
|
|
|
|
proc add_push_entry {r} {
|
|
global repo_config
|
|
set remote_m .mbar.remote
|
|
set push_m $remote_m.push
|
|
set enable 0
|
|
if {![catch {set a $repo_config(remote.$r.url)}]} {
|
|
if {![catch {set a $repo_config(remote.$r.push)}]} {
|
|
set enable 1
|
|
}
|
|
} else {
|
|
catch {
|
|
set fd [open [gitdir remotes $r] r]
|
|
while {[gets $fd n] >= 0} {
|
|
if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
|
|
set enable 1
|
|
break
|
|
}
|
|
}
|
|
close $fd
|
|
}
|
|
}
|
|
|
|
if {$enable} {
|
|
if {![winfo exists $push_m]} {
|
|
menu $push_m
|
|
$remote_m insert 0 cascade \
|
|
-label [mc "Push to"] \
|
|
-menu $push_m
|
|
}
|
|
|
|
$push_m add command \
|
|
-label $r \
|
|
-command [list push_to $r]
|
|
}
|
|
}
|
|
|
|
proc make_sure_remote_submenues_exist {remote_m} {
|
|
set fetch_m $remote_m.fetch
|
|
set prune_m $remote_m.prune
|
|
set remove_m $remote_m.remove
|
|
|
|
if {![winfo exists $fetch_m]} {
|
|
menu $remove_m
|
|
$remote_m insert 0 cascade \
|
|
-label [mc "Remove Remote"] \
|
|
-menu $remove_m
|
|
|
|
menu $prune_m
|
|
$remote_m insert 0 cascade \
|
|
-label [mc "Prune from"] \
|
|
-menu $prune_m
|
|
|
|
menu $fetch_m
|
|
$remote_m insert 0 cascade \
|
|
-label [mc "Fetch from"] \
|
|
-menu $fetch_m
|
|
}
|
|
}
|
|
|
|
proc update_all_remotes_menu_entry {} {
|
|
global all_remotes
|
|
|
|
if {[git-version < 1.6.6]} { return }
|
|
|
|
set have_remote 0
|
|
foreach r $all_remotes {
|
|
incr have_remote
|
|
}
|
|
|
|
set remote_m .mbar.remote
|
|
set fetch_m $remote_m.fetch
|
|
set prune_m $remote_m.prune
|
|
if {$have_remote > 1} {
|
|
make_sure_remote_submenues_exist $remote_m
|
|
if {[$fetch_m type end] eq "command" \
|
|
&& [$fetch_m entrycget end -label] ne [mc "All"]} {
|
|
|
|
$fetch_m insert end separator
|
|
$fetch_m insert end command \
|
|
-label [mc "All"] \
|
|
-command fetch_from_all
|
|
|
|
$prune_m insert end separator
|
|
$prune_m insert end command \
|
|
-label [mc "All"] \
|
|
-command prune_from_all
|
|
}
|
|
} else {
|
|
if {[winfo exists $fetch_m]} {
|
|
if {[$fetch_m type end] eq "command" \
|
|
&& [$fetch_m entrycget end -label] eq [mc "All"]} {
|
|
|
|
delete_from_menu $fetch_m end
|
|
delete_from_menu $fetch_m end
|
|
|
|
delete_from_menu $prune_m end
|
|
delete_from_menu $prune_m end
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
proc populate_remotes_menu {} {
|
|
global all_remotes
|
|
|
|
foreach r $all_remotes {
|
|
add_fetch_entry $r
|
|
add_push_entry $r
|
|
}
|
|
|
|
update_all_remotes_menu_entry
|
|
}
|
|
|
|
proc add_single_remote {name location} {
|
|
global all_remotes repo_config
|
|
lappend all_remotes $name
|
|
|
|
git remote add $name $location
|
|
|
|
# XXX: Better re-read the config so that we will never get out
|
|
# of sync with git remote implementation?
|
|
set repo_config(remote.$name.url) $location
|
|
set repo_config(remote.$name.fetch) "+refs/heads/*:refs/remotes/$name/*"
|
|
|
|
add_fetch_entry $name
|
|
add_push_entry $name
|
|
|
|
update_all_remotes_menu_entry
|
|
}
|
|
|
|
proc delete_from_menu {menu name} {
|
|
if {[winfo exists $menu]} {
|
|
$menu delete $name
|
|
}
|
|
}
|
|
|
|
proc remove_remote {name} {
|
|
global all_remotes repo_config
|
|
|
|
git remote rm $name
|
|
|
|
catch {
|
|
# Missing values are ok
|
|
unset repo_config(remote.$name.url)
|
|
unset repo_config(remote.$name.fetch)
|
|
unset repo_config(remote.$name.push)
|
|
}
|
|
|
|
set i [lsearch -exact $all_remotes $name]
|
|
set all_remotes [lreplace $all_remotes $i $i]
|
|
|
|
set remote_m .mbar.remote
|
|
delete_from_menu $remote_m.fetch $name
|
|
delete_from_menu $remote_m.prune $name
|
|
delete_from_menu $remote_m.remove $name
|
|
# Not all remotes are in the push menu
|
|
catch { delete_from_menu $remote_m.push $name }
|
|
|
|
update_all_remotes_menu_entry
|
|
}
|