git-gui/lib/commit.tcl - jrn/git - Git at Google

 # git-gui misc. commit reading/writing support
 # Copyright (C) 2006, 2007 Shawn Pearce

 proc load_last_commit {} {
 	global HEAD PARENT MERGE_HEAD commit_type ui_comm commit_author
 	global repo_config

 	if {[llength $PARENT] == 0} {
 		error_popup [mc "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 [mc "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 [git_read cat-file commit $curHEAD]
 			fconfigure $fd -encoding binary -translation lf
 			# By default commits are assumed to be in utf-8
 			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]]
 				} elseif {[regexp "author (.*)\\s<(.*)>\\s(\\d.*$)" $line all name email time]} {
 					set commit_author [list name $name email $email date $time]
 				}
 			}
 			set msg [read $fd]
 			close $fd

 			set enc [tcl_encoding $enc]
 			if {$enc ne {}} {
 				set msg [encoding convertfrom $enc $msg]
 			}
 			set msg [string trim $msg]
 		} err]} {
 		error_popup [strcat [mc "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 ui_ready
 }

 set GIT_COMMITTER_IDENT {}

 proc committer_ident {} {
 	global GIT_COMMITTER_IDENT

 	if {$GIT_COMMITTER_IDENT eq {}} {
 		if {[catch {set me [git var GIT_COMMITTER_IDENT]} err]} {
 			error_popup [strcat [mc "Unable to obtain your identity:"] "\n\n$err"]
 			return {}
 		}
 		if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
 			$me me GIT_COMMITTER_IDENT]} {
 			error_popup [strcat [mc "Invalid GIT_COMMITTER_IDENT:"] "\n\n$me"]
 			return {}
 		}
 	}

 	return $GIT_COMMITTER_IDENT
 }

 proc do_signoff {} {
 	global ui_comm

 	set me [committer_ident]
 	if {$me eq {}} return

 	set sob "Signed-off-by: $me"
 	set last [$ui_comm get {end -1c linestart} {end -1c}]
 	if {$last ne $sob} {
 		$ui_comm edit separator
 		if {$last ne {}
 			&& ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
 			$ui_comm insert end "\n"
 		}
 		$ui_comm insert end "\n$sob"
 		$ui_comm edit separator
 		$ui_comm see end
 	}
 }

 proc create_new_commit {} {
 	global commit_type ui_comm commit_author

 	set commit_type normal
 	unset -nocomplain commit_author
 	$ui_comm delete 0.0 end
 	$ui_comm edit reset
 	$ui_comm edit modified false
 	rescan ui_ready
 }

 proc setup_commit_encoding {msg_wt {quiet 0}} {
 	global repo_config

 	if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
 		set enc utf-8
 	}
 	set use_enc [tcl_encoding $enc]
 	if {$use_enc ne {}} {
 		fconfigure $msg_wt -encoding $use_enc
 	} else {
 		if {!$quiet} {
 			error_popup [mc "warning: Tcl does not support encoding '%s'." $enc]
 		}
 		fconfigure $msg_wt -encoding utf-8
 	}
 }

 proc commit_tree {} {
 	global HEAD commit_type file_states ui_comm repo_config
 	global 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 [mc "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 ui_ready
 		return
 	}

 	# -- At least one file should differ in the index.
 	#
 	set files_ready 0
 	foreach path [array names file_states] {
 		set s $file_states($path)
 		switch -glob -- [lindex $s 0] {
 		_? {continue}
 		A? -
 		D? -
 		T? -
 		M? {set files_ready 1}
 		_U -
 		U? {
 			error_popup [mc "Unmerged files cannot be committed.

 File %s has merge conflicts.  You must resolve them and stage the file before committing.
 " [short_path $path]]
 			unlock_index
 			return
 		}
 		default {
 			error_popup [mc "Unknown file state %s detected.

 File %s cannot be committed by this program.
 " [lindex $s 0] [short_path $path]]
 		}
 		}
 	}
 	if {!$files_ready && ![string match *merge $curType] && ![is_enabled nocommit]} {
 		info_popup [mc "No changes to commit.

 You must stage at least 1 file before you can commit.
 "]
 		unlock_index
 		return
 	}

 	if {[is_enabled nocommitmsg]} { do_quit 0 }

 	# -- 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 [mc "Please supply a commit message.

 A good commit message has the following format:

 - First line: Describe in one sentence what you did.
 - Second line: Blank
 - Remaining lines: Describe why this change is good.
 "]
 		unlock_index
 		return
 	}

 	# -- Build the message file.
 	#
 	set msg_p [gitdir GITGUI_EDITMSG]
 	set msg_wt [open $msg_p w]
 	fconfigure $msg_wt -translation lf
 	setup_commit_encoding $msg_wt
 	puts $msg_wt $msg
 	close $msg_wt

 	if {[is_enabled nocommit]} { do_quit 0 }

 	# -- Run the pre-commit hook.
 	#
 	set fd_ph [githook_read pre-commit]
 	if {$fd_ph eq {}} {
 		commit_commitmsg $curHEAD $msg_p
 		return
 	}

 	ui_status [mc "Calling pre-commit hook..."]
 	set pch_error {}
 	fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
 	fileevent $fd_ph readable \
 		[list commit_prehook_wait $fd_ph $curHEAD $msg_p]
 }

 proc commit_prehook_wait {fd_ph curHEAD msg_p} {
 	global pch_error

 	append pch_error [read $fd_ph]
 	fconfigure $fd_ph -blocking 1
 	if {[eof $fd_ph]} {
 		if {[catch {close $fd_ph}]} {
 			catch {file delete $msg_p}
 			ui_status [mc "Commit declined by pre-commit hook."]
 			hook_failed_popup pre-commit $pch_error
 			unlock_index
 		} else {
 			commit_commitmsg $curHEAD $msg_p
 		}
 		set pch_error {}
 		return
 	}
 	fconfigure $fd_ph -blocking 0
 }

 proc commit_commitmsg {curHEAD msg_p} {
 	global is_detached repo_config
 	global pch_error

 	if {$is_detached
 	    && ![file exists [gitdir rebase-merge head-name]]
 	    && 	[is_config_true gui.warndetachedcommit]} {
 		set msg [mc "You are about to commit on a detached head.\
 This is a potentially dangerous thing to do because if you switch\
 to another branch you will lose your changes and it can be difficult\
 to retrieve them later from the reflog. You should probably cancel this\
 commit and create a new branch to continue.\n\
 \n\
 Do you really want to proceed with your Commit?"]
 		if {[ask_popup $msg] ne yes} {
 			unlock_index
 			return
 		}
 	}

 	# -- Run the commit-msg hook.
 	#
 	set fd_ph [githook_read commit-msg $msg_p]
 	if {$fd_ph eq {}} {
 		commit_writetree $curHEAD $msg_p
 		return
 	}

 	ui_status [mc "Calling commit-msg hook..."]
 	set pch_error {}
 	fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
 	fileevent $fd_ph readable \
 		[list commit_commitmsg_wait $fd_ph $curHEAD $msg_p]
 }

 proc commit_commitmsg_wait {fd_ph curHEAD msg_p} {
 	global pch_error

 	append pch_error [read $fd_ph]
 	fconfigure $fd_ph -blocking 1
 	if {[eof $fd_ph]} {
 		if {[catch {close $fd_ph}]} {
 			catch {file delete $msg_p}
 			ui_status [mc "Commit declined by commit-msg hook."]
 			hook_failed_popup commit-msg $pch_error
 			unlock_index
 		} else {
 			commit_writetree $curHEAD $msg_p
 		}
 		set pch_error {}
 		return
 	}
 	fconfigure $fd_ph -blocking 0
 }

 proc commit_writetree {curHEAD msg_p} {
 	ui_status [mc "Committing changes..."]
 	set fd_wt [git_read write-tree]
 	fileevent $fd_wt readable \
 		[list commit_committree $fd_wt $curHEAD $msg_p]
 }

 proc commit_committree {fd_wt curHEAD msg_p} {
 	global HEAD PARENT MERGE_HEAD commit_type commit_author
 	global current_branch
 	global ui_comm selected_commit_type
 	global file_states selected_paths rescan_active
 	global repo_config
 	global env

 	gets $fd_wt tree_id
 	if {[catch {close $fd_wt} err]} {
 		catch {file delete $msg_p}
 		error_popup [strcat [mc "write-tree failed:"] "\n\n$err"]
 		ui_status [mc "Commit failed."]
 		unlock_index
 		return
 	}

 	# -- Verify this wasn't an empty change.
 	#
 	if {$commit_type eq {normal}} {
 		set fd_ot [git_read cat-file commit $PARENT]
 		fconfigure $fd_ot -encoding binary -translation lf
 		set old_tree [gets $fd_ot]
 		close $fd_ot

 		if {[string equal -length 5 {tree } $old_tree]
 			&& [string length $old_tree] == 45} {
 			set old_tree [string range $old_tree 5 end]
 		} else {
 			error [mc "Commit %s appears to be corrupt" $PARENT]
 		}

 		if {$tree_id eq $old_tree} {
 			catch {file delete $msg_p}
 			info_popup [mc "No changes to commit.

 No files were modified by this commit and it was not a merge commit.

 A rescan will be automatically started now.
 "]
 			unlock_index
 			rescan {ui_status [mc "No changes to commit."]}
 			return
 		}
 	}

 	if {[info exists commit_author]} {
 		set old_author [commit_author_ident $commit_author]
 	}
 	# -- Create the commit.
 	#
 	set cmd [list commit-tree $tree_id]
 	if {[is_config_true commit.gpgsign]} {
 		lappend cmd -S
 	}
 	foreach p [concat $PARENT $MERGE_HEAD] {
 		lappend cmd -p $p
 	}
 	lappend cmd <$msg_p
 	if {[catch {set cmt_id [eval git $cmd]} err]} {
 		catch {file delete $msg_p}
 		error_popup [strcat [mc "commit-tree failed:"] "\n\n$err"]
 		ui_status [mc "Commit failed."]
 		unlock_index
 		unset -nocomplain commit_author
 		commit_author_reset $old_author
 		return
 	}
 	if {[info exists commit_author]} {
 		unset -nocomplain commit_author
 		commit_author_reset $old_author
 	}

 	# -- Update the HEAD ref.
 	#
 	set reflogm commit
 	if {$commit_type ne {normal}} {
 		append reflogm " ($commit_type)"
 	}
 	set msg_fd [open $msg_p r]
 	setup_commit_encoding $msg_fd 1
 	gets $msg_fd subject
 	close $msg_fd
 	append reflogm {: } $subject
 	if {[catch {
 			git update-ref -m $reflogm HEAD $cmt_id $curHEAD
 		} err]} {
 		catch {file delete $msg_p}
 		error_popup [strcat [mc "update-ref failed:"] "\n\n$err"]
 		ui_status [mc "Commit failed."]
 		unlock_index
 		return
 	}

 	# -- 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]}
 	catch {file delete [gitdir CHERRY_PICK_HEAD]}

 	# -- Let rerere do its thing.
 	#
 	if {[get_config rerere.enabled] eq {}} {
 		set rerere [file isdirectory [gitdir rr-cache]]
 	} else {
 		set rerere [is_config_true rerere.enabled]
 	}
 	if {$rerere} {
 		catch {git rerere}
 	}

 	# -- Run the post-commit hook.
 	#
 	set fd_ph [githook_read post-commit]
 	if {$fd_ph ne {}} {
 		global pch_error
 		set pch_error {}
 		fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
 		fileevent $fd_ph readable \
 			[list commit_postcommit_wait $fd_ph $cmt_id]
 	}

 	$ui_comm delete 0.0 end
 	$ui_comm edit reset
 	$ui_comm edit modified false
 	if {$::GITGUI_BCK_exists} {
 		catch {file delete [gitdir GITGUI_BCK]}
 		set ::GITGUI_BCK_exists 0
 	}

 	if {[is_enabled singlecommit]} { do_quit 0 }

 	# -- 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_ -
 		T_ -
 		D_ {
 			unset file_states($path)
 			catch {unset selected_paths($path)}
 		}
 		DO {
 			set file_states($path) [list _O [lindex $s 1] {} {}]
 		}
 		AM -
 		AD -
 		AT -
 		TM -
 		TD -
 		MM -
 		MT -
 		MD {
 			set file_states($path) [list \
 				_[string index $m 1] \
 				[lindex $s 1] \
 				[lindex $s 3] \
 				{}]
 		}
 		}
 	}

 	display_all_files
 	unlock_index
 	reshow_diff
 	ui_status [mc "Created commit %s: %s" [string range $cmt_id 0 7] $subject]
 }

 proc commit_postcommit_wait {fd_ph cmt_id} {
 	global pch_error

 	append pch_error [read $fd_ph]
 	fconfigure $fd_ph -blocking 1
 	if {[eof $fd_ph]} {
 		if {[catch {close $fd_ph}]} {
 			hook_failed_popup post-commit $pch_error 0
 		}
 		unset pch_error
 		return
 	}
 	fconfigure $fd_ph -blocking 0
 }

 proc commit_author_ident {details} {
 	global env
 	array set author $details
 	set old [array get env GIT_AUTHOR_*]
 	set env(GIT_AUTHOR_NAME) $author(name)
 	set env(GIT_AUTHOR_EMAIL) $author(email)
 	set env(GIT_AUTHOR_DATE) $author(date)
 	return $old
 }
 proc commit_author_reset {details} {
 	global env
 	unset env(GIT_AUTHOR_NAME) env(GIT_AUTHOR_EMAIL) env(GIT_AUTHOR_DATE)
 	if {$details ne {}} {
 		array set env $details
 	}
 }
	# git-gui misc. commit reading/writing support
	# Copyright (C) 2006, 2007 Shawn Pearce

	proc load_last_commit {} {
	global HEAD PARENT MERGE_HEAD commit_type ui_comm commit_author
	global repo_config

	if {[llength $PARENT] == 0} {
	error_popup [mc "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 [mc "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 [git_read cat-file commit $curHEAD]
	fconfigure $fd -encoding binary -translation lf
	# By default commits are assumed to be in utf-8
	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]]
	} elseif {[regexp "author (.)\\s<(.)>\\s(\\d.*$)" $line all name email time]} {
	set commit_author [list name $name email $email date $time]
	}
	}
	set msg [read $fd]
	close $fd

	set enc [tcl_encoding $enc]
	if {$enc ne {}} {
	set msg [encoding convertfrom $enc $msg]
	}
	set msg [string trim $msg]
	} err]} {
	error_popup [strcat [mc "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 ui_ready
	}

	set GIT_COMMITTER_IDENT {}

	proc committer_ident {} {
	global GIT_COMMITTER_IDENT

	if {$GIT_COMMITTER_IDENT eq {}} {
	if {[catch {set me [git var GIT_COMMITTER_IDENT]} err]} {
	error_popup [strcat [mc "Unable to obtain your identity:"] "\n\n$err"]
	return {}
	}
	if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
	$me me GIT_COMMITTER_IDENT]} {
	error_popup [strcat [mc "Invalid GIT_COMMITTER_IDENT:"] "\n\n$me"]
	return {}
	}
	}

	return $GIT_COMMITTER_IDENT
	}

	proc do_signoff {} {
	global ui_comm

	set me [committer_ident]
	if {$me eq {}} return

	set sob "Signed-off-by: $me"
	set last [$ui_comm get {end -1c linestart} {end -1c}]
	if {$last ne $sob} {
	$ui_comm edit separator
	if {$last ne {}
	&& ![regexp {^[A-Z][A-Za-z]-[A-Za-z-]+: } $last]} {
	$ui_comm insert end "\n"
	}
	$ui_comm insert end "\n$sob"
	$ui_comm edit separator
	$ui_comm see end
	}
	}

	proc create_new_commit {} {
	global commit_type ui_comm commit_author

	set commit_type normal
	unset -nocomplain commit_author
	$ui_comm delete 0.0 end
	$ui_comm edit reset
	$ui_comm edit modified false
	rescan ui_ready
	}

	proc setup_commit_encoding {msg_wt {quiet 0}} {
	global repo_config

	if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
	set enc utf-8
	}
	set use_enc [tcl_encoding $enc]
	if {$use_enc ne {}} {
	fconfigure $msg_wt -encoding $use_enc
	} else {
	if {!$quiet} {
	error_popup [mc "warning: Tcl does not support encoding '%s'." $enc]
	}
	fconfigure $msg_wt -encoding utf-8
	}
	}

	proc commit_tree {} {
	global HEAD commit_type file_states ui_comm repo_config
	global 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 [mc "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 ui_ready
	return
	}

	# -- At least one file should differ in the index.
	#
	set files_ready 0
	foreach path [array names file_states] {
	set s $file_states($path)
	switch -glob -- [lindex $s 0] {
	_? {continue}
	A? -
	D? -
	T? -
	M? {set files_ready 1}
	_U -
	U? {
	error_popup [mc "Unmerged files cannot be committed.

	File %s has merge conflicts. You must resolve them and stage the file before committing.
	" [short_path $path]]
	unlock_index
	return
	}
	default {
	error_popup [mc "Unknown file state %s detected.

	File %s cannot be committed by this program.
	" [lindex $s 0] [short_path $path]]
	}
	}
	}
	if {!$files_ready && ![string match *merge $curType] && ![is_enabled nocommit]} {
	info_popup [mc "No changes to commit.

	You must stage at least 1 file before you can commit.
	"]
	unlock_index
	return
	}

	if {[is_enabled nocommitmsg]} { do_quit 0 }

	# -- 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 [mc "Please supply a commit message.

	A good commit message has the following format:

	- First line: Describe in one sentence what you did.
	- Second line: Blank
	- Remaining lines: Describe why this change is good.
	"]
	unlock_index
	return
	}

	# -- Build the message file.
	#
	set msg_p [gitdir GITGUI_EDITMSG]
	set msg_wt [open $msg_p w]
	fconfigure $msg_wt -translation lf
	setup_commit_encoding $msg_wt
	puts $msg_wt $msg
	close $msg_wt

	if {[is_enabled nocommit]} { do_quit 0 }

	# -- Run the pre-commit hook.
	#
	set fd_ph [githook_read pre-commit]
	if {$fd_ph eq {}} {
	commit_commitmsg $curHEAD $msg_p
	return
	}

	ui_status [mc "Calling pre-commit hook..."]
	set pch_error {}
	fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
	fileevent $fd_ph readable \
	[list commit_prehook_wait $fd_ph $curHEAD $msg_p]
	}

	proc commit_prehook_wait {fd_ph curHEAD msg_p} {
	global pch_error

	append pch_error [read $fd_ph]
	fconfigure $fd_ph -blocking 1
	if {[eof $fd_ph]} {
	if {[catch {close $fd_ph}]} {
	catch {file delete $msg_p}
	ui_status [mc "Commit declined by pre-commit hook."]
	hook_failed_popup pre-commit $pch_error
	unlock_index
	} else {
	commit_commitmsg $curHEAD $msg_p
	}
	set pch_error {}
	return
	}
	fconfigure $fd_ph -blocking 0
	}

	proc commit_commitmsg {curHEAD msg_p} {
	global is_detached repo_config
	global pch_error

	if {$is_detached
	&& ![file exists [gitdir rebase-merge head-name]]
	&& [is_config_true gui.warndetachedcommit]} {
	set msg [mc "You are about to commit on a detached head.\
	This is a potentially dangerous thing to do because if you switch\
	to another branch you will lose your changes and it can be difficult\
	to retrieve them later from the reflog. You should probably cancel this\
	commit and create a new branch to continue.\n\
	\n\
	Do you really want to proceed with your Commit?"]
	if {[ask_popup $msg] ne yes} {
	unlock_index
	return
	}
	}

	# -- Run the commit-msg hook.
	#
	set fd_ph [githook_read commit-msg $msg_p]
	if {$fd_ph eq {}} {
	commit_writetree $curHEAD $msg_p
	return
	}

	ui_status [mc "Calling commit-msg hook..."]
	set pch_error {}
	fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
	fileevent $fd_ph readable \
	[list commit_commitmsg_wait $fd_ph $curHEAD $msg_p]
	}

	proc commit_commitmsg_wait {fd_ph curHEAD msg_p} {
	global pch_error

	append pch_error [read $fd_ph]
	fconfigure $fd_ph -blocking 1
	if {[eof $fd_ph]} {
	if {[catch {close $fd_ph}]} {
	catch {file delete $msg_p}
	ui_status [mc "Commit declined by commit-msg hook."]
	hook_failed_popup commit-msg $pch_error
	unlock_index
	} else {
	commit_writetree $curHEAD $msg_p
	}
	set pch_error {}
	return
	}
	fconfigure $fd_ph -blocking 0
	}

	proc commit_writetree {curHEAD msg_p} {
	ui_status [mc "Committing changes..."]
	set fd_wt [git_read write-tree]
	fileevent $fd_wt readable \
	[list commit_committree $fd_wt $curHEAD $msg_p]
	}

	proc commit_committree {fd_wt curHEAD msg_p} {
	global HEAD PARENT MERGE_HEAD commit_type commit_author
	global current_branch
	global ui_comm selected_commit_type
	global file_states selected_paths rescan_active
	global repo_config
	global env

	gets $fd_wt tree_id
	if {[catch {close $fd_wt} err]} {
	catch {file delete $msg_p}
	error_popup [strcat [mc "write-tree failed:"] "\n\n$err"]
	ui_status [mc "Commit failed."]
	unlock_index
	return
	}

	# -- Verify this wasn't an empty change.
	#
	if {$commit_type eq {normal}} {
	set fd_ot [git_read cat-file commit $PARENT]
	fconfigure $fd_ot -encoding binary -translation lf
	set old_tree [gets $fd_ot]
	close $fd_ot

	if {[string equal -length 5 {tree } $old_tree]
	&& [string length $old_tree] == 45} {
	set old_tree [string range $old_tree 5 end]
	} else {
	error [mc "Commit %s appears to be corrupt" $PARENT]
	}

	if {$tree_id eq $old_tree} {
	catch {file delete $msg_p}
	info_popup [mc "No changes to commit.

	No files were modified by this commit and it was not a merge commit.

	A rescan will be automatically started now.
	"]
	unlock_index
	rescan {ui_status [mc "No changes to commit."]}
	return
	}
	}

	if {[info exists commit_author]} {
	set old_author [commit_author_ident $commit_author]
	}
	# -- Create the commit.
	#
	set cmd [list commit-tree $tree_id]
	if {[is_config_true commit.gpgsign]} {
	lappend cmd -S
	}
	foreach p [concat $PARENT $MERGE_HEAD] {
	lappend cmd -p $p
	}
	lappend cmd <$msg_p
	if {[catch {set cmt_id [eval git $cmd]} err]} {
	catch {file delete $msg_p}
	error_popup [strcat [mc "commit-tree failed:"] "\n\n$err"]
	ui_status [mc "Commit failed."]
	unlock_index
	unset -nocomplain commit_author
	commit_author_reset $old_author
	return
	}
	if {[info exists commit_author]} {
	unset -nocomplain commit_author
	commit_author_reset $old_author
	}

	# -- Update the HEAD ref.
	#
	set reflogm commit
	if {$commit_type ne {normal}} {
	append reflogm " ($commit_type)"
	}
	set msg_fd [open $msg_p r]
	setup_commit_encoding $msg_fd 1
	gets $msg_fd subject
	close $msg_fd
	append reflogm {: } $subject
	if {[catch {
	git update-ref -m $reflogm HEAD $cmt_id $curHEAD
	} err]} {
	catch {file delete $msg_p}
	error_popup [strcat [mc "update-ref failed:"] "\n\n$err"]
	ui_status [mc "Commit failed."]
	unlock_index
	return
	}

	# -- 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]}
	catch {file delete [gitdir CHERRY_PICK_HEAD]}

	# -- Let rerere do its thing.
	#
	if {[get_config rerere.enabled] eq {}} {
	set rerere [file isdirectory [gitdir rr-cache]]
	} else {
	set rerere [is_config_true rerere.enabled]
	}
	if {$rerere} {
	catch {git rerere}
	}

	# -- Run the post-commit hook.
	#
	set fd_ph [githook_read post-commit]
	if {$fd_ph ne {}} {
	global pch_error
	set pch_error {}
	fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
	fileevent $fd_ph readable \
	[list commit_postcommit_wait $fd_ph $cmt_id]
	}

	$ui_comm delete 0.0 end
	$ui_comm edit reset
	$ui_comm edit modified false
	if {$::GITGUI_BCK_exists} {
	catch {file delete [gitdir GITGUI_BCK]}
	set ::GITGUI_BCK_exists 0
	}

	if {[is_enabled singlecommit]} { do_quit 0 }

	# -- 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_ -
	T_ -
	D_ {
	unset file_states($path)
	catch {unset selected_paths($path)}
	}
	DO {
	set file_states($path) [list _O [lindex $s 1] {} {}]
	}
	AM -
	AD -
	AT -
	TM -
	TD -
	MM -
	MT -
	MD {
	set file_states($path) [list \
	_[string index $m 1] \
	[lindex $s 1] \
	[lindex $s 3] \
	{}]
	}
	}
	}

	display_all_files
	unlock_index
	reshow_diff
	ui_status [mc "Created commit %s: %s" [string range $cmt_id 0 7] $subject]
	}

	proc commit_postcommit_wait {fd_ph cmt_id} {
	global pch_error

	append pch_error [read $fd_ph]
	fconfigure $fd_ph -blocking 1
	if {[eof $fd_ph]} {
	if {[catch {close $fd_ph}]} {
	hook_failed_popup post-commit $pch_error 0
	}
	unset pch_error
	return
	}
	fconfigure $fd_ph -blocking 0
	}

	proc commit_author_ident {details} {
	global env
	array set author $details
	set old [array get env GIT_AUTHOR_*]
	set env(GIT_AUTHOR_NAME) $author(name)
	set env(GIT_AUTHOR_EMAIL) $author(email)
	set env(GIT_AUTHOR_DATE) $author(date)
	return $old
	}
	proc commit_author_reset {details} {
	global env
	unset env(GIT_AUTHOR_NAME) env(GIT_AUTHOR_EMAIL) env(GIT_AUTHOR_DATE)
	if {$details ne {}} {
	array set env $details
	}
	}