- fconfigure $fd \
- -blocking 0 \
- -encoding binary \
- -translation binary
- fileevent $fd readable [list read_diff $fd]
-}
-
-proc read_diff {fd} {
- global ui_diff ui_status_value diff_active
- global is_3way_diff current_diff_header
-
- $ui_diff conf -state normal
- while {[gets $fd line] >= 0} {
- # -- Cleanup uninteresting diff header lines.
- #
- if { [string match {diff --git *} $line]
- || [string match {diff --cc *} $line]
- || [string match {diff --combined *} $line]
- || [string match {--- *} $line]
- || [string match {+++ *} $line]} {
- append current_diff_header $line "\n"
- continue
- }
- if {[string match {index *} $line]} continue
- if {$line eq {deleted file mode 120000}} {
- set line "deleted symlink"
- }
-
- # -- Automatically detect if this is a 3 way diff.
- #
- if {[string match {@@@ *} $line]} {set is_3way_diff 1}
-
- if {[string match {mode *} $line]
- || [string match {new file *} $line]
- || [string match {deleted file *} $line]
- || [string match {Binary files * and * differ} $line]
- || $line eq {\ No newline at end of file}
- || [regexp {^\* Unmerged path } $line]} {
- set tags {}
- } elseif {$is_3way_diff} {
- set op [string range $line 0 1]
- switch -- $op {
- { } {set tags {}}
- {@@} {set tags d_@}
- { +} {set tags d_s+}
- { -} {set tags d_s-}
- {+ } {set tags d_+s}
- {- } {set tags d_-s}
- {--} {set tags d_--}
- {++} {
- if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
- set line [string replace $line 0 1 { }]
- set tags d$op
- } else {
- set tags d_++
- }
- }
- default {
- puts "error: Unhandled 3 way diff marker: {$op}"
- set tags {}
- }
- }
- } else {
- set op [string index $line 0]
- switch -- $op {
- { } {set tags {}}
- {@} {set tags d_@}
- {-} {set tags d_-}
- {+} {
- if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
- set line [string replace $line 0 0 { }]
- set tags d$op
- } else {
- set tags d_+
- }
- }
- default {
- puts "error: Unhandled 2 way diff marker: {$op}"
- set tags {}
- }
- }
- }
- $ui_diff insert end $line $tags
- if {[string index $line end] eq "\r"} {
- $ui_diff tag add d_cr {end - 2c}
- }
- $ui_diff insert end "\n" $tags
- }
- $ui_diff conf -state disabled
-
- if {[eof $fd]} {
- close $fd
- set diff_active 0
- unlock_index
- set ui_status_value {Ready.}
-
- if {[$ui_diff index end] eq {2.0}} {
- handle_empty_diff
- }
- }
-}
-
-proc apply_hunk {x y} {
- global current_diff_path current_diff_header current_diff_side
- global ui_diff ui_index file_states
-
- if {$current_diff_path eq {} || $current_diff_header eq {}} return
- if {![lock_index apply_hunk]} return
-
- set apply_cmd {git apply --cached --whitespace=nowarn}
- set mi [lindex $file_states($current_diff_path) 0]
- if {$current_diff_side eq $ui_index} {
- set mode unstage
- lappend apply_cmd --reverse
- if {[string index $mi 0] ne {M}} {
- unlock_index
- return
- }
- } else {
- set mode stage
- if {[string index $mi 1] ne {M}} {
- unlock_index
- return
- }
- }
-
- set s_lno [lindex [split [$ui_diff index @$x,$y] .] 0]
- set s_lno [$ui_diff search -backwards -regexp ^@@ $s_lno.0 0.0]
- if {$s_lno eq {}} {
- unlock_index
- return
- }
-
- set e_lno [$ui_diff search -forwards -regexp ^@@ "$s_lno + 1 lines" end]
- if {$e_lno eq {}} {
- set e_lno end
- }
-
- if {[catch {
- set p [open "| $apply_cmd" w]
- fconfigure $p -translation binary -encoding binary
- puts -nonewline $p $current_diff_header
- puts -nonewline $p [$ui_diff get $s_lno $e_lno]
- close $p} err]} {
- error_popup "Failed to $mode selected hunk.\n\n$err"
- unlock_index
- return
- }
-
- $ui_diff conf -state normal
- $ui_diff delete $s_lno $e_lno
- $ui_diff conf -state disabled
-
- if {[$ui_diff get 1.0 end] eq "\n"} {
- set o _
- } else {
- set o ?
- }
-
- if {$current_diff_side eq $ui_index} {
- set mi ${o}M
- } elseif {[string index $mi 0] eq {_}} {
- set mi M$o
- } else {
- set mi ?$o
- }
- unlock_index
- display_file $current_diff_path $mi
- if {$o eq {_}} {
- clear_diff
- }
-}
-
-######################################################################
-##
-## commit
-
-proc load_last_commit {} {
- global HEAD PARENT MERGE_HEAD commit_type ui_comm
- global repo_config
-
- if {[llength $PARENT] == 0} {
- error_popup {There is nothing to amend.
-
-You are about to create the initial commit.
-There is no commit before this to amend.
-}
- return
- }
-
- repository_state curType curHEAD curMERGE_HEAD
- if {$curType eq {merge}} {
- error_popup {Cannot amend while merging.
-
-You are currently in the middle of a merge that
-has not been fully completed. You cannot amend
-the prior commit unless you first abort the
-current merge activity.
-}
- return
- }
-
- set msg {}
- set parents [list]
- if {[catch {
- set fd [open "| git cat-file commit $curHEAD" r]
- fconfigure $fd -encoding binary -translation lf
- if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
- set enc utf-8
- }
- while {[gets $fd line] > 0} {
- if {[string match {parent *} $line]} {
- lappend parents [string range $line 7 end]
- } elseif {[string match {encoding *} $line]} {
- set enc [string tolower [string range $line 9 end]]
- }
- }
- fconfigure $fd -encoding $enc
- set msg [string trim [read $fd]]
- close $fd
- } err]} {
- error_popup "Error loading commit data for amend:\n\n$err"
- return
- }
-
- set HEAD $curHEAD
- set PARENT $parents
- set MERGE_HEAD [list]
- switch -- [llength $parents] {
- 0 {set commit_type amend-initial}
- 1 {set commit_type amend}
- default {set commit_type amend-merge}
- }
-
- $ui_comm delete 0.0 end
- $ui_comm insert end $msg
- $ui_comm edit reset
- $ui_comm edit modified false
- rescan {set ui_status_value {Ready.}}
-}
-
-proc create_new_commit {} {
- global commit_type ui_comm
-
- set commit_type normal
- $ui_comm delete 0.0 end
- $ui_comm edit reset
- $ui_comm edit modified false
- rescan {set ui_status_value {Ready.}}
-}
-
-set GIT_COMMITTER_IDENT {}
-
-proc committer_ident {} {
- global GIT_COMMITTER_IDENT
-
- if {$GIT_COMMITTER_IDENT eq {}} {
- if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
- error_popup "Unable to obtain your identity:\n\n$err"
- return {}
- }
- if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
- $me me GIT_COMMITTER_IDENT]} {
- error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
- return {}
- }
- }
-
- return $GIT_COMMITTER_IDENT
-}
-
-proc commit_tree {} {
- global HEAD commit_type file_states ui_comm repo_config
- global ui_status_value pch_error
-
- if {![lock_index update]} return
- if {[committer_ident] eq {}} return
-
- # -- 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 another commit can be created.
-
-The rescan will be automatically started now.
-}
- unlock_index
- rescan {set ui_status_value {Ready.}}
- return
- }
-
- # -- At least one file should differ in the index.
- #
- set files_ready 0
- foreach path [array names file_states] {
- switch -glob -- [lindex $file_states($path) 0] {
- _? {continue}
- A? -
- D? -
- M? {set files_ready 1}
- U? {
- error_popup "Unmerged files cannot be committed.
-
-File [short_path $path] has merge conflicts.
-You must resolve them and add the file before committing.
-"
- unlock_index
- return
- }
- default {
- error_popup "Unknown file state [lindex $s 0] detected.
-
-File [short_path $path] cannot be committed by this program.
-"
- }
- }
- }
- if {!$files_ready} {
- info_popup {No changes to commit.
-
-You must add at least 1 file before you can commit.
-}
- unlock_index
- return
- }
-
- # -- A message is required.
- #
- set msg [string trim [$ui_comm get 1.0 end]]
- regsub -all -line {[ \t\r]+$} $msg {} msg
- if {$msg eq {}} {
- error_popup {Please supply a commit message.
-
-A good commit message has the following format:
-
-- First line: Describe in one sentance what you did.
-- Second line: Blank
-- Remaining lines: Describe why this change is good.
-}
- unlock_index
- return
- }
-
- # -- Run the pre-commit hook.
- #
- set pchook [gitdir hooks pre-commit]
-
- # On Cygwin [file executable] might lie so we need to ask
- # the shell if the hook is executable. Yes that's annoying.
- #
- if {[is_Windows] && [file isfile $pchook]} {
- set pchook [list sh -c [concat \
- "if test -x \"$pchook\";" \
- "then exec \"$pchook\" 2>&1;" \
- "fi"]]
- } elseif {[file executable $pchook]} {
- set pchook [list $pchook |& cat]
- } else {
- commit_writetree $curHEAD $msg
- return
- }
-
- set ui_status_value {Calling pre-commit hook...}
- set pch_error {}
- set fd_ph [open "| $pchook" r]
- fconfigure $fd_ph -blocking 0 -translation binary
- fileevent $fd_ph readable \
- [list commit_prehook_wait $fd_ph $curHEAD $msg]
-}
-
-proc commit_prehook_wait {fd_ph curHEAD msg} {
- global pch_error ui_status_value
-
- append pch_error [read $fd_ph]
- fconfigure $fd_ph -blocking 1
- if {[eof $fd_ph]} {
- if {[catch {close $fd_ph}]} {
- set ui_status_value {Commit declined by pre-commit hook.}
- hook_failed_popup pre-commit $pch_error
- unlock_index
- } else {
- commit_writetree $curHEAD $msg
- }
- set pch_error {}
- return
- }
- fconfigure $fd_ph -blocking 0
-}
-
-proc commit_writetree {curHEAD msg} {
- global ui_status_value
-
- set ui_status_value {Committing changes...}
- set fd_wt [open "| git write-tree" r]
- fileevent $fd_wt readable \
- [list commit_committree $fd_wt $curHEAD $msg]
-}
-
-proc commit_committree {fd_wt curHEAD msg} {
- global HEAD PARENT MERGE_HEAD commit_type
- global single_commit all_heads current_branch
- global ui_status_value ui_comm selected_commit_type
- global file_states selected_paths rescan_active
- global repo_config
-
- gets $fd_wt tree_id
- if {$tree_id eq {} || [catch {close $fd_wt} err]} {
- error_popup "write-tree failed:\n\n$err"
- set ui_status_value {Commit failed.}
- unlock_index
- return
- }
-
- # -- Build the message.
- #
- set msg_p [gitdir COMMIT_EDITMSG]
- set msg_wt [open $msg_p w]
- if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
- set enc utf-8
- }
- fconfigure $msg_wt -encoding $enc -translation binary
- puts -nonewline $msg_wt $msg
- close $msg_wt
-
- # -- Create the commit.
- #
- set cmd [list git commit-tree $tree_id]
- set parents [concat $PARENT $MERGE_HEAD]
- if {[llength $parents] > 0} {
- foreach p $parents {
- lappend cmd -p $p
- }
- } else {
- # git commit-tree writes to stderr during initial commit.
- lappend cmd 2>/dev/null
- }
- lappend cmd <$msg_p
- if {[catch {set cmt_id [eval exec $cmd]} err]} {
- error_popup "commit-tree failed:\n\n$err"
- set ui_status_value {Commit failed.}
- unlock_index
- return
- }
-
- # -- Update the HEAD ref.
- #
- set reflogm commit
- if {$commit_type ne {normal}} {
- append reflogm " ($commit_type)"
- }
- set i [string first "\n" $msg]
- if {$i >= 0} {
- append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
- } else {
- append reflogm {: } $msg
- }
- set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
- if {[catch {eval exec $cmd} err]} {
- error_popup "update-ref failed:\n\n$err"
- set ui_status_value {Commit failed.}
- unlock_index
- return
- }
-
- # -- Make sure our current branch exists.
- #
- if {$commit_type eq {initial}} {
- lappend all_heads $current_branch
- set all_heads [lsort -unique $all_heads]
- populate_branch_menu
- }
-
- # -- Cleanup after ourselves.
- #
- catch {file delete $msg_p}
- catch {file delete [gitdir MERGE_HEAD]}
- catch {file delete [gitdir MERGE_MSG]}
- catch {file delete [gitdir SQUASH_MSG]}
- catch {file delete [gitdir GITGUI_MSG]}
-
- # -- Let rerere do its thing.
- #
- if {[file isdirectory [gitdir rr-cache]]} {
- catch {exec git rerere}
- }
-
- # -- Run the post-commit hook.
- #
- set pchook [gitdir hooks post-commit]
- if {[is_Windows] && [file isfile $pchook]} {
- set pchook [list sh -c [concat \
- "if test -x \"$pchook\";" \
- "then exec \"$pchook\";" \
- "fi"]]
- } elseif {![file executable $pchook]} {
- set pchook {}
- }
- if {$pchook ne {}} {
- catch {exec $pchook &}
- }
-
- $ui_comm delete 0.0 end
- $ui_comm edit reset
- $ui_comm edit modified false
-
- if {$single_commit} do_quit
-
- # -- Update in memory status
- #
- set selected_commit_type new
- set commit_type normal
- set HEAD $cmt_id
- set PARENT $cmt_id
- set MERGE_HEAD [list]
-
- foreach path [array names file_states] {
- set s $file_states($path)
- set m [lindex $s 0]
- switch -glob -- $m {
- _O -
- _M -
- _D {continue}
- __ -
- A_ -
- M_ -
- D_ {
- unset file_states($path)
- catch {unset selected_paths($path)}
- }
- DO {
- set file_states($path) [list _O [lindex $s 1] {} {}]
- }
- AM -
- AD -
- MM -
- MD {
- set file_states($path) [list \
- _[string index $m 1] \
- [lindex $s 1] \
- [lindex $s 3] \
- {}]
- }
- }
- }
-
- display_all_files
- unlock_index
- reshow_diff
- set ui_status_value \
- "Changes committed as [string range $cmt_id 0 7]."
-}
-
-######################################################################
-##
-## fetch pull push
-
-proc fetch_from {remote} {
- set w [new_console "fetch $remote" \
- "Fetching new changes from $remote"]
- set cmd [list git fetch]
- lappend cmd $remote
- console_exec $w $cmd
-}
-
-proc pull_remote {remote branch} {
- global HEAD commit_type file_states repo_config
-
- if {![lock_index update]} return
-
- # -- Our in memory state should match the repository.
- #
- repository_state curType curHEAD curMERGE_HEAD
- if {$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 a pull operation can be started.
-
-The rescan will be automatically started now.
-}
- unlock_index
- rescan {set ui_status_value {Ready.}}
- return
- }
-
- # -- No differences should exist before a pull.
- #
- if {[array size file_states] != 0} {
- error_popup {Uncommitted but modified files are present.
-
-You should not perform a pull with unmodified
-files in your working directory as Git will be
-unable to recover from an incorrect merge.
-
-You should commit or revert all changes before
-starting a pull operation.
-}
- unlock_index
- return
- }
-
- set w [new_console "pull $remote $branch" \
- "Pulling new changes from branch $branch in $remote"]
- set cmd [list git pull]
- if {$repo_config(gui.pullsummary) eq {false}} {
- lappend cmd --no-summary
- }
- lappend cmd $remote
- lappend cmd $branch
- console_exec $w $cmd [list post_pull_remote $remote $branch]
-}
-
-proc post_pull_remote {remote branch success} {
- global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
- global ui_status_value
-
- unlock_index
- if {$success} {
- repository_state commit_type HEAD MERGE_HEAD
- set PARENT $HEAD
- set selected_commit_type new
- set ui_status_value "Pulling $branch from $remote complete."
- } else {
- rescan [list set ui_status_value \
- "Conflicts detected while pulling $branch from $remote."]
- }
-}
-
-proc push_to {remote} {
- set w [new_console "push $remote" \
- "Pushing changes to $remote"]
- set cmd [list git push]
- lappend cmd $remote
- console_exec $w $cmd
-}
-
-######################################################################
-##
-## ui helpers
-
-proc mapicon {w state path} {
- global all_icons
-
- if {[catch {set r $all_icons($state$w)}]} {
- puts "error: no icon for $w state={$state} $path"
- return file_plain
- }
- return $r
-}
-
-proc mapdesc {state path} {
- global all_descs
-
- if {[catch {set r $all_descs($state)}]} {
- puts "error: no desc for state={$state} $path"
- return $state
- }
- return $r
-}
-
-proc escape_path {path} {
- regsub -all "\n" $path "\\n" path
- return $path
-}
-
-proc short_path {path} {
- return [escape_path [lindex [file split $path] end]]
-}
-
-set next_icon_id 0
-set null_sha1 [string repeat 0 40]
-
-proc merge_state {path new_state {head_info {}} {index_info {}}} {
- global file_states next_icon_id null_sha1
-
- set s0 [string index $new_state 0]
- set s1 [string index $new_state 1]
-
- if {[catch {set info $file_states($path)}]} {
- set state __
- set icon n[incr next_icon_id]
- } else {
- set state [lindex $info 0]
- set icon [lindex $info 1]
- if {$head_info eq {}} {set head_info [lindex $info 2]}
- if {$index_info eq {}} {set index_info [lindex $info 3]}
- }
-
- if {$s0 eq {?}} {set s0 [string index $state 0]} \
- elseif {$s0 eq {_}} {set s0 _}
-
- if {$s1 eq {?}} {set s1 [string index $state 1]} \
- elseif {$s1 eq {_}} {set s1 _}
-
- if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
- set head_info [list 0 $null_sha1]
- } elseif {$s0 ne {_} && [string index $state 0] eq {_}
- && $head_info eq {}} {
- set head_info $index_info
- }
-
- set file_states($path) [list $s0$s1 $icon \
- $head_info $index_info \
- ]
- return $state
-}
-
-proc display_file_helper {w path icon_name old_m new_m} {
- global file_lists
-
- if {$new_m eq {_}} {
- set lno [lsearch -sorted -exact $file_lists($w) $path]
- if {$lno >= 0} {
- set file_lists($w) [lreplace $file_lists($w) $lno $lno]
- incr lno
- $w conf -state normal
- $w delete $lno.0 [expr {$lno + 1}].0
- $w conf -state disabled
- }
- } elseif {$old_m eq {_} && $new_m ne {_}} {
- lappend file_lists($w) $path
- set file_lists($w) [lsort -unique $file_lists($w)]
- set lno [lsearch -sorted -exact $file_lists($w) $path]
- incr lno
- $w conf -state normal
- $w image create $lno.0 \
- -align center -padx 5 -pady 1 \
- -name $icon_name \
- -image [mapicon $w $new_m $path]
- $w insert $lno.1 "[escape_path $path]\n"
- $w conf -state disabled
- } elseif {$old_m ne $new_m} {
- $w conf -state normal
- $w image conf $icon_name -image [mapicon $w $new_m $path]
- $w conf -state disabled
- }
-}
-
-proc display_file {path state} {
- global file_states selected_paths
- global ui_index ui_workdir
-
- set old_m [merge_state $path $state]
- set s $file_states($path)
- set new_m [lindex $s 0]
- set icon_name [lindex $s 1]
-
- set o [string index $old_m 0]
- set n [string index $new_m 0]
- if {$o eq {U}} {
- set o _
- }
- if {$n eq {U}} {
- set n _
- }
- display_file_helper $ui_index $path $icon_name $o $n
-
- if {[string index $old_m 0] eq {U}} {
- set o U
- } else {
- set o [string index $old_m 1]
- }
- if {[string index $new_m 0] eq {U}} {
- set n U
- } else {
- set n [string index $new_m 1]
- }
- display_file_helper $ui_workdir $path $icon_name $o $n
-
- 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 \
- -encoding binary \
- -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[encoding convertto $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 \
- -encoding binary \
- -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 "[encoding convertto $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 \
- -encoding binary \
- -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 "[encoding convertto $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 is_tracking_branch {name} {
- global tracking_branches
-
- if {![catch {set info $tracking_branches($name)}]} {
- return 1
- }
- foreach t [array names tracking_branches] {
- if {[string match {*/\*} $t] && [string match $t $name]} {
- return 1
- }
- }
- return 0
-}
-
-proc load_all_heads {} {
- global all_heads
-
- set all_heads [list]
- set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
- while {[gets $fd line] > 0} {
- if {[is_tracking_branch $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
- }
- }
-
- if {$all_heads ne {}} {
- $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 all_tracking_branches {} {
- global tracking_branches
-
- set all_trackings {}
- set cmd {}
- foreach name [array names tracking_branches] {
- if {[regsub {/\*$} $name {} name]} {
- lappend cmd $name
- } else {
- regsub ^refs/(heads|remotes)/ $name {} name
- lappend all_trackings $name
- }
- }
-
- if {$cmd ne {}} {
- set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
- while {[gets $fd name] > 0} {
- regsub ^refs/(heads|remotes)/ $name {} name
- lappend all_trackings $name
- }
- close $fd
- }
-
- return [lsort -unique $all_trackings]
-}
-
-proc do_create_branch_action {w} {
- global all_heads null_sha1 repo_config
- global create_branch_checkout create_branch_revtype
- global create_branch_head create_branch_trackinghead
- global create_branch_name create_branch_revexp
-
- set newbranch $create_branch_name
- if {$newbranch eq {}
- || $newbranch eq $repo_config(gui.newbranchtemplate)} {
- tk_messageBox \
- -icon error \
- -type ok \
- -title [wm title $w] \
- -parent $w \
- -message "Please supply a branch name."
- focus $w.desc.name_t
- return
- }
- 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 $create_branch_revexp}
- }
- 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 radio_selector {varname value args} {
- upvar #0 $varname var
- set var $value
-}
-
-trace add variable create_branch_head write \
- [list radio_selector create_branch_revtype head]
-trace add variable create_branch_trackinghead write \
- [list radio_selector create_branch_revtype tracking]
-
-trace add variable delete_branch_head write \
- [list radio_selector delete_branch_checktype head]
-trace add variable delete_branch_trackinghead write \
- [list radio_selector delete_branch_checktype tracking]
-
-proc do_create_branch {} {
- global all_heads current_branch repo_config
- global create_branch_checkout create_branch_revtype
- global create_branch_head create_branch_trackinghead
- global create_branch_name create_branch_revexp
-
- 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
- label $w.desc.name_l -text {Name:} -font font_ui
- entry $w.desc.name_t \
- -borderwidth 1 \
- -relief sunken \
- -width 40 \
- -textvariable create_branch_name \
- -font font_ui \
- -validate key \
- -validatecommand {
- if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
- return 1
- }
- grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
- grid columnconfigure $w.desc 1 -weight 1
- pack $w.desc -anchor nw -fill x -pady 5 -padx 5
-
- labelframe $w.from \
- -text {Starting Revision} \
- -font font_ui
- 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
- grid $w.from.head_r $w.from.head_m -sticky w
- set all_trackings [all_tracking_branches]
- if {$all_trackings ne {}} {
- set create_branch_trackinghead [lindex $all_trackings 0]
- 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
- grid $w.from.tracking_r $w.from.tracking_m -sticky w
- }
- radiobutton $w.from.exp_r \
- -text {Revision Expression:} \
- -value expression \
- -variable create_branch_revtype \
- -font font_ui
- entry $w.from.exp_t \
- -borderwidth 1 \
- -relief sunken \
- -width 50 \
- -textvariable create_branch_revexp \
- -font font_ui \
- -validate key \
- -validatecommand {
- if {%d == 1 && [regexp {\s} %S]} {return 0}
- if {%d == 1 && [string length %S] > 0} {
- set create_branch_revtype expression
- }
- return 1
- }
- grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
- grid columnconfigure $w.from 1 -weight 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
-
- set create_branch_checkout 1
- set create_branch_head $current_branch
- set create_branch_revtype head
- set create_branch_name $repo_config(gui.newbranchtemplate)
- set create_branch_revexp {}
-
- bind $w <Visibility> "
- grab $w
- $w.desc.name_t icursor end
- 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_checktype delete_branch_head delete_branch_trackinghead
-
- set check_rev {}
- switch -- $delete_branch_checktype {
- head {set check_rev $delete_branch_head}
- tracking {set check_rev $delete_branch_trackinghead}
- always {set check_rev {:none}}
- }
- if {$check_rev eq {:none}} {
- set check_cmt {}
- } elseif {[catch {set check_cmt [exec git rev-parse --verify "${check_rev}^0"]}]} {
- tk_messageBox \
- -icon error \
- -type ok \
- -title [wm title $w] \
- -parent $w \
- -message "Invalid check revision: $check_rev"
- return
- }
-
- 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 {$check_cmt ne {}} {
- if {$b eq $check_rev} continue
- if {[catch {set m [exec git merge-base $o $check_cmt]}]} 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 $check_rev:
-
- - [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_checktype eq {always}} {
- 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 -exact $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_checktype delete_branch_head delete_branch_trackinghead
-
- 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
-
- labelframe $w.validate \
- -text {Delete Only If} \
- -font font_ui
- radiobutton $w.validate.head_r \
- -text {Merged Into Local Branch:} \
- -value head \
- -variable delete_branch_checktype \
- -font font_ui
- eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
- grid $w.validate.head_r $w.validate.head_m -sticky w
- set all_trackings [all_tracking_branches]
- if {$all_trackings ne {}} {
- set delete_branch_trackinghead [lindex $all_trackings 0]
- radiobutton $w.validate.tracking_r \
- -text {Merged Into Tracking Branch:} \
- -value tracking \
- -variable delete_branch_checktype \
- -font font_ui
- eval tk_optionMenu $w.validate.tracking_m \
- delete_branch_trackinghead \
- $all_trackings
- grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
- }
- radiobutton $w.validate.always_r \
- -text {Always (Do not perform merge checks)} \
- -value always \
- -variable delete_branch_checktype \
- -font font_ui
- 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
-
- set delete_branch_head $current_branch
- set delete_branch_checktype head
-
- 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 {new_branch} {
- global HEAD commit_type current_branch repo_config
-
- if {![lock_index switch]} return
-
- # -- 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
- }
-
- # -- Don't do a pointless switch.
- #
- if {$current_branch eq $new_branch} {
- unlock_index
- return
- }
-
- if {$repo_config(gui.trustmtime) eq {true}} {
- switch_branch_stage2 {} $new_branch