- set buf_rdi {}
- set buf_rdf {}
- set buf_rlo {}
-
- set rescan_active 3
- set ui_status_value {Scanning for modified files ...}
- set fd_di [open "| git diff-index --cached -z [PARENT]" r]
- set fd_df [open "| git diff-files -z" r]
- set fd_lo [open $ls_others r]
-
- fconfigure $fd_di -blocking 0 -translation binary -encoding binary
- fconfigure $fd_df -blocking 0 -translation binary -encoding binary
- fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
- fileevent $fd_di readable [list read_diff_index $fd_di $after]
- fileevent $fd_df readable [list read_diff_files $fd_df $after]
- fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
-}
-
-proc load_message {file} {
- global ui_comm
-
- set f [gitdir $file]
- if {[file isfile $f]} {
- if {[catch {set fd [open $f r]}]} {
- return 0
- }
- set content [string trim [read $fd]]
- close $fd
- regsub -all -line {[ \r\t]+$} $content {} content
- $ui_comm delete 0.0 end
- $ui_comm insert end $content
- return 1
- }
- return 0
-}
-
-proc read_diff_index {fd after} {
- global buf_rdi
-
- append buf_rdi [read $fd]
- set c 0
- set n [string length $buf_rdi]
- while {$c < $n} {
- set z1 [string first "\0" $buf_rdi $c]
- if {$z1 == -1} break
- incr z1
- set z2 [string first "\0" $buf_rdi $z1]
- if {$z2 == -1} break
-
- incr c
- set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
- set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
- merge_state \
- [encoding convertfrom $p] \
- [lindex $i 4]? \
- [list [lindex $i 0] [lindex $i 2]] \
- [list]
- set c $z2
- incr c
- }
- if {$c < $n} {
- set buf_rdi [string range $buf_rdi $c end]
- } else {
- set buf_rdi {}
- }
-
- rescan_done $fd buf_rdi $after
-}
-
-proc read_diff_files {fd after} {
- global buf_rdf
-
- append buf_rdf [read $fd]
- set c 0
- set n [string length $buf_rdf]
- while {$c < $n} {
- set z1 [string first "\0" $buf_rdf $c]
- if {$z1 == -1} break
- incr z1
- set z2 [string first "\0" $buf_rdf $z1]
- if {$z2 == -1} break
-
- incr c
- set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
- set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
- merge_state \
- [encoding convertfrom $p] \
- ?[lindex $i 4] \
- [list] \
- [list [lindex $i 0] [lindex $i 2]]
- set c $z2
- incr c
- }
- if {$c < $n} {
- set buf_rdf [string range $buf_rdf $c end]
- } else {
- set buf_rdf {}
- }
-
- rescan_done $fd buf_rdf $after
-}
-
-proc read_ls_others {fd after} {
- global buf_rlo
-
- append buf_rlo [read $fd]
- set pck [split $buf_rlo "\0"]
- set buf_rlo [lindex $pck end]
- foreach p [lrange $pck 0 end-1] {
- merge_state [encoding convertfrom $p] ?O
- }
- rescan_done $fd buf_rlo $after
-}
-
-proc rescan_done {fd buf after} {
- global rescan_active
- global file_states repo_config
- upvar $buf to_clear
-
- if {![eof $fd]} return
- set to_clear {}
- close $fd
- if {[incr rescan_active -1] > 0} return
-
- prune_selection
- unlock_index
- display_all_files
- reshow_diff
- uplevel #0 $after
-}
-
-proc prune_selection {} {
- global file_states selected_paths
-
- foreach path [array names selected_paths] {
- if {[catch {set still_here $file_states($path)}]} {
- unset selected_paths($path)
- }
- }
-}
-
-######################################################################
-##
-## diff
-
-proc clear_diff {} {
- global ui_diff current_diff_path current_diff_header
- global ui_index ui_workdir
-
- $ui_diff conf -state normal
- $ui_diff delete 0.0 end
- $ui_diff conf -state disabled
-
- set current_diff_path {}
- set current_diff_header {}
-
- $ui_index tag remove in_diff 0.0 end
- $ui_workdir tag remove in_diff 0.0 end
-}
-
-proc reshow_diff {} {
- global ui_status_value file_states file_lists
- global current_diff_path current_diff_side
-
- set p $current_diff_path
- if {$p eq {}
- || $current_diff_side eq {}
- || [catch {set s $file_states($p)}]
- || [lsearch -sorted -exact $file_lists($current_diff_side) $p] == -1} {
- clear_diff
- } else {
- show_diff $p $current_diff_side
- }
-}
-
-proc handle_empty_diff {} {
- global current_diff_path file_states file_lists
-
- set path $current_diff_path
- set s $file_states($path)
- if {[lindex $s 0] ne {_M}} return
-
- info_popup "No differences detected.
-
-[short_path $path] has no changes.
-
-The modification date of this file was updated
-by another application, but the content within
-the file was not changed.
-
-A rescan will be automatically started to find
-other files which may have the same state."
-
- clear_diff
- display_file $path __
- rescan {set ui_status_value {Ready.}} 0
-}
-
-proc show_diff {path w {lno {}}} {
- global file_states file_lists
- global is_3way_diff diff_active repo_config
- global ui_diff ui_status_value ui_index ui_workdir
- global current_diff_path current_diff_side current_diff_header
-
- if {$diff_active || ![lock_index read]} return
-
- clear_diff
- if {$lno == {}} {
- set lno [lsearch -sorted -exact $file_lists($w) $path]
- if {$lno >= 0} {
- incr lno
- }
- }
- if {$lno >= 1} {
- $w tag add in_diff $lno.0 [expr {$lno + 1}].0
- }
-
- set s $file_states($path)
- set m [lindex $s 0]
- set is_3way_diff 0
- set diff_active 1
- set current_diff_path $path
- set current_diff_side $w
- set current_diff_header {}
- set ui_status_value "Loading diff of [escape_path $path]..."
-
- # - Git won't give us the diff, there's nothing to compare to!
- #
- if {$m eq {_O}} {
- set max_sz [expr {128 * 1024}]
- if {[catch {
- set fd [open $path r]
- set content [read $fd $max_sz]
- close $fd
- set sz [file size $path]
- } err ]} {
- set diff_active 0
- unlock_index
- set ui_status_value "Unable to display [escape_path $path]"
- error_popup "Error loading file:\n\n$err"
- return
- }
- $ui_diff conf -state normal
- if {![catch {set type [exec file $path]}]} {
- set n [string length $path]
- if {[string equal -length $n $path $type]} {
- set type [string range $type $n end]
- regsub {^:?\s*} $type {} type
- }
- $ui_diff insert end "* $type\n" d_@
- }
- if {[string first "\0" $content] != -1} {
- $ui_diff insert end \
- "* Binary file (not showing content)." \
- d_@
- } else {
- if {$sz > $max_sz} {
- $ui_diff insert end \
-"* Untracked file is $sz bytes.
-* Showing only first $max_sz bytes.
-" d_@
- }
- $ui_diff insert end $content
- if {$sz > $max_sz} {
- $ui_diff insert end "
-* Untracked file clipped here by [appname].
-* To see the entire file, use an external editor.
-" d_@
- }
- }
- $ui_diff conf -state disabled
- set diff_active 0
- unlock_index
- set ui_status_value {Ready.}
- return
- }
-
- set cmd [list | git]
- if {$w eq $ui_index} {
- lappend cmd diff-index
- lappend cmd --cached
- } elseif {$w eq $ui_workdir} {
- if {[string index $m 0] eq {U}} {
- lappend cmd diff
- } else {
- lappend cmd diff-files
- }
- }
-
- lappend cmd -p
- lappend cmd --no-color
- if {$repo_config(gui.diffcontext) > 0} {
- lappend cmd "-U$repo_config(gui.diffcontext)"
- }
- if {$w eq $ui_index} {
- lappend cmd [PARENT]
- }
- lappend cmd --
- lappend cmd $path
-
- if {[catch {set fd [open $cmd r]} err]} {
- set diff_active 0
- unlock_index
- set ui_status_value "Unable to display [escape_path $path]"
- error_popup "Error loading diff:\n\n$err"
- return
- }
-
- 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 {[committer_ident] eq {}} return
- if {![lock_index update]} 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_Cygwin] && [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 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_Cygwin] && [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 {[is_enabled singlecommit]} 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 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 console_done
-}
-
-proc push_to {remote} {
- set w [new_console \
- "push $remote" \
- "Pushing changes to $remote"]
- set cmd [list git push]
- lappend cmd -v
- lappend cmd $remote
- console_exec $w $cmd console_done