git-gui / lib / remote.tclon commit git-send-email.perl: Add --to-cmd (6e74e07)
   1# git-gui remote management
   2# Copyright (C) 2006, 2007 Shawn Pearce
   3
   4set some_heads_tracking 0;  # assume not
   5
   6proc is_tracking_branch {name} {
   7        global tracking_branches
   8        foreach spec $tracking_branches {
   9                set t [lindex $spec 0]
  10                if {$t eq $name || [string match $t $name]} {
  11                        return 1
  12                }
  13        }
  14        return 0
  15}
  16
  17proc all_tracking_branches {} {
  18        global tracking_branches
  19
  20        set all [list]
  21        set pat [list]
  22        set cmd [list]
  23
  24        foreach spec $tracking_branches {
  25                set dst [lindex $spec 0]
  26                if {[string range $dst end-1 end] eq {/*}} {
  27                        lappend pat $spec
  28                        lappend cmd [string range $dst 0 end-2]
  29                } else {
  30                        lappend all $spec
  31                }
  32        }
  33
  34        if {$pat ne {}} {
  35                set fd [eval git_read for-each-ref --format=%(refname) $cmd]
  36                while {[gets $fd n] > 0} {
  37                        foreach spec $pat {
  38                                set dst [string range [lindex $spec 0] 0 end-2]
  39                                set len [string length $dst]
  40                                if {[string equal -length $len $dst $n]} {
  41                                        set src [string range [lindex $spec 2] 0 end-2]
  42                                        set spec [list \
  43                                                $n \
  44                                                [lindex $spec 1] \
  45                                                $src[string range $n $len end] \
  46                                                ]
  47                                        lappend all $spec
  48                                }
  49                        }
  50                }
  51                close $fd
  52        }
  53
  54        return [lsort -index 0 -unique $all]
  55}
  56
  57proc load_all_remotes {} {
  58        global repo_config
  59        global all_remotes tracking_branches some_heads_tracking
  60        global remote_url
  61
  62        set some_heads_tracking 0
  63        set all_remotes [list]
  64        set trck [list]
  65
  66        set rh_str refs/heads/
  67        set rh_len [string length $rh_str]
  68        set rm_dir [gitdir remotes]
  69        if {[file isdirectory $rm_dir]} {
  70                set all_remotes [glob \
  71                        -types f \
  72                        -tails \
  73                        -nocomplain \
  74                        -directory $rm_dir *]
  75
  76                foreach name $all_remotes {
  77                        catch {
  78                                set fd [open [file join $rm_dir $name] r]
  79                                while {[gets $fd line] >= 0} {
  80                                        if {[regexp {^URL:[     ]*(.+)$} $line line url]} {
  81                                                set remote_url($name) $url
  82                                                continue
  83                                        }
  84                                        if {![regexp {^Pull:[   ]*([^:]+):(.+)$} \
  85                                                $line line src dst]} continue
  86                                        if {[string index $src 0] eq {+}} {
  87                                                set src [string range $src 1 end]
  88                                        }
  89                                        if {![string equal -length 5 refs/ $src]} {
  90                                                set src $rh_str$src
  91                                        }
  92                                        if {![string equal -length 5 refs/ $dst]} {
  93                                                set dst $rh_str$dst
  94                                        }
  95                                        if {[string equal -length $rh_len $rh_str $dst]} {
  96                                                set some_heads_tracking 1
  97                                        }
  98                                        lappend trck [list $dst $name $src]
  99                                }
 100                                close $fd
 101                        }
 102                }
 103        }
 104
 105        foreach line [array names repo_config remote.*.url] {
 106                if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
 107                lappend all_remotes $name
 108                set remote_url($name) $repo_config(remote.$name.url)
 109
 110                if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
 111                        set fl {}
 112                }
 113                foreach line $fl {
 114                        if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
 115                        if {[string index $src 0] eq {+}} {
 116                                set src [string range $src 1 end]
 117                        }
 118                        if {![string equal -length 5 refs/ $src]} {
 119                                set src $rh_str$src
 120                        }
 121                        if {![string equal -length 5 refs/ $dst]} {
 122                                set dst $rh_str$dst
 123                        }
 124                        if {[string equal -length $rh_len $rh_str $dst]} {
 125                                set some_heads_tracking 1
 126                        }
 127                        lappend trck [list $dst $name $src]
 128                }
 129        }
 130
 131        set tracking_branches [lsort -index 0 -unique $trck]
 132        set all_remotes [lsort -unique $all_remotes]
 133}
 134
 135proc add_fetch_entry {r} {
 136        global repo_config
 137        set remote_m .mbar.remote
 138        set fetch_m $remote_m.fetch
 139        set prune_m $remote_m.prune
 140        set remove_m $remote_m.remove
 141        set enable 0
 142        if {![catch {set a $repo_config(remote.$r.url)}]} {
 143                if {![catch {set a $repo_config(remote.$r.fetch)}]} {
 144                        set enable 1
 145                }
 146        } else {
 147                catch {
 148                        set fd [open [gitdir remotes $r] r]
 149                        while {[gets $fd n] >= 0} {
 150                                if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
 151                                        set enable 1
 152                                        break
 153                                }
 154                        }
 155                        close $fd
 156                }
 157        }
 158
 159        if {$enable} {
 160                if {![winfo exists $fetch_m]} {
 161                        menu $remove_m
 162                        $remote_m insert 0 cascade \
 163                                -label [mc "Remove Remote"] \
 164                                -menu $remove_m
 165
 166                        menu $prune_m
 167                        $remote_m insert 0 cascade \
 168                                -label [mc "Prune from"] \
 169                                -menu $prune_m
 170
 171                        menu $fetch_m
 172                        $remote_m insert 0 cascade \
 173                                -label [mc "Fetch from"] \
 174                                -menu $fetch_m
 175                }
 176
 177                $fetch_m add command \
 178                        -label $r \
 179                        -command [list fetch_from $r]
 180                $prune_m add command \
 181                        -label $r \
 182                        -command [list prune_from $r]
 183                $remove_m add command \
 184                        -label $r \
 185                        -command [list remove_remote $r]
 186        }
 187}
 188
 189proc add_push_entry {r} {
 190        global repo_config
 191        set remote_m .mbar.remote
 192        set push_m $remote_m.push
 193        set enable 0
 194        if {![catch {set a $repo_config(remote.$r.url)}]} {
 195                if {![catch {set a $repo_config(remote.$r.push)}]} {
 196                        set enable 1
 197                }
 198        } else {
 199                catch {
 200                        set fd [open [gitdir remotes $r] r]
 201                        while {[gets $fd n] >= 0} {
 202                                if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
 203                                        set enable 1
 204                                        break
 205                                }
 206                        }
 207                        close $fd
 208                }
 209        }
 210
 211        if {$enable} {
 212                if {![winfo exists $push_m]} {
 213                        menu $push_m
 214                        $remote_m insert 0 cascade \
 215                                -label [mc "Push to"] \
 216                                -menu $push_m
 217                }
 218
 219                $push_m add command \
 220                        -label $r \
 221                        -command [list push_to $r]
 222        }
 223}
 224
 225proc populate_remotes_menu {} {
 226        global all_remotes
 227
 228        foreach r $all_remotes {
 229                add_fetch_entry $r
 230                add_push_entry $r
 231        }
 232}
 233
 234proc add_single_remote {name location} {
 235        global all_remotes repo_config
 236        lappend all_remotes $name
 237
 238        git remote add $name $location
 239
 240        # XXX: Better re-read the config so that we will never get out
 241        # of sync with git remote implementation?
 242        set repo_config(remote.$name.url) $location
 243        set repo_config(remote.$name.fetch) "+refs/heads/*:refs/remotes/$name/*"
 244
 245        add_fetch_entry $name
 246        add_push_entry $name
 247}
 248
 249proc delete_from_menu {menu name} {
 250        if {[winfo exists $menu]} {
 251                $menu delete $name
 252        }
 253}
 254
 255proc remove_remote {name} {
 256        global all_remotes repo_config
 257
 258        git remote rm $name
 259
 260        catch {
 261                # Missing values are ok
 262                unset repo_config(remote.$name.url)
 263                unset repo_config(remote.$name.fetch)
 264                unset repo_config(remote.$name.push)
 265        }
 266
 267        set i [lsearch -exact all_remotes $name]
 268        lreplace all_remotes $i $i
 269
 270        set remote_m .mbar.remote
 271        delete_from_menu $remote_m.fetch $name
 272        delete_from_menu $remote_m.prune $name
 273        delete_from_menu $remote_m.remove $name
 274        # Not all remotes are in the push menu
 275        catch { delete_from_menu $remote_m.push $name }
 276}