set pathList [list]
foreach path [array names file_states] {
switch -- [lindex $file_states($path) 0] {
- AM -
- MM {lappend pathList $path}
+ A? -
+ M? {lappend pathList $path}
}
}
if {$pathList ne {}} {
switch -glob -- [lindex $s 0] {
A? {set new _O}
M? {set new _M}
+ D_ {set new _D}
D? {set new _?}
?? {continue}
}
switch -glob -- [lindex $file_states($path) 0] {
AD -
MD -
+ UD -
_D {set new DD}
_M -
MM -
+ UM -
+ U_ -
M_ {set new M_}
_O -
##
## branch management
-proc load_all_branches {} {
- global all_branches
+proc load_all_heads {} {
+ global all_heads tracking_branches
- set all_branches [list]
+ set all_heads [list]
set cmd [list git for-each-ref]
lappend cmd --format=%(refname)
lappend cmd refs/heads
set fd [open "| $cmd" r]
while {[gets $fd line] > 0} {
- if {[regsub ^refs/heads/ $line {} line]} {
- lappend all_branches $line
- }
+ if {![catch {set info $tracking_branches($line)}]} continue
+ if {![regsub ^refs/heads/ $line {} name]} continue
+ lappend all_heads $name
}
close $fd
- set all_branches [lsort $all_branches]
+ set all_heads [lsort $all_heads]
}
proc populate_branch_menu {m} {
- global all_branches disable_on_lock
+ global all_heads disable_on_lock
$m add separator
- foreach b $all_branches {
+ foreach b $all_heads {
$m add radiobutton \
-label $b \
- -command [list do_switch_branch $b] \
+ -command [list switch_branch $b] \
-variable current_branch \
-value $b \
-font font_ui
}
}
+proc do_create_branch {} {
+ error "NOT IMPLEMENTED"
+}
+
+proc do_delete_branch {} {
+ error "NOT IMPLEMENTED"
+}
+
+proc switch_branch {b} {
+ global HEAD commit_type file_states current_branch
+ global selected_commit_type ui_comm
+
+ if {![lock_index switch]} return
+
+ # -- Backup the selected branch (repository_state resets it)
+ #
+ set new_branch $current_branch
+
+ # -- 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
+ }
+
+ # -- Toss the message buffer if we are in amend mode.
+ #
+ if {[string match amend* $curType]} {
+ $ui_comm delete 0.0 end
+ $ui_comm edit reset
+ $ui_comm edit modified false
+ }
+
+ set selected_commit_type new
+ set current_branch $new_branch
+
+ unlock_index
+ error "NOT FINISHED"
+}
+
######################################################################
##
## remote management
proc load_all_remotes {} {
- global gitdir all_remotes repo_config
+ global gitdir repo_config
+ global all_remotes tracking_branches
set all_remotes [list]
+ array unset tracking_branches
+
set rm_dir [file join $gitdir remotes]
if {[file isdirectory $rm_dir]} {
- set all_remotes [concat $all_remotes [glob \
+ set all_remotes [glob \
-types f \
-tails \
-nocomplain \
- -directory $rm_dir *]]
+ -directory $rm_dir *]
+
+ foreach name $all_remotes {
+ catch {
+ set fd [open [file join $rm_dir $name] r]
+ while {[gets $fd line] >= 0} {
+ if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
+ $line line src dst]} continue
+ if {![regexp ^refs/ $dst]} {
+ set dst "refs/heads/$dst"
+ }
+ set tracking_branches($dst) [list $name $src]
+ }
+ close $fd
+ }
+ }
}
foreach line [array names repo_config remote.*.url] {
- if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
- lappend all_remotes $name
+ if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
+ lappend all_remotes $name
+
+ 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"
+ }
+ set tracking_branches($dst) [list $name $src]
}
}
global gitdir repo_config all_remotes disable_on_lock
foreach remote $all_remotes {
- set rb {}
+ set rb_list [list]
if {[array get repo_config remote.$remote.url] ne {}} {
if {[array get repo_config remote.$remote.fetch] ne {}} {
- regexp {^([^:]+):} \
- [lindex $repo_config(remote.$remote.fetch) 0] \
- line rb
+ foreach line $repo_config(remote.$remote.fetch) {
+ if {[regexp {^([^:]+):} $line line rb]} {
+ lappend rb_list $rb
+ }
+ }
}
} else {
catch {
set fd [open [file join $gitdir remotes $remote] r]
while {[gets $fd line] >= 0} {
if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
- break
+ lappend rb_list $rb
}
}
close $fd
}
}
- set rb_short $rb
- regsub ^refs/heads/ $rb {} rb_short
- if {$rb_short ne {}} {
+ foreach rb $rb_list {
+ regsub ^refs/heads/ $rb {} rb_short
$m add command \
-label "Branch $rb_short from $remote..." \
-command [list pull_remote $remote $rb] \
{_D i question "Missing"}
{DD i removed "Removed by commit"}
+ {D_ i removed "Removed by commit"}
{DO i removed "Removed (still exists)"}
{DM i removed "Removed (but modified)"}
}
}
-proc do_repack {} {
- set w [new_console {repack} \
- {Repacking the object database}]
- set cmd [list git repack]
- lappend cmd -a
- lappend cmd -d
- console_exec $w $cmd
+proc do_gc {} {
+ set w [new_console {gc} {Compressing the object database}]
+ console_exec $w {git gc}
}
proc do_fsck_objects {} {
}
proc revert_helper {txt paths} {
+ global gitdir appname
global file_states current_diff
if {![lock_index begin-update]} return
set s "these $n files"
}
+ set reponame [lindex [file split \
+ [file normalize [file dirname $gitdir]]] \
+ end]
+
set reply [tk_dialog \
.confirm_revert \
- "title" \
- "Revert unincluded changes in $s?
+ "$appname ($reponame)" \
+ "Revert changes in $s?
-Any unincluded changes will be permanently lost by the revert." \
- questhead \
+Any unadded changes will be permanently lost by the revert." \
+ question \
1 \
{Do Nothing} \
{Revert Changes} \
.mbar.repository add separator
if {!$single_commit} {
- .mbar.repository add command -label {Repack Database} \
- -command do_repack \
+ .mbar.repository add command -label {Compress Database} \
+ -command do_gc \
-font font_ui
.mbar.repository add command -label {Verify Database} \
-font font_ui
}
}
+
.mbar.repository add command -label Quit \
-command do_quit \
-accelerator $M1T-Q \
-accelerator $M1T-A \
-font font_ui
+# -- Branch Menu
+#
if {!$single_commit} {
- # -- Branch Menu
- #
menu .mbar.branch
.mbar.branch add command -label {Create...} \
lappend disable_on_lock \
[list .mbar.commit entryconf [.mbar.commit index last] -state]
-.mbar.commit add command -label {Include In Commit} \
+.mbar.commit add command -label {Add To Commit} \
-command do_include_selection \
-font font_ui
lappend disable_on_lock \
[list .mbar.commit entryconf [.mbar.commit index last] -state]
-.mbar.commit add command -label {Include All In Commit} \
+.mbar.commit add command -label {Add All To Commit} \
-command do_include_all \
-accelerator $M1T-I \
-font font_ui
-command do_options \
-font font_ui
+ # -- Tools Menu
+ #
+ if {[file exists /usr/local/miga/lib/gui-miga]} {
+ proc do_miga {} {
+ global gitdir ui_status_value
+ if {![lock_index update]} return
+ set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
+ set miga_fd [open "|$cmd" r]
+ fconfigure $miga_fd -blocking 0
+ fileevent $miga_fd readable [list miga_done $miga_fd]
+ set ui_status_value {Running miga...}
+ }
+ proc miga_done {fd} {
+ read $fd 512
+ if {[eof $fd]} {
+ close $fd
+ unlock_index
+ rescan [list set ui_status_value {Ready.}]
+ }
+ }
+ .mbar add cascade -label Tools -menu .mbar.tools
+ menu .mbar.tools
+ .mbar.tools add command -label "Migrate" \
+ -command do_miga \
+ -font font_ui
+ lappend disable_on_lock \
+ [list .mbar.tools entryconf [.mbar.tools index last] -state]
+ }
+
# -- Help Menu
#
.mbar add cascade -label Help -menu .mbar.help
lappend disable_on_lock \
{.vpane.lower.commarea.buttons.rescan conf -state}
-button .vpane.lower.commarea.buttons.incall -text {Include All} \
+button .vpane.lower.commarea.buttons.incall -text {Add All} \
-command do_include_all \
-font font_ui
pack .vpane.lower.commarea.buttons.incall -side top -fill x
wm title . "$appname ([file normalize [file dirname $gitdir]])"
focus -force $ui_comm
-# -- Warn the user about environmental problems.
-# Cygwin's Tcl does *not* pass its env array
-# onto any processes it spawns. This means
-# that the git processes get none of our
-# environment. That may not work...
+# -- Warn the user about environmental problems. Cygwin's Tcl
+# does *not* pass its env array onto any processes it spawns.
+# This means that git processes get none of our environment.
#
if {[is_Windows]} {
set ignored_env 0
unset ignored_env msg suggest_user name
}
+# -- Only initialize complex UI if we are going to stay running.
+#
if {!$single_commit} {
load_all_remotes
- load_all_branches
+ load_all_heads
+
populate_branch_menu .mbar.branch
populate_fetch_menu .mbar.fetch
populate_pull_menu .mbar.pull
populate_push_menu .mbar.push
}
+
lock_index begin-read
after 1 do_rescan