- if {$new_m eq {__}} {
- unset file_states($path)
- catch {unset selected_paths($path)}
- }
-}
-
-proc display_all_files_helper {w path icon_name m} {
- global file_lists
-
- lappend file_lists($w) $path
- set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
- $w image create end \
- -align center -padx 5 -pady 1 \
- -name $icon_name \
- -image [mapicon $w $m $path]
- $w insert end "[escape_path $path]\n"
-}
-
-proc display_all_files {} {
- global ui_index ui_workdir
- global file_states file_lists
- global last_clicked
-
- $ui_index conf -state normal
- $ui_workdir conf -state normal
-
- $ui_index delete 0.0 end
- $ui_workdir delete 0.0 end
- set last_clicked {}
-
- set file_lists($ui_index) [list]
- set file_lists($ui_workdir) [list]
-
- foreach path [lsort [array names file_states]] {
- set s $file_states($path)
- set m [lindex $s 0]
- set icon_name [lindex $s 1]
-
- set s [string index $m 0]
- if {$s ne {U} && $s ne {_}} {
- display_all_files_helper $ui_index $path \
- $icon_name $s
- }
-
- if {[string index $m 0] eq {U}} {
- set s U
- } else {
- set s [string index $m 1]
- }
- if {$s ne {_}} {
- display_all_files_helper $ui_workdir $path \
- $icon_name $s
- }
- }
-
- $ui_index conf -state disabled
- $ui_workdir conf -state disabled
-}
-
-proc update_indexinfo {msg pathList after} {
- global update_index_cp ui_status_value
-
- if {![lock_index update]} return
-
- set update_index_cp 0
- set pathList [lsort $pathList]
- set totalCnt [llength $pathList]
- set batch [expr {int($totalCnt * .01) + 1}]
- if {$batch > 25} {set batch 25}
-
- set ui_status_value [format \
- "$msg... %i/%i files (%.2f%%)" \
- $update_index_cp \
- $totalCnt \
- 0.0]
- set fd [open "| git update-index -z --index-info" w]
- fconfigure $fd \
- -blocking 0 \
- -buffering full \
- -buffersize 512 \
- -translation binary
- fileevent $fd writable [list \
- write_update_indexinfo \
- $fd \
- $pathList \
- $totalCnt \
- $batch \
- $msg \
- $after \
- ]
-}
-
-proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
- global update_index_cp ui_status_value
- global file_states current_diff_path
-
- if {$update_index_cp >= $totalCnt} {
- close $fd
- unlock_index
- uplevel #0 $after
- return
- }
-
- for {set i $batch} \
- {$update_index_cp < $totalCnt && $i > 0} \
- {incr i -1} {
- set path [lindex $pathList $update_index_cp]
- incr update_index_cp
-
- set s $file_states($path)
- switch -glob -- [lindex $s 0] {
- A? {set new _O}
- M? {set new _M}
- D_ {set new _D}
- D? {set new _?}
- ?? {continue}
- }
- set info [lindex $s 2]
- if {$info eq {}} continue
-
- puts -nonewline $fd "$info\t$path\0"
- display_file $path $new
- }
-
- set ui_status_value [format \
- "$msg... %i/%i files (%.2f%%)" \
- $update_index_cp \
- $totalCnt \
- [expr {100.0 * $update_index_cp / $totalCnt}]]
-}
-
-proc update_index {msg pathList after} {
- global update_index_cp ui_status_value
-
- if {![lock_index update]} return
-
- set update_index_cp 0
- set pathList [lsort $pathList]
- set totalCnt [llength $pathList]
- set batch [expr {int($totalCnt * .01) + 1}]
- if {$batch > 25} {set batch 25}
-
- set ui_status_value [format \
- "$msg... %i/%i files (%.2f%%)" \
- $update_index_cp \
- $totalCnt \
- 0.0]
- set fd [open "| git update-index --add --remove -z --stdin" w]
- fconfigure $fd \
- -blocking 0 \
- -buffering full \
- -buffersize 512 \
- -translation binary
- fileevent $fd writable [list \
- write_update_index \
- $fd \
- $pathList \
- $totalCnt \
- $batch \
- $msg \
- $after \
- ]
-}
-
-proc write_update_index {fd pathList totalCnt batch msg after} {
- global update_index_cp ui_status_value
- global file_states current_diff_path
-
- if {$update_index_cp >= $totalCnt} {
- close $fd
- unlock_index
- uplevel #0 $after
- return
- }
-
- for {set i $batch} \
- {$update_index_cp < $totalCnt && $i > 0} \
- {incr i -1} {
- set path [lindex $pathList $update_index_cp]
- incr update_index_cp
-
- switch -glob -- [lindex $file_states($path) 0] {
- AD {set new __}
- ?D {set new D_}
- _O -
- AM {set new A_}
- U? {
- if {[file exists $path]} {
- set new M_
- } else {
- set new D_
- }
- }
- ?M {set new M_}
- ?? {continue}
- }
- puts -nonewline $fd "$path\0"
- display_file $path $new
- }
-
- set ui_status_value [format \
- "$msg... %i/%i files (%.2f%%)" \
- $update_index_cp \
- $totalCnt \
- [expr {100.0 * $update_index_cp / $totalCnt}]]
-}
-
-proc checkout_index {msg pathList after} {
- global update_index_cp ui_status_value
-
- if {![lock_index update]} return
-
- set update_index_cp 0
- set pathList [lsort $pathList]
- set totalCnt [llength $pathList]
- set batch [expr {int($totalCnt * .01) + 1}]
- if {$batch > 25} {set batch 25}
-
- set ui_status_value [format \
- "$msg... %i/%i files (%.2f%%)" \
- $update_index_cp \
- $totalCnt \
- 0.0]
- set cmd [list git checkout-index]
- lappend cmd --index
- lappend cmd --quiet
- lappend cmd --force
- lappend cmd -z
- lappend cmd --stdin
- set fd [open "| $cmd " w]
- fconfigure $fd \
- -blocking 0 \
- -buffering full \
- -buffersize 512 \
- -translation binary
- fileevent $fd writable [list \
- write_checkout_index \
- $fd \
- $pathList \
- $totalCnt \
- $batch \
- $msg \
- $after \
- ]
-}
-
-proc write_checkout_index {fd pathList totalCnt batch msg after} {
- global update_index_cp ui_status_value
- global file_states current_diff_path
-
- if {$update_index_cp >= $totalCnt} {
- close $fd
- unlock_index
- uplevel #0 $after
- return
- }
-
- for {set i $batch} \
- {$update_index_cp < $totalCnt && $i > 0} \
- {incr i -1} {
- set path [lindex $pathList $update_index_cp]
- incr update_index_cp
- switch -glob -- [lindex $file_states($path) 0] {
- U? {continue}
- ?M -
- ?D {
- puts -nonewline $fd "$path\0"
- display_file $path ?_
- }
- }
- }
-
- set ui_status_value [format \
- "$msg... %i/%i files (%.2f%%)" \
- $update_index_cp \
- $totalCnt \
- [expr {100.0 * $update_index_cp / $totalCnt}]]
-}
-
-######################################################################
-##
-## branch management
-
-proc load_all_heads {} {
- global all_heads tracking_branches
-
- 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 {![catch {set info $tracking_branches($line)}]} continue
- if {![regsub ^refs/heads/ $line {} name]} continue
- lappend all_heads $name
- }
- close $fd
-
- set all_heads [lsort $all_heads]
-}
-
-proc populate_branch_menu {} {
- global all_heads disable_on_lock
-
- set m .mbar.branch
- set last [$m index last]
- for {set i 0} {$i <= $last} {incr i} {
- if {[$m type $i] eq {separator}} {
- $m delete $i last
- set new_dol [list]
- foreach a $disable_on_lock {
- if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
- lappend new_dol $a
- }
- }
- set disable_on_lock $new_dol
- break
- }
- }
-
- $m add separator
- foreach b $all_heads {
- $m add radiobutton \
- -label $b \
- -command [list switch_branch $b] \
- -variable current_branch \
- -value $b \
- -font font_ui
- lappend disable_on_lock \
- [list $m entryconf [$m index last] -state]
- }
-}
-
-proc do_create_branch_action {w} {
- global all_heads null_sha1
- global create_branch_checkout create_branch_revtype
- global create_branch_head create_branch_trackinghead
-
- set newbranch [string trim [$w.desc.name.t get 0.0 end]]
- if {![catch {exec git show-ref --verify -- "refs/heads/$newbranch"}]} {
- tk_messageBox \
- -icon error \
- -type ok \
- -title [wm title $w] \
- -parent $w \
- -message "Branch '$newbranch' already exists."
- focus $w.desc.name.t
- return
- }
- if {[catch {exec git check-ref-format "heads/$newbranch"}]} {
- tk_messageBox \
- -icon error \
- -type ok \
- -title [wm title $w] \
- -parent $w \
- -message "We do not like '$newbranch' as a branch name."
- focus $w.desc.name.t
- return
- }
-
- set rev {}
- switch -- $create_branch_revtype {
- head {set rev $create_branch_head}
- tracking {set rev $create_branch_trackinghead}
- expression {set rev [string trim [$w.from.exp.t get 0.0 end]]}
- }
- if {[catch {set cmt [exec git rev-parse --verify "${rev}^0"]}]} {
- tk_messageBox \
- -icon error \
- -type ok \
- -title [wm title $w] \
- -parent $w \
- -message "Invalid starting revision: $rev"
- return
- }
- set cmd [list git update-ref]
- lappend cmd -m
- lappend cmd "branch: Created from $rev"
- lappend cmd "refs/heads/$newbranch"
- lappend cmd $cmt
- lappend cmd $null_sha1
- if {[catch {eval exec $cmd} err]} {
- tk_messageBox \
- -icon error \
- -type ok \
- -title [wm title $w] \
- -parent $w \
- -message "Failed to create '$newbranch'.\n\n$err"
- return
- }
-
- lappend all_heads $newbranch
- set all_heads [lsort $all_heads]
- populate_branch_menu
- destroy $w
- if {$create_branch_checkout} {
- switch_branch $newbranch
- }
-}
-
-proc do_create_branch {} {
- global all_heads current_branch tracking_branches
- global create_branch_checkout create_branch_revtype
- global create_branch_head create_branch_trackinghead
-
- set create_branch_checkout 1
- set create_branch_revtype head
- set create_branch_head $current_branch
- set create_branch_trackinghead {}
-
- set w .branch_editor
- toplevel $w
- wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
-
- label $w.header -text {Create New Branch} \
- -font font_uibold
- pack $w.header -side top -fill x
-
- frame $w.buttons
- button $w.buttons.create -text Create \
- -font font_ui \
- -default active \
- -command [list do_create_branch_action $w]
- pack $w.buttons.create -side right
- button $w.buttons.cancel -text {Cancel} \
- -font font_ui \
- -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.desc \
- -text {Branch Description} \
- -font font_ui
- frame $w.desc.name
- label $w.desc.name.l -text {Name:} -font font_ui
- text $w.desc.name.t \
- -borderwidth 1 \
- -relief sunken \
- -height 1 \
- -width 40 \
- -font font_ui
- bind $w.desc.name.t <Shift-Key-Tab> "focus $w.postActions.checkout;break"
- bind $w.desc.name.t <Key-Tab> "focus $w.from.exp.t;break"
- bind $w.desc.name.t <Key-Return> "do_create_branch_action $w;break"
- bind $w.desc.name.t <Key> {
- if {{%K} ne {BackSpace}
- && {%K} ne {Tab}
- && {%K} ne {Escape}
- && {%K} ne {Return}} {
- if {%k <= 32} break
- if {[string first %A {~^:?*[}] >= 0} break
- }
- }
- pack $w.desc.name.l -side left -padx 5
- pack $w.desc.name.t -side left -fill x -expand 1
- pack $w.desc.name -padx 5 -fill x -expand 1
- pack $w.desc -anchor nw -fill x -pady 5 -padx 5
-
- set all_trackings [list]
- foreach b [array names tracking_branches] {
- regsub ^refs/(heads|remotes)/ $b {} b
- lappend all_trackings $b
- }
- set all_trackings [lsort -unique $all_trackings]
- if {$all_trackings ne {}} {
- set create_branch_trackinghead [lindex $all_trackings 0]
- }
-
- labelframe $w.from \
- -text {Starting Revision} \
- -font font_ui
- frame $w.from.head
- radiobutton $w.from.head.r \
- -text {Local Branch:} \
- -value head \
- -variable create_branch_revtype \
- -font font_ui
- eval tk_optionMenu $w.from.head.m create_branch_head $all_heads
- pack $w.from.head.r -side left
- pack $w.from.head.m -side left
- frame $w.from.tracking
- radiobutton $w.from.tracking.r \
- -text {Tracking Branch:} \
- -value tracking \
- -variable create_branch_revtype \
- -font font_ui
- eval tk_optionMenu $w.from.tracking.m \
- create_branch_trackinghead \
- $all_trackings
- pack $w.from.tracking.r -side left
- pack $w.from.tracking.m -side left
- frame $w.from.exp
- radiobutton $w.from.exp.r \
- -text {Revision Expression:} \
- -value expression \
- -variable create_branch_revtype \
- -font font_ui
- text $w.from.exp.t \
- -borderwidth 1 \
- -relief sunken \
- -height 1 \
- -width 50 \
- -font font_ui
- bind $w.from.exp.t <Shift-Key-Tab> "focus $w.desc.name.t;break"
- bind $w.from.exp.t <Key-Tab> "focus $w.postActions.checkout;break"
- bind $w.from.exp.t <Key-Return> "do_create_branch_action $w;break"
- pack $w.from.exp.r -side left
- pack $w.from.exp.t -side left -fill x -expand 1
- pack $w.from.head -padx 5 -fill x -expand 1
- pack $w.from.tracking -padx 5 -fill x -expand 1
- pack $w.from.exp -padx 5 -fill x -expand 1
- pack $w.from -anchor nw -fill x -pady 5 -padx 5
-
- labelframe $w.postActions \
- -text {Post Creation Actions} \
- -font font_ui
- checkbutton $w.postActions.checkout \
- -text {Checkout after creation} \
- -variable create_branch_checkout \
- -font font_ui
- pack $w.postActions.checkout -anchor nw
- pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
-
- bind $w <Visibility> "grab $w; focus $w.desc.name.t"
- bind $w <Key-Escape> "destroy $w"
- bind $w <Key-Return> "do_create_branch_action $w;break"
- wm title $w "[appname] ([reponame]): Create Branch"
- tkwait window $w
-}
-
-proc do_delete_branch_action {w} {
- global all_heads
- global delete_branch_checkhead delete_branch_head
-
- set to_delete [list]
- set not_merged [list]
- foreach i [$w.list.l curselection] {
- set b [$w.list.l get $i]
- if {[catch {set o [exec git rev-parse --verify $b]}]} continue
- if {$delete_branch_checkhead} {
- if {$b eq $delete_branch_head} continue
- if {[catch {set m [exec git merge-base $o $delete_branch_head]}]} continue
- if {$o ne $m} {
- lappend not_merged $b
- continue
- }
- }
- lappend to_delete [list $b $o]
- }
- if {$not_merged ne {}} {
- set msg "The following branches are not completely merged into $delete_branch_head:
-
- - [join $not_merged "\n - "]"
- tk_messageBox \
- -icon info \
- -type ok \
- -title [wm title $w] \
- -parent $w \
- -message $msg
- }
- if {$to_delete eq {}} return
- if {!$delete_branch_checkhead} {
- set msg {Recovering deleted branches is difficult.
-
-Delete the selected branches?}
- if {[tk_messageBox \
- -icon warning \
- -type yesno \
- -title [wm title $w] \
- -parent $w \
- -message $msg] ne yes} {
- return
- }
- }
-
- set failed {}
- foreach i $to_delete {
- set b [lindex $i 0]
- set o [lindex $i 1]
- if {[catch {exec git update-ref -d "refs/heads/$b" $o} err]} {
- append failed " - $b: $err\n"
- } else {
- set x [lsearch -sorted $all_heads $b]
- if {$x >= 0} {
- set all_heads [lreplace $all_heads $x $x]
- }
- }
- }
-
- if {$failed ne {}} {
- tk_messageBox \
- -icon error \
- -type ok \
- -title [wm title $w] \
- -parent $w \
- -message "Failed to delete branches:\n$failed"
- }
-
- set all_heads [lsort $all_heads]
- populate_branch_menu
- destroy $w
-}
-
-proc do_delete_branch {} {
- global all_heads tracking_branches current_branch
- global delete_branch_checkhead delete_branch_head
-
- set delete_branch_checkhead 1
- set delete_branch_head $current_branch
-
- set w .branch_editor
- toplevel $w
- wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
-
- label $w.header -text {Delete Local Branch} \
- -font font_uibold
- pack $w.header -side top -fill x
-
- frame $w.buttons
- button $w.buttons.create -text Delete \
- -font font_ui \
- -command [list do_delete_branch_action $w]
- pack $w.buttons.create -side right
- button $w.buttons.cancel -text {Cancel} \
- -font font_ui \
- -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.list \
- -text {Local Branches} \
- -font font_ui
- listbox $w.list.l \
- -height 10 \
- -width 50 \
- -selectmode extended \
- -font font_ui
- foreach h $all_heads {
- if {$h ne $current_branch} {
- $w.list.l insert end $h
- }
- }
- pack $w.list.l -fill both -pady 5 -padx 5
- pack $w.list -fill both -pady 5 -padx 5
-
- set all_trackings [list]
- foreach b [array names tracking_branches] {
- regsub ^refs/(heads|remotes)/ $b {} b
- lappend all_trackings $b
- }
-
- labelframe $w.validate \
- -text {Only Delete If} \
- -font font_ui
- frame $w.validate.head
- checkbutton $w.validate.head.r \
- -text {Already Merged Into:} \
- -variable delete_branch_checkhead \
- -font font_ui
- eval tk_optionMenu $w.validate.head.m delete_branch_head \
- $all_heads \
- [lsort -unique $all_trackings]
- pack $w.validate.head.r -side left
- pack $w.validate.head.m -side left
- pack $w.validate.head -padx 5 -fill x -expand 1
- pack $w.validate -anchor nw -fill x -pady 5 -padx 5
-
- bind $w <Visibility> "grab $w; focus $w"
- bind $w <Key-Escape> "destroy $w"
- wm title $w "[appname] ([reponame]): Delete Branch"
- tkwait window $w
-}
-
-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 repo_config
- global all_remotes tracking_branches
-
- set all_remotes [list]
- array unset tracking_branches
-
- 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 {^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]} 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]
- }
projects / git.git / blobdiff